LaplacesDemon/0000755000176200001440000000000015145103447012765 5ustar liggesusersLaplacesDemon/README0000644000176200001440000000302415144316355013647 0ustar liggesusersLaplacesDemon was initially developed and uploaded to CRAN by Byron Hall, the owner of Statisticat, LLC. Later on, the maintainer of the package changed to Martina Hall. The last version available on CRAN from the original authors and maintainers was version 13.03.04, which was removed from CRAN on 2013-07-16 at the request of the maintainer. After removal from CRAN, the development of LaplacesDemon continued for some time on GitHub under the name of Statisticat LLC (presumably still run by Byron Hall). The last commit by Statisticat for LaplacesDemon on GitHub was performed on 25. Mar 2015. After that Statisticat deleted their account on GitHub and ceased further development of the package. As Statisticat could not be reached, neither by e-mail nor by snail-mail (the latter was attempted by Rasmus Bååth), Henrik Singmann took over as maintainer of LaplacesDemon in July 2016 with the goal to resubmit the package to CRAN (as version 16.0.x). Henrik Singmann does not actively continue the development of LaplacesDemon but only retains it on CRAN in its current state. Note that in order to resubmit the package to CRAN all links to the now defunct website of Statisticat (formerly: http://www.bayesian-inference.com) were replaced with links to versions of this website on the web archive (https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index). To contribute to the development of LaplacesDemon or discuss the development please visit its new repository: https://github.com/LaplacesDemonR/LaplacesDemon LaplacesDemon/MD50000644000176200001440000004257415145103447013311 0ustar liggesusersa6e41063c7d5197f04babc6b20ffa0e8 *CHANGELOG 83fd529851d792f17db1e71173b6ba5f *DESCRIPTION c3cc24977ea0e5e80769e2e325f7d3dd *LICENSE e539630e54f7c3a13050b5e65cf2911f *NAMESPACE c27d786c909d4ef57c05712d9c9bf726 *R/ABB.R 33c69e8d43c7784acc22eb1bc6d8f649 *R/AcceptanceRate.R 16c3489c056d2f39d592c9f471c7ac15 *R/BMK.Diagnostic.R bf679430138de042faeb49c727d7ca28 *R/BayesFactor.R 4cfc42508f0575688df7d00c25b35332 *R/BayesTheorem.R 3e16da373bf32805248dd253e771b1b9 *R/BayesianBootstrap.R e6c64fa5d4905d4e34fee438c42c55a3 *R/BigData.R 06b72f285c444517b28319c52e0ded8a *R/Blocks.R 9406cc4858bbef6035dd2b9b84c134c3 *R/CSF.R 4000ce28c60fcd1d62421d70d7f4275c *R/CenterScale.R db1c9cd2471a7032e01682e7284195cb *R/Combine.R 13e0dcae66e99e651234072c10e290e5 *R/Consort.R 647cabec19a93f87a91c637f05f33e68 *R/ESS.R b168c30a6ae2eddbfdac832ca05602e0 *R/Elicitation.R a68a745208a14ef5b6aeaf1f693359ed *R/GIV.R 5c54dce83e14826f5b5b0ace17e77cb7 *R/Gelfand.Diagnostic.R 0637bd92d91cf891eaa9d5147fa70f68 *R/Gelman.Diagnostic.R 99e03cf3ac853f606ecffd2548b824a2 *R/Geweke.Diagnostic.R 7da089c48573392048753c70b61bda44 *R/Hangartner.Diagnostic.R 075835fabdf43666c3a0a79e1c5c32bf *R/Heidelberger.Diagnostic.R 26a3577ae887a6b6ed17b86074318471 *R/IAT.R a894704d53804f8a36e174663bd9177d *R/Importance.R 222919560e549175ca42bb8d16356b32 *R/IterativeQuadrature.R 881b01c39994e322e6b49e3e38906578 *R/Juxtapose.R ef700197a6b8c3aa70d274db0fbbe3b2 *R/KLD.R 1b8fc355ef16d1def6ae5dee8c930315 *R/KS.Diagnostic.R 0a03263af55aa6f641ec8d7f74298c32 *R/LML.R 5ff95fc03645f50327404df3d8fc522c *R/LPL.interval.R 17a21a580b77a4489563f49b2493b8a2 *R/LaplaceApproximation.R e1f3b8127eccc4e12889effe1826faf0 *R/LaplacesDemon.R c246715bd85cd2e3d69c4d7859694a98 *R/LaplacesDemon.RAM.R 9dc38fc6015363f135da6d22ac1face2 *R/LaplacesDemon.hpc.R 7b0edb335f0152dd04fad7644da41eb2 *R/Levene.Test.R 8e9f9a046445ce624a2b9311dd01f8a0 *R/LossMatrix.R 6b4e9df909700bc9e4c10cdbf65857cf *R/MCSE.R 1513c1298e07ae61a4709dc263462814 *R/MISS.R 48fce694d14a5acf05f986ec27efc070 *R/Math.R 88b122f98bea5e1a05821c5858895580 *R/Matrices.R 3356cce03a44c7ad59c03f578df7d1fe *R/MinnesotaPrior.R 80e0b0a1023ac505a329e85bd12cc623 *R/Mode.R 463884bbfa7aaf99cb05238a4f878928 *R/Model.Spec.Time.R b50f0448874be2c5cc3d494dd53aebb0 *R/PMC.R 860f1680f5e20304a6d8295e73c7d596 *R/PMC.RAM.R 0f6b66377faac92de49fc7790dd29a60 *R/PosteriorChecks.R 44b08287bfbbb71f6307bb66d0042657 *R/Precision.R 2db8f76c681887ff93646604270d2757 *R/Raftery.Diagnostic.R f1c5dd2edb81dde788b9fef8a52366d5 *R/RejectionSampling.R e2776a943e7e065e022564eca2026460 *R/SIR.R a2a436805b18d74437a13ec2a6d811b7 *R/SensitivityAnalysis.R b5ff9c1b139e9c82e93798684ed61c21 *R/Stick.R d60aba167ea17987d8bd162965b6547a *R/Thin.R 2b5168e39cf167a87d9e49e7c48301c8 *R/Validate.R 8e2deeecda6269fc0c91acd260bddbe1 *R/VariationalBayes.R 3685568f1bf2e3aa96acae47785e7cff *R/WAIC.R df946a98614210753309350e6edf88a6 *R/as.covar.R 0891231cd9133c691805d11498d786ec *R/as.initial.values.R a4773335a49ce7ca9b4bb1dff26c0329 *R/as.parm.names.R 7e310280878dbaee151e88092fae7e31 *R/as.ppc.R ec8ac80f70315dafb8a46f6840696129 *R/burnin.R 67e406d5e8b2c9d32ad46565cc5c4b44 *R/caterpillar.plot.R 8475e2ce9f934f7ca066972438f24ae1 *R/cond.plot.R f8a791c997679700c0b5a30370b77521 *R/de.Finetti.Game.R ada37abad692ed54eae3444e71298fd6 *R/deburn.R cab9b0751c39fd884aa4a7f1a63455f3 *R/distributions.R fd6afa6bb7ddffff64b580847ca2076f *R/hpc_server.R 6832f098d4bfef1647dbbd2a1c5ecddc *R/interval.R f6873e8d5625828f5b533aab7259e1e2 *R/is.appeased.R 8def50ae0487cb26f86ab036a54799fc *R/is.bayesian.R 526fee66db8b31c40eb2325eba171b26 *R/is.class.R 4741a4b4e3f354a60bceeea8ba97a687 *R/is.constant.R 219d16036116c4dba69dbe8e2c710653 *R/is.constrained.R 5c182030f3d5a36db4067be4d9d0c61b *R/is.data.R 6867b15b16632381a781a006cd66eb94 *R/is.model.R 1d6df244cbeb8d4a89850b8325937d50 *R/is.proper.R 7043a2fb99ac6b035efd4029e96f7a25 *R/is.stationary.R cdec4d8911803e342f04e07f06d5fcb1 *R/joint.density.plot.R 7573227df1e0c7b66c26985997849132 *R/joint.pr.plot.R af88af14a7fe0d97ee69ba2538716973 *R/log-log.R 5c9234a3f79d774f078ca1946d191b07 *R/logit.R 29ce6627e4b81b8c2cc0ad664ad4b72a *R/p.interval.R 54c5cb92a9f36cec58f342e062c33a60 *R/plot.bmk.R 5714a2228c6d62b61e41e14669cb6644 *R/plot.demonoid.R 0020558b9fe5ed2b0e315d2c1b24e2fd *R/plot.demonoid.hpc.R 1cc75c4ff7fd6ce11a56085a3f9026bd *R/plot.demonoid.ppc.R 8b9447d698344ee9e750e7aeb9234d93 *R/plot.importance.R f90ec172b129538d7b0d32d1de285fcd *R/plot.iterquad.R ad89f6d92c22c822c1f1b4ee86dbdfd9 *R/plot.iterquad.ppc.R b4912ee5f69d27a976d4ee7ebb6637d6 *R/plot.juxtapose.R 2253b7b8779f37831771a08b718a76c0 *R/plot.laplace.R 784700f5b897ffa8e8e63d406f869140 *R/plot.laplace.ppc.R 48f30f17eda0350eed2e4a50abef6cbd *R/plot.miss.R 5a091369e567f9568bce12e5cca4eea3 *R/plot.pmc.R eeef5e4e24a5e2b02487a12b0c64d8fa *R/plot.pmc.ppc.R d719e23001de040f896ad1138c4fddeb *R/plot.vb.R 47723d015f80fcdb39c4a5398b5bf804 *R/plot.vb.ppc.R 0bec9bb666dd719385439071e1d7e9bf *R/plotMatrix.R 125a25ee3396798ddab3c89180601ec3 *R/plotSamples.R 88aaaba5ab6bc0ec8eef7bc5640c1d86 *R/predict.demonoid.R 30d1ec069dc30bfc4ff9431968798133 *R/predict.iterquad.R 593cc533f2cb78682691c6ea53a2c7ae *R/predict.laplace.R 98806ad7d87e1aa7822f0cbf06f1ce18 *R/predict.pmc.R ef4e57896ea51ccfc86a6666ec8d7bda *R/predict.vb.R 4cfc6f9b4baf7618ebf8e08e0fae66a9 *R/print.demonoid.R 5027826cdba8371fa7ef4e9c829f990d *R/print.heidelberger.R 92a5506afcf8f918b0ddbfd57abd9b39 *R/print.iterquad.R 55cb450fdd2c7963030ada4acaf22f66 *R/print.laplace.R 6ca561612120cb1b0e6962ed50ebf5ea *R/print.miss.R ccf37b4ad7d8deda0e1d213b739d1acc *R/print.pmc.R 0b8b7e4f00448e9fd126a67bf6550136 *R/print.raftery.R 40990c9caa5cf8f0ade04630aead77bb *R/print.vb.R ce33ecde26a90181dcafbdb8b7e5d9f2 *R/summary.demonoid.ppc.R 50986289a74f9f207b9757cb0804e8f2 *R/summary.iterquad.ppc.R 309c7fc2f32af896f0bb94a1fc22c248 *R/summary.laplace.ppc.R a071b4a06aff5cbab6f2774fd360c73c *R/summary.miss.R 3bb614c076befdbf6348e8d72c58797f *R/summary.pmc.ppc.R 33f8ac1d7bf837189ddf8e1524b5a37a *R/summary.vb.ppc.R ec6cf1febf0e6b5ec0d94642bf01b06c *README c8cd3f6f68b4778af57c5e04c4e368d0 *build/partial.rdb ae3eac1866428cf2d23ab74ca04deb7a *build/vignette.rds 1df2e11a174cec53f7e0200228674659 *data/demonchoice.txt 834b37bf46a2fa1ae99ada3fecccdf03 *data/demonfx.txt d6ad9b8e2f294fb7335d96d0dcbf86be *data/demonsessions.txt 330bc28f86c3ebcfb391f73a1611d61b *data/demonsnacks.txt 23247d75cfea5c7e5a83bd2feb269e9f *data/demontexas.txt e483cccc0155f04010f36a63b5b555a9 *inst/CITATION 33f3d2d3432c91edffada5f0911f70d6 *inst/doc/BayesianInference.Stex 9f4af6a4633392afcf420834f980bc61 *inst/doc/BayesianInference.pdf 293d2a5a0705b26feaa358d186fc9a10 *inst/doc/Examples.Stex e25c32bf1e064290eff5b01cfd6f8597 *inst/doc/Examples.pdf 72435861066256b6de07dd4dec08223d *inst/doc/LaplacesDemonTutorial.R 0ca4408d6303f319224744110e730ca1 *inst/doc/LaplacesDemonTutorial.Stex 3eaef4cd1ce1c764b446f714058a7c5f *inst/doc/LaplacesDemonTutorial.pdf dee4eb6dd6f6acadd1ca8369e8617ad2 *man/ABB.Rd df692f6b354f6a95e8336725ad80ac07 *man/AcceptanceRate.Rd b0457cd4a7fd0b608efe58647460c8fa *man/BMK.Diagnostic.Rd 058be3e7c1cfac872ebcbba659d0aee3 *man/BayesFactor.Rd a46e94e02f43879570d853562ee8012d *man/BayesTheorem.Rd 8b390301ab28fcc784979ce878e832e6 *man/BayesianBootstrap.Rd 7791838fb74c6b2ad0acbc9abf3fc586 *man/BigData.Rd 07cddbe3d360f6e55a04de1ef8ec56eb *man/Blocks.Rd 56f8712085c81e62147132301014e508 *man/CSF.Rd 93adad157336bf6b00a3a6a3156dd538 *man/CenterScale.Rd e231ce9e6cfbd227830e5dde813bf27b *man/Combine.Rd c2c8e700bac34a29fc2a195aa2ab0b26 *man/Consort.Rd 6e13486656e62d851829c7d9e49a30e6 *man/ESS.Rd e2863a867e9efdb22581a5ed4986fbac *man/Elicitation.Rd a0a512d10600a2a45fff9461933f3467 *man/GIV.Rd e4862c4a7d5470387ab985ccd627b670 *man/Gelfand.Diagnostic.Rd 8d45e3db5f15b15f7641cef9a75c8d43 *man/Gelman.Diagnostic.Rd 2c7373a2e83aa713fae179d515190a8d *man/Geweke.Diagnostic.Rd 25ad23fa396172b5f84135790722fbee *man/Hangartner.Diagnostic.Rd f50a5fde5e6e3ba6fd063d71eb982b2e *man/Heidelberger.Diagnostic.Rd 270d64ae12e5d64cafca6765799a2359 *man/IAT.Rd 6a5d40e02805f15c89534e51c048271e *man/Importance.Rd 9cc1b2d94f2364550a9c1a5d2c736950 *man/IterativeQuadrature.Rd c7e1ff128c999733877a3d0344e52a0d *man/Juxtapose.Rd e5f7d3ced33891fe96f153b1d252a3de *man/KLD.Rd 4e480ecda2ba58872fdf501300873919 *man/KS.Diagnostic.Rd e76bb5b26cccf3d4b585c5e878d84416 *man/LML.Rd 16fc4add45e330e025fa24e97b82d44f *man/LPL.interval.Rd 1d8a97b9d07674affe038a4aab186c1a *man/LaplaceApproximation.Rd 0d7ba0135dbed77445d91f057e98a9dd *man/LaplacesDemon-package.Rd 412efcfac3670885f17d839b17432455 *man/LaplacesDemon.RAM.Rd f784789d2257927b61f7c38b31334f88 *man/LaplacesDemon.Rd e77a4c020e440299412993291a0df8d3 *man/Levene.Test.Rd f57da8f40e21f170e3c0ceecadba60c9 *man/LossMatrix.Rd fee8f6e1ae1d1b1785b7672a7dbc5705 *man/MCSE.Rd 7bd62da7bd65db2b719575ee5d545fcd *man/MISS.Rd 8a03cd8ac34e9a92d4d4dcf455bbd55b *man/Math.Rd b70f6261f97425e5ee0990864947b452 *man/Matrices.Rd be2aeb8c2d6a4cf536b75c28ed813dbe *man/MinnesotaPrior.Rd 2c987b586fe6fd2e582bfe177d6221a7 *man/Mode.Rd 2974d9af3352421ba9fbfe3aafe82228 *man/Model.Spec.Time.Rd b1b15a9350e1b3a95b6c164c1b83b753 *man/PMC.RAM.Rd 1ae3124e67dc1b9f21b8b40f03718c59 *man/PMC.Rd f3c73071f9e999d79dddae8c322c5b26 *man/PosteriorChecks.Rd 2625e457f037c451e26f9e1e88e7aa31 *man/Precision.Rd 38026b439e2aeaa96d7a3d2c04d19464 *man/Raftery.Diagnostic.Rd 4a1c5834368c9069d3eea653fe793f4c *man/RejectionSampling.Rd 2fae130002d25f47ab3aca81bd52bbe1 *man/SIR.Rd dcb94310c9ac2180a3d177e5d5b34b78 *man/SensitivityAnalysis.Rd ecffa470f4de610914cdca4bb0380150 *man/Stick.Rd 2c5780c2e4a52b28d17d53402fadd299 *man/Thin.Rd 73974a5c29c3d8949d9db16a5e9c0b64 *man/Validate.Rd 19524bf685496ffa70f1379faf1269ac *man/VariationalBayes.Rd b1b188179fe2b028089393e26f5a1865 *man/WAIC.Rd 8e758fcb68dcea715f1940abb2933b14 *man/as.covar.Rd 8d3c086262b548b852ec1c995fcffc3c *man/as.initial.values.Rd 167f4b27778ec8de48b2fa2659de5e55 *man/as.parm.names.Rd 9118b34e19825c77d4730c50b51ea5c6 *man/as.ppc.Rd 1be80144400d2cfb15511a2e69ffb826 *man/burnin.Rd 617619dab0296186189cdb58df134ad0 *man/caterpillar.plot.Rd 9c33224960655e76af15af0c4d1b082e *man/cond.plot.Rd a0d30de161387f71a2c09d3680fde234 *man/data.demonchoice.Rd c2b65932b631181c58478ca8c721d2f5 *man/data.demonfx.Rd 3d67886d0b20296236092b8d399431bb *man/data.demonsessions.Rd 049f783a38a5409bece9ea7749093561 *man/data.demonsnacks.Rd 7f54c434c1c112a6e04d4da1369f14eb *man/data.demontexas.Rd 5d5c4c0ccbee8fc2fae3a988acb42b10 *man/de.Finetti.Game.Rd 6cc587ea3b78c0ad3b67c2803462397a *man/deburn.Rd f67df8bea0f85fad2186515ce870b513 *man/dist.Asymmetric.Laplace.Rd d04ac98e83092888555213d396dbe958 *man/dist.Asymmetric.Log.Laplace.Rd bd27bbdc8240353c675c7d2ce65b76ac *man/dist.Asymmetric.Multivariate.Laplace.Rd ff8b5df7d7ed834af0d2c431f8cb23b4 *man/dist.Bernoulli.Rd 48030d2d9606b03dd0a7811d24e19fab *man/dist.Categorical.Rd 2e900990909215458a406d18f60fe701 *man/dist.ContinuousRelaxation.Rd d604e24475b87c66611319b3eceee3b9 *man/dist.Dirichlet.Rd d9cd7d26f02a840307e91c5d0149d7ae *man/dist.Generalized.Pareto.Rd 0e77f49bdf5e9b88d9850bc1ef7c96b4 *man/dist.Generalized.Poisson.Rd 604334d0073b5cabfbe4f4bcc66bcfd4 *man/dist.HalfCauchy.Rd 45131dec4a0d835b4a685496a83aef89 *man/dist.HalfNorm.Rd 8cfcc802cff2ceb89b478267ddb9f91a *man/dist.Halft.Rd 7d78ce8531bada4d97399b2ca4f220c9 *man/dist.Horseshoe.Rd 34d6c5b2631bd0052c7e6c0809eb3c63 *man/dist.HuangWand.Rd 960b2a17e2a50b5a2d880bc73a26effe *man/dist.Inverse.Beta.Rd c7df184388cf9206fdfe888f69518606 *man/dist.Inverse.ChiSquare.Rd d565ff068090e3407765990cadfb18c7 *man/dist.Inverse.Gamma.Rd 16b1be2b41f8a6914d6a0f8fc28d3f34 *man/dist.Inverse.Gaussian.Rd 6b36c836f1da2741e7acb5b4b042eed0 *man/dist.Inverse.Matrix.Gamma.Rd 10ae67bf13ddf292182bf6fd7d7fd7d2 *man/dist.Inverse.Wishart.Cholesky.Rd 94cfa166b6356b5e7cfc8bb33f1ef0c4 *man/dist.Inverse.Wishart.Rd ed6808349666a415ea41e0273a8b50ce *man/dist.LASSO.Rd 795961aa270a6a7411fdfd4e0b8f43d1 *man/dist.Laplace.Mixture.Rd cb6b15a47a90ae7e8606f4287340d2ba *man/dist.Laplace.Precision.Rd c0def495bae5dc1cb20064c005e1e138 *man/dist.Laplace.Rd 1f0314af551b04cf5744707500639805 *man/dist.Log.Laplace.Rd dcb1129491c7949fd54b40ec6e5b7252 *man/dist.Log.Normal.Precision.Rd 83c1ffcf622a774d544b4810beecf4bd *man/dist.Matrix.Gamma.Rd ebfbc075768f85c0535322d16f8c9270 *man/dist.Matrix.Normal.Rd 0d58194c0c3190aeda98d50bfd481e20 *man/dist.Multivariate.Cauchy.Cholesky.Rd dd499dfd8752e11ad407b05a116f5716 *man/dist.Multivariate.Cauchy.Precision.Cholesky.Rd 89bc191e476f5f0743212aaabd16dd7f *man/dist.Multivariate.Cauchy.Precision.Rd 94b35e13f25f1506d9789a3c95ec0357 *man/dist.Multivariate.Cauchy.Rd 4426ef90c29e52af230f4602f92e5639 *man/dist.Multivariate.Laplace.Cholesky.Rd fe4cfc699c3247569ea508edbf07e677 *man/dist.Multivariate.Laplace.Rd 630d1651cd7920c42e67abc09c4f75e7 *man/dist.Multivariate.Normal.Cholesky.Rd dc0b9c06ffb7a4a02b81667b40715154 *man/dist.Multivariate.Normal.Precision.Cholesky.Rd 3b78a8d82dd5431c3a36a261bf4b36f6 *man/dist.Multivariate.Normal.Precision.Rd 52b8da12db576f5d9b62d7c8e1b807d1 *man/dist.Multivariate.Normal.Rd 17afb3be6ae13f0c00278238c0f4281f *man/dist.Multivariate.Polya.Rd 94ca34a46443ca8326165c0be51f6fe6 *man/dist.Multivariate.Power.Exponential.Cholesky.Rd 259d4360d0621f58a9a4242d07548685 *man/dist.Multivariate.Power.Exponential.Rd d3bc292f1881f7bf207de93e778da1eb *man/dist.Multivariate.t.Cholesky.Rd d534b5f68889154a9175eca80dbff4e3 *man/dist.Multivariate.t.Precision.Cholesky.Rd 5ef346c8fd2710f7a18834501acf6368 *man/dist.Multivariate.t.Precision.Rd 1f34a367d1411e4644a6340ea927b0fd *man/dist.Multivariate.t.Rd 414af101325ba49e70948414f5954201 *man/dist.Normal.Inverse.Wishart.Rd a7eef10a6c76b020efd5cc9425aae19b *man/dist.Normal.Laplace.Rd 163374e6f492534b1bc1845621b53c00 *man/dist.Normal.Mixture.Rd 2596090279ba2fbd398236459fa8f41b *man/dist.Normal.Precision.Rd cfc56d66ad1fd8dd610985e54de44262 *man/dist.Normal.Variance.Rd 96e7e5283fbe90d57be85ab43d4930eb *man/dist.Normal.Wishart.Rd 72c8c7cb14754e43fe9974b2e2a29ebf *man/dist.Pareto.Rd 5fcb98c6cf39fae47a8a8dc0976764d5 *man/dist.Power.Exponential.Rd 07dc265db23baad50bac3401c9ed1c0f *man/dist.Scaled.Inverse.Wishart.Rd 986481de8e2aa89af6e9e50b1578cfb6 *man/dist.Skew.Discrete.Laplace.Rd 58a8f716683dfcad30354e8f0e583c4b *man/dist.Skew.Laplace.Rd ab0d429d04499cf34becf57b033d6e6f *man/dist.Stick.Rd 54361d8e17eb1b6c3f2ce77a0dac5d0d *man/dist.Student.t.Precision.Rd ac577a64ff349abddacd2d3bfaf7d463 *man/dist.Student.t.Rd 514fe2d9feed3c06ff2dcdd0bd8b4552 *man/dist.Truncated.Rd 9937c2416b1399be5d937177e18ce4b1 *man/dist.Wishart.Cholesky.Rd 19cac62fd4c939c67c4aae6fb1e51ff5 *man/dist.Wishart.Rd 004f05aec32fc2137d72869602742d55 *man/dist.YangBerger.Rd 0dd28ec1bf0b7a91408da311a101a8e0 *man/dist.Zellner.Rd 33b65d62db4c2bd2e1542671618b5f06 *man/hpc_server.Rd 906d577819fd88323643f5fc83e04b8b *man/interval.Rd 23578e1d16a092b88b30ff8425840192 *man/is.appeased.Rd c120dff3e635bd38617c5f0ef345e050 *man/is.bayesian.Rd 6db4d051e7842fcfb37f20db58ac137f *man/is.class.Rd 348f1eaa7f93b942ed5b0e19cfb1c56c *man/is.constant.Rd a0a0220741ba0dd3b1fcdb580846709e *man/is.constrained.Rd deea69065ce47aa5944628989e20a779 *man/is.data.Rd 1b4970b52f742b9abc2a97292f2f73e2 *man/is.model.Rd da5db607d1a0ef7f450a0137fa0b2e22 *man/is.proper.Rd 35d3852516abe02b5027ae0b91a02e16 *man/is.stationary.Rd 5ef308f32c3c4615cad72ec7c2b14141 *man/joint.density.plot.Rd 5b0341238b6369ad65ed72be73ebadfa *man/joint.pr.plot.Rd eb0bd2d521aabaea20730ecc73f3f106 *man/log-log.Rd 72db795ef19f383328b79d3a86de5698 *man/logit.Rd 83fe3964936c1a4bde11f3dcb83ed893 *man/p.interval.Rd b503d3911867246ae35265eb4d07459c *man/plot.bmk.Rd 6da412751938621a56b5c3b0f5700c4d *man/plot.demonoid.Rd f246d90adf2d4a390e17bb018f177a05 *man/plot.demonoid.ppc.Rd c841efc816e2011567eeb7ff1f9baf0c *man/plot.importance.Rd 69fe9c1b9f5f85c1618320d4ab8873f8 *man/plot.iterquad.Rd 434b1cdb2145b051a2ecc54765ff1213 *man/plot.iterquad.ppc.Rd b830448fee2b63642d9f16edf6711e98 *man/plot.juxtapose.Rd 6933c6a171d1cf8f41bfcec08a2b0f7f *man/plot.laplace.Rd de5aa85b2a05db1c433075f057029a88 *man/plot.laplace.ppc.Rd 717396265047887c7263bf9072d5d2bb *man/plot.miss.Rd 2cb39048b45a7fb5660a9ed65a565498 *man/plot.pmc.Rd 7a65aa18a3794928e72981f8cb57a5a3 *man/plot.pmc.ppc.Rd eaa80af9ea7a52ad99155c355725d5b3 *man/plot.vb.Rd f4c73420ab7b073c8d5e3d04402f1b14 *man/plot.vb.ppc.Rd bf3e010c148cf42ef336a846dbf6f25b *man/plotMatrix.Rd 5943f54b093e18a8b4b87bb666567507 *man/plotSamples.Rd 73e80b19f77cedbdecdda9e68719b29a *man/predict.demonoid.Rd 8333861764c6f6a0ebda16056c47023a *man/predict.iterquad.Rd e52981cb7d035f175e275b3976bdba0a *man/predict.laplace.Rd 3d80a62c1c4514156903f3c60797ad63 *man/predict.pmc.Rd 3a44d5a1e493d080fbf93637be1d25cc *man/predict.vb.Rd a21dd79f3225be74c0a21c5fd4cea553 *man/print.demonoid.Rd ca910f7cb691a07d1c0e0bffaa973ca4 *man/print.heidelberger.Rd 1d99c040126feed3e698c97435f7535b *man/print.iterquad.Rd c2d2c3ba127d8628d9ff560f0ba17234 *man/print.laplace.Rd dd6b0695e8464f709d322e3552fb5fdf *man/print.miss.Rd 50a99e5bece037eceb4e9e9f05ed612a *man/print.pmc.Rd d9211103bbb0346943dc24bc10c92ba3 *man/print.raftery.Rd 1717b1c5eafba2f12712f466291ad4e0 *man/print.vb.Rd f685940a743560fcf4b2cbdb94a2a802 *man/summary.demonoid.ppc.Rd 624bc33cad83296812b06e9e372013a6 *man/summary.iterquad.ppc.Rd 10adf183b0da0c888a4d0c2c79d9a42c *man/summary.laplace.ppc.Rd 0a9649593af142a9936cdf2b53d59026 *man/summary.miss.Rd e820992cb6e82b9a381c0b2bacc4ef46 *man/summary.pmc.ppc.Rd db0827fc66da911273acdc943bd83cca *man/summary.vb.ppc.Rd 33f3d2d3432c91edffada5f0911f70d6 *vignettes/BayesianInference.Stex 293d2a5a0705b26feaa358d186fc9a10 *vignettes/Examples.Stex e17f2653401f4c24772a2fa22c55fa6b *vignettes/LDlogo.png 0ca4408d6303f319224744110e730ca1 *vignettes/LaplacesDemonTutorial.Stex 5a30e852dee126237bb5179e4215701d *vignettes/References.bib LaplacesDemon/R/0000755000176200001440000000000015144340046013163 5ustar liggesusersLaplacesDemon/R/PMC.RAM.R0000755000176200001440000000473715144316355014367 0ustar liggesusers########################################################################### # PMC.RAM # # # # The purpose of the PMC.RAM function is to estimate the RAM required to # # update a given model and data in PMC. # ########################################################################### PMC.RAM <- function(Model, Data, Iterations, Thinning, M, N) { if(missing(Model)) stop("The Model argument is required.") if(missing(Data)) stop("The Data argument is required.") Const <- 1048600 LIV <- length(Data[["parm.names"]]) LM <- length(Data[["mon.names"]]) alpha <- as.vector(object.size(matrix(rep(1/M, M), M, Iterations))) / Const Covar <- as.vector(object.size(array(0, dim=c(LIV,LIV,Iterations,M)))) / Const Data <- as.vector(object.size(Data)) / Const Deviance <- as.vector(object.size(rep(0,N))) / Const Initial.Values <- as.vector(object.size(matrix(0, M, length(Data[["parm.names"]])))) / Const LH <- as.vector(object.size(array(0, dim=c(N, Iterations, M)))) / Const LP <- as.vector(object.size(array(0, dim=c(N, Iterations, M)))) / Const Model <- as.vector(object.size(Model)) / Const Monitor <- as.vector(object.size(matrix(runif(N*LM), N, LM))) / Const Mu <- as.vector(object.size(array(0, dim=c(Iterations, LIV, M)))) / Const Posterior1 <- as.vector(object.size(array(0, dim=c(N, LIV, Iterations, M)))) / Const Posterior2 <- Posterior1[,,Iterations,1] Posterior2 <- as.vector(object.size(Posterior2)) / Const #Note: Posterior2 gets thinned, but at one point it's this large. Summary <- as.vector(object.size(matrix(0, LIV+1+LM, 7))) / Const W <- as.vector(object.size(matrix(0, N, Iterations))) / Const mem.list <- list(alpha=alpha, Covar=Covar, Data=Data, Deviance=Deviance, Initial.Values=Initial.Values, LH=LH, LP=LP, Model=Model, Monitor=Monitor, Mu=Mu, Posterior1=Posterior1, Posterior2=Posterior2, Summary=Summary, W=W, Total=sum(alpha,Covar,Data,Deviance,Initial.Values,LH,LP, Model,Monitor,Mu,Posterior1,Posterior2,Summary,W)) return(mem.list) } #End LaplacesDemon/R/summary.miss.R0000755000176200001440000000262015144316355015766 0ustar liggesusers########################################################################### # summary.miss # # # # The purpose of the summary.miss function is to summarize an object of # # class miss. # ########################################################################### summary.miss <- function(object=NULL, ...) { if(is.null(object)) stop("The object argument is NULL.") x <- object$Imp Summ <- matrix(NA, nrow(x), 7, dimnames=list(1:nrow(x), c("Mean","SD","MCSE","ESS","LB","Median","UB"))) Summ[,1] <- rowMeans(x) Summ[,2] <- sqrt(.rowVars(x)) Summ[,3] <- 0 Summ[,4] <- 0 Summ[,5] <- apply(x, 1, quantile, c(0.025), na.rm=TRUE) Summ[,6] <- apply(x, 1, quantile, c(0.500), na.rm=TRUE) Summ[,7] <- apply(x, 1, quantile, c(0.925), na.rm=TRUE) acf.temp <- matrix(1, trunc(10*log10(ncol(x))), nrow(x)) for (i in 1:nrow(x)) { ### MCSE temp <- try(MCSE(x[i,]), silent=TRUE) if(!inherits(temp, "try-error")) Summ[i,3] <- temp else Summ[i,3] <- MCSE(x[i,], method="sample.variance") ### ESS Summ[i,4] <- ESS(x[i,])} print(Summ) return(invisible(Summ)) } #End LaplacesDemon/R/BayesFactor.R0000755000176200001440000000452415144316355015526 0ustar liggesusers########################################################################### # BayesFactor # # # # The purpose of the BayesFactor function is to estimate a Bayes factor # # from two objects, either of class demonoid, laplace, or pmc. # ########################################################################### BayesFactor <- function(x) { ### Initial Checks if(missing(x)) stop("x is required.") Model.num <- length(x) for (i in 1:Model.num) { if(!identical(class(x[[i]]), "demonoid") & !identical(class(x[[i]]), "laplace") & !identical(class(x[[i]]), "pmc") & !identical(class(x[[i]]), "vb")) stop("x is not of class demonoid, laplace, pmc, or vb.") if(identical(class(x[[i]]), "laplace") & identical(x[[i]]$Converged, FALSE)) { stop("LaplaceApproximation() did not converge in ", "M[",i,"].\n", sep="")} if(identical(class(x[[i]]), "vb") & identical(x[[i]]$Converged, FALSE)) { stop("VariationalBayes() did not converge in ", "M[",i,"].\n", sep="")} if(is.na(x[[i]]$LML)) stop(cat("LML is missing in M[",i,"].", sep="")) } ### Bayes factor B <- matrix(NA, Model.num, Model.num) for (i in 1:Model.num) {for (j in 1:Model.num) { B[i,j] <- exp(x[[i]]$LML - x[[j]]$LML)}} strength <- rep(NA,6) strength[1] <- "-Inf < B <= 0.1 Strong against" strength[2] <- "0.1 < B <= (1/3) Substantial against" strength[3] <- "(1/3) < B < 1 Barely worth mentioning against" strength[4] <- "1 <= B < 3 Barely worth mentioning for" strength[5] <- "3 <= B < 10 Substantial for" strength[6] <- "10 <= B < Inf Strong for" ### Posterior Probability ML <- rep(NA, Model.num) for (i in 1:Model.num) {ML[i] <- exp(x[[i]]$LML)} Posterior.Probability <- ML / sum(ML) ### Output BF.out <- list(B=B, Hypothesis="row > column", Strength.of.Evidence=strength, Posterior.Probability=Posterior.Probability) class(BF.out) <- "bayesfactor" return(BF.out) } #End LaplacesDemon/R/LaplacesDemon.RAM.R0000755000176200001440000000550015144316355016444 0ustar liggesusers########################################################################### # LaplacesDemon.RAM # # # # The purpose of the LaplacesDemon.RAM function is to estimate the RAM # # required to update a given model and data in LaplacesDemon. # ########################################################################### LaplacesDemon.RAM <- function(Model, Data, Iterations, Thinning, Algorithm="RWM") { if(missing(Model)) stop("The Model argument is required.") if(missing(Data)) stop("The Data argument is required.") Const <- 1048600 LIV <- length(Data[["parm.names"]]) LM <- length(Data[["mon.names"]]) Covar <- 0 if(Algorithm %in% c("ADMG","AFSS","AM","AMM","DRAM","DRM","ESS","IM", "INCA","MALA","OHSS","RWM","RAM","UESS")) { ### Covariance is required Covar <- Covar + as.vector(object.size(matrix(runif(LIV*LIV), LIV, LIV))) / Const } else if(Algorithm %in% c("AGG","AM","AMM","AMWG","DRAM","DRM","INCA", "MWG","RWM","SAMWG","SMWG","USAMWG","USMWG")) { ### Variance is required Covar <- Covar + as.vector(object.size(runif(LIV))) / Const} Data <- as.vector(object.size(Data)) / Const Deviance <- as.vector(object.size(runif(round(Iterations / Thinning)))) / Const Initial.Values <- as.vector(object.size(runif(LIV))) / Const Model <- as.vector(object.size(Model)) / Const Monitor <- as.vector(object.size(matrix(runif(Iterations*LM), round(Iterations / Thinning), LM))) / Const post <- 0 if(Algorithm %in% c("AHMC","AM","DRAM","INCA","NUTS","OHSS")) post <- as.vector(object.size(matrix(runif(Iterations*LIV), Iterations, LIV))) / Const Posterior1 <- as.vector(object.size(matrix(runif(round(Iterations / Thinning)), round(Iterations / Thinning), LIV))) / Const Posterior2 <- as.vector(object.size(matrix(runif(round(Iterations / Thinning)), round(Iterations / Thinning), LIV))) / Const Summary1 <- as.vector(object.size(matrix(runif((LIV+1+LM)*7), LIV+1+LM, 7))) / Const Summary2 <- as.vector(object.size(matrix(runif((LIV+1+LM)*7), LIV+1+LM, 7))) / Const mem.list <- list(Covar=Covar, Data=Data, Deviance=Deviance, Initial.Values=Initial.Values, Model=Model, Monitor=Monitor, post=post, Posterior1=Posterior1, Posterior2=Posterior2, Summary1=Summary1, Summary2=Summary2, Total=sum(Covar,Data,Deviance,Initial.Values,Model,Monitor, post,Posterior1,Posterior2,Summary1,Summary2)) return(mem.list) } #End LaplacesDemon/R/Raftery.Diagnostic.R0000755000176200001440000000627015144316355017023 0ustar liggesusers########################################################################### # Raftery.Diagnostic # # # # The purpose of the Raftery.Diagnostic function is to perform MCMC # # diagnostics on an object of class demonoid. # ########################################################################### Raftery.Diagnostic <- function(x, q=0.025, r=0.005, s=0.95, eps=0.001) { if(missing(x)) stop("x is a required argument") if(!identical(class(x), "demonoid")) stop("x must be an object of class demonoid.") if(all(is.na(x$Posterior2))) post <- x$Posterior1 else post <- x$Posterior2 Thinning <- x$Thinning resmatrix <- matrix(nrow=ncol(post), ncol=4, dimnames=list(colnames(post), c("M", "N", "Nmin", "I"))) phi <- qnorm(0.5 * (1 + s)) nmin <- as.integer(ceiling((q * (1 - q) * phi^2) / r^2)) if(nmin > nrow(post)) resmatrix <- c("Error", nmin) else for (i in 1:ncol(post)) { quant <- quantile(post[, i, drop=TRUE], probs=q) dichot <- post[, i, drop=TRUE] <= quant kthin <- 0 bic <- 1 while (bic >= 0) { kthin <- kthin + Thinning testres <- as.vector(Thin(dichot, By=kthin)) testres <- factor(testres, levels=c(FALSE,TRUE)) newdim <- length(testres) testtran <- table(testres[1:(newdim - 2)], testres[2:(newdim - 1)], testres[3:newdim]) testtran <- array(as.double(testtran), dim=dim(testtran)) g2 <- 0 for (i1 in 1:2) { for (i2 in 1:2) { for (i3 in 1:2) { if(testtran[i1, i2, i3] != 0) { fitted <- (sum(testtran[i1, i2, 1:2]) * sum(testtran[1:2, i2, i3])) / (sum(testtran[1:2, i2, 1:2])) g2 <- g2 + testtran[i1, i2, i3] * log(testtran[i1, i2, i3]/fitted) * 2 }}}} bic <- g2 - log(newdim - 2) * 2 } finaltran <- table(testres[1:(newdim - 1)], testres[2:newdim]) alpha <- finaltran[1, 2]/(finaltran[1, 1] + finaltran[1, 2]) beta <- finaltran[2, 1]/(finaltran[2, 1] + finaltran[2, 2]) tempburn <- log((eps * (alpha + beta))/max(alpha, beta))/(log(abs(1 - alpha - beta))) nburn <- as.integer(ceiling(tempburn) * kthin) tempprec <- ((2 - alpha - beta) * alpha * beta * phi^2) / (((alpha + beta)^3) * r^2) nkeep <- as.integer(ceiling(tempprec) * kthin) iratio <- (nburn + nkeep) / nmin resmatrix[i, 1] <- nburn resmatrix[i, 2] <- nkeep + nburn resmatrix[i, 3] <- nmin resmatrix[i, 4] <- signif(iratio, digits=3) } y <- list(params=c(q=q, r=r, s=s), resmatrix=resmatrix) class(y) <- "raftery" return(y) } #End LaplacesDemon/R/is.class.R0000755000176200001440000001002115144316355015030 0ustar liggesusers########################################################################### # is.class # # # # The purpose of the is.class functions is to provide logical tests # # regarding the classes of objects. # ########################################################################### is.bayesfactor <- function(x) { bayesfactor <- FALSE if(identical(class(x), "bayesfactor")) bayesfactor <- TRUE return(bayesfactor) } is.blocks <- function(x) { if(identical(class(x), "blocks")) blocks <- TRUE return(blocks) } is.bmk <- function(x) { bmk <- FALSE if(identical(class(x), "bmk")) bmk <- TRUE return(bmk) } is.demonoid <- function(x) { demonoid <- FALSE if(identical(class(x), "demonoid")) demonoid <- TRUE return(demonoid) } is.demonoid.hpc <- function(x) { demonoid.hpc <- FALSE if(identical(class(x), "demonoid.hpc")) demonoid.hpc <- TRUE return(demonoid.hpc) } is.demonoid.ppc <- function(x) { demonoid.ppc <- FALSE if(identical(class(x), "demonoid.ppc")) demonoid.ppc <- TRUE return(demonoid.ppc) } is.demonoid.val <- function(x) { demonoid.val <- FALSE if(identical(class(x), "demonoid.val")) demonoid.val <- TRUE return(demonoid.val) } is.hangartner <- function(x) { hangartner <- FALSE if(identical(class(x), "hangartner")) hangartner <- TRUE return(hangartner) } is.heidelberger <- function(x) { heidelberger <- FALSE if(identical(class(x), "heidelberger")) heidelberger <- TRUE return(heidelberger) } is.importance <- function(x) { importance <- FALSE if(identical(class(x), "importance")) importance <- TRUE return(importance) } is.iterquad <- function(x) { iterquad <- FALSE if(identical(class(x), "iterquad")) iterquad <- TRUE return(iterquad) } is.iterquad.ppc <- function(x) { iterquad.ppc <- FALSE if(identical(class(x), "iterquad.ppc")) iterquad.ppc <- TRUE return(iterquad.ppc) } is.juxtapose <- function(x) { juxtapose <- FALSE if(identical(class(x), "juxtapose")) juxtapose <- TRUE return(juxtapose) } is.laplace <- function(x) { laplace <- FALSE if(identical(class(x), "laplace")) laplace <- TRUE return(laplace) } is.laplace.ppc <- function(x) { laplace.ppc <- FALSE if(identical(class(x), "laplace.ppc")) laplace.ppc <- TRUE return(laplace.ppc) } is.miss <- function(x) { miss <- FALSE if(identical(class(x), "miss")) miss <- TRUE return(miss) } is.pmc <- function(x) { pmc <- FALSE if(identical(class(x), "pmc")) pmc <- TRUE return(pmc) } is.pmc.ppc <- function(x) { pmc.ppc <- FALSE if(identical(class(x), "pmc.ppc")) pmc.ppc <- TRUE return(pmc.ppc) } is.pmc.val <- function(x) { pmc.val <- FALSE if(identical(class(x), "pmc.val")) pmc.val <- TRUE return(pmc.val) } is.posteriorchecks <- function(x) { posteriorchecks <- FALSE if(identical(class(x), "posteriorchecks")) posteriorchecks <- TRUE return(posteriorchecks) } is.raftery <- function(x) { raftery <- FALSE if(identical(class(x), "raftery")) raftery <- TRUE return(raftery) } is.rejection <- function(x) { rejection <- FALSE if(identical(class(x), "rejection")) rejection <- TRUE return(rejection) } is.sensitivity <- function(x) { sensitivity <- FALSE if(identical(class(x), "sensitivity")) sensitivity <- TRUE return(sensitivity) } is.vb <- function(x) { vb <- FALSE if(identical(class(x), "vb")) vb <- TRUE return(vb) } is.vb.ppc <- function(x) { vb.ppc <- FALSE if(identical(class(x), "vb.ppc")) vb.ppc <- TRUE return(vb.ppc) } #End LaplacesDemon/R/Matrices.R0000755000176200001440000011263415144316355015075 0ustar liggesusers########################################################################### # Matrices # # # # These are utility functions for matrices. # ########################################################################### as.indicator.matrix <- function(x) { n <- length(x) x <- as.factor(x) X <- matrix(0, n, length(levels(x))) X[(1:n) + n*(unclass(x)-1)] <- 1 dimnames(X) <- list(names(x), levels(x)) return(X) } as.inverse <- function(x) { if(!is.matrix(x)) x <- matrix(x) if(!is.square.matrix(x)) stop("x must be a square matrix.") if(!is.symmetric.matrix(x)) stop("x must be a symmetric matrix.") tol <- .Machine$double.eps options(show.error.messages=FALSE) xinv <- try(solve(x)) if(inherits(xinv, "try-error")) { k <- nrow(x) eigs <- eigen(x, symmetric=TRUE) if(min(eigs$values) < tol) { tolmat <- diag(k) for (i in 1:k) if(eigs$values[i] < tol) tolmat[i,i] <- 1/tol else tolmat[i,i] <- 1/eigs$values[i] } else tolmat <- diag(1/eigs$values, nrow=length(eigs$values)) xinv <- eigs$vectors %*% tolmat %*% t(eigs$vectors) } options(show.error.messages=TRUE) xinv <- as.symmetric.matrix(xinv) return(xinv) } as.parm.matrix <- function(x, k, parm, Data, a=-Inf, b=Inf, restrict=FALSE, chol=FALSE) { X <- matrix(0, k, k) if(restrict == TRUE) { X[upper.tri(X, diag=TRUE)] <- c(1, parm[grep(deparse(substitute(x)), Data[["parm.names"]])])} else { X[upper.tri(X, diag=TRUE)] <- parm[grep(deparse(substitute(x)), Data[["parm.names"]])]} if(chol == TRUE) { if(a != -Inf | b != Inf) { x <- as.vector(X[upper.tri(X, diag=TRUE)]) x.num <- which(x < a) x[x.num] <- a x.num <- which(x > b) x[x.num] <- b X[upper.tri(X, diag=TRUE)] <- x diag(X) <- abs(diag(X)) } X[lower.tri(X)] <- 0 return(X) } X[lower.tri(X)] <- t(X)[lower.tri(X)] if(a != -Inf | b != Inf) { x <- as.vector(X[upper.tri(X, diag=TRUE)]) x.num <- which(x < a) x[x.num] <- a x.num <- which(x > b) x[x.num] <- b X[upper.tri(X, diag=TRUE)] <- x X[lower.tri(X)] <- t(X)[lower.tri(X)] } if(!is.symmetric.matrix(X)) X <- as.symmetric.matrix(X) if(!exists("LDEnv")) LDEnv <- new.env() if(restrict == FALSE) { if(is.positive.definite(X)) { assign("LaplacesDemonMatrix", as.vector(X[upper.tri(X, diag=TRUE)]), envir=LDEnv)} else { if(exists("LaplacesDemonMatrix", envir=LDEnv)) { X[upper.tri(X, diag=TRUE)] <- as.vector(get("LaplacesDemonMatrix", envir=LDEnv)) X[lower.tri(X)] <- t(X)[lower.tri(X)]} else {X <- diag(k)}} } if(restrict == TRUE) { if(is.positive.definite(X)) { assign("LaplacesDemonMatrix", as.vector(X[upper.tri(X, diag=TRUE)][-1]), envir=LDEnv)} else { if(exists("LaplacesDemonMatrix", envir=LDEnv)) { X[upper.tri(X, diag=TRUE)] <- c(1, as.vector(get("LaplacesDemonMatrix", envir=LDEnv))) X[lower.tri(X)] <- t(X)[lower.tri(X)] if(!is.symmetric.matrix(X)) X <- as.symmetric.matrix(X) } else {X <- diag(k)}} } return(X) } as.positive.definite <- function(x) { eig.tol <- 1e-06 conv.tol <- 1e-07 posd.tol <- 1e-08 iter <- 0; maxit <- 100 n <- ncol(x) D_S <- x D_S[] <- 0 X <- x converged <- FALSE conv <- Inf while (iter < maxit && !converged) { Y <- X R <- Y - D_S e <- eigen(R, symmetric=TRUE) Q <- e$vectors d <- e$values p <- d > eig.tol * d[1] if(!any(p)) stop("Matrix seems negative semi-definite.") Q <- Q[, p, drop=FALSE] X <- tcrossprod(Q * rep(d[p], each=nrow(Q)), Q) D_S <- X - R conv <- norm(Y - X, "I") / norm(Y, "I") iter <- iter + 1 converged <- (conv <= conv.tol) } if(!converged) { warning("as.positive.definite did not converge in ", iter, " iterations.")} e <- eigen(X, symmetric=TRUE) d <- e$values Eps <- posd.tol * abs(d[1]) if(d[n] < Eps) { d[d < Eps] <- Eps Q <- e$vectors o.diag <- diag(X) X <- Q %*% (d * t(Q)) D <- sqrt(pmax(Eps, o.diag)/diag(X)) X[] <- D * X * rep(D, each=n)} X <- as.symmetric.matrix(X) return(X) } as.positive.semidefinite <- function(x) { if(!is.matrix(x)) x <- matrix(x) if(!is.square.matrix(x)) stop("x must be a square matrix.") if(!is.symmetric.matrix(x)) stop("x must be a symmetric matrix.") iter <- 0; maxit <- 100 converged <- FALSE while (iter < maxit && !converged) { iter <- iter + 1 out <- eigen(x=x, symmetric=TRUE) mGamma <- t(out$vectors) vLambda <- out$values vLambda[vLambda < 0] <- 0 x <- t(mGamma) %*% diag(vLambda) %*% mGamma x <- as.symmetric.matrix(x) if(is.positive.semidefinite(x)) converged <- TRUE } if(converged == FALSE) { warning("as.positive.semidefinite did not converge in ", iter, " iterations.")} return(x) } as.symmetric.matrix <- function(x, k=NULL) { if(is.vector(x)) { if(any(!is.finite(x))) stop("x must have finite values.") if(is.null(k)) k <- (-1 + sqrt(1 + 8 * length(x))) / 2 symm <- matrix(0, k, k) symm[lower.tri(symm, diag=TRUE)] <- x symm2 <- symm symm2[upper.tri(symm2, diag=TRUE)] <- 0 symm <- symm + t(symm2) } else if(is.matrix(x)) { if(!is.square.matrix(x)) stop("x must be a square matrix.") if(any(!is.finite(diag(x)))) stop("The diagonal of x must have finite values.") symm <- x x.lower.fin <- FALSE; x.upper.fin <- FALSE if(all(is.finite(x[lower.tri(x, diag=TRUE)]))) x.lower.fin <- TRUE if(all(is.finite(x[upper.tri(x, diag=TRUE)]))) x.upper.fin <- TRUE if(x.lower.fin) symm[upper.tri(x)] <- t(x)[upper.tri(x)] else if(x.upper.fin) symm[lower.tri(x)] <- t(x)[lower.tri(x)] else { new.up <- x[upper.tri(x)] new.low <- x[lower.tri(x)] new.up[which(!is.finite(new.up))] <- t(x)[lower.tri(x)][which(!is.finite(new.up))] new.low[which(!is.finite(new.low))] <- t(x)[upper.tri(x)][which(!is.finite(new.low))] if(any(!is.finite(c(new.up, new.low)))) stop("Off-diagonals in x must have finite values.") else { symm[upper.tri(symm)] <- new.up symm[lower.tri(symm)] <- new.low } } } else stop("x must be a vector or matrix.") return(symm) } .colVars <- function(X) { N <- nrow(X) Y <- X - matrix(colMeans(X), N, ncol(X), byrow=TRUE) Z <- colMeans(Y*Y)*N/{N-1} return(Z) } Cov2Cor <- function(Sigma) { if(missing(Sigma)) stop("Sigma is a required argument.") if(any(!is.finite(Sigma))) stop("Sigma must have finite values.") if(is.matrix(Sigma)) { if(!is.positive.definite(Sigma)) stop("Sigma is not positive-definite.") x <- 1 / sqrt(diag(Sigma)) R <- x * t(x * Sigma)} else if(is.vector(Sigma)) { k <- as.integer(sqrt(length(Sigma))) Sigma <- matrix(Sigma, k, k) x <- 1 / sqrt(diag(Sigma)) R <- as.vector(x * t(x * Sigma))} return(R) } CovEstim <- function(Model, parm, Data, Method="Hessian") { if(Method == "Hessian") { VarCov <- try(-as.inverse(Hessian(Model, parm, Data)), silent=TRUE) if(!inherits(VarCov, "try-error")) diag(VarCov)[which(diag(VarCov) <= 0)] <- .Machine$double.eps else { cat("\nWARNING: Failure to solve matrix inversion of ", "Approx. Hessian.\n", sep="") cat("NOTE: Identity matrix is supplied instead.\n") VarCov <- diag(length(parm))} } else if(Method == "Identity") VarCov <- diag(length(parm)) else if(Method == "OPG") { if(is.null(Data[["X"]])) stop("X is required in the data.") y <- TRUE if(is.null(Data[["y"]])) { y <- FALSE if(is.null(Data[["Y"]])) stop("y or Y is required in the data.")} if(y == TRUE) { if(length(Data[["y"]]) != nrow(Data[["X"]])) stop("length of y differs from rows in X.") } else { if(nrow(Data[["Y"]]) != nrow(Data[["X"]])) stop("The number of rows differs in y and X.")} LIV <- length(parm) VarCov <- matrix(0, LIV, LIV) for (i in 1:nrow(Data[["X"]])) { Data.temp <- Data Data.temp$X <- Data.temp$X[i,,drop=FALSE] if(y == TRUE) Data.temp$y <- Data.temp$y[i] else Data.temp$Y <- Data.temp$Y[i,] g <- partial(Model, parm, Data.temp) VarCov <- VarCov + tcrossprod(g,g)} VarCov <- as.inverse(as.symmetric.matrix(VarCov)) } else if(Method == "Sandwich") { B <- as.inverse(Hessian(Model, parm, Data)) if(is.null(Data[["X"]])) stop("X is required in the data.") y <- TRUE if(is.null(Data[["y"]])) { y <- FALSE if(is.null(Data[["Y"]])) stop("y or Y is required in the data.")} if(y == TRUE) { if(length(Data[["y"]]) != nrow(Data[["X"]])) stop("length of y differs from rows in X.") } else { if(nrow(Data[["Y"]]) != nrow(Data[["X"]])) stop("The number of rows differs in y and X.")} LIV <- length(parm) M <- matrix(0, LIV, LIV) n <- nrow(Data[["X"]]) for (i in 1:n) { Data.temp <- Data Data.temp$X <- Data.temp$X[i,,drop=FALSE] if(y == TRUE) Data.temp$y <- Data.temp$y[i] else Data.temp$Y <- Data.temp$Y[i,] g <- partial(Model, parm, Data.temp) M <- M + tcrossprod(g,g)} M <- as.symmetric.matrix(M) VarCov <- B %*% M %*% B #Bread, Meat, Bread } else cat("\nWARNING: CovEst Method is unrecognized.") return(VarCov) } GaussHermiteCubeRule <- function(N, dims, rule) { if(missing(rule)) Q <- GaussHermiteQuadRule(N) else Q <- rule if(dims == 1) return(Q) patterns_eq <- function(N, dims) { I <- matrix(1:N) for (i in 2:dims) { nf <- dim(I)[1] nc <- dim(I)[2] I2 <- cbind(kronecker(matrix(I[1, ], 1, nc), matrix(1, N, 1)), (1:N)) for (j in 2:nf) I2 <- rbind(I2, cbind(kronecker(matrix(I[j, ], 1, nc), matrix(1, N, 1)), (1:N))) I <- I2} return(I) } I <- patterns_eq(N, dims) n <- dim(I)[1] X2 <- matrix(0, n, dims) A2 <- matrix(1, n, 1) for (i in 1:n) for (j in 1:dims) { X2[i, j] <- Q$nodes[I[i, j]] A2[i, 1] <- A2[i, 1] * Q$weights[I[i, j]]} Max <- Q$weights[1] * Q$weights[round((N + 1)/2)]/15 keep <- (A2 > Max) n2 <- sum(keep) X <- matrix(0, n2, dims) A <- matrix(1, n2, 1) k <- 0 for (i in 1:n) if(keep[i]) { k <- k + 1 X[k, ] <- X2[i, ] A[k, ] <- A2[i, ]} out <- list(nodes=X, weights=as.vector(A)) class(out) <- "gausshermitecuberule" return(out) } Hessian <- function(Model, parm, Data, Interval=1e-6, Method="Richardson") { if(Method == "simple") { parm.len <- length(parm) eps <- Interval * parm H <- matrix(0, parm.len, parm.len) for (i in 1:parm.len) { for (j in i:parm.len) { x1 <- x2 <- x3 <- x4 <- parm x1[i] <- x1[i] + eps[i] x1[j] <- x1[j] + eps[j] x2[i] <- x2[i] + eps[i] x2[j] <- x2[j] - eps[j] x3[i] <- x3[i] - eps[i] x3[j] <- x3[j] + eps[j] x4[i] <- x4[i] - eps[i] x4[j] <- x4[j] - eps[j] H[i, j] <- {Model(x1, Data)[["LP"]] - Model(x2, Data)[["LP"]] - Model(x3, Data)[["LP"]] + Model(x4, Data)[["LP"]]} / {4 * eps[i] * eps[j]} } } H[lower.tri(H)] <- t(H)[lower.tri(H)] return(H) } else if(Method != "Richardson") stop("Method is unknown.") genD <- function(Model, parm, Data, Interval) { d <- 0.0001 r <- 4 v <- 2 zero.tol <- sqrt(.Machine$double.eps / 7e-7) f0 <- Model(parm, Data)[["LP"]] p <- length(parm) h0 <- abs(d*parm) + Interval*(abs(parm) < zero.tol) D <- matrix(0, length(f0), (p*(p + 3)) / 2) Daprox <- matrix(0, length(f0), r) Hdiag <- matrix(0, length(f0), p) Haprox <- matrix(0, length(f0), r) for (i in 1:p) { h <- h0 for (k in 1:r) { f1 <- Model(parm + (i == (1:p))*h, Data)[["LP"]] f2 <- Model(parm - (i == (1:p))*h, Data)[["LP"]] Daprox[,k] <- (f1 - f2) / (2*h[i]) Haprox[,k] <- (f1 - 2*f0 + f2) / h[i]^2 h <- h / v NULL} for (m in 1:(r - 1)) for (k in 1:(r - m)) { Daprox[,k] <- {Daprox[,k+1]*(4^m) - Daprox[,k]} / (4^m - 1) Haprox[,k] <- {Haprox[,k+1]*(4^m) - Haprox[,k]} / (4^m - 1) NULL} D[,i] <- Daprox[,1] Hdiag[,i] <- Haprox[,1] NULL} u <- p for (i in 1:p) { for (j in 1:i) { u <- u + 1 if(i == j) {D[,u] <- Hdiag[,i]; NULL} else { h <- h0 for (k in 1:r) { f1 <- Model(parm + (i == (1:p))*h + (j == (1:p))*h, Data)[["LP"]] f2 <- Model(parm - (i == (1:p))*h - (j == (1:p))*h, Data)[["LP"]] Daprox[,k] <- {f1 - 2*f0 + f2 - Hdiag[,i]*h[i]^2 - Hdiag[,j]*h[j]^2} / (2*h[i]*h[j]) h <- h / v} for (m in 1:(r - 1)) for (k in 1:(r-m)) { Daprox[,k] <- {Daprox[,k+1]*(4^m) - Daprox[,k]} / (4^m - 1); NULL} D[,u] <- Daprox[,1] NULL}}} invisible(D) } D <- genD(Model, parm, Data, Interval) if(1 != nrow(D)) stop("BUG! should not get here.") H <- diag(NA, length(parm)) u <- length(parm) for (i in 1:length(parm)) { for (j in 1:i) { u <- u + 1 H[i,j] <- D[,u]}} H <- H + t(H) diag(H) <- diag(H) / 2 return(H) } is.positive.definite <- function(x) { if(!is.matrix(x)) stop("x is not a matrix.") if(!is.square.matrix(x)) stop("x is not a square matrix.") if(!is.symmetric.matrix(x)) stop("x is not a symmetric matrix.") ### Deprecated Method 1 #pd <- TRUE #ed <- eigen(x, symmetric=TRUE) #ev <- ed$values #if(!all(ev >= -1e-06 * abs(ev[1]))) pd <- FALSE ### Deprecated Method 2 #eval <- eigen(x, only.values=TRUE)$values #if(any(is.complex(eval))) eval <- rep(0, max(dim(x))) #tol <- max(dim(x)) * max(abs(eval)) * .Machine$double.eps #if(all(eval > tol)) pd <- TRUE #else pd <- FALSE ### Currently Active, Method 3 eigs <- eigen(x, symmetric=TRUE)$values if(any(is.complex(eigs))) return(FALSE) if(all(eigs > 0)) pd <- TRUE else pd <- FALSE return(pd) } is.positive.semidefinite <- function(x) { if(!is.matrix(x)) stop("x is not a matrix.") if(!is.square.matrix(x)) stop("x is not a square matrix.") if(!is.symmetric.matrix(x)) stop("x is not a symmetric matrix.") eigs <- eigen(x, symmetric=TRUE)$values if(any(is.complex(eigs))) return(FALSE) if(all(eigs >= 0)) pd <- TRUE else pd <- FALSE return(pd) } is.square.matrix <- function(x) {return(nrow(x) == ncol(x))} is.symmetric.matrix <- function(x) {return(sum(x == t(x)) == (nrow(x)^2))} Jacobian <- function(Model, parm, Data, Interval=1e-6, Method="simple") { f <- Model(parm, Data)[[1]] n <- length(parm) if(Method == "simple") { df <-matrix(NA, length(f), n) for (i in 1:n) { dx <- parm dx[i] <- dx[i] + Interval df[,i] <- {Model(dx, Data)[[1]] - f} / Interval} return(df) } else if(Method == "Richardson") { d <- 0.0001 zero.tol <- sqrt(.Machine$double.eps / 7e-7) r <- 4 v <- 2 a <- array(NA, c(length(f), r, n)) h <- abs(d*parm) + Interval*(abs(parm) < zero.tol) for (k in 1:r) { for (i in 1:n) { a[,k,i] <- {Model(parm + h*(i == seq(n)), Data)[[1]] - Model(parm - h*(i == seq(n)), Data)[[1]]} / (2*h[i])} h <- h / v} for (m in 1:(r - 1)) a <- {a[,2:(r+1-m),,drop=FALSE]*(4^m) - a[,1:(r-m),,drop=FALSE]} / (4^m-1) return(array(a, dim(a)[c(1,3)])) } else stop("The", Method, "is unknown.") } logdet <- function(x) { return(2*sum(log(diag(chol(x))))) } lower.triangle <- function(x, diag=FALSE) { return(x[lower.tri(x, diag=diag)]) } read.matrix <- function(file, header=FALSE, sep=",", nrow=0, samples=0, size=0, na.rm=FALSE) { if(nrow <= 0) nrow <- length(count.fields(file)) con <- file(file, open="r") on.exit(close(con)) if(size <= 0) size <- nrow if(samples <= 0) samples <- nrow use <- sort(sample(nrow, samples)) now <- strsplit(readLines(con, 1), sep)[[1]] ncol <- length(now) if(header == TRUE) { col.names <- now read <- 1 skip <- 1 } else { col.names <- paste("X[,", 1:ncol, "]", sep="") read <- 0 skip <- 0 } seek(con, 0) X <- matrix(0, nrow=samples, ncol=ncol) rownames(X) <- use left <- nrow got <- 1 while (left > 0) { now <- matrix(scan(file=con, sep=sep, skip=skip, n=size*ncol, quiet=TRUE), ncol=ncol, byrow=TRUE) print(dim(now)) begin <- read + 1 end <- read + size want <- (begin:end)[begin:end %in% use] - read if(length(want) > 0) { nowdat <- now[want,] newgot <- got + length(want) - 1 X[got:newgot,] <- nowdat got <- newgot + 1} read <- read + size left <- left - size } colnames(X) <- col.names if(na.rm == TRUE) { num.mis <- sum(is.na(X)) if(num.mis > 0) { cat("\n", num.mis, "missing value(s) found.") cat("\n", sum(complete.cases(X)), "row(s) found with missing values.")}} return(X) } .rowVars <- function(X) { N <- ncol(X) Y <- X - matrix(rowMeans(X), nrow(X), N) Z <- rowMeans(Y*Y)*N/{N-1} return(Z) } SparseGrid <- function(J, K) { ### Initial Checks J <- max(abs(round(J)), 1) K <- max(abs(round(K)), 1) type <- "GQN" #Gauss-Hermite GQN <- function(level) { switch(level, { n <- c(0) w <- c(1) }, { n <- c(1) w <- c(0.5) }, { n <- c(0, 1.73205080756888) w <- c(0.666666666666667, 0.166666666666667) }, { n <- c(0.741963784302726, 2.3344142183389800) w <- c(0.454124145231931, 0.0458758547680685) }, { n <- c(0, 1.35562617997427, 2.85697001387281) w <- c(0.533333333333333, 0.222075922005613, 0.0112574113277207) }, { n <- c(0.616706590192594, 1.88917587775371, 3.32425743355212) w <- c(0.408828469556029, 0.0886157460419145, 0.00255578440205624) }, { n <- c(0, 1.15440539473997, 2.36675941073454, 3.75043971772574) w <- c(0.4571428571428580, 0.240123178605013000, 0.0307571239675865, 0.000548268855972219) }, { n <- c(0.539079811351375, 1.63651904243511, 2.802485861287540, 4.14454718612589) w <- c(0.373012257679077, 0.117239907661759, 0.00963522012078826, 0.000112614538375368) }, { n <- c(0, 1.02325566378913, 2.07684797867783, 3.205429002856470, 4.51274586339978) w <- c(0.406349206349207, 0.244097502894939, 0.049916406765218, 0.00278914132123177, 2.23458440077466e-05) }, { n <- c(0.484935707515498, 1.46598909439116, 2.484325841638950, 3.58182348355193, 4.859462828332310) w <- c(0.3446423349320190, 0.13548370298026700, 0.0191115805007703, 0.00075807093431222, 4.31065263071831e-06) }, { n <- c(0, 0.928868997381064, 1.87603502015485, 2.86512316064364, 3.93616660712998, 5.18800122437487) w <- c(0.369408369408370000, 0.24224029987397000, 0.066138746071057600, 0.00672028523553727, 0.000195671930271223, 8.1218497902149e-07) }, { n <- c(0.444403001944139, 1.34037519715162, 2.259464451000800, 3.22370982877010, 4.271825847932280, 5.50090170446775) w <- c(0.3216643615128300, 0.14696704804533000, 0.0291166879123641, 0.00220338068753318, 4.83718492259061e-05, 1.49992716763716e-07) }, { n <- c(0, 0.85667949351945, 1.72541837958824, 2.62068997343221, 3.56344438028163, 4.59139844893652, 5.80016725238650) w <- c(0.340992340992341, 0.237871522964136, 0.0791689558604501, 0.0117705605059965, 0.000681236350442926, 1.15265965273339e-05, 2.7226276428059e-08) }, { n <- c(0.412590457954602, 1.24268895548546, 2.088344745701940, 2.96303657983867, 3.886924575059770, 4.89693639734556, 6.08740954690129) w <- c(0.3026346268130190, 0.15408333984251400, 0.0386501088242534, 0.00442891910694741, 0.000200339553760744, 2.66099134406763e-06, 4.86816125774839e-09) }, { n <- c(0, 0.799129068324548, 1.60671006902873, 2.43243682700976, 3.28908242439877, 4.19620771126902, 5.19009359130478, 6.36394788882984) w <- c(0.3182595182595180, 0.2324622936097320, 0.0894177953998444, 0.0173657744921376, 0.00156735750354996, 5.64214640518902e-05, 5.9754195979206e-07, 8.58964989963318e-10) }, { n <- c(0.386760604500557, 1.16382910055496, 1.951980345716330, 2.76024504763070, 3.600873624171550, 4.49295530252001, 5.472225705949340, 6.63087819839313) w <- c(0.286568521238012, 0.158338372750949, 0.0472847523540141, 0.00726693760118474, 0.00052598492657391, 1.53000321624873e-05, 1.30947321628682e-07, 1.49781472316183e-10) }, { n <- c(0, 0.751842600703896, 1.50988330779674, 2.28101944025299, 3.07379717532819, 3.90006571719801, 4.77853158962998, 5.74446007865941, 6.88912243989533) w <- c(0.299538370126608, 0.226706308468979, 0.0974063711627181, 0.0230866570257112, 0.00285894606228465, 0.000168491431551339, 4.01267944797987e-06, 2.80801611793058e-08, 2.58431491937492e-11) }, { n <- c(0.365245755507698, 1.0983955180915, 1.83977992150865, 2.59583368891124, 3.37473653577809, 4.1880202316294, 5.05407268544274, 6.0077459113596, 7.13946484914648) w <- c(0.2727832346542880, 0.160685303893513, 0.0548966324802227, 0.0105165177519414, 0.00106548479629165, 5.1798961441162e-05, 1.02155239763698e-06, 5.90548847883655e-09, 4.41658876935871e-12) }, { n <- c(0, 0.71208504404238, 1.42887667607837, 2.15550276131694, 2.89805127651575, 3.66441654745064, 4.46587262683103, 5.32053637733604, 6.26289115651325, 7.38257902403043) w <- c(0.28377319275152100, 0.220941712199144000, 0.10360365727614400, 0.028666691030118500, 0.00450723542034204, 0.000378502109414268, 1.53511459546667e-05, 2.53222003209287e-07, 1.22037084844748e-09, 7.48283005405723e-13) }, { n <- c(0.346964157081356, 1.04294534880275, 1.74524732081413, 2.45866361117237, 3.18901481655339, 3.94396735065732, 4.73458133404606, 5.5787388058932, 6.51059015701366, 7.61904854167976) w <- c(0.260793063449555, 0.161739333984, 0.061506372063976, 0.013997837447101, 0.00183010313108049, 0.000128826279961929, 4.40212109023086e-06, 6.12749025998296e-08, 2.48206236231518e-10, 1.25780067243793e-13) }, { n <- c(0, 0.678045692440644, 1.35976582321123, 2.04910246825716, 2.75059298105237, 3.46984669047538, 4.21434398168842, 4.99496394478203, 5.82938200730447, 6.75144471871746, 7.84938289511382) w <- c(0.270260183572877, 0.21533371569506, 0.108392285626419, 0.0339527297865428, 0.00643969705140878, 0.000708047795481537, 4.21923474255159e-05, 1.22535483614825e-06, 1.45066128449307e-08, 4.97536860412175e-11, 2.09899121956567e-14) }, { n <- c(0.331179315715274, 0.995162422271216, 1.66412483911791, 2.34175999628771, 3.03240422783168, 3.74149635026652, 4.47636197731087, 5.24772443371443, 6.07307495112290, 6.98598042401882, 8.07402998402171) w <- c(0.250243596586935, 0.161906293413675, 0.0671963114288899, 0.0175690728808058, 0.00280876104757721, 0.000262283303255964, 1.33459771268087e-05, 3.319853749814e-07, 3.36651415945821e-09, 9.84137898234601e-12, 3.47946064787714e-15) }, { n <- c(0, 0.648471153534496, 1.29987646830398, 1.95732755293342, 2.62432363405918, 3.30504002175297, 4.00477532173330, 4.73072419745147, 5.49347398647179, 6.31034985444840, 7.21465943505186, 8.29338602741735) w <- c(0.258509740808839, 0.209959669577543, 0.112073382602621, 0.0388671837034809, 0.00857967839146566, 0.00116762863749786, 9.3408186090313e-05, 4.08997724499215e-06, 8.77506248386172e-08, 7.67088886239991e-10, 1.92293531156779e-12, 5.73238316780209e-16) }, { n <- c(0.317370096629452, 0.953421922932109, 1.593480429816420, 2.240467851691750, 2.89772864322331, 3.56930676407356, 4.26038360501991, 4.97804137463912, 5.73274717525120, 6.54167500509863, 7.43789066602166, 8.50780351919526) w <- c(0.240870115546641, 0.161459512867, 0.0720693640171784, 0.021126344408967, 0.00397660892918131, 0.000464718718779398, 3.2095005652746e-05, 1.21765974544258e-06, 2.26746167348047e-08, 1.71866492796487e-10, 3.71497415276242e-13, 9.39019368904192e-17) }, { n <- c(0, 0.622462279186076, 1.24731197561679, 1.87705836994784, 2.51447330395221, 3.16277567938819, 3.82590056997249, 4.50892992296729, 5.21884809364428, 5.96601469060670, 6.76746496380972, 7.65603795539308, 8.71759767839959) w <- c(0.248169351176485, 0.20485102565034, 0.114880924303952, 0.043379970167645, 0.0108567559914623, 0.0017578504052638, 0.000177766906926527, 1.06721949052025e-05, 3.5301525602455e-07, 5.73802386889938e-09, 3.79115000047719e-11, 7.10210303700393e-14, 1.53003899799868e-17) }) return(list(nodes=n, weights=w)) } SparseGridGetSeq <- function(J, norm) { seq.vec <- rep(0, J) a <- norm - J seq.vec[1] <- a fs <- matrix(seq.vec, nrow=1, ncol=length(seq.vec)) cnt <- 1 while (seq.vec[J] < a) { if(cnt == J) { for (i in seq(cnt - 1, 1, -1)) { cnt <- i if(seq.vec[i] != 0) { break } } } seq.vec[cnt] <- seq.vec[cnt] - 1 cnt <- cnt + 1 seq.vec[cnt] <- a - sum(seq.vec[1:(cnt - 1)]) if(cnt < J) { seq.vec[(cnt + 1):J] <- rep(0, J - cnt) } fs <- rbind(fs, seq.vec) } fs <- fs + 1 return(fs) } SparseGridKronProd <- function(n1D, w1D) { nodes <- matrix(n1D[[1]], nrow=length(n1D[[1]]), ncol=1) weights <- w1D[[1]] if(length(n1D) > 1) { for (j in 2:length(n1D)) { newnodes <- n1D[[j]] nodes <- cbind(kronecker(nodes, rep(1, length(newnodes))), kronecker(rep(1, nrow(nodes)), newnodes)) weights <- kronecker(weights, w1D[[j]]) } } return(list(nodes=nodes, weights=weights)) } sortrows <- function (A, index.return=FALSE) { if(!is.matrix(A)) { stop("SparseGrid:::sortrows expects a matrix as argument A.") } A.nrow <- nrow(A) A.ncol <- ncol(A) if(index.return == TRUE) indices <- 1:nrow(A) for (col.cnt in seq(ncol(A), 1, -1)) { tmp.indices <- order(A[, col.cnt]) A <- A[tmp.indices, , drop=FALSE] if(index.return == TRUE) indices <- indices[tmp.indices] } if(index.return == TRUE) { res <- list(x=matrix(A, nrow=A.nrow, ncol=A.ncol), ix=indices) } else res <- matrix(A, nrow=A.nrow, ncol=A.ncol) return(res) } tryCatch({ n1D <- vector(mode="list", length=K) w1D <- vector(mode="list", length=K) R1D <- rep(0, K) for (level in 1:K) { res <- eval(call(type, level)) nodes <- res$nodes weights <- res$weights R1D[level] <- length(weights) n1D[[level]] <- nodes w1D[[level]] <- weights } }, error=function(e) {cat("Error evaluating the 1D rule\n")}) minq <- max(0, K - J) maxq <- K - 1 nodes <- matrix(0, nrow=0, ncol=J) weights <- numeric(0) for (q.cnt in minq:maxq) { r <- length(weights) bq <- (-1)^(maxq - q.cnt) * choose(J - 1, J + q.cnt - K) indices.mat <- SparseGridGetSeq(J, J + q.cnt) Rq <- sapply(1:nrow(indices.mat), function(row.cnt) { prod(R1D[indices.mat[row.cnt, ]])}) Rq.sum <- sum(Rq) nodes <- rbind(nodes, matrix(0, nrow=Rq.sum, ncol=J)) weights <- c(weights, rep(0, Rq.sum)) for (j in 1:nrow(indices.mat)) { midx <- indices.mat[j, ] res <- SparseGridKronProd(n1D[midx], w1D[midx]) nodes[(r + 1):(r + Rq[j]), ] <- res$nodes weights[(r + 1):(r + Rq[j])] <- bq * res$weights r <- r + Rq[j] } nodes.sorted <- sortrows(nodes, index.return=TRUE) nodes <- nodes.sorted$x weights <- weights[nodes.sorted$ix] keep <- 1 lastkeep <- 1 if(nrow(nodes) > 1) { for (j in 2:nrow(nodes)) { if(all(nodes[j, ] == nodes[j - 1, ])) { weights[lastkeep] <- weights[lastkeep] + weights[j] } else { lastkeep <- j keep <- c(keep, j) } } } nodes <- matrix(nodes[keep, ], nrow=length(keep), ncol=J) weights <- weights[keep] } nr <- length(weights) m <- n1D[[1]] for (j in 1:J) { keep <- rep(0, nr) numnew <- 0 for (r in 1:nr) { if(nodes[r, j] != m) { numnew <- numnew + 1 keep[numnew] <- r } } if(numnew > 0) { nodes <- rbind(nodes, matrix(nodes[keep[1:numnew], ], nrow=numnew, ncol=J)) nodes[(nr + 1):(nr + numnew), j] <- 2 * m - nodes[(nr + 1):(nr + numnew), j] weights <- c(weights, weights[keep[1:numnew]]) nr <- nr + numnew } } nodes.sorted <- sortrows(nodes, index.return=TRUE) nodes <- nodes.sorted$x weights <- weights[nodes.sorted$ix] weights <- abs(weights)/sum(abs(weights)) return(list(nodes=nodes, weights=weights)) } TransitionMatrix <- function(theta.y=NULL, y.theta=NULL, p.theta=NULL) { if(!is.null(theta.y)) { theta.y <- as.vector(theta.y) N <- length(theta.y) theta.y <- as.matrix(table(theta.y[-N], theta.y[-1])) theta.y <- theta.y / rowSums(theta.y) return(theta.y) } else { N <- length(y.theta) y.theta <- as.matrix(table(From=y.theta[-N], To=y.theta[-1])) y.theta <- y.theta / rowSums(y.theta) if(!is.null(p.theta)) { if(!is.matrix(p.theta)) p.theta <- as.matrix(p.theta) if(!identical(dim(y.theta),dim(p.theta))) stop("Dimensions of p.theta differ from the matrix of y.theta.") theta.y <- y.theta * p.theta theta.y <- theta.y / rowSums(theta.y) } else p.theta <- y.theta return(p.theta) } } tr <- function(x) {return(sum(diag(x)))} upper.triangle <- function(x, diag=FALSE) { return(x[upper.tri(x, diag=diag)]) } #End LaplacesDemon/R/Math.R0000755000176200001440000001024315144316355014210 0ustar liggesusers########################################################################### # Math # # # # This is a collection of functions to facilitate math. # ########################################################################### GaussHermiteQuadRule <- function(N) { N <- abs(round(N)) i <- seq(1, N-1, by=1) d <- sqrt(i/2) Diag <- function(x, k=0) { if(!is.numeric(x) && !is.complex(x)) stop("Argument 'x' must be a real or complex vector or matrix.") if(!is.numeric(k) || k != round(k)) stop("Argument 'k' must be an integer.") if(is.matrix(x)) { n <- nrow(x); m <- ncol(x) if(k >= m || -k >= n) { y <- matrix(0, nrow=0, ncol=0) } else { y <- x[col(x) == row(x) + k] } } else { if(is.vector(x)) { n <- length(x) m <- n + abs(k) y <- matrix(0, nrow=m, ncol=m) y[col(y) == row(y) + k] <- x } else { stop("Argument 'x' must be a real or complex vector or matrix.") } } return(y) } E <- eigen(Diag(d, 1) + Diag(d, -1), symmetric=TRUE) L <- E$values V <- E$vectors inds <- order(L) x <- L[inds] V <- t(V[, inds]) w <- sqrt(pi) * V[, 1]^2 out <- list(nodes=x, weights=w) class(out) <- "gausshermitequadrule" return(out) } Hermite <- function(x, N, prob=TRUE) { N <- abs(round(N)) isBadLength <- (length(N) != 1) && (length(x) != length(N)) && (length(x) != 1) if(isBadLength == TRUE) stop(paste("Argument 'n' must be either a vector of same length", "as argument 'x',\n a single integer or 'x' must be a ", "single value!", sep="")) H <- function(x, N) { if(N <= 1) return(switch(N + 1, 1, x)) else return(x * Recall(x, N - 1) - (N - 1) * Recall(x, N - 2)) } scale <- 1 if(prob == FALSE) { x <- sqrt(2) * x scale <- 2^(N / 2)} return(scale * mapply(H, x, N)) } logadd <- function(x, add=TRUE) { x <- as.vector(x) x <- sort(x[is.finite(x)], decreasing=TRUE) x <- c(x[1], x[which(x != x[1])]) if(length(x) == 1) return(x) n <- length(x) if(add == TRUE) z <- x[1] + log(1 + sum(exp(x[-1] - x[1]))) else z <- x[1] + sum(log(1 - exp(x[-1] - x[1]))) return(z) } partial <- function(Model, parm, Data, Interval=1e-6, Method="simple") { f <- Model(parm, Data)[["LP"]] n <- length(parm) if(Method == "simple") { if(n == 1) return({Model(parm + Interval, Data)[["LP"]] - f} / Interval) df <- rep(NA, n) for (i in 1:n) { dx <- parm dx[i] <- dx[i] + Interval df[i] <- {Model(dx, Data)[["LP"]] - f} / Interval} df[which(!is.finite(df))] <- 0 return(df) } else if(Method == "Richardson") { zero.tol <- sqrt(.Machine$double.eps / 7e-7) d <- 0.0001 r <- 4 v <- 2 a <- matrix(NA, r, n) h <- abs(d*parm) + Interval*{abs(parm) < zero.tol} for (k in 1:r) { if(n == 1) a[k,] <- {Model(parm + h, Data)[["LP"]] - Model(parm - h, Data)[["LP"]]} / (2*h) else for (i in 1:n) { if((k != 1) && {abs(a[(k-1),i]) < 1e-20}) a[k,i] <- 0 else a[k,i] <- (Model(parm + h*(i == seq(n)), Data)[["LP"]] - Model(parm - h*(i == seq(n)), Data)[["LP"]]) / (2*h[i])} a[k,which(!is.finite(a[k,]))] <- 0 h <- h / v} for (m in 1:(r - 1)) a <- (a[2:(r+1-m),,drop=FALSE]*(4^m)-a[1:(r-m),,drop=FALSE])/(4^m-1) return(c(a)) } else stop("The", Method, "method is unknown.") } #End LaplacesDemon/R/MISS.R0000755000176200001440000001371215144316355014076 0ustar liggesusers########################################################################### # MISS # # # # The MISS function performs multiple imputation via sequential sampling. # ########################################################################### MISS <- function(X, Iterations=100, Algorithm="GS", Fit=NULL, verbose=TRUE) { ### Initial Checks if(missing(X)) stop("X is a required argument.") if(!is.matrix(X)) stop("X is not a matrix.") N <- nrow(X) J <- ncol(X) if(J < 2) stop("At least 2 columns in X are required.") Nmiss <- apply(X, 2, function(x) sum(is.na(x))) if(sum(Nmiss) == 0) stop("There are no missing values in X.") cat("\nNumber of Missing Values by Variable:\n") print(Nmiss) cat("\n") if(Algorithm != "GS") stop("Algorithm unknown.") for (i in 1:N) if(sum(is.na(X[i,])) == J) stop("All missing row found.") ### Parameters and Variable Type if(is.null(Fit)) { Type <- rep(1, J) parm <- list() for (j in 1:J) { uniq <- unique(X[complete.cases(X[,j]),j]) if(length(uniq) == 1) stop("Constant found.") else if(length(uniq) == 2) { if(all(c(0,1) == uniq[order(uniq)])) { ### Binary Logit or Robit Type[j] <- 2 parm[[j]] <- list(z=rep(0, sum(!is.na(X[,j]))), beta=rep(0, J), lambda=rep(1, sum(!is.na(X[,j])))) } else parm[[j]] <- list(beta=rep(0,J), sigma=0) } else { ### Linear Regression if(Algorithm == "ESS") parm[[j]] <- list(beta=rep(0,J), gamma=0, sigma=0) else parm[[j]] <- list(beta=rep(0,J), sigma=0) } } rm(uniq) } else { if(!identical(class(Fit), "miss")) stop("Fit is not an object of class miss.") Algorithm <- Fit$Algorithm parm <- Fit$parm Type <- Fit$Type} ### Observed indicator matrix O varnames <- colnames(X) O <- matrix(TRUE, N, J) O[which(is.na(X))] <- FALSE ### Initial Missing Values if(is.null(Fit)) { for (j in 1:J) if(Type[j] == 1) X[which(is.na(X[,j])),j] <- mean(X[,j], na.rm=TRUE) else X[which(is.na(X[,j])),j] <- 1 } else { if(sum(Nmiss) != length(Fit$Imp[,1])) stop("Length of Initial.Missings differs from number missing.") X[which(is.na(X))] <- Fit$Imp[,ncol(Fit$Imp)]} Imp <- matrix(0, sum(Nmiss), Iterations) ### Multiple Imputation Samplers GibbsLinReg <- function(y, obs, X) { X <- cbind(1, as.matrix(X)) Xobs <- X[obs,] yobs <- y[obs] XtX <- t(Xobs) %*% Xobs ridge <- 1e-5 penalty <- ridge * diag(XtX) if(length(penalty) == 1) penalty <- matrix(penalty) v <- as.inverse(as.symmetric.matrix(XtX + diag(penalty))) coef <- t(yobs %*% Xobs %*% v) resid <- yobs - Xobs %*% coef df <- max(sum(obs) - ncol(Xobs), 1) sigma <- sqrt(sum((resid)^2) / rchisq(1, df)) beta <- coef + {t(chol({v + t(v)} / 2)) %*% rnorm(ncol(Xobs))} * sigma imp <- X[!obs,] %*% beta + rnorm(sum(!obs)) * sigma out <- list(imp=imp, beta=beta, sigma=sigma) return(out)} GibbsRobit <- function(y, obs, X, z, beta, lambda) { X <- cbind(1, as.matrix(X)) Xobs <- X[obs,] yobs <- y[obs] n <- length(yobs) nu <- 8 mu <- Xobs %*% beta z[yobs==0] <- qnorm(runif(n, 0, pnorm(0, mu, sqrt(1/lambda))), mu, sqrt(1/lambda))[yobs==0] z[yobs==1] <- qnorm(runif(n, pnorm(0, mu, sqrt(1/lambda)),1), mu, sqrt(1/lambda))[yobs==1] W <- diag(lambda) vbeta <- as.inverse(as.symmetric.matrix(t(Xobs) %*% W %*% Xobs)) betahat <- vbeta %*% {t(Xobs) %*% W %*% z} beta <- c(rmvn(1, t(betahat), vbeta)) lambda <- rgamma(n, {nu + 1} / 2, scale=2/(nu + {z - Xobs %*% beta}^2)) mu <- X[!obs,] %*% beta eta <- invlogit(mu) imp <- rbern(length(eta), eta) out <- list(imp=imp, z=z, beta=beta, lambda=lambda) } ### Main Loop cat("\nImputation begins...\n") for (i in 1:Iterations) { cat("\nIteration:", i, " ") imp <- NULL for (j in 1:J) { if(Nmiss[j] > 0) { if(verbose == TRUE) cat(" V", j, " ", sep="") if(Algorithm == "GS" & Type[j] == 1) { out <- GibbsLinReg(y=X[,j], obs=O[,j], X=X[,-j]) parm[[j]]$beta <- out$beta parm[[j]]$sigma <- out$sigma } else if(Algorithm == "GS" & Type[j] == 2) { out <- GibbsRobit(y=X[,j], obs=O[,j], X=X[,-j], z=parm[[j]]$z, beta=parm[[j]]$beta, lambda=parm[[j]]$lambda) parm[[j]]$z <- out$z parm[[j]]$beta <- out$beta parm[[j]]$sigma <- out$sigma } X[,j][!O[,j]] <- out$imp imp <- c(imp, out$imp)} if(j == J) Imp[,i] <- imp}} cat("\n\nEstimating Posterior Modes...") PostMode <- apply(Imp, 1, Mode) cat("\nFinished.\n") out <- list(Algorithm=Algorithm, Imp=Imp, parm=parm, PostMode=PostMode, Type=Type) class(out) <- "miss" return(out) } #End LaplacesDemon/R/summary.iterquad.ppc.R0000755000176200001440000002673215144316355017424 0ustar liggesusers########################################################################### # summary.iterquad.ppc # # # # The purpose of the summary.iterquad.ppc function is to summarize an # # object of class iterquad.ppc (posterior predictive check). # ########################################################################### summary.iterquad.ppc <- function(object=NULL, Categorical=FALSE, Rows=NULL, Discrep=NULL, d=0, Quiet=FALSE, ...) { if(is.null(object)) stop("The object argument is NULL.") y <- object$y yhat <- object$yhat Deviance <- object$Deviance monitor <- object$monitor if(is.null(Rows)) Rows <- 1:length(y) if(any(Rows > length(y)) || any(Rows <= 0)) { warning("Invalid Rows argument; All rows included.") Rows <- 1:length(y)} ### Create Continuous Summary Table for y and yhat if(Categorical == FALSE) { Summ <- matrix(NA, length(y), 8, dimnames=list(1:length(y), c("y","Mean","SD","LB","Median","UB","PQ","Discrep"))) Summ[,1] <- y Summ[,2] <- round(rowMeans(yhat),3) Summ[,3] <- round(sqrt(.rowVars(yhat)),3) for(i in 1:length(y)) { Summ[i,4] <- round(quantile(yhat[i,], probs=0.025, na.rm=TRUE),3) Summ[i,5] <- round(quantile(yhat[i,], probs=0.500, na.rm=TRUE),3) Summ[i,6] <- round(quantile(yhat[i,], probs=0.975, na.rm=TRUE),3) Summ[i,7] <- round(mean(yhat[i,] >= y[i], na.rm=TRUE),3) } ### Discrepancy Statistics Concordance <- 1 - mean(({Summ[,7] < 0.025} | {Summ[,7] > 0.975}), na.rm=TRUE) Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "Chi-Square"}) { Summ[,8] <- round((y - rowMeans(yhat))^2 / .rowVars(yhat),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Chi-Square2"}) { chisq.obs <- chisq.rep <- yhat E.y <- E.yrep <- rowMeans(yhat, na.rm=TRUE) for (i in 1:nrow(yhat)) { chisq.obs[i,] <- (y[i] - E.y[i])^2 / E.y[i] chisq.rep[i,] <- (yhat[i,] - E.yrep[i])^2 / E.yrep[i] } Summ[,8] <- round(rowMeans(chisq.rep > chisq.obs, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean((Summ[,8] < 0.025) | (Summ[,8] > 0.975), na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Kurtosis"}) { kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} for (i in 1:length(y)) {Summ[i,8] <- round(kurtosis(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "L.criterion"}) { Summ[,8] <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MASE"}) { Summ[,8] <- round(abs(rowMeans(y - yhat, na.rm=TRUE) / mean(abs(diff(y)), na.rm=TRUE)), 3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MSE"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "PPL"}) { Summ[,8] <- round(.rowVars(yhat) + (d/(d+1)) * (rowMeans(yhat) - y)^2,3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Loss"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Utility"}) { Summ[,8] <- round(rowMeans(-1*(y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "RMSE"}) { Summ[,8] <- round(sqrt(rowMeans((y - yhat)^2, na.rm=TRUE)),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Skewness"}) { skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} for (i in 1:length(y)) {Summ[i,8] <- round(skewness(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "max(yhat[i,]) > max(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- max(yhat[i,]) > max(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,]) > mean(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,]) > mean(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > d)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > d)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > mean(y))"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > mean(y))} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "min(yhat[i,]) < min(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- min(yhat[i,]) < min(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "round(yhat[i,]) = d"}) { for (i in 1:length(y)) { Summ[i,8] <- round(mean(round(yhat[i,]) == d, na.rm=TRUE), 3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "sd(yhat[i,]) > sd(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- sd(yhat[i,]) > sd(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} L <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2), 3) S.L <- round(sd(L, na.rm=TRUE),3); L <- round(sum(L, na.rm=TRUE),3) ### Deviance Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE) / 2,3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" ### Create Summary Table for monitored variables Mon <- matrix(NA, nrow(monitor), 5, dimnames=list(c(rownames(monitor)), c("Mean","SD","LB","Median","UB"))) for (i in 1:nrow(monitor)) { Mon[i,1] <- mean(monitor[i,]) Mon[i,2] <- round(sd(monitor[i,]),3) Mon[i,3] <- round(quantile(monitor[i,], probs=0.025),3) Mon[i,4] <- round(quantile(monitor[i,], probs=0.500),3) Mon[i,5] <- round(quantile(monitor[i,], probs=0.975),3) } ### Create Output Summ.out <- list(BPIC=bpic, Concordance=Concordance, Discrepancy.Statistic=round(Discrepancy.Statistic,5), L.criterion=L, S.L=S.L, Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Concordance: ", Concordance, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("L-criterion: ", L, ", S.L: ", S.L, sep="", "\n") cat("Monitors:\n") print(Mon) cat("\n\nRecords:\n") print(Summ[Rows,])} } ### Create Categorical Summary Table else { catcounts <- table(y) sumnames <- rep(NA, length(catcounts)+3) sumnames[1] <- "y" for (i in 1:length(catcounts)) { sumnames[i+1] <- paste("p(yhat=",names(catcounts)[i],")",sep="")} sumnames[length(sumnames)-1] <- "Lift" sumnames[length(sumnames)] <- "Discrep" Summ <- matrix(NA, length(y), length(sumnames), dimnames=list(1:length(y), sumnames)) Summ[,1] <- y for (i in 1:length(catcounts)) { Summ[,i+1] <- rowSums(yhat == as.numeric(names(catcounts)[i])) / ncol(yhat)} Summ[,{ncol(Summ)-1}] <- 1 for (i in 1:length(y)) { Summ[i,{ncol(Summ)-1}] <- Summ[i, grep(Summ[i,1],names(catcounts))+1] / {as.vector(catcounts[grep(Summ[i,1],names(catcounts))]) / sum(catcounts)} - 1} ### Discrepancy Statistics Mean.Lift <- round(mean(Summ[,{ncol(Summ)-1}]),3) Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "p(yhat[i,] != y[i])"}) { for (i in 1:length(y)) { Summ[i,ncol(Summ)] <- 1 - Summ[i, grep(Summ[i,1],names(catcounts))+1]} Discrepancy.Statistic <- round(mean(Summ[,ncol(Summ)], na.rm=TRUE),3)} ### Deviance Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE) / 2,3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" ### Create Summary Table for monitored variables Mon <- matrix(NA, nrow(monitor), 5, dimnames=list(c(rownames(monitor)), c("Mean","SD","LB","Median","UB"))) for (i in 1:nrow(monitor)) { Mon[i,1] <- mean(monitor[i,]) Mon[i,2] <- sd(monitor[i,]) Mon[i,3] <- quantile(monitor[i,], probs=0.025) Mon[i,4] <- quantile(monitor[i,], probs=0.500) Mon[i,5] <- quantile(monitor[i,], probs=0.975) } ### Create Output Summ.out <- list(BPIC=bpic, Mean.Lift=Mean.Lift, Discrepancy.Statistic=round(Discrepancy.Statistic,5), Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Mean Lift: ", Mean.Lift, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("Monitors:\n") print(Mon) cat("\n\nRecords: \n") print(Summ[Rows,])} } return(invisible(Summ.out)) } #End LaplacesDemon/R/plot.pmc.R0000755000176200001440000001141215144343123015043 0ustar liggesusers########################################################################### # plot.pmc # # # # The purpose of the plot.pmc function is to plot an object of class pmc. # ########################################################################### plot.pmc <- function(x, BurnIn=0, Data=NULL, PDF=FALSE, Parms=NULL, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "pmc")) stop("x must be of class pmc.") if(is.null(Data)) stop("The Data argument is NULL.") if(BurnIn >= nrow(x$Posterior2)) BurnIn <- 0 Stat.at <- BurnIn + 1 ### Selecting Parms if(is.null(Parms)) { Posterior <- x$Posterior2 keepcols <- 1:ncol(Posterior)} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], colnames(x$Posterior2))) == 0) stop("Parameter in Parms does not exist.") keepcols <- grep(Parms[1], colnames(x$Posterior2)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], colnames(x$Posterior2))) == 0) stop("Parameter in Parms does not exist.") keepcols <- c(keepcols, grep(Parms[i], colnames(x$Posterior2)))}} Posterior <- as.matrix(x$Posterior2[,keepcols]) colnames(Posterior) <- colnames(x$Posterior2)[keepcols]} if(PDF == TRUE) { pdf("PMC.Plots.pdf") par(mfrow=c(2,2)) } else {par(mfrow=c(2,2), ask=TRUE)} ### Plot Parameters for (j in 1:ncol(Posterior)) { ### Plot Parameter Trace Plots k <- keepcols[j] LL <- Me <- UL <- matrix(0, x$M, x$Iterations) for (m in 1:x$M) {for (i in Stat.at:x$Iterations) { LL[m,i] <- as.vector(quantile(x$Posterior1[,k,i,m], probs=0.025)) Me[m,i] <- as.vector(quantile(x$Posterior1[,k,i,m], probs=0.500)) UL[m,i] <- as.vector(quantile(x$Posterior1[,k,i,m], probs=0.975))}} plot(Stat.at:x$Iterations, Me[1,Stat.at:x$Iterations], ylim=c(min(LL[,Stat.at:x$Iterations]), max(UL[,Stat.at:x$Iterations])), pch=20, xlab="Iterations", ylab="Value", main=colnames(Posterior)[j]) for (i in Stat.at:x$Iterations) lines(c(i,i), c(LL[1,i], UL[1,i])) if(x$M > 1) { for (m in 2:x$M) { points(Stat.at:x$Iterations+(m-1)*0.1, Me[m,Stat.at:x$Iterations], col=m, pch=20) for (i in Stat.at:x$Iterations) { lines(c(i+(m-1)*0.1,i+(m-1)*0.1), c(LL[m,i], UL[m,i]), col=m)}}} ### Plot Parameter Densities plot(density(Posterior[Stat.at:x$Thinned.Samples,j]), xlab="Value", main=colnames(Posterior)[j]) polygon(density(Posterior[Stat.at:x$Thinned.Samples,j]), col="black", border="black") abline(v=0, col="red", lty=2) } ### Plot Deviance Density plot(density(x$Deviance[Stat.at:length(x$Deviance)]), xlab="Value", main="Deviance") polygon(density(x$Deviance[Stat.at:length(x$Deviance)]), col="black", border="black") abline(v=0, col="red", lty=2) ### Plot Monitored Variable Densities if(is.vector(x$Monitor)) {J <- 1; nn <- length(x$Monitor)} else if(is.matrix(x$Monitor)) { J <- ncol(x$Monitor); nn <- nrow(x$Monitor)} for (j in 1:J) { plot(density(x$Monitor[Stat.at:nn,j]), xlab="Value", main=Data[["mon.names"]][j]) polygon(density(x$Monitor[Stat.at:nn,j]), col="black", border="black") abline(v=0, col="red", lty=2)} ### Plot Convergence Diagnostics plot(x$Perplexity, ylim=c(0,1), type="l", xlab="Iterations", ylab="", sub="Perplexity=black; ESSN=red", main="Convergence") lines(x$ESSN, col="red") W <- Thin(x$W, By=x$Thinning) boxplot(W, outline=FALSE, col="red", xlab="Iterations", ylab="Importance Weights") if(x$M > 1) { plot(x$alpha[1,], col=1, ylim=c(0,1), type="l", main="Mixture Probabilities", xlab="Iterations", ylab="alpha") for (m in 2:x$M) { lines(x$alpha[m,], col=m)}} if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/plot.importance.R0000755000176200001440000000275515144316355016446 0ustar liggesusers########################################################################### # plot.importance # # # # The purpose of the plot.importance function is to plot variable # # importance according either to BPIC or the L-criterion in an object of # # class importance. # ########################################################################### plot.importance <- function(x, Style="BPIC", ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!identical(Style, "BPIC") & !identical(Style, "Concordance") & !identical(Style, "Discrep") & !identical(Style, "L-criterion")) stop("Style is unrecognized.") if(!identical(class(x), "importance")) stop("x must be of class importance.") if(identical(Style, "BPIC")) dotchart(x[,1], main="Variable Importance", xlab="BPIC", pch=20) else if(identical(Style, "Concordance")) dotchart(x[,2], main="Variable Importance", xlab="Concordance", pch=20) else if(identical(Style, "Discrep")) dotchart(x[,3], main="Variable Importance", xlab="Discrepancy Statistic", pch=20) else dotchart(x[,4], main="Variable Importance", xlab="L-criterion", pch=20) return(invisible()) } #End LaplacesDemon/R/LML.R0000755000176200001440000002460015144316355013745 0ustar liggesusers########################################################################### # LML (Logarithm of the Marginal Likelihood) # # # # This function provides a few different methods of approximating the # # logarithm of the marginal likelihood (LML), and usually also # # approximates the Hessian matrix (returning a variance-covariance # # matrix, its negative inverse). # ########################################################################### LML <- function(Model=NULL, Data=NULL, Modes=NULL, theta=NULL, LL=NULL, Covar=NULL, method="NSIS") { LML.out <- list(LML=NA, VarCov=NA) if(!is.null(Modes) & !is.null(theta) & !is.null(LL) & !is.null(Covar) & method == "GD") { log.g.theta <- dmvn(theta, Modes, Covar, log=TRUE) LML <- log(1 / mean(exp(log.g.theta - LL))) ### Output LML.out <- list(LML=LML, VarCov=NA) } if(!is.null(LL) & method == "HME") { med <- median(LL) LML <- med - log(mean(exp(-LL + med))) ### Output LML.out <- list(LML=LML, VarCov=NA) } if(!is.null(Model) & !is.null(Data) & !is.null(Modes) & (method == "LME")) { Interval <- 1.0e-6 parm.len <- length(Modes) if(is.null(Covar)) { eps <- Interval * Modes Approx.Hessian <- Hessian(Model, Modes, Data) VarCov <- try(-as.inverse(Approx.Hessian), silent=TRUE) if(!inherits(VarCov, "try-error")) diag(VarCov)[which(diag(VarCov) <= 0)] <- .Machine$double.eps else { cat("\nWARNING: Failure to solve matrix inversion of ", "Approx. Hessian in LML.\n", sep="") cat("NOTE: Identity matrix is supplied instead.\n") VarCov <- diag(parm.len)} } else { VarCov <- Covar rm(Covar)} ### Logarithm of the Marginal Likelihood LML <- NA options(warn=-1) LML.test <- try(parm.len/2 * log(2*pi) + 0.5*logdet(VarCov) + as.vector(Model(Modes, Data)[["LP"]]), silent=TRUE) if(!inherits(LML.test, "try-error")) LML <- LML.test[1] options(warn=0) ### Output LML.out <- list(LML=LML, VarCov=VarCov) } if(!is.null(theta) & !is.null(LL) & (method =="NSIS")) { if(!is.matrix(theta)) stop("theta must be a matrix.") thetacol <- ncol(theta) LL <- as.vector(LL) LLlen <- length(LL) if(nrow(theta) != LLlen) stop("The number of rows in theta differs from the ", "length of LL.") if(LLlen < 301) { cat("\nWARNING: At least 301 samples are required for NSIS in LML.\n") return(list(LML=NA, VarCov=NA))} if(thetacol > round(LLlen / 2)) { cat("\nWARNING: The number of parameters,", thetacol, ",\n exceeds half the number of stationary samples,", round(LLlen / 2), ",\n required for NSIS.\n") return(list(LML=NA, VarCov=NA))} cov.prob <- 0.5 bounds <- matrix(c(-Inf, Inf), 2, ncol(theta)) .GetID <- function(point, center, width) {return(paste(floor((point - center) / width), collapse=" "))} .PopulateHist <- function(points, heights, width) { max.point <- points[heights == max(heights), , drop=FALSE][1, ] center <- max.point - width / 2 hist.env <- new.env(hash=TRUE, parent=emptyenv()) for (i in seq(along=heights)) { id <- .GetID(points[i, ], center, width) if(exists(id, envir=hist.env)) cur.tuple <- get(id, envir=hist.env) else cur.tuple <- c(Inf, 0) assign(id, c(min(heights[i], cur.tuple[1]), cur.tuple[2] + 1), envir=hist.env) } return(list(env=hist.env, center=center, width=width, dim=length(center))) } .Profile <- function(hist) { ids <- ls(hist$env) counts <- sapply(ids, function(id) get(id, envir=hist$env)[2]) names(counts) <- ids return(sort(counts, decreasing=TRUE)) } .Lookup <- function(point, hist) { id <- .GetID(point, hist$center, hist$width) return(ifelse(exists(id, envir=hist$env), get(id, envir=hist$env)[1], -Inf)) } .SetHistNorm <- function(hist) { ids <- ls(hist$env) heights <- sapply(ids, function(id) get(id, envir=hist$env)[1]) max.height <- max(heights) hist$norm <- (log(hist$width ^ hist$dim * sum(exp(heights - max.height))) + max.height) return(hist) } .Coverage <- function(points, hist) { heights <- apply(points, 1, function(point) .Lookup(point, hist)) return(length(heights[heights > -Inf]) / length(heights)) } .Dist <- function(p1, p2) { return(max(abs(p1 - p2))) } .GetWidth <- function(theta.hist, theta.width, LL.hist, opt.prob=0.5) { low.point <- theta.hist[which(LL.hist == min(LL.hist))[1], , drop=FALSE] high.point <- theta.hist[which(LL.hist == max(LL.hist))[1], , drop=FALSE] minLL.dists <- apply(theta.hist, 1, function(theta) { .Dist(theta, low.point)}) maxLL.dists <- apply(theta.hist, 1, function(theta) { .Dist(theta, high.point)}) small.dist <- 0.5 * min(maxLL.dists[maxLL.dists > 0]) big.dist <- 2 * max(minLL.dists) F <- function(width) { hist <- .PopulateHist(theta.hist, LL.hist, width) return(.Coverage(theta.width, hist) - opt.prob) } options(warn=-1) solve.test <- try(uniroot(F, lower=small.dist, upper=big.dist, tol=min(.05, 2/nrow(theta.width))), silent=TRUE) options(warn=0) if(!inherits(solve.test, "try-error")) return(solve.test$root) else return(1) } .GetLimits <- function(hist) { split.ids <- strsplit(ls(hist$env), " ") coords <- matrix(NA, ncol=hist$dim, nrow=length(split.ids)) for (i in seq(along=split.ids)) coords[i, ] <- as.integer(split.ids[[i]]) max.coords <- apply(coords, 2, max) min.coords <- apply(coords, 2, min) result <- rbind(apply(coords, 2, min) * hist$width + hist$center, (apply(coords, 2, max) + 1) * hist$width + hist$center) rownames(result) <- c("min", "max") return(result) } .MargLL <- function(hist, theta.imp, LL.imp) { n <- length(LL.imp) samples <- rep(0, n) for (i in seq(length=n)) samples[i] <- exp(.Lookup(theta.imp[i, ], hist) - LL.imp[i]) return(list(samples=samples, mll=-log(mean(samples)))) } .SplitComponents <- function(theta, LL) { tot.count <- length(LL) hist.count <- min(0.2 * tot.count, round(sqrt(tot.count) * 2)) width.count <- 40 imp.count <- tot.count - hist.count - width.count return(list(theta.hist=theta[1:hist.count, , drop=FALSE], theta.bw=theta[(hist.count + 1):(hist.count + width.count), , drop=FALSE], theta.imp=theta[(tot.count - imp.count + 1):tot.count, , drop=FALSE], LL.hist=LL[1:hist.count], LL.imp=LL[(tot.count - imp.count + 1):tot.count])) } .CheckBounds <- function(hist, bounds) { limits <- hist$limits <- .GetLimits(hist) if(!all((bounds[1, ] == -Inf) | (bounds[1, ] < limits[1, ]))) stop(paste("Bounds error: histogram lower limits (", paste(limits[1, ], collapse=" "), ") lower than specified bounds (", paste(bounds[1, ], collapse=" "), ").", sep="")) if(!all((bounds[2, ] == Inf) | (bounds[2, ] > limits[2, ]))) stop(paste("Bounds error: histogram upper limits (", paste(limits[2, ], collapse=" "), ") greater than specified bounds (", paste(bounds[2, ], collapse=" "), ").", sep="")) return(hist) } options(warn=-1) comps <- .SplitComponents(theta, LL) width <- .GetWidth(comps$theta.hist, comps$theta.bw, comps$LL.hist, cov.prob) hist <- .PopulateHist(comps$theta.hist, comps$LL.hist, width) hist <- .SetHistNorm(hist) hist <- .CheckBounds(hist, bounds) ml.out <- .MargLL(hist, comps$theta.imp, comps$LL.imp) ml.out$samples <- ml.out$samples[is.finite(ml.out$samples)] sd.samples <- sd(ml.out$samples) / sqrt(length(ml.out$samples)) conf.interval <- qnorm(c(0.975, 0.025)) * sd.samples + mean(ml.out$samples) conf.interval[which(conf.interval < .Machine$double.eps)] <- .Machine$double.eps conf.interval <- -log(conf.interval) options(warn=0) LML <- ml.out$mll + hist$norm LML[which(!is.finite(LML))] <- NA ### Output LML.out <- list(LML=LML, VarCov=NA) } return(LML.out) } #End LaplacesDemon/R/is.constant.R0000755000176200001440000000121615144316355015562 0ustar liggesusers########################################################################### # is.constant # # # # The purpose of the is.constant function is to provide a logical test of # # whether or not a vector is a constant. # ########################################################################### is.constant <- function(x) { if(missing(x)) stop("The x argument is required.") if(!is.vector(x)) x <- as.vector(x) uni <- length(unique(x)) return(uni <= 1) } #End LaplacesDemon/R/interval.R0000755000176200001440000000523015144316355015143 0ustar liggesusers########################################################################### # interval # # # # The purpose of the interval function is to constrain the element(s) of # # a scalar, vector, matrix, or array to the interval [a,b]. # ########################################################################### interval <- function(x, a=-Inf, b=Inf, reflect=TRUE) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(a > b) stop("a > b.") if(reflect & is.finite(a) & is.finite(b) & any(!is.finite(x))) { if(is.array(x)) { d <- dim(x) x <- as.vector(x)} x.inf.pos <- !is.finite(x); x[x.inf.pos] <- interval(x[x.inf.pos], a, b, reflect=FALSE) if(is.array(x)) x <- array(x, dim=d) } ### Scalar if(is.vector(x) & {length(x) == 1}) { if(reflect == FALSE) x <- max(a, min(b, x)) else if(x < a | x > b) { out <- TRUE while(out) { if(x < a) x <- a + a - x if(x > b) x <- b + b - x if(x >= a & x <= b) out <- FALSE }}} ### Vector else if(is.vector(x) & {length(x) > 1}) { if(reflect == FALSE) { x.num <- which(x < a) x[x.num] <- a x.num <- which(x > b) x[x.num] <- b} else if(any(x < a) | any(x > b)) { out <- TRUE while(out) { x.num <- which(x < a) x[x.num] <- a + a - x[x.num] x.num <- which(x > b) x[x.num] <- b + b - x[x.num] if(all(x >= a) & all(x <= b)) out <- FALSE }}} ### Matrix or Array else if(is.array(x)) { d <- dim(x) x <- as.vector(x) if(reflect == FALSE) { x.num <- which(x < a) x[x.num] <- a x.num <- which(x > b) x[x.num] <- b} else if(any(x < a) | any(x > b)) { out <- TRUE while(out) { x.num <- which(x < a) x[x.num] <- a + a - x[x.num] x.num <- which(x > b) x[x.num] <- b + b - x[x.num] if(all(x >= a) & all(x <= b)) out <- FALSE }} x <- array(x, dim=d)} return(x) } #End LaplacesDemon/R/VariationalBayes.R0000755000176200001440000003525215144316355016563 0ustar liggesusers########################################################################### # VariationalBayes # # # # The purpose of the VariationalBayes function is to estimate a model # # with a Variational Bayes algorithm. # ########################################################################### VariationalBayes <- function(Model, parm, Data, Covar=NULL, Interval=1.0E-6, Iterations=1000, Method="Salimans2", Samples=1000, sir=TRUE, Stop.Tolerance=1.0E-5, CPUs=1, Type="PSOCK") { ########################## Initial Checks ########################## time1 <- proc.time() VB.call <- match.call() if(missing(Model)) stop("Model is a required argument.") if(!is.function(Model)) stop("Model must be a function.") if(missing(Data)) stop("Data is a required argument.") if(missing(parm)) { cat("Initial values were not supplied, and\n") cat("have been set to zero prior to VariationalBayes().\n") parm <- rep(0, length(Data[["parm.names"]]))} LIV <- length(as.vector(parm)) for (i in 1:length(Data)) { if(is.matrix(Data[[i]])) { if(all(is.finite(Data[[i]]))) { mat.rank <- qr(Data[[i]], tol=1e-10)$rank if(mat.rank < ncol(Data[[i]])) { cat("WARNING: Matrix", names(Data)[[i]], "may be rank-deficient.\n")}}}} if({Interval <= 0} | {Interval > 1}) Interval <- 1.0E-6 Iterations <- min(max(round(Iterations), 10), 1000000) "%!in%" <- function(x,table) return(match(x, table, nomatch=0) == 0) if(Method %!in% c("Salimans2")) stop("Method is unknown.") if(Stop.Tolerance <= 0) Stop.Tolerance <- 1.0E-5 as.character.function <- function(x, ... ) { fname <- deparse(substitute(x)) f <- match.fun(x) out <- c(sprintf('"%s" <- ', fname), capture.output(f)) if(grepl("^[<]", tail(out,1))) out <- head(out, -1) return(out) } acount <- length(grep("apply", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, " possible instance(s) of apply functions\n") cat( "were found in the Model specification. Iteration speed will\n") cat(" increase if apply functions are vectorized in R or coded\n") cat(" in a faster language such as C++ via the Rcpp package.\n")} acount <- length(grep("for", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, " possible instance(s) of for loops\n") cat(" were found in the Model specification. Iteration speed will\n") cat(" increase if for loops are vectorized in R or coded in a\n") cat(" faster language such as C++ via the Rcpp package.\n")} ### Sample Size of Data if(!is.null(Data[["n"]])) if(length(Data[["n"]]) == 1) N <- Data[["n"]] if(!is.null(Data[["N"]])) if(length(Data[["N"]]) == 1) N <- Data[["N"]] if(!is.null(Data[["y"]])) N <- nrow(matrix(Data[["y"]])) if(!is.null(Data[["Y"]])) N <- nrow(matrix(Data[["Y"]])) if(!is.null(N)) cat("Sample Size: ", N, "\n") else stop("Sample size of Data not found in n, N, y, or Y.") ########################### Preparation ############################ m.old <- Model(parm, Data) if(!is.list(m.old)) stop("Model must return a list.") if(length(m.old) != 5) stop("Model must return five components.") if(any(names(m.old) != c("LP","Dev","Monitor","yhat","parm"))) stop("Name mismatch in returned list of Model function.") if(length(m.old[["LP"]]) > 1) stop("Multiple joint posteriors exist!") if(!identical(length(parm), length(m.old[["parm"]]))) stop("The number of initial values and parameters differs.") if(!is.finite(m.old[["LP"]])) { cat("Generating initial values due to a non-finite posterior.\n") if(!is.null(Data[["PGF"]])) Initial.Values <- GIV(Model, Data, PGF=TRUE) else Initial.Values <- GIV(Model, Data, PGF=FALSE) m.old <- Model(Initial.Values, Data) } if(!is.finite(m.old[["LP"]])) stop("The posterior is non-finite.") if(!is.finite(m.old[["Dev"]])) stop("The deviance is non-finite.") parm <- m.old[["parm"]] if(!identical(Model(m.old[["parm"]], Data)[["LP"]], m.old[["LP"]])) { cat("WARNING: LP differs when initial values are held constant.\n") cat(" Derivatives may be problematic if used.\n")} ##################### Begin Variational Bayes ##################### cat("Variational Bayes begins...\n") if(Method == "Salimans2") { VB <- .vbsalimans2(Model, parm, Data, Covar, Iterations, Interval, Stop.Tolerance, m.old) } Dev <- as.vector(VB$Dev) iter <- VB$iter parm.len <- LIV parm.new <- VB$parm.new parm.old <- VB$parm.old post <- VB$post Step.Size <- VB$Step.Size tol.new <- VB$tol.new VarCov <- VB$VarCov rm(VB) if(iter == 1) stop("VariationalBayes stopped at iteration 1.") if(tol.new <= Stop.Tolerance) converged <- TRUE else converged <- FALSE ### Column names to samples if(dim(post)[2] == length(Data[["parm.names"]])) dimnames(post) <- list(1:dim(post)[1], Data[["parm.names"]], 1:2) ################# Sampling Importance Resampling ################## if({sir == TRUE} & {converged == TRUE}) { cat("Sampling from Posterior with Sampling Importance Resampling\n") posterior <- SIR(Model, Data, mu=parm.new, Sigma=VarCov, n=Samples, CPUs=CPUs, Type=Type) Mon <- matrix(0, nrow(posterior), length(Data[["mon.names"]])) dev <- rep(0, nrow(posterior)) for (i in 1:nrow(posterior)) { mod <- Model(posterior[i,], Data) dev[i] <- mod[["Dev"]] Mon[i,] <- mod[["Monitor"]] } colnames(Mon) <- Data[["mon.names"]]} else { if({sir == TRUE} & {converged == FALSE}) cat("Posterior samples are not drawn due to Converge=FALSE\n") posterior <- NA; Mon <- NA} ##################### Summary, Point-Estimate ###################### cat("Creating Summary from Point-Estimates\n") Summ1 <- matrix(NA, parm.len, 4, dimnames=list(Data[["parm.names"]], c("Mean","SD","LB","UB"))) Summ1[,1] <- parm.new Summ1[,2] <- sqrt(diag(VarCov)) Summ1[,3] <- parm.new - 2*Summ1[,2] Summ1[,4] <- parm.new + 2*Summ1[,2] ################### Summary, Posterior Samples #################### Summ2 <- NA if({sir == TRUE} & {converged == TRUE}) { cat("Creating Summary from Posterior Samples\n") Summ2 <- matrix(NA, ncol(posterior), 7, dimnames=list(Data[["parm.names"]], c("Mean","SD","MCSE","ESS","LB","Median","UB"))) Summ2[,1] <- colMeans(posterior) Summ2[,2] <- sqrt(.colVars(posterior)) Summ2[,3] <- Summ2[,2] / sqrt(nrow(posterior)) Summ2[,4] <- rep(nrow(posterior), ncol(posterior)) Summ2[,5] <- apply(posterior, 2, quantile, c(0.025)) Summ2[,6] <- apply(posterior, 2, quantile, c(0.500)) Summ2[,7] <- apply(posterior, 2, quantile, c(0.975)) Deviance <- rep(0, 7) Deviance[1] <- mean(dev) Deviance[2] <- sd(dev) Deviance[3] <- sd(dev) / sqrt(nrow(posterior)) Deviance[4] <- nrow(posterior) Deviance[5] <- as.numeric(quantile(dev, probs=0.025, na.rm=TRUE)) Deviance[6] <- as.numeric(quantile(dev, probs=0.500, na.rm=TRUE)) Deviance[7] <- as.numeric(quantile(dev, probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Deviance) for (j in 1:ncol(Mon)) { Monitor <- rep(NA,7) Monitor[1] <- mean(Mon[,j]) Monitor[2] <- sd(as.vector(Mon[,j])) Monitor[3] <- sd(as.vector(Mon[,j])) / sqrt(nrow(Mon)) Monitor[4] <- nrow(Mon) Monitor[5] <- as.numeric(quantile(Mon[,j], probs=0.025, na.rm=TRUE)) Monitor[6] <- as.numeric(quantile(Mon[,j], probs=0.500, na.rm=TRUE)) Monitor[7] <- as.numeric(quantile(Mon[,j], probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Monitor) rownames(Summ2)[nrow(Summ2)] <- Data[["mon.names"]][j] } } ############### Logarithm of the Marginal Likelihood ############### LML <- list(LML=NA, VarCov=VarCov) if({sir == TRUE} & {converged == TRUE}) { cat("Estimating Log of the Marginal Likelihood\n") lml <- LML(theta=posterior, LL=(dev*(-1/2)), method="NSIS") LML[[1]] <- lml[[1]]} else if({sir == FALSE} & {converged == TRUE}) { cat("Estimating Log of the Marginal Likelihood\n") LML <- LML(Model, Data, Modes=parm.new, Covar=VarCov, method="LME")} colnames(VarCov) <- rownames(VarCov) <- Data[["parm.names"]] time2 <- proc.time() ############################# Output ############################## VB <- list(Call=VB.call, Converged=converged, Covar=VarCov, Deviance=as.vector(Dev), History=post, Initial.Values=parm, Iterations=iter, LML=LML[[1]], LP.Final=as.vector(Model(parm.new, Data)[["LP"]]), LP.Initial=m.old[["LP"]], Minutes=round(as.vector(time2[3] - time1[3]) / 60, 2), Monitor=Mon, Posterior=posterior, Step.Size.Final=Step.Size, Step.Size.Initial=Step.Size, Summary1=Summ1, Summary2=Summ2, Tolerance.Final=tol.new, Tolerance.Stop=Stop.Tolerance) class(VB) <- "vb" cat("Variational Bayes is finished.\n\n") return(VB) } .vbsalimans2 <- function(Model, parm, Data, Covar, Iterations, Interval, Stop.Tolerance, m.old) { m.new <- m.old LIV <- length(parm) m <- parm if(is.null(Covar)) V <- diag(LIV) #Variance else { V <- as.positive.definite(Covar) if(nrow(V) != ncol(V)) stop("Covar is not square.") if(nrow(V) != LIV) V <- diag(LIV) else { V <- Covar diag(V) <- abs(diag(V))}} rm(Covar) z <- m #Guess of the mean P <- as.inverse(V) #Precision a <- rep(0, LIV) zbar <- rep(0, LIV) Pbar <- matrix(0, LIV, LIV) abar <- rep(0, LIV) w <- 1 / sqrt(Iterations) #step-size half1 <- Iterations / 2 half2 <- 2 / Iterations post <- array(0, dim=c(Iterations, LIV, 2)) post[1,,1] <- m post[1,,2] <- diag(V) Dev <- matrix(m.old[["Dev"]],1,1) ### Stochastic Approximation for (iter in 1:Iterations) { mbar <- mbar.last <- m #mean Vbar <- Vbar.last <- V #variance m.old <- m.new #model ### Print Status if(iter %% round(Iterations / 10) == 0) { cat("Iteration: ", iter, " of ", Iterations, "\n")} ### Draw a sample from the approximating distribution q xstar <- m while(identical(xstar, m)) { xstar <- try(m + as.vector(matrix(rnorm(LIV),1,LIV) %*% chol(V)), silent=TRUE) if(inherits(xstar, "try-error")) xstar <- rnorm(LIV,m,abs(diag(V))) m.temp <- try(Model(xstar, Data), silent=TRUE) if(inherits(xstar, "try-error")) xstar <- m else xstar <- m.temp[["parm"]] if(any(!is.finite(c(m.temp[["LP"]], m.temp[["Dev"]], m.temp[["Monitor"]])))) xstar <- m} ### Gradient and Hessian g <- partial(Model, xstar, Data, Interval=Interval) H <- Hessian(Model, xstar, Data, Interval=Interval) ### Stochastic Approx. a <- (1 - w)*a + w*g P <- (1 - w)*P - w*H z <- (1 - w)*z + w*xstar if(any(!is.finite(P))) P <- diag(LIV) if(!is.symmetric.matrix(P)) P <- as.symmetric.matrix(P) diag(P) <- abs(diag(P)) if(!is.positive.definite(P)) P <- as.positive.definite(P) V <- as.inverse(P) m <- as.vector(V %*% a + z) ### Evaluate Proposal m.new <- try(Model(m, Data), silent=TRUE) if(inherits(m.new, "try-error")) m.new <- m.old else if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) m.new <- m.old else if(log(runif(1)) >= (m.new[["LP"]] - m.old[["LP"]])) m.new <- m.old m <- m.new[["parm"]] ### Storage post[iter,,1] <- m post[iter,,2] <- diag(V) Dev <- rbind(Dev, m.new[["Dev"]]) ### Do averaging if over half-way if(iter > half1) { abar <- abar + half2*g Pbar <- Pbar - half2*H zbar <- zbar + half2*xstar if(any(!is.finite(Pbar))) Pbar <- diag(LIV) if(!is.symmetric.matrix(Pbar)) Pbar <- as.symmetric.matrix(Pbar) diag(Pbar) <- abs(diag(Pbar)) if(!is.positive.definite(Pbar)) Pbar <- as.positive.definite(Pbar) Vbar <- as.inverse(Pbar) mbar <- as.vector(Vbar %*% abar + zbar) mbar <- Model(mbar, Data)[["parm"]] ### Tolerance tol.new <- sum(sqrt(sum({mbar - mbar.last} * {mbar - mbar.last})), sqrt(sum({diag(Vbar) - diag(Vbar.last)} * {diag(Vbar) - diag(Vbar.last)}))) if(tol.new <= Stop.Tolerance) { post <- post[1:iter,,] break} } } Dev <- Dev[-1,] #mbar and Vbar should be returned, but not if wildly different... LB <- mbar - 3*diag(Vbar) UB <- mbar + 3*diag(Vbar) if(any((m < LB) | (m > UB))) { mbar <- m Vbar <- diag(LIV) * diag(V)} ### Output VB <- list(Dev=Dev, iter=iter, parm.new=mbar, parm.old=parm, post=post, Step.Size=w, tol.new=tol.new, VarCov=Vbar) return(VB) } #End LaplacesDemon/R/Mode.R0000755000176200001440000000721715144316355014212 0ustar liggesusers########################################################################### # Mode # # # # The purpose of these functions is to return the mode or modes of a # # vector, or test for the presence or number of modes. # ########################################################################### is.amodal <- function(x, min.size=0.1) { if(any(is.na(Modes(x, min.size)[[1]]))) return(TRUE) else return(FALSE) } is.bimodal <- function(x, min.size=0.1) { if(length(Modes(x, min.size)[[1]]) == 2) return(TRUE) else return(FALSE) } is.multimodal <- function(x, min.size=0.1) { if(length(Modes(x, min.size)[[1]]) > 1) return(TRUE) else return(FALSE) } is.trimodal <- function(x, min.size=0.1) { if(length(Modes(x, min.size)[[1]]) == 3) return(TRUE) else return(FALSE) } is.unimodal <- function(x, min.size=0.1) { if((length(Modes(x, min.size)[[1]]) == 1) & (!any(is.na(Modes(x, min.size)[[1]])))) return(TRUE) else return(FALSE) } Mode <- function(x) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!is.vector(x)) x <- as.vector(x) x <- x[is.finite(x)] ### Amodal if(is.constant(x)) return(NA) ### Discrete if(all(x == round(x))) { Mode <- as.numeric(names(which.max(table(x))))} ### Continuous (using kernel density) else { x <- as.vector(as.numeric(as.character(x))) kde <- density(x) Mode <- kde$x[kde$y == max(kde$y)][1] } return(Mode) } Modes <- function(x, min.size=0.1) { ### Initial Checks if(missing(x)) stop("The x argument is required.") x <- as.vector(as.numeric(as.character(x))) x <- x[is.finite(x)] ### Amodal if(is.constant(x)) return(list(modes=NA, mode.dens=NA, size=1)) ### Differentiate kernel density by x length(density(x)$y) dens.y.diff <- density(x)$y[-1] - density(x)$y[-length(density(x)$y)] incr <- dens.y.diff incr[which(dens.y.diff > 0)] <- 1 incr[which(dens.y.diff <= 0)] <- 0 ### Kernel density by increasing/decreasing density regions begin <- 1; count <- 1 for (i in 2:length(incr)) { if(incr[i] != incr[i-1]) { count <- count + 1 begin <- c(begin, i)} } begin <- c(begin, length(incr)) size <- modes <- mode.dens <- rep(0, count/2) init <- 1 dens <- density(x); sumdens <- sum(dens$y) if(incr[1] == 0) { size[1] <- sum(dens$y[1:begin[2]]) / sumdens init <- 2} j <- init for (i in init:length(size)) { size[i] <- sum(dens$y[begin[j]:begin[j+2]]) / sumdens kde <- dens kde$x <- kde$x[begin[j]:begin[j+2]] kde$y <- kde$y[begin[j]:begin[j+2]] modes[i] <- kde$x[kde$y == max(kde$y)][1] mode.dens[i] <- kde$y[kde$y == max(kde$y)][1] j <- j + 2 } ### Order everything by density size <- size[order(mode.dens, decreasing=TRUE)] modes <- modes[order(mode.dens, decreasing=TRUE)] mode.dens <- mode.dens[order(mode.dens, decreasing=TRUE)] ### Remove modes with size < 10% if(any(size < 0.1)) { modes <- modes[-which(size < min.size)] mode.dens <- mode.dens[-which(size < min.size)] size <- size[-which(size < min.size)] } if(sum(size) > 1) size <- size / sum(size) #Output return(list(modes=modes, mode.dens=mode.dens, size=size)) } #End LaplacesDemon/R/print.demonoid.R0000755000176200001440000000533315144316355016254 0ustar liggesusers########################################################################### # print.demonoid # # # # The purpose of the print.demonoid function is to print the contents of # # an object of class demonoid to the screen. # ########################################################################### print.demonoid <- function(x, ...) { if(missing(x)) stop("The x argument is required.") cat("Call:\n") print(x$Call) cat("\nAcceptance Rate: ", round(x$Acceptance.Rate,5), "\n", sep="") cat("Algorithm: ", x$Algorithm, "\n", sep="") cat("Covariance Matrix: (NOT SHOWN HERE; diagonal shown instead)\n") if(is.matrix(x$Covar)) { print(diag(x$Covar)) } else if(!is.list(x$Covar) & is.vector(x$Covar)) { print(x$Covar) } else for (i in 1:length(x$Covar)) { cat("Block:", i, "\n") print(diag(x$Covar[[i]])) cat("\n")} cat("\nCovariance (Diagonal) History: (NOT SHOWN HERE)\n") cat("Deviance Information Criterion (DIC):\n") DIC <- matrix(c(round(x$DIC1[1],3), round(x$DIC1[2],3), round(x$DIC1[3],3), round(x$DIC2[1],3), round(x$DIC2[2],3), round(x$DIC2[3],3)), 3, 2, dimnames=list(c("Dbar","pD","DIC"),c("All","Stationary"))) print(DIC) cat("Initial Values:\n") print(x$Initial.Values) cat("\nIterations: ", x$Iterations, "\n", sep="") cat("Log(Marginal Likelihood): ", x$LML, "\n", sep="") cat("Minutes of run-time: ", round(x$Minutes,2), "\n", sep="") cat("Model: (NOT SHOWN HERE)\n") cat("Monitor: (NOT SHOWN HERE)\n") cat("Parameters (Number of): ", x$Parameters, "\n", sep="") cat("Posterior1: (NOT SHOWN HERE)\n") cat("Posterior2: (NOT SHOWN HERE)\n") cat("Recommended Burn-In of Thinned Samples: ", x$Rec.BurnIn.Thinned, "\n", sep="") cat("Recommended Burn-In of Un-thinned Samples: ", x$Rec.BurnIn.UnThinned, "\n", sep="") cat("Recommended Thinning: ", x$Rec.Thinning, "\n", sep="") cat("Specs: (NOT SHOWN HERE)\n") cat("Status is displayed every ", x$Status, " iterations\n", sep="") cat("Summary1: (SHOWN BELOW)\n") cat("Summary2: (SHOWN BELOW)\n") cat("Thinned Samples: ", x$Thinned.Samples, "\n", sep="") cat("Thinning: ", x$Thinning, "\n", sep="") cat("\n\nSummary of All Samples\n") print(x$Summary1) cat("\n\nSummary of Stationary Samples\n") print(x$Summary2) invisible(x) } #End LaplacesDemon/R/WAIC.R0000755000176200001440000000133115144316355014040 0ustar liggesusers########################################################################### # WAIC # # # # The purpose of the WAIC function is to calculate the Widely Applicable # # Information Criterion. # ########################################################################### WAIC <- function(x) { lppd <- sum (log(rowMeans(exp(x)))) pWAIC1 <- 2*sum(log(rowMeans(exp(x))) - rowMeans(x)) pWAIC2 <- sum(.rowVars(x)) WAIC <- -2*lppd + 2*pWAIC2 return(list(WAIC=WAIC, lppd=lppd, pWAIC=pWAIC2, pWAIC1=pWAIC1)) } #End LaplacesDemon/R/is.appeased.R0000755000176200001440000000151215144316355015512 0ustar liggesusers########################################################################### # is.appeased # # # # The purpose of the is.appeased function is to perform a logical test of # # whether or not Laplace's Demon is appeased with an object of class # # demonoid. # ########################################################################### is.appeased <- function(x) { appeased <- FALSE if(!identical(class(x), "demonoid")) stop("x must be of class demonoid.") captive <- capture.output(Consort(x)) z <- grep("has been appeased", captive) if(length(z) > 0) appeased <- TRUE return(appeased) } #End LaplacesDemon/R/LaplacesDemon.R0000755000176200001440000151643615144316355016046 0ustar liggesusers########################################################################### # LaplacesDemon # # # # The purpose of the LaplacesDemon function is to use MCMC on the # # logarithm of the unnormalized joint posterior density of a Bayesian # # model. # ########################################################################### LaplacesDemon <- function(Model, Data, Initial.Values, Covar=NULL, Iterations=10000, Status=100, Thinning=10, Algorithm="MWG", Specs=list(B=NULL), Debug=list(DB.chol=FALSE, DB.eigen=FALSE, DB.MCSE=FALSE, DB.Model=TRUE), LogFile="", ...) { cat("\nLaplace's Demon was called on ", date(), "\n", sep="", file=LogFile, append=TRUE) time1 <- proc.time() LDcall <- match.call() ########################## Initial Checks ########################## cat("\nPerforming initial checks...\n", file=LogFile, append=TRUE) if(missing(Model)) stop("A function must be entered for Model.", file=LogFile, append=TRUE) if(!is.function(Model)) stop("Model must be a function.", file=LogFile, append=TRUE) if(missing(Data)) stop("A list containing data must be entered for Data.", file=LogFile, append=TRUE) if(is.null(Data[["mon.names"]])) stop("In Data, mon.names is NULL.", file=LogFile, append=TRUE) if(is.null(Data[["parm.names"]])) stop("In Data, parm.names is NULL.", file=LogFile, append=TRUE) for (i in 1:length(Data)) { if(is.matrix(Data[[i]])) { if(all(is.finite(Data[[i]]))) { mat.rank <- qr(Data[[i]], tol=1e-10)$rank if(mat.rank < ncol(Data[[i]])) { cat("WARNING: Matrix", names(Data)[[i]], "may be rank-deficient.\n", file=LogFile, append=TRUE)}}}} if(missing(Initial.Values)) { cat("WARNING: Initial Values were not supplied.\n", file=LogFile, append=TRUE) Initial.Values <- rep(0, length(Data[["parm.names"]]))} if(!identical(length(Initial.Values), length(Data[["parm.names"]]))) { cat("WARNING: The length of Initial Values differed from", "Data$parm.names.\n", file=LogFile, append=TRUE) Initial.Values <- rep(0, length(Data[["parm.names"]]))} if(any(!is.finite(Initial.Values))) { cat("WARNING: Initial Values contain non-finite values.\n", file=LogFile, append=TRUE) Initial.Values <- rep(0, length(Data[["parm.names"]]))} Iterations <- round(abs(Iterations)) if(Iterations < 11) { Iterations <- 11 cat("'Iterations' has been changed to ", Iterations, ".\n", sep="", file=LogFile, append=TRUE)} Status <- round(abs(Status)) if({Status < 1} || {Status > Iterations}) { Status <- Iterations cat("'Status' has been changed to ", Status, ".\n", sep="", file=LogFile, append=TRUE)} Thinning <- round(abs(Thinning)) if({Thinning < 1} || {Thinning > Iterations}) { Thinning <- 1 cat("'Thinning' has been changed to ", Thinning, ".\n", sep="", file=LogFile, append=TRUE)} if(Algorithm %in% c("ADMG","AFSS","AGG","AHMC","AIES","AM","AMM", "AMWG","CHARM","DEMC","DRAM","DRM","ESS","Experimental","GG", "Gibbs","HARM","HMC","HMCDA","IM","INCA","MALA","MCMCMC","MTM", "MWG","NUTS","OHSS","pCN","RAM","Refractive","RDMH","RJ","RSS", "RWM","SAMWG","SGLD","Slice","SMWG","THMC","twalk","UESS", "USAMWG","USMWG")) { if(Algorithm == "ADMG") { Algorithm <- "Adaptive Directional Metropolis-within-Gibbs" if(missing(Specs) | is.null(Specs)) Specs <- list(n=0, Periodicity=1) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("n","Periodicity") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["n"]] <- abs(round(Specs[["n"]])) Specs[["Periodicity"]] <- max(abs(round(Specs[["Periodicity"]])), length(Initial.Values)) } else if(Algorithm == "AFSS") { Algorithm <- "Automated Factor Slice Sampler" if(missing(Specs) | is.null(Specs)) Specs <- list(A=Inf, B=NULL, m=Inf, n=0, w=1) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("A","B","m","n","w") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["A"]] <- min(round(abs(Specs[["A"]])), Iterations) Specs[["m"]] <- abs(round(Specs[["m"]])) if(!identical(length(Specs[["m"]]), length(Initial.Values))) Specs[["m"]] <- rep(Specs[["m"]], length(Initial.Values)) Specs[["n"]] <- abs(round(Specs[["n"]])) Specs[["w"]] <- abs(Specs[["w"]]) if(!identical(length(Specs[["w"]]), length(Initial.Values))) Specs[["w"]] <- rep(Specs[["w"]], length(Initial.Values)) } else if(Algorithm == "AGG") { Algorithm <- "Adaptive Griddy-Gibbs" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Grid","dparm","smax","CPUs","Packages","Dyn.libs") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(is.list(Specs[["Grid"]])) { if(length(Specs[["Grid"]]) != length(Initial.Values)) { Specs[["Grid"]] <- list(NULL) for (i in 1:length(Initial.Values)) Specs[["Grid"]][[i]] <- GaussHermiteQuadRule(3)$nodes cat("\nGrid was misspecified and changed to default.\n", file=LogFile, append=TRUE)} } else { temp <- as.vector(Specs[["Grid"]]) Specs[["Grid"]] <- list(NULL) for (i in 1:length(Initial.Values)) Specs[["Grid"]][[i]] <- temp} if(!is.null(Specs[["dparm"]])) { Specs[["dparm"]] <- unique(interval(round(Specs[["dparm"]]), 1, length(Initial.Values))) Specs[["dparm"]] <- Specs[["dparm"]][order(Specs[["dparm"]])]} else Specs[["dparm"]] <- 0 Specs[["smax"]] <- abs(Specs[["smax"]]) Specs[["CPUs"]] <- max(1, abs(round(Specs[["CPUs"]]))) } else if(Algorithm == "AHMC") { Algorithm <- "Adaptive Hamiltonian Monte Carlo" if(missing(Specs) | is.null(Specs)) Specs=list(epsilon=rep(1/length(Initial.Values), length(Initial.Values)), L=2, m=rep(1, length(Initial.Values)), Periodicity=1) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("epsilon","L","m","Periodicity") %in% names(Specs))) if(!identical(names(Specs), c("epsilon","L","m","Periodicity"))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(is.null(Specs[["epsilon"]])) Specs[["epsilon"]] <- rep(1/length(Initial.Values), length(Initial.Values)) Specs[["epsilon"]] <- as.vector(abs(Specs[["epsilon"]])) if(length(Specs[["epsilon"]]) != length(Initial.Values)) { cat("\nLength of epsilon is incorrect.\n", file=LogFile, append=TRUE) Specs[["epsilon"]] <- rep(Specs[["epsilon"]][1], length(Initial.Values))} Specs[["L"]] <- abs(round(Specs[["L"]])) if(Specs[["L"]] < 1) { cat("\nL has been increased to its minimum: 1.\n", file=LogFile, append=TRUE) Specs[["L"]] <- 1} if(is.null(Specs[["m"]])) Specs[["m"]] <- diag(length(Initial.Values)) } else if(Algorithm == "AIES") { Algorithm <- "Affine-Invariant Ensemble Sampler" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Nc","Z","beta","CPUs","Packages","Dyn.libs") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["Nc"]] <- max(abs(round(Specs[["Nc"]])), 3) if(!is.null(Specs[["Z"]])) { if(is.matrix(Specs[["Z"]])) { if(ncol(Specs[["Z"]]) != length(Initial.Values)) stop("Z has the wrong number of columns.", file=LogFile, append=TRUE) if(nrow(Specs[["Z"]]) != Specs[["Nc"]]) stop("Z has the wrong number of rows.", file=LogFile, append=TRUE)}} if(length(Specs[["beta"]]) != 1) { cat("\nLength of beta is wrong. Changed to 1.\n", file=LogFile, append=TRUE) Specs[["beta"]] <- as.vector(Specs[["beta"]])[1]} if(Specs[["beta"]] <= 1) { cat("\nbeta must be > 1. Changed to 2.\n", file=LogFile, append=TRUE) Specs[["beta"]] <- 2} Specs[["CPUs"]] <- max(1, abs(round(Specs[["CPUs"]]))) if(Specs[["CPUs"]] > 1 & Specs[["Nc"]] %% 2 != 0) stop("For CPUs > 1, Nc must be even.", file=LogFile, append=TRUE) } else if(Algorithm == "AM") { Algorithm <- "Adaptive Metropolis" if(missing(Specs) | is.null(Specs)) Specs=list(Adaptive=floor(Iterations/2), Periodicity=1) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Adaptive","Periodicity") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) } else if(Algorithm == "AMM") { Algorithm <- "Adaptive-Mixture Metropolis" if(missing(Specs) | is.null(Specs)) Specs=list(Adaptive=floor(Iterations/2), B=NULL, n=0, Periodicity=1, w=0.05) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Adaptive","B","n","Periodicity","w") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(!is.null(Specs[["B"]])) { if(is.null(Covar)) { Covar <- list(NULL) for (b in 1:length(Specs[["B"]])) { Covar[[b]] <- diag(length(Specs[["B"]][[b]]))}}} Specs[["n"]] <- round(abs(Specs[["n"]])) Specs[["w"]] <- abs(Specs[["w"]]) if(Specs[["w"]] <= 0 || Specs[["w"]] >= 1) { Specs[["w"]] <- 0.05 cat("\nw was misspecified and changed to 0.05.\n", file=LogFile, append=TRUE)} } else if(Algorithm == "AMWG") { Algorithm <- "Adaptive Metropolis-within-Gibbs" if(missing(Specs) | is.null(Specs)) Specs=list(B=NULL, n=0, Periodicity=50) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("B","n","Periodicity") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) } else if(Algorithm == "CHARM") { Algorithm <- "Componentwise Hit-And-Run Metropolis" if(missing(Specs) | is.null(Specs)) Specs <- list(alpha.star=NA) else { if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("alpha.star") %in% names(Specs))) stop("The Specs argument is incorrect", file=LogFile, append=TRUE) Specs[["alpha.star"]] <- abs(as.vector(Specs[["alpha.star"]])[1]) if(Specs[["alpha.star"]] <= 0 | Specs[["alpha.star"]] >= 1) { cat("\nalpha.star not in (0,1), set to 0.44.\n", file=LogFile, append=TRUE) alpha.star <- 0.44}} } else if(Algorithm == "DEMC") { Algorithm <- "Differential Evolution Markov Chain" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Nc","Z","gamma","w") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["Nc"]] <- max(abs(round(Specs[["Nc"]])), 3) if(!is.null(Specs[["Z"]])) { if(is.matrix(Specs[["Z"]])) { if(ncol(Specs[["Z"]]) != length(Initial.Values)) stop("Z has the wrong number of columns.", file=LogFile, append=TRUE) if(nrow(Specs[["Z"]]) != (floor(Iterations/Thinning)+1)) { Z.temp <- Specs[["Z"]][nrow(Specs[["Z"]]),] if(nrow(Specs[["Z"]]) < (floor(Iterations/Thinning)+1)) { Specs[["Z"]] <- rbind(Specs[["Z"]], Specs[["Z"]][1:(floor(Iterations/Thinning)+1-nrow(Specs[["Z"]])),]) } else if(nrow(Specs[["Z"]]) > (floor(Iterations/Thinning)+1)) Specs[["Z"]] <- Specs[["Z"]][1:(floor(Iterations/Thinning)+1),] Specs[["Z"]][1,] <- Z.temp } Specs[["Z"]] <- array(Specs[["Z"]], dim=c(floor(Iterations/Thinning)+1, length(Initial.Values), Specs[["Nc"]]))} if(dim(Specs[["Z"]])[1] != floor(Iterations/Thinning)+1) stop("The first dimension of Z is incorrect.", file=LogFile, append=TRUE) if(dim(Specs[["Z"]])[2] != length(Initial.Values)) stop("The second dimension of Z is incorrect.", file=LogFile, append=TRUE) if(dim(Specs[["Z"]])[3] != Specs[["Nc"]]) stop("The third dimension of Z is incorrect.", file=LogFile, append=TRUE)} if(is.null(Specs[["gamma"]])) Specs[["gamma"]] <- 2.381204 / sqrt(2*length(Initial.Values)) else Specs[["gamma"]] <- abs(Specs[["gamma"]]) Specs[["w"]] <- interval(Specs[["w"]], 0, 1) } else if(Algorithm == "DRAM") { Algorithm <- "Delayed Rejection Adaptive Metropolis" if(missing(Specs) | is.null(Specs)) Specs=list(Adaptive=floor(Iterations/2), Periodicity=1) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Adaptive","Periodicity") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) } else if(Algorithm == "DRM") { Algorithm <- "Delayed Rejection Metropolis" Specs <- NULL } else if(Algorithm == "ESS") { Algorithm <- "Elliptical Slice Sampler" if(missing(Specs) | is.null(Specs)) Specs=list(B=NULL) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("B") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(is.null(Specs[["B"]])) Specs[["B"]] <- list() } else if(Algorithm == "Experimental") { Specs=NULL } else if(Algorithm == "GG") { Algorithm <- "Griddy-Gibbs" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Grid","dparm","CPUs","Packages","Dyn.libs") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(is.list(Specs[["Grid"]])) { if(length(Specs[["Grid"]]) != length(Initial.Values)) { Specs[["Grid"]] <- list(NULL) for (i in 1:length(Initial.Values)) Specs[["Grid"]][[i]] <- seq(from=-0.1, to=0.1, len=5) cat("\nGrid was misspecified and changed to default.\n", file=LogFile, append=TRUE)} } else { temp <- as.vector(Specs[["Grid"]]) Specs[["Grid"]] <- list(NULL) for (i in 1:length(Initial.Values)) Specs[["Grid"]][[i]] <- temp} if(!is.null(Specs[["dparm"]])) { Specs[["dparm"]] <- unique(interval(round(Specs[["dparm"]]), 1, length(Initial.Values))) Specs[["dparm"]] <- Specs[["dparm"]][order(Specs[["dparm"]])]} else Specs[["dparm"]] <- 0 Specs[["CPUs"]] <- max(1, abs(round(Specs[["CPUs"]]))) } else if(Algorithm == "Gibbs") { Algorithm <- "Gibbs Sampler" if(missing(Specs) | is.null(Specs)) { cat("\nSpecs missing or null, Algorithm changed to MWG.\n", file=LogFile, append=TRUE) Algorithm == "MWG" Specs <- NULL } else { if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("FC","MWG") %in% names(Specs))) stop("The Specs argument is incorrect", file=LogFile, append=TRUE) if(!is.function(Specs[["FC"]])) stop("FC must be a function.", file=LogFile, append=TRUE) FCtest <- try(Specs[["FC"]](Initial.Values, Data), silent=TRUE) if(inherits(FCtest, "try-error")) stop("Error in FC.", file=LogFile, append=TRUE) if(!is.vector(FCtest)) stop("FC must return a vector.", file=LogFile, append=TRUE) if(length(FCtest) != length(Initial.Values)) stop("Length of parameters to/from FC differs.", file=LogFile, append=TRUE) if(!is.null(Specs[["MWG"]]) & !is.vector(Specs[["MWG"]]) & !is.numeric(Specs[["MWG"]])) stop("MWG must be a numeric vector.", file=LogFile, append=TRUE)} } else if(Algorithm == "HARM") { Algorithm <- "Hit-And-Run Metropolis" if(missing(Specs) | is.null(Specs)) Specs <- list(alpha.star=NA, B=NULL) else { if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("alpha.star","B") %in% names(Specs))) stop("The Specs argument is incorrect", file=LogFile, append=TRUE) Specs[["alpha.star"]] <- abs(as.vector(Specs[["alpha.star"]])[1]) if(Specs[["alpha.star"]] <= 0 | Specs[["alpha.star"]] >= 1) { cat("\nalpha.star not in (0,1), set to 0.234.\n", file=LogFile, append=TRUE) alpha.star <- 0.234} if(is.na(Specs[["alpha.star"]]) & !is.null(Specs[["B"]])) alpha.star <- 0.234} if(is.null(Specs[["B"]])) Specs[["B"]] <- list() } else if(Algorithm == "HMC") { Algorithm <- "Hamiltonian Monte Carlo" if(missing(Specs) | is.null(Specs)) Specs=list(epsilon=rep(1/length(Initial.Values), length(Initial.Values)), L=2, m=rep(1, length(Initial.Values))) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("epsilon","L","m") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["epsilon"]] <- abs(Specs[["epsilon"]]) if(length(Specs[["epsilon"]]) != length(Initial.Values)) { Specs[["epsilon"]] <- rep(Specs[["epsilon"]][1], length(Initial.Values))} Specs[["L"]] <- abs(round(Specs[["L"]])) if(Specs[["L"]] < 1) { cat("\nL has been increased to its minimum: 1.\n", file=LogFile, append=TRUE) L <- 1} if(is.null(Specs[["m"]])) Specs[["m"]] <- diag(length(Initial.Values)) } else if(Algorithm == "HMCDA") { Algorithm <- "Hamiltonian Monte Carlo with Dual-Averaging" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("A","delta","epsilon","Lmax","lambda") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["A"]] <- min(round(abs(Specs[["A"]])), Iterations) Specs[["delta"]] <- max(min(abs(Specs[["delta"]]), 1), 1/Iterations) if(!is.null(Specs[["epsilon"]])) Specs[["epsilon"]] <- abs(Specs[["epsilon"]][1]) Specs[["Lmax"]] <- abs(round(Specs[["Lmax"]])) Specs[["lambda"]] <- abs(Specs[["lambda"]]) if(!is.null(Specs[["epsilon"]])) if(Specs[["lambda"]] < Specs[["epsilon"]]) Specs[["lambda"]] <- Specs[["epsilon"]] } else if(Algorithm == "IM") { Algorithm <- "Independence Metropolis" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("mu") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["mu"]] <- as.vector(Specs[["mu"]]) if(length(Specs[["mu"]]) != length(Initial.Values)) stop("length(mu) != length(Initial.Values).", file=LogFile, append=TRUE) } else if(Algorithm == "INCA") { Algorithm <- "Interchain Adaptation" if(missing(Specs) | is.null(Specs)) Specs=list(Adaptive=floor(Iterations/2), Periodicity=1) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Adaptive","Periodicity") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) } else if(Algorithm == "MALA") { Algorithm <- "Metropolis-Adjusted Langevin Algorithm" if(missing(Specs) | is.null(Specs)) Specs=list(A=1e7, alpha.star=0.574, delta=1, epsilon=c(1e-6,1e-7)) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("A","alpha.star","gamma","delta","epsilon") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["A"]] <- abs(Specs[["A"]][1]) Specs[["gamma"]] <- min(max(Specs[["gamma"]][1], 0), Iterations) Specs[["delta"]] <- min(max(Specs[["delta"]][1], 1e-10), 1000) Specs[["epsilon"]] <- abs(Specs[["epsilon"]][1:2]) } else if(Algorithm == "MCMCMC") { Algorithm <- "Metropolis-Coupled Markov Chain Monte Carlo" if(missing(Specs) | is.null(Specs)) Specs <- list(lambda=1, CPUs=1, Packages=NULL, Dyn.libs=NULL) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("lambda","CPUs","Packages","Dyn.libs") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["lambda"]] <- abs(Specs[["lambda"]]) if(Specs[["CPUs"]] <= 1) cat("\nCPUs must be at least 2. Attempting 2 CPUs...\n", file=LogFile, append=TRUE) Specs[["CPUs"]] <- max(2, abs(round(Specs[["CPUs"]]))) } else if(Algorithm == "MTM") { Algorithm <- "Multiple-Try Metropolis" if(missing(Specs) | is.null(Specs)) Specs <- list(K=4, CPUs=1, Packages=NULL, Dyn.libs=NULL) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("K","CPUs","Packages","Dyn.libs") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["K"]] <- abs(round(Specs[["K"]])) if(Specs[["CPUs"]] < 1) cat("\nCPUs must be at least 1.\n", file=LogFile, append=TRUE) Specs[["CPUs"]] <- max(1, abs(round(Specs[["CPUs"]]))) } else if(Algorithm == "MWG") { Algorithm <- "Metropolis-within-Gibbs" if(missing(Specs) | is.null(Specs)) Specs <- list(B=NULL) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("B") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) } else if(Algorithm == "NUTS") { Algorithm <- "No-U-Turn Sampler" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("A","delta","epsilon","Lmax") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["A"]] <- max(min(round(abs(Specs[["A"]])), Iterations),1) Specs[["delta"]] <- max(min(abs(Specs[["delta"]]), 1), 1/Iterations) if(!is.null(Specs[["epsilon"]])) Specs[["epsilon"]] <- abs(Specs[["epsilon"]][1]) Specs[["Lmax"]] <- round(abs(Specs[["Lmax"]])) } else if(Algorithm == "OHSS") { Algorithm <- "Oblique Hyperrectangle Slice Sampler" if(missing(Specs) | is.null(Specs)) Specs <- list(A=Iterations+1, n=0) else { if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("A", "n") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["A"]] <- round(abs(Specs[["A"]])) Specs[["n"]] <- round(abs(Specs[["n"]]))} } else if(Algorithm == "pCN") { Algorithm <- "Preconditioned Crank-Nicolson" if(missing(Specs) | is.null(Specs)) Specs <- list(beta=0.01) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("beta") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["beta"]] <- max(min(Specs[["beta"]], 1), 0) } else if(Algorithm == "RAM") { Algorithm <- "Robust Adaptive Metropolis" if(missing(Specs) | is.null(Specs)) Specs=list(alpha.star=0.234, B=NULL, Dist="N", gamma=0.66, n=0) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("alpha.star","B","Dist","gamma","n") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["alpha.star"]] <- Specs[["alpha.star"]][1] if(Specs[["alpha.star"]] <= 0 || Specs[["alpha.star"]] >= 1) { cat("\nalpha.star not in (0,1). Changed to 0.234.\n", file=LogFile, append=TRUE) Specs[["alpha.star"]] <- 0.234} if(!is.null(Specs[["B"]])) { if(is.null(Covar)) { Covar <- list(NULL) for (b in 1:length(Specs[["B"]])) { Covar[[b]] <- diag(length(Specs[["B"]][[b]]))}}} if(Specs[["Dist"]] != "t" & Specs[["Dist"]] != "N") { cat("\nDist was not t or N, and changed to N.\n", file=LogFile, append=TRUE) Specs[["Dist"]] <- "N"} Specs[["gamma"]] <- Specs[["gamma"]][1] if(Specs[["gamma"]] <= 0.5 || Specs[["gamma"]] > 1) { cat("\ngamma not in (0.5,1]. Changed to 0.66.\n", file=LogFile, append=TRUE) Specs[["gamma"]] <- 0.66} Specs[["n"]] <- abs(Specs[["n"]][1]) } else if(Algorithm == "RDMH") { Algorithm <- "Random Dive Metropolis-Hastings" Specs <- NULL } else if(Algorithm == "Refractive") { Algorithm <- "Refractive Sampler" if(missing(Specs) | is.null(Specs)) Specs=list(Adaptive=1, m=2, w=0.1, r=1.3) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Adaptive","m","w","r") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["m"]] <- abs(round(Specs[["m"]])) if(length(Specs[["m"]]) != 1) Specs[["m"]] <- Specs[["m"]][1] if(Specs[["m"]] < 2) { cat("\nm was misspecified, and is replaced with 2.\n", file=LogFile, append=TRUE) Specs[["m"]] <- 2} Specs[["w"]] <- abs(Specs[["w"]]) if(length(Specs[["w"]]) != 1) Specs[["w"]] <- Specs[["w"]][1] Specs[["r"]] <- abs(Specs[["r"]]) if(length(Specs[["r"]]) != 1) Specs[["r"]] <- Specs[["r"]][1] } else if(Algorithm == "RJ") { Algorithm <- "Reversible-Jump" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("bin.n","bin.p","parm.p","selectable","selected") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["bin.n"]] <- round(Specs[["bin.n"]]) if(Specs[["bin.n"]] > length(Initial.Values)) Specs[["bin.n"]] <- length(Initial.Values) if(Specs[["bin.n"]] < 1) Specs[["bin.n"]] <- 1 if(Specs[["bin.p"]] < 0 | Specs[["bin.p"]] > 1) { Specs[["bin.p"]] <- interval(Specs[["bin.p"]], 0, 1, reflect=FALSE) cat("\nbin.p must be in [0,1]. It's now", round(Specs[["bin.p"]],5), "\n", file=LogFile, append=TRUE)} Specs[["parm.p"]] <- as.vector(Specs[["parm.p"]]) if(length(Specs[["parm.p"]]) != length(Initial.Values)) { Specs[["parm.p"]] <- rep(Specs[["parm.p"]][1], length(Initial.Values)) cat("\nparm.p now has the correct length, all equal to parm.p[1].\n", file=LogFile, append=TRUE)} Specs[["selectable"]] <- as.vector(Specs[["selectable"]]) if(length(Specs[["selectable"]]) != length(Initial.Values)) { Specs[["selectable"]] <- rep(1, length(Initial.Values)) cat("\nselectable now has the correct length, all set to 1.\n", file=LogFile, append=TRUE)} Specs[["selected"]] <- as.vector(Specs[["selected"]]) if(length(Specs[["selected"]]) != length(Initial.Values)) { Specs[["selected"]] <- rep(1, length(Initial.Values)) cat("\nselected now has the correct length, all set to 1.\n", file=LogFile, append=TRUE)} } else if(Algorithm == "RSS") { Algorithm <- "Reflective Slice Sampler" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("m","w") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["m"]] <- abs(round(Specs[["m"]])) if(length(Specs[["m"]]) != 1) Specs[["m"]] <- Specs[["m"]][1] if(Specs[["m"]] < 1) { cat("\nm was misspecified, and is replaced with 1.\n", file=LogFile, append=TRUE) Specs[["m"]] <- 1} Specs[["w"]] <- abs(Specs[["w"]]) if(length(Specs[["w"]]) != length(Initial.Values)) Specs[["w"]] <- rep(Specs[["w"]], len=length(Initial.Values)) if(any(Specs[["w"]] <= 0)) { cat("\nw was misspecified, and is replaced with 1.\n", file=LogFile, append=TRUE) Specs[["w"]][which(Specs[["w"]] <= 0)] <- 1} } else if(Algorithm == "RWM") { Algorithm <- "Random-Walk Metropolis" if(missing(Specs) | is.null(Specs)) Specs <- list(B=list()) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("B") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) } else if(Algorithm == "SAMWG") { Algorithm <- "Sequential Adaptive Metropolis-within-Gibbs" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Dyn","Periodicity") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(!is.matrix(Specs[["Dyn"]])) Specs[["Dyn"]] <- as.matrix(Specs[["Dyn"]]) } else if(Algorithm == "SGLD") { Algorithm <- "Stochastic Gradient Langevin Dynamics" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("epsilon","file","Nr","Nc","size") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["Nr"]] <- abs(round(Specs[["Nr"]])) Specs[["Nc"]] <- abs(round(Specs[["Nc"]])) Specs[["size"]] <- abs(round(Specs[["size"]])) if(Specs[["size"]] >= Specs[["Nr"]]) stop("size must be less than nr.") if(any(is.na(Specs[["epsilon"]]))) Specs[["epsilon"]] <- 1 / Specs[["Nr"]] if(length(Specs[["epsilon"]]) == 1) Specs[["epsilon"]] <- rep(Specs[["epsilon"]], Iterations) if(length(Specs[["epsilon"]]) > Iterations) Specs[["epsilon"]] <- Specs[["epsilon"]][1:Iterations] } else if(Algorithm == "Slice") { Algorithm <- "Slice Sampler" if(missing(Specs) | is.null(Specs)) Specs <- list(B=NULL, Bounds=c(-Inf,Inf), m=Inf, Type="Continuous", w=1) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("B","Bounds","m","Type","w") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(is.null(Specs[["B"]])) { B <- list() B[[1]] <- 1:length(Initial.Values) Bounds <- list() Bounds[[1]] <- Specs[["Bounds"]] m <- list() m[[1]] <- Specs[["m"]] Type <- list() Type[[1]] <- Specs[["Type"]] w <- list() w[[1]] <- Specs[["w"]] Specs[["B"]] <- B Specs[["Bounds"]] <- Bounds Specs[["m"]] <- m Specs[["Type"]] <- Type Specs[["w"]] <- w} if(!is.list(Specs[["B"]])) stop("B must be a list.", file=LogFile, append=TRUE) if(!is.list(Specs[["Bounds"]])) { Bounds <- list() for (i in 1:length(Initial.Values)) Bounds[[i]] <- Specs[["Bounds"]] Specs[["Bounds"]] <- Bounds} if(!is.list(Specs[["m"]])) { Specs[["m"]] <- abs(Specs[["m"]][1]) m <- list() for (i in 1:length(Initial.Values)) m[[i]] <- Specs[["m"]] Specs[["m"]] <- m} if(!is.list(Specs[["Type"]])) { Specs[["Type"]] <- Specs[["Type"]][1] if(!Specs[["Type"]] %in% c("Continuous", "Nominal", "Ordinal")) Specs[["Type"]] <- "Continuous" Type <- list() for (i in 1:length(Initial.Values)) Type[[i]] <- Specs[["Type"]] Specs[["Type"]] <- Type} if(!is.list(Specs[["w"]])) { Specs[["w"]] <- abs(Specs[["w"]][1]) w <- list() for (i in 1:length(Initial.Values)) w[[i]] <- Specs[["w"]] Specs[["w"]] <- w} } else if(Algorithm == "SMWG") { Algorithm <- "Sequential Metropolis-within-Gibbs" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Dyn") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(!is.matrix(Specs[["Dyn"]])) Specs[["Dyn"]] <- as.matrix(Specs[["Dyn"]]) } else if(Algorithm == "THMC") { Algorithm <- "Tempered Hamiltonian Monte Carlo" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("epsilon","L","m", "Temperature") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["epsilon"]] <- as.vector(abs(Specs[["epsilon"]])) if(length(Specs[["epsilon"]]) != length(Initial.Values)) { cat("\nLength of epsilon is incorrect.\n", file=LogFile, append=TRUE) Specs[["epsilon"]] <- rep(Specs[["epsilon"]][1], length(Initial.Values))} Specs[["L"]] <- abs(round(Specs[["L"]])) if(Specs[["L"]] < 2) { cat("\nL has been increased to its minimum: 2.\n", file=LogFile, append=TRUE) Specs[["L"]] <- 2} if(is.null(Specs[["m"]])) Specs[["m"]] <- diag(length(Initial.Values)) if(Specs[["Temperature"]] <= 0) { cat("\nTemperature is incorrect, changed to 1.\n", file=LogFile, append=TRUE) Specs[["Temperature"]] <- 1} } else if(Algorithm == "twalk") { Algorithm <- "t-walk" if(missing(Specs) | is.null(Specs)) Specs=list(SIV=NULL, n1=4, at=6, aw=1.5) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("SIV","n1","at","aw") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(is.null(Specs[["SIV"]])) { cat("\nGenerating SIV...\n", file=LogFile, append=TRUE) if(!is.null(Data[["PGF"]])) Specs[["SIV"]] <- GIV(Model, Data, PGF=TRUE) else Specs[["SIV"]] <- GIV(Model, Data)} if(!identical(length(Specs[["SIV"]]), length(Initial.Values))) { cat("\nGenerating SIV due to length mismatch.\n", file=LogFile, append=TRUE) if(!is.null(Data[["PGF"]])) Specs[["SIV"]] <- GIV(Model, Data, PGF=TRUE) else Specs[["SIV"]] <- GIV(Model, Data)} Mo2 <- Model(Specs[["SIV"]], Data) if(!is.finite(Mo2[["LP"]])) stop("SIV results in a non-finite posterior.", file=LogFile, append=TRUE) if(!is.finite(Mo2[["Dev"]])) stop("SIV results in a non-finite deviance.", file=LogFile, append=TRUE) Specs[["SIV"]] <- Mo2[["parm"]] rm(Mo2) if(Specs[["n1"]] < 1) { cat("\nn1 must be at least 1. Changed to 4.\n", file=LogFile, append=TRUE) Specs[["n1"]] <- 4} if(Specs[["at"]] <= 0) { cat("\nat must be positive. Changed to 6.\n", file=LogFile, append=TRUE) Specs[["at"]] <- 6} if(Specs[["aw"]] <= 0) { cat("\naw must be positive. Changed to 1.5.\n", file=LogFile, append=TRUE) Specs[["aw"]] <- 1.5} } else if(Algorithm == "UESS") { Algorithm = "Univariate Eigenvector Slice Sampler" if(missing(Specs) | is.null(Specs)) Specs=list(A=Inf, B=NULL, m=100, n=0) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("A","B","m","n") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) Specs[["A"]] <- abs(round(Specs[["A"]])) if(!is.null(Specs[["B"]])) { if(is.null(Covar)) { Covar <- list(NULL) for (b in 1:length(Specs[["B"]])) { Covar[[b]] <- diag(length(Specs[["B"]][[b]]))}}} Specs[["m"]] <- abs(round(Specs[["m"]])) Specs[["n"]] <- abs(round(Specs[["n"]])) } else if(Algorithm == "USAMWG") { Algorithm <- "Updating Sequential Adaptive Metropolis-within-Gibbs" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Dyn","Periodicity","Fit","Begin") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(!is.matrix(Specs[["Dyn"]])) Specs[["Dyn"]] <- as.matrix(Specs[["Dyn"]]) } else if(Algorithm == "USMWG") { Algorithm <- "Updating Sequential Metropolis-within-Gibbs" if(missing(Specs)) stop("The Specs argument is required.", file=LogFile, append=TRUE) if(!is.list(Specs)) stop("The Specs argument is not a list.", file=LogFile, append=TRUE) if(!all(c("Dyn","Fit","Begin") %in% names(Specs))) stop("The Specs argument is incorrect.", file=LogFile, append=TRUE) if(!is.matrix(Specs[["Dyn"]])) Specs[["Dyn"]] <- as.matrix(Specs[["Dyn"]]) } } else {cat("Unknown algorithm has been changed to Metropolis-within-Gibbs.\n", file=LogFile, append=TRUE) Algorithm <- "Metropolis-within-Gibbs" Specs <- NULL} if(!is.null(Specs[["Adaptive"]])) { Specs[["Adaptive"]] <- abs(Specs[["Adaptive"]]) if({Specs[["Adaptive"]] < 1} | {Specs[["Adaptive"]] > Iterations}) Specs[["Adaptive"]] <- Iterations + 1} if(!is.null(Specs[["B"]])) { if(length(Specs[["B"]]) > 0) { if(any(!is.finite(unlist(Specs[["B"]])))) stop("Non-finite values in specification B.", file=LogFile, append=TRUE) if(!identical(as.vector(as.numeric(unlist(Specs[["B"]]))), round(abs(as.vector(as.numeric(unlist(Specs[["B"]]))))))) stop("Specification B must have only positive integers.", file=LogFile, append=TRUE) if(!identical(length(unlist(Specs[["B"]])), length(Initial.Values))) stop("Non-integer values in specification B.", file=LogFile, append=TRUE)}} if(!is.null(Specs[["Periodicity"]])) { Specs[["Periodicity"]] <- abs(Specs[["Periodicity"]]) if({Specs[["Periodicity"]] < 1} | {Specs[["Periodicity"]] > Iterations}) Specs[["Periodicity"]] <- Iterations + 1} Mo0 <- Model(Initial.Values, Data) if(!is.list(Mo0)) stop("Model must return a list.", file=LogFile, append=TRUE) if(length(Mo0) != 5) stop("Model must return five components.", file=LogFile, append=TRUE) if(any(names(Mo0) != c("LP","Dev","Monitor","yhat","parm"))) stop("Name mismatch in returned list of Model function.", file=LogFile, append=TRUE) if(length(Mo0[["LP"]]) > 1) stop("Multiple joint posteriors exist!", file=LogFile, append=TRUE) if(!identical(length(Mo0[["Monitor"]]), length(Data[["mon.names"]]))) stop("Length of mon.names differs from length of monitors.", file=LogFile, append=TRUE) as.character.function <- function(x, ... ) { fname <- deparse(substitute(x)) f <- match.fun(x) out <- c(sprintf('"%s" <- ', fname), capture.output(f)) if(grepl("^[<]", tail(out, 1))) out <- head(out, -1) return(out) } acount <- length(grep("apply", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, "possible instance(s) of apply functions\n", file=LogFile, append=TRUE) cat(" were found in the Model specification. Iteration speed will\n", file=LogFile, append=TRUE) cat(" increase if apply functions are vectorized in R or coded\n", file=LogFile, append=TRUE) cat(" in a faster language such as C++ via the Rcpp package.\n", file=LogFile, append=TRUE)} acount <- length(grep("for", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, "possible instance(s) of for loops\n", file=LogFile, append=TRUE) cat(" were found in the Model specification. Iteration speed will\n", file=LogFile, append=TRUE) cat(" increase if for loops are vectorized in R or coded in a\n", file=LogFile, append=TRUE) cat(" faster language such as C++ via the Rcpp package.\n", file=LogFile, append=TRUE)} rm(acount) if(!identical(Model(Mo0[["parm"]], Data)[["LP"]], Mo0[["LP"]])) { cat("WARNING: LP differs when initial values are held constant.\n", file=LogFile, append=TRUE) cat(" Derivatives may be problematic if used.\n", file=LogFile, append=TRUE)} ######################### Initial Settings ######################### Acceptance <- 0 if(!is.finite(Mo0[["LP"]])) { cat("Generating initial values due to a non-finite posterior.\n", file=LogFile, append=TRUE) if(!is.null(Data[["PGF"]])) Initial.Values <- GIV(Model, Data, PGF=TRUE) else Initial.Values <- GIV(Model, Data) Mo0 <- Model(Initial.Values, Data) } if(is.infinite(Mo0[["LP"]])) stop("The posterior is infinite!", file=LogFile, append=TRUE) if(is.nan(Mo0[["LP"]])) stop("The posterior is not a number!", file=LogFile, append=TRUE) if(is.na(Mo0[["Dev"]])) stop("The deviance is a missing value!", file=LogFile, append=TRUE) if(is.infinite(Mo0[["Dev"]])) stop("The deviance is infinite!", file=LogFile, append=TRUE) if(is.nan(Mo0[["Dev"]])) stop("The deviance is not a number!", file=LogFile, append=TRUE) if(any(is.na(Mo0[["Monitor"]]))) stop("Monitored variable(s) have a missing value!", file=LogFile, append=TRUE) if(any(is.infinite(Mo0[["Monitor"]]))) stop("Monitored variable(s) have an infinite value!", file=LogFile, append=TRUE) if(any(is.nan(Mo0[["Monitor"]]))) stop("Monitored variable(s) include a value that is not a number!", file=LogFile, append=TRUE) if(Algorithm == "t-walk") { Mo0 <- Model(Initial.Values, Data) if(any(Mo0[["parm"]] == Specs[["SIV"]])) stop("Initial.Values and SIV not unique after model update.", file=LogFile, append=TRUE)} ###################### Laplace Approximation ####################### ### Sample Size of Data if(!is.null(Data[["n"]])) if(length(Data[["n"]]) == 1) N <- Data[["n"]] if(!is.null(Data[["N"]])) if(length(Data[["N"]]) == 1) N <- Data[["N"]] if(!is.null(Data[["y"]])) N <- nrow(matrix(Data[["y"]])) if(!is.null(Data[["Y"]])) N <- nrow(matrix(Data[["Y"]])) if(is.null(N)) stop("Sample size of Data not found in n, N, y, or Y.", file=LogFile, append=TRUE) if({all(Initial.Values == 0)} & {N >= 5*length(Initial.Values)}) { cat("\nLaplace Approximation will be used on initial values.\n", file=LogFile, append=TRUE) LIV <- length(Initial.Values) Fit.LA <- LaplaceApproximation(Model, Initial.Values, Data, Method="SPG", CovEst="Identity", sir=FALSE) Covar <- 2.381204 * 2.381204 / length(Initial.Values) * Fit.LA$Covar Initial.Values <- Fit.LA$Summary1[1:length(Initial.Values),1] cat("The covariance matrix from Laplace Approximation has been scaled\n", file=LogFile, append=TRUE) cat("for Laplace's Demon, and the posterior modes are now the initial\n", file=LogFile, append=TRUE) cat("values for Laplace's Demon.\n\n", file=LogFile, append=TRUE)} ######################### Prepare for MCMC ######################### Mo0 <- Model(Initial.Values, Data) Dev <- matrix(Mo0[["Dev"]], floor(Iterations/Thinning)+1, 1) Mon <- matrix(Mo0[["Monitor"]], floor(Iterations/Thinning)+1, length(Mo0[["Monitor"]]), byrow=TRUE) LIV <- length(Initial.Values) thinned <- matrix(Initial.Values, floor(Iterations/Thinning)+1, length(Initial.Values), byrow=TRUE) ScaleF <- 2.381204 * 2.381204 / LIV if(Algorithm %in% c("Adaptive Metropolis", "Adaptive-Mixture Metropolis", "Delayed Rejection Adaptive Metropolis", "Delayed Rejection Metropolis", "Interchain Adaptation", "Metropolis-Coupled Markov Chain Monte Carlo", "Random-Walk Metropolis")) { ### Algorithms that require both VarCov and tuning if(is.list(Covar) & Algorithm != "Adaptive-Mixture Metropolis" & Algorithm != "Random-Walk Metropolis") { Covar <- NULL} else if(is.matrix(Covar) & !is.list(Covar)) { diag(Covar)[which(diag(Covar) < 1e-100)] <- 1e-100 tuning <- sqrt(diag(Covar)) VarCov <- Covar } else if(is.vector(Covar) & !is.list(Covar)) { tuning <- abs(as.vector(Covar)) if(length(tuning) != LIV) tuning <- rep(ScaleF, LIV) tuning[which(tuning < 1e-100)] <- 1e-100 VarCov <- matrix(0, LIV, LIV) diag(VarCov) <- tuning } else if(is.null(Covar)) { tuning <- rep(ScaleF, LIV) VarCov <- matrix(0, LIV, LIV) diag(VarCov) <- tuning } else if(is.list(Covar)) { tuning <- Covar for (i in 1:length(tuning)) { tuning[[i]] <- sqrt(diag(tuning[[i]]))} VarCov <- Covar} if(is.matrix(VarCov) & !is.list(VarCov)) { DiagCovar <- matrix(diag(VarCov), 1, LIV)} else if(is.list(VarCov)) { DiagCovar <- matrix(1, 1, LIV) for (b in 1:length(Specs[["B"]])) { DiagCovar[Specs[["B"]][[b]]] <- diag(VarCov[[b]])}} } else if(Algorithm %in% c("Adaptive Directional Metropolis-within-Gibbs", "Automated Factor Slice Sampler", "Elliptical Slice Sampler", "Independence Metropolis", "Metropolis-Adjusted Langevin Algorithm", "Oblique Hyperrectangle Slice Sampler", "Preconditioned Crank-Nicolson", "Robust Adaptive Metropolis", "Univariate Eigenvector Slice Sampler")) { ### Algorithms that require VarCov, but not tuning if(is.list(Covar)) VarCov <- Covar else if(is.matrix(Covar) & !is.list(Covar)) VarCov <- Covar else if(is.vector(Covar) & !is.list(Covar)) { VarCov <- matrix(0, LIV, LIV) diag(VarCov) <- abs(as.vector(Covar)) diag(VarCov)[which(diag(VarCov) < 1e-100)] <- 1e-100 } else if(is.null(Covar)) { VarCov <- matrix(0, LIV, LIV) diag(VarCov) <- rep(ScaleF, LIV) } else if(is.list(Covar)) VarCov <- Covar if(is.matrix(VarCov) & !is.list(VarCov)) DiagCovar <- matrix(diag(VarCov), 1, LIV) else if(is.list(VarCov)) { DiagCovar <- matrix(1, 1, LIV) for (b in 1:length(Specs[["B"]])) { DiagCovar[Specs[["B"]][[b]]] <- diag(VarCov[[b]])}} } else if(Algorithm %in% c("Adaptive Griddy-Gibbs", "Adaptive Metropolis-within-Gibbs", "Gibbs Sampler", "Metropolis-within-Gibbs", "Multiple-Try Metropolis", "Sequential Adaptive Metropolis-within-Gibbs", "Sequential Metropolis-within-Gibbs", "Updating Sequential Adaptive Metropolis-within-Gibbs", "Updating Sequential Metropolis-within-Gibbs")) { ### Algorithms that do not require VarCov, but require tuning if(is.list(Covar)) Covar <- NULL else if(is.matrix(Covar) & !is.list(Covar)) { tuning <- sqrt(diag(Covar)) tuning[which(tuning < 1e-100)] <- 1e-100 } else if(is.vector(Covar) & !is.list(Covar)) { tuning <- abs(as.vector(Covar)) if(length(tuning) != length(Initial.Values)) tuning <- rep(ScaleF, LIV) tuning[which(tuning < 1e-100)] <- 1e-100 } else if(is.null(Covar)) { tuning <- rep(ScaleF, LIV)} VarCov <- NULL DiagCovar <- matrix(tuning, 1, LIV) } else { ### Algorithms that do not require VarCov or tuning VarCov <- NULL DiagCovar <- matrix(1, 1, LIV) } rm(Covar) ############################ Begin MCMC ############################ cat("Algorithm:", Algorithm, "\n", file=LogFile, append=TRUE) cat("\nLaplace's Demon is beginning to update...\n", file=LogFile, append=TRUE) options(warn=2) on.exit(options(warn=0)) if(Algorithm == "Adaptive Directional Metropolis-within-Gibbs") { mcmc.out <- .mcmcadmg(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Adaptive Griddy-Gibbs") { mcmc.out <- .mcmcagg(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, Debug, LogFile)} else if(Algorithm == "Adaptive Hamiltonian Monte Carlo") { mcmc.out <- .mcmcahmc(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Affine-Invariant Ensemble Sampler") { mcmc.out <- .mcmcaies(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Adaptive Metropolis") { mcmc.out <- .mcmcam(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile)} else if(Algorithm == "Adaptive-Mixture Metropolis" & !is.list(VarCov)) { mcmc.out <- .mcmcamm(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile)} else if(Algorithm == "Adaptive-Mixture Metropolis" & is.list(VarCov)) { mcmc.out <- .mcmcamm.b(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile)} else if(Algorithm == "Adaptive Metropolis-within-Gibbs") { mcmc.out <- .mcmcamwg(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, Debug, LogFile)} else if(Algorithm == "Automated Factor Slice Sampler") { mcmc.out <- .mcmcafss(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Componentwise Hit-And-Run Metropolis") { mcmc.out <- .mcmccharm(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Delayed Rejection Adaptive Metropolis") { mcmc.out <- .mcmcdram(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile)} else if(Algorithm == "Delayed Rejection Metropolis") { mcmc.out <- .mcmcdrm(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile)} else if(Algorithm == "Differential Evolution Markov Chain") { mcmc.out <- .mcmcdemc(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Elliptical Slice Sampler") { mcmc.out <- .mcmcess(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Experimental") { # mcmc.out <- .mcmcexperimental(Model, Data, Iterations, Status, # Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, # ScaleF, thinned, Debug, LogFile)} stop("Experimental function not found.", file=LogFile, append=TRUE)} else if(Algorithm == "Gibbs Sampler") { mcmc.out <- .mcmcgibbs(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, Debug, LogFile)} else if(Algorithm == "Griddy-Gibbs") { mcmc.out <- .mcmcgg(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Hamiltonian Monte Carlo") { mcmc.out <- .mcmchmc(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Hamiltonian Monte Carlo with Dual-Averaging") { mcmc.out <- .mcmchmcda(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Hit-And-Run Metropolis") { mcmc.out <- .mcmcharm(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Independence Metropolis") { mcmc.out <- .mcmcim(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Interchain Adaptation") { mcmc.out <- .mcmcinca(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile)} else if(Algorithm == "Metropolis-Adjusted Langevin Algorithm") { mcmc.out <- .mcmcmala(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Metropolis-Coupled Markov Chain Monte Carlo") { mcmc.out <- .mcmcmcmcmc(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile)} else if(Algorithm == "Multiple-Try Metropolis") { mcmc.out <- .mcmcmtm(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, thinned, tuning, Debug, LogFile)} else if(Algorithm == "Metropolis-within-Gibbs") { mcmc.out <- .mcmcmwg(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, Debug, LogFile)} else if(Algorithm == "No-U-Turn Sampler") { mcmc.out <- .mcmcnuts(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Oblique Hyperrectangle Slice Sampler") { mcmc.out <- .mcmcohss(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Preconditioned Crank-Nicolson") { mcmc.out <- .mcmcpcn(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Random Dive Metropolis-Hastings") { mcmc.out <- .mcmcrdmh(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Random-Walk Metropolis") { mcmc.out <- .mcmcrwm(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile)} else if(Algorithm == "Refractive Sampler") { mcmc.out <- .mcmcrefractive(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, thinned, Debug, LogFile)} else if(Algorithm == "Reflective Slice Sampler") { mcmc.out <- .mcmcrss(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, thinned, Debug, LogFile)} else if(Algorithm == "Reversible-Jump") { mcmc.out <- .mcmcrj(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Robust Adaptive Metropolis") { mcmc.out <- .mcmcram(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Sequential Adaptive Metropolis-within-Gibbs") { mcmc.out <- .mcmcsamwg(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, parm.names=Data[["parm.names"]], Debug, LogFile)} else if(Algorithm == "Sequential Metropolis-within-Gibbs") { mcmc.out <- .mcmcsmwg(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, parm.names=Data[["parm.names"]], Debug, LogFile)} else if(Algorithm == "Stochastic Gradient Langevin Dynamics") { mcmc.out <- .mcmcsgld(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Slice Sampler") { mcmc.out <- .mcmcslice(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Tempered Hamiltonian Monte Carlo") { mcmc.out <- .mcmcthmc(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "t-walk") { mcmc.out <- .mcmctwalk(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile)} else if(Algorithm == "Univariate Eigenvector Slice Sampler") { mcmc.out <- .mcmcuess(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile)} else if(Algorithm == "Updating Sequential Adaptive Metropolis-within-Gibbs") { mcmc.out <- .mcmcusamwg(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, parm.names=Data[["parm.names"]], Debug, LogFile)} else if(Algorithm == "Updating Sequential Metropolis-within-Gibbs") { mcmc.out <- .mcmcusmwg(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, parm.names=Data[["parm.names"]], Debug, LogFile)} else stop("The algorithm is unrecognized.", file=LogFile, append=TRUE) options(warn=0) ######################### MCMC is Finished ######################### Acceptance <- mcmc.out$Acceptance Dev <- mcmc.out$Dev DiagCovar <- mcmc.out$DiagCovar Mon <- mcmc.out$Mon thinned <- mcmc.out$thinned VarCov <- mcmc.out$VarCov remove(mcmc.out) rownames(DiagCovar) <- NULL colnames(DiagCovar) <- Data[["parm.names"]] thinned <- matrix(thinned[-1,], nrow(thinned)-1, ncol(thinned)) Dev <- matrix(Dev[-1,], nrow(Dev)-1, 1) Mon <- matrix(Mon[-1,], nrow(Mon)-1, ncol(Mon)) if(is.matrix(VarCov) & !is.list(VarCov)) { colnames(VarCov) <- rownames(VarCov) <- Data[["parm.names"]]} else if(is.vector(VarCov) & !is.list(VarCov)) { names(VarCov) <- Data[["parm.names"]]} thinned.rows <- nrow(thinned) ### Warnings (After Updating) if(any(Acceptance == 0)) cat("\nWARNING: All proposals were rejected.\n", file=LogFile, append=TRUE) ### Real Values thinned[which(!is.finite(thinned))] <- 0 Dev[which(!is.finite(Dev))] <- 0 Mon[which(!is.finite(Mon))] <- 0 ### Assess Stationarity cat("\nAssessing Stationarity\n", file=LogFile, append=TRUE) if(thinned.rows %% 10 == 0) thinned2 <- thinned if(thinned.rows %% 10 != 0) thinned2 <- thinned[1:(10*trunc(thinned.rows/10)),] HD <- BMK.Diagnostic(thinned2, batches=10) Ind <- 1 * (HD > 0.5) BurnIn <- thinned.rows batch.list <- seq(from=1, to=nrow(thinned2), by=floor(nrow(thinned2)/10)) for (i in 1:9) { if(sum(Ind[,i:9]) == 0) { BurnIn <- batch.list[i] - 1 break}} Stat.at <- BurnIn + 1 rm(batch.list, HD, Ind, thinned2) ### Assess Thinning and ESS Size for all parameter samples cat("Assessing Thinning and ESS\n", file=LogFile, append=TRUE) acf.rows <- trunc(10*log10(thinned.rows)) acf.temp <- matrix(1, acf.rows, LIV) ESS1 <- Rec.Thin <- rep(1, LIV) for (j in 1:LIV) { temp0 <- acf(thinned[,j], lag.max=acf.rows, plot=FALSE) if(length(temp0$acf[-1,1,1]) == acf.rows) acf.temp[,j] <- abs(temp0$acf[-1,1,1]) ESS1[j] <- ESS(thinned[,j]) Rec.Thin[j] <- which(acf.temp[,j] <= 0.1)[1]*Thinning} Rec.Thin[which(is.na(Rec.Thin))] <- nrow(acf.temp) ESS3 <- ESS(Mon) ### Posterior Summary Table 1: All Thinned Samples cat("Creating Summaries\n", file=LogFile, append=TRUE) Num.Mon <- ncol(Mon) Summ1 <- matrix(NA, LIV, 7, dimnames=list(Data[["parm.names"]], c("Mean","SD","MCSE","ESS","LB","Median","UB"))) Summ1[,1] <- colMeans(thinned) Summ1[,2] <- sqrt(.colVars(thinned)) Summ1[,3] <- 0 Summ1[,4] <- ESS1 rm(ESS1) Summ1[,5] <- apply(thinned, 2, quantile, c(0.025), na.rm=TRUE) Summ1[,6] <- apply(thinned, 2, quantile, c(0.500), na.rm=TRUE) Summ1[,7] <- apply(thinned, 2, quantile, c(0.975), na.rm=TRUE) for (i in 1:ncol(thinned)) { temp <- try(MCSE(thinned[,i]), silent=!Debug[["DB.MCSE"]]) if(!inherits(temp, "try-error")) Summ1[i,3] <- temp else { if(Debug[["DB.MCSE"]] == TRUE) cat("MCSE of", Data[["parm.names"]][i], "failed in Summary1\n", file=LogFile, append=TRUE) Summ1[i,3] <- MCSE(thinned[,i], method="sample.variance")}} Deviance <- rep(NA,7) Deviance[1] <- mean(Dev) Deviance[2] <- sd(as.vector(Dev)) temp <- try(MCSE(as.vector(Dev)), silent=!Debug[["DB.MCSE"]]) if(inherits(temp, "try-error")) { if(Debug[["DB.MCSE"]] == TRUE) cat("MCSE of deviance failed in Summary1\n", file=LogFile, append=TRUE) temp <- MCSE(as.vector(Dev), method="sample.variance")} Deviance[3] <- temp Deviance[4] <- ESS(Dev) Deviance[5] <- as.numeric(quantile(Dev, probs=0.025, na.rm=TRUE)) Deviance[6] <- as.numeric(quantile(Dev, probs=0.500, na.rm=TRUE)) Deviance[7] <- as.numeric(quantile(Dev, probs=0.975, na.rm=TRUE)) Summ1 <- rbind(Summ1, Deviance) for (j in 1:Num.Mon) { Monitor <- rep(NA,7) Monitor[1] <- mean(Mon[,j]) Monitor[2] <- sd(as.vector(Mon[,j])) temp <- try(MCSE(as.vector(Mon[,j])), silent=!Debug[["DB.MCSE"]]) if(inherits(temp, "try-error")) { if(Debug[["DB.MCSE"]] == TRUE) cat("MCSE of", Data[["mon.names"]][j], "failed in Summary1\n", file=LogFile, append=TRUE) temp <- MCSE(Mon[,j], method="sample.variance")} Monitor[3] <- temp Monitor[4] <- ESS3[j] Monitor[5] <- as.numeric(quantile(Mon[,j], probs=0.025, na.rm=TRUE)) Monitor[6] <- as.numeric(quantile(Mon[,j], probs=0.500, na.rm=TRUE)) Monitor[7] <- as.numeric(quantile(Mon[,j], probs=0.975, na.rm=TRUE)) Summ1 <- rbind(Summ1, Monitor) rownames(Summ1)[nrow(Summ1)] <- Data[["mon.names"]][j]} rm(ESS3) ### Posterior Summary Table 2: Stationary Samples Summ2 <- matrix(NA, LIV, 7, dimnames=list(Data[["parm.names"]], c("Mean","SD","MCSE","ESS","LB","Median","UB"))) if(Stat.at < thinned.rows) { ESS6 <- ESS(Mon[Stat.at:thinned.rows,]) thinned2 <- matrix(thinned[Stat.at:thinned.rows,], thinned.rows-Stat.at+1, ncol(thinned)) Dev2 <- matrix(Dev[Stat.at:thinned.rows,], thinned.rows-Stat.at+1, ncol(Dev)) Mon2 <- matrix(Mon[Stat.at:thinned.rows,], thinned.rows-Stat.at+1, ncol(Mon)) Summ2[,1] <- colMeans(thinned2) Summ2[,2] <- sqrt(.colVars(thinned2)) Summ2[,3] <- 0 Summ2[,4] <- ESS(thinned[Stat.at:thinned.rows,]) Summ2[,5] <- apply(thinned2, 2, quantile, c(0.025), na.rm=TRUE) Summ2[,6] <- apply(thinned2, 2, quantile, c(0.500), na.rm=TRUE) Summ2[,7] <- apply(thinned2, 2, quantile, c(0.975), na.rm=TRUE) for (i in 1:ncol(thinned2)) { temp <- try(MCSE(thinned2[,i]), silent=!Debug[["DB.MCSE"]]) if(!inherits(temp, "try-error")) Summ2[i,3] <- temp else { if(Debug[["DB.MCSE"]] == TRUE) cat("MCSE of", Data[["parm.names"]][i], "failed in Summary2\n", file=LogFile, append=TRUE) Summ2[i,3] <- MCSE(thinned2[,i], method="sample.variance")}} Deviance <- rep(NA,7) Deviance[1] <- mean(Dev2) Deviance[2] <- sd(as.vector(Dev2)) temp <- try(MCSE(as.vector(Dev2)), silent=!Debug[["DB.MCSE"]]) if(inherits(temp, "try-error")) { if(Debug[["DB.MCSE"]] == TRUE) cat("MCSE of deviance failed in Summary2\n", file=LogFile, append=TRUE) temp <- MCSE(as.vector(Dev2), method="sample.variance")} Deviance[3] <- temp Deviance[4] <- ESS(Dev[Stat.at:thinned.rows,]) Deviance[5] <- as.numeric(quantile(Dev2, probs=0.025, na.rm=TRUE)) Deviance[6] <- as.numeric(quantile(Dev2, probs=0.500, na.rm=TRUE)) Deviance[7] <- as.numeric(quantile(Dev2, probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Deviance) for (j in 1:Num.Mon) { Monitor <- rep(NA,7) Monitor[1] <- mean(Mon2[,j]) Monitor[2] <- sd(as.vector(Mon2[,j])) temp <- try(MCSE(as.vector(Mon2[,j])), silent=!Debug[["DB.MCSE"]]) if(inherits(temp, "try-error")) { if(Debug[["DB.MCSE"]] == TRUE) cat("MCSE of", Data[["mon.names"]][j], "failed in Summary2\n", file=LogFile, append=TRUE) temp <- MCSE(Mon2[,j], method="sample.variance")} Monitor[3] <- temp Monitor[4] <- ESS6[j] Monitor[5] <- as.numeric(quantile(Mon2[,j], probs=0.025, na.rm=TRUE)) Monitor[6] <- as.numeric(quantile(Mon2[,j], probs=0.500, na.rm=TRUE)) Monitor[7] <- as.numeric(quantile(Mon2[,j], probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Monitor) rownames(Summ2)[nrow(Summ2)] <- Data[["mon.names"]][j]} rm(ESS6) } ### Column names to samples if(identical(ncol(Mon), length(Data[["mon.names"]]))) colnames(Mon) <- Data[["mon.names"]] if(identical(ncol(thinned), length(Data[["parm.names"]]))) { colnames(thinned) <- Data[["parm.names"]]} ### Logarithm of the Marginal Likelihood LML <- list(LML=NA, VarCov=NA) if(Algorithm %in% c("Adaptive Griddy-Gibbs", "Affine-Invariant Ensemble Sampler", "Automated Factor Slice Sampler", "Componentwise Hit-And-Run Metropolis", "Delayed Rejection Metropolis", "Elliptical Slice Sampler", "Gibbs Sampler", "Griddy-Gibbs", "Hamiltonian Monte Carlo", "Hit-And-Run Metropolis", "Independence Metropolis", "Metropolis-Adjusted Langevin Algorithm", "Metropolis-Coupled Markov Chain Monte Carlo", "Metropolis-within-Gibbs", "Multiple-Try Metropolis", "No-U-Turn Sampler", "Oblique Hyperrectangle Slice Sampler", "Preconditioned Crank-Nicolson", "Random Dive Metropolis-Hastings", "Random-Walk Metropolis", "Reflective Slice Sampler", "Refractive Sampler", "Reversible-Jump", "Sequential Metropolis-within-Gibbs", "Slice Sampler", "Stochastic Gradient Langevin Dynamics", "Tempered Hamiltonian Monte Carlo", "t-walk", "Univariate Eigenvector Slice Sampler") & {Stat.at < thinned.rows}) { cat("Estimating Log of the Marginal Likelihood\n", file=LogFile, append=TRUE) LML <- LML(theta=thinned2, LL=as.vector(Dev2)*(-1/2), method="NSIS")} time2 <- proc.time() ### Compile Output cat("Creating Output\n", file=LogFile, append=TRUE) LaplacesDemon.out <- list(Acceptance.Rate=round(Acceptance/Iterations,7), Algorithm=Algorithm, Call=LDcall, Covar=VarCov, CovarDHis=DiagCovar, Deviance=as.vector(Dev), DIC1=c(mean(as.vector(Dev)), var(as.vector(Dev))/2, mean(as.vector(Dev)) + var(as.vector(Dev))/2), DIC2=if(Stat.at < thinned.rows) { c(mean(as.vector(Dev2)), var(as.vector(Dev2))/2, mean(as.vector(Dev2)) + var(as.vector(Dev2))/2)} else rep(NA,3), Initial.Values=Initial.Values, Iterations=Iterations, LML=LML[[1]], Minutes=round(as.vector(time2[3] - time1[3]) / 60,2), Model=Model, Monitor=Mon, Parameters=LIV, Posterior1=thinned, Posterior2=if(Stat.at < thinned.rows) { thinned[Stat.at:thinned.rows,]} else thinned[thinned.rows,], Rec.BurnIn.Thinned=BurnIn, Rec.BurnIn.UnThinned=BurnIn*Thinning, Rec.Thinning=min(1000, max(Rec.Thin)), Specs=Specs, Status=Status, Summary1=Summ1, Summary2=Summ2, Thinned.Samples=thinned.rows, Thinning=Thinning) class(LaplacesDemon.out) <- "demonoid" cat("\nLaplace's Demon has finished.\n", file=LogFile, append=TRUE) return(LaplacesDemon.out) } .mcmcadmg <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { n <- Specs[["n"]] Periodicity <- Specs[["Periodicity"]] Acceptance <- matrix(0, 1, LIV) AccRate <- rep(0, LIV) obs.sum <- matrix(Mo0[["parm"]]*n, LIV, 1) obs.scatter <- tcrossprod(Mo0[["parm"]])*n s <- svd(VarCov) U <- diag(s$u) tol <- LIV*max(s$d)*.Machine$double.eps problem <- any(s$d <= tol) DiagCovar <- matrix(diag(VarCov), floor(Iterations/Thinning)+1, LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Random-Scan Componentwise Estimation if(iter > 10) AccRate <- Acceptance / {iter - 1} if(problem == FALSE) lambda <- U*rnorm(LIV, 0, sqrt(0.01 + s$d*exp(2*s$d*(AccRate - 0.3)))) else lambda <- rnorm(LIV, 0, sqrt(diag(VarCov))) for (j in sample.int(LIV)) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- prop[j] + lambda[j] ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]]) if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}} ### Update Sample and Scatter Sum obs.sum <- obs.sum + Mo0[["parm"]] obs.scatter <- obs.scatter + tcrossprod(Mo0[["parm"]]) ### Adaptation if(iter %% Periodicity == 0) { VarCov <- obs.scatter/{n + iter} - tcrossprod(obs.sum/{n + iter}) diag(VarCov) <- diag(VarCov) + 1e-05 s <- svd(VarCov) U <- diag(s$u) tol <- LIV*max(s$d)*.Machine$double.eps problem <- any(s$d <= tol)} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]] DiagCovar[t.iter,] <- diag(VarCov)} } ### Output out <- list(Acceptance=mean(as.vector(Acceptance)), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcafss <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { A <- Specs[["A"]] Block <- Specs[["B"]] m <- Specs[["m"]] n <- Specs[["n"]] w <- Specs[["w"]] B <- length(Block) targetRatio <- 0.5 if(B == 0) { if(!is.symmetric.matrix(VarCov)) { cat("\nAsymmetric Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.symmetric.matrix(VarCov)} if(!is.positive.definite(VarCov)) { cat("\nNon-Positive-Definite Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.positive.definite(VarCov)} decomp.freq <- max(LIV * floor(Iterations / Thinning / 100), 10) cat("\nEigendecomposition will occur every", decomp.freq, "iterations.\n\n", file=LogFile, append=TRUE) factors <- eigen(VarCov)$vectors obs.sum <- matrix(Mo0[["parm"]]*n, LIV, 1) obs.scatter <- tcrossprod(Mo0[["parm"]])*n DiagCovar <- matrix(w, floor(Iterations/Thinning)+1, LIV, byrow=TRUE) nExpands <- nShrinks <- rep(0, LIV) IterPerAdapt <- 1 nProposals <- 0 for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Random-Scan Componentwise Estimation for (j in sample.int(LIV)) { y.slice <- Mo0[["LP"]] - rexp(1) upper <- runif(1,0,w[j]) lower <- upper - w[j] ### Step Out count <- 0 while (count <= m[j]) { Mo1 <- try(Model(Mo0[["parm"]] + lower*factors[,j], Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out the lower", "bound failed for", Data[["parm.names"]][j], "in step", count+1, ".\n", file=LogFile, append=TRUE) lower <- lower + w[j] break} else if(!is.finite(Mo1[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out the lower", "bound for", Data[["parm.names"]][j], "resulted in a non-finite LP", "in step", count+1, ".\n", file=LogFile, append=TRUE) lower <- lower + w[j] break} nExpands[j] <- nExpands[j] + 1 if(Mo1[["LP"]] <= y.slice) break lower <- lower - w[j] count <- count + 1 } count <- 0 while (count <= m[j]) { Mo1 <- try(Model(Mo0[["parm"]] + upper*factors[,j], Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out the upper", "bound failed for", Data[["parm.names"]][j], "in step", count+1, ".\n", file=LogFile, append=TRUE) upper <- upper - w[j] break} else if(!is.finite(Mo1[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out the upper", "bound for", Data[["parm.names"]][j], "resulted in a non-finite LP", "in step", count+1, ".\n", file=LogFile, append=TRUE) upper <- upper - w[j] break} nExpands[j] <- nExpands[j] + 1 if(Mo1[["LP"]] <= y.slice) break upper <- upper + w[j] count <- count + 1 } ### Rejection Sampling repeat { lower <- -abs(min(lower, upper)) upper <- abs(max(lower, upper)) prop <- runif(1, lower, upper) Mo1 <- try(Model(Mo0[["parm"]] + prop * factors[,j], Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Rejection sampling", "failed for", Data[["parm.names"]][j], "\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Rejection sampling for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) Mo1 <- Mo0} if(Mo1[["LP"]] >= y.slice) break else if(abs(prop) < 1e-100) break nShrinks[j] <- nShrinks[j] + 1 if(prop < 0) lower <- prop else upper <- prop } Mo0 <- Mo1 } nProposals <- nProposals + 1 obs.sum <- obs.sum + Mo0[["parm"]] obs.scatter <- obs.scatter + tcrossprod(Mo0[["parm"]]) ### Adaptation if({iter <= A} & {A - iter >= decomp.freq}) { ### Tune Interval Widths if(nProposals %% IterPerAdapt == 0) { denom <- nExpands + nShrinks for (j in 1:LIV) { if(denom[j] > 0) { ratio <- nExpands[j] / denom[j] if(ratio == 0) ratio <- 1 / denom[j] multiplier <- ratio / targetRatio w[j] <- w[j]*multiplier } } nExpands <- nShrinks <- rep(0,LIV) nProposals <- 0 IterPerAdapt <- IterPerAdapt * 2} ### Tune Sampling Factors if(iter %% decomp.freq == 0) { VarCov <- obs.scatter/{n + iter} - tcrossprod(obs.sum/{n + iter}) factors <- eigen(VarCov)$vectors nExpands <- nShrinks <- rep(0,LIV) IterPerAdapt <- 1 nProposals <- 0} } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]] DiagCovar[t.iter,] <- w} } } else { if(!identical(length(VarCov), B)) stop("Number of components in Covar differs from number ", "of blocks.", file=LogFile, append=TRUE) factors <- obs.sum <- obs.scatter <- list() decomp.freq <- rep(0, length(B)) for (b in 1:B) { if(length(Block[[b]]) == 1) stop("Single-parameter blocks are not allowed in AFSS.", file=LogFile, append=TRUE) if(!identical(length(Block[[b]]), length(diag(VarCov[[b]])))) stop("Diagonal of Covar[[",b,"]] differs from block length.") if(!is.symmetric.matrix(VarCov[[b]])) { cat("\nAsymmetric Covar block, correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.symmetric.matrix(VarCov[[b]])} if(!is.positive.definite(VarCov[[b]])) { cat("\nNon-Positive-Definite Covar block,", "correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.positive.definite(VarCov[[b]])} decomp.freq[b] <- max(length(Block[[b]]) * floor(Iterations / Thinning / 100), 10) factors[[b]] <-try(eigen(VarCov[[b]])$vectors, silent=!Debug[["DB.eigen"]]) if(inherits(factors[[b]], "try-error")) { if(Debug[["DB.eigen"]] == TRUE) cat("\nWARNING: Eigendecomposition of covariance", "matrix failed for block", b, ".\n", file=LogFile, append=TRUE) cat(" Eigendecomposition of an identity matrix", "occurs instead.\n", file=LogFile, append=TRUE) factors[[b]] <- diag(length(Block[[b]]))} obs.sum[[b]] <- matrix(Mo0[["parm"]][Block[[b]]]*n, length(Block[[b]]), 1) obs.scatter[[b]] <- tcrossprod(Mo0[["parm"]][Block[[b]]])*n} if(all(decomp.freq == decomp.freq[1])) cat("\nEigendecomposition will occur every", decomp.freq[1], "iterations.\n\n", file=LogFile, append=TRUE) else cat("\nEigendecomposition frequency varies by block,", "and will occur between\n", min(decomp.freq), "and", max(decomp.freq), "iterations.\n\n", file=LogFile, append=TRUE) DiagCovar <- matrix(w, floor(Iterations/Thinning)+1, LIV, byrow=TRUE) nExpands <- nShrinks <- rep(0, LIV) IterPerAdapt <- rep(1, B) nProposals <- rep(0, B) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Blockwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Proceed by Block for (b in 1:B) { ### Random-Scan Componentwise Estimation for (j in sample(Block[[b]])) { bj <- which(Block[[b]] == j) y.slice <- Mo0[["LP"]] - rexp(1) upper <- runif(1,0,w[j]) lower <- upper - w[j] ### Step Out count <- 0 while (count <= m[j]) { prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + lower*factors[[b]][,bj] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out the lower", "bound failed for", Data[["parm.names"]][j], "in step", count+1, ".\n", file=LogFile, append=TRUE) lower <- lower + w[j] break} else if(!is.finite(Mo1[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out the lower", "bound for", Data[["parm.names"]][j], "resulted in a non-finite LP", "in step", count+1, ".\n", file=LogFile, append=TRUE) lower <- lower + w[j] break} nExpands[j] <- nExpands[j] + 1 if(Mo1[["LP"]] <= y.slice) break lower <- lower - w[j] count <- count + 1 } count <- 0 while (count <= m[j]) { prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + upper*factors[[b]][,bj] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out the upper", "bound failed for", Data[["parm.names"]][j], "in step", count+1, ".\n", file=LogFile, append=TRUE) upper <- upper - w[j] break} else if(!is.finite(Mo1[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out the upper", "bound for", Data[["parm.names"]][j], "resulted in a non-finite LP", "in step", count+1, ".\n", file=LogFile, append=TRUE) upper <- upper - w[j] break} nExpands[j] <- nExpands[j] + 1 if(Mo1[["LP"]] <= y.slice) break upper <- upper + w[j] count <- count + 1 } ### Rejection Sampling repeat { prop <- Mo0[["parm"]] lower <- -abs(min(lower, upper)) upper <- abs(max(lower, upper)) u <- runif(1, lower, upper) prop[Block[[b]]] <- prop[Block[[b]]] + u*factors[[b]][,bj] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Rejection sampling", "failed for", Data[["parm.names"]][j], "\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Rejection sampling for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) Mo1 <- Mo0} if(Mo1[["LP"]] >= y.slice) break else if(abs(u) < 1e-100) break nShrinks[j] <- nShrinks[j] + 1 if(u < 0) lower <- u else upper <- u } Mo0 <- Mo1 } nProposals[b] <- nProposals[b] + 1 obs.sum[[b]] <- obs.sum[[b]] + Mo0[["parm"]][Block[[b]]] obs.scatter[[b]] <- obs.scatter[[b]] + tcrossprod(Mo0[["parm"]][Block[[b]]]) ### Adaptation if({iter <= A} & {A - iter >= decomp.freq[b]}) { ### Tune Interval Widths if(nProposals[b] %% IterPerAdapt[b] == 0) { for (j in Block[[b]]) { denom <- nExpands[j] + nShrinks[j] if(denom > 0) { ratio <- nExpands[j] / denom if(ratio == 0) ratio <- 1 / denom multiplier <- ratio / targetRatio w[j] <- w[j]*multiplier } } nExpands[Block[[b]]] <- rep(0,length(Block[[b]])) nShrinks[Block[[b]]] <- rep(0,length(Block[[b]])) nProposals[b] <- 0 IterPerAdapt[b] <- IterPerAdapt[b] * 2} ### Tune Sampling Factors if(iter %% decomp.freq[b] == 0) { VarCov[[b]] <- obs.scatter[[b]]/{n + iter} - tcrossprod(obs.sum[[b]]/{n + iter}) factors[[b]] <- eigen(VarCov[[b]])$vectors nExpands[Block[[b]]] <- rep(0,length(Block[[b]])) nShrinks[Block[[b]]] <- rep(0,length(Block[[b]])) IterPerAdapt[b] <- 1 nProposals[b] <- 0} } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]] DiagCovar[t.iter,] <- w} } } } ### Output out <- list(Acceptance=Iterations, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcagg <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, Debug, LogFile) { Grid <- Specs[["Grid"]] dparm <- Specs[["dparm"]] smax <- Specs[["smax"]] CPUs <- Specs[["CPUs"]] Packages <- Specs[["Packages"]] Dyn.libs <- Specs[["Dyn.libs"]] AGGCP <- function(Model, Data, j, Mo0, Grid, tuning, smax, Debug, LogFile) { G <- length(Grid[[j]]) x <- Grid[[j]] * sqrt(2) * tuning[j] LP.grid <- rep(0, G) prop <- Mo0[["parm"]] theta <- prop[j] + x for (g in 1:G) { prop[j] <- theta[g] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) Mo1 <- Mo0} LP.grid[g] <- Mo1[["LP"]] theta[g] <- Mo1[["parm"]][j]} if(all(!is.finite(LP.grid))) LP.grid <- rep(0, G) LP.grid[which(!is.finite(LP.grid))] <- min(LP.grid[which(is.finite(LP.grid))]) LP.grid <- exp(LP.grid - logadd(LP.grid)) LP.grid <- LP.grid / sum(LP.grid) s <- spline(theta, LP.grid, n=1000) s$y <- interval(s$y, 0, Inf, reflect=FALSE) if(length(which(s$y > 0)) == 0) prop[j] <- theta[which.max(LP.grid)[1]] else prop[j] <- sample(s$x, 1, prob=s$y) Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else tuning[j] <- min(max(sqrt(sum(LP.grid * x^2)), 1e-10), smax) Mo0 <- Mo1 return(list(Mo0=Mo0, tuning=tuning)) } AGGCPP <- function(Model, Data, j, Mo0, Grid, tuning, smax, Debug, LogFile, cl) { G <- length(Grid[[j]]) x <- Grid[[j]] * sqrt(2) * tuning[j] LP.grid <- rep(0, G) LIV <- length(Mo0[["parm"]]) prop <- matrix(Mo0[["parm"]], G, LIV, byrow=TRUE) prop[, j] <- prop[, j] + x Mo1 <- parLapply(cl, 1:G, function(x) Model(prop[x,], Data)) LP.grid <- as.vector(unlist(lapply(Mo1, function(x) x[["LP"]]))) prop <- matrix(as.vector(unlist(lapply(Mo1, function(x) x[["parm"]]))), G, LIV, byrow=TRUE) theta <- prop[, j] if(all(!is.finite(LP.grid))) LP.grid <- rep(0, G) LP.grid[which(!is.finite(LP.grid))] <- min(LP.grid[which(is.finite(LP.grid))]) LP.grid <- exp(LP.grid - logadd(LP.grid)) LP.grid <- LP.grid / sum(LP.grid) s <- spline(theta, LP.grid, n=1000) s$y <- interval(s$y, 0, Inf, reflect=FALSE) prop <- Mo0[["parm"]] if(length(which(s$y > 0)) == 0) prop[j] <- theta[which.max(LP.grid)[1]] else prop[j] <- sample(s$x, 1, prob=s$y) Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else tuning[j] <- min(max(sqrt(sum(LP.grid * x^2)), 1e-10), smax) Mo0 <- Mo1 return(list(Mo0=Mo0, tuning=tuning)) } Acceptance <- matrix(0, 1, LIV) Grid.orig <- Grid post <- matrix(Mo0[["parm"]], Iterations, LIV, byrow=TRUE) if(CPUs == 1) { for (iter in 1:Iterations) { if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) for (j in sample.int(LIV)) { if(j %in% dparm) Mo0 <- .mcmcggdp(Model, Data, j, Mo0, Grid, Debug, LogFile) else { agg <- AGGCP(Model, Data, j, Mo0, Grid, tuning, smax, Debug, LogFile) Mo0 <- agg$Mo0 tuning[j] <- agg$tuning[j]}} if(iter %% Thinning == 0) { t.iter <- floor(iter/Thinning) + 1 thinned[t.iter, ] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter, ] <- Mo0[["Monitor"]] DiagCovar <- rbind(DiagCovar, tuning)}} } else { detectedCores <- detectCores() cat("\n\nCPUs Detected:", detectedCores, "\n", file=LogFile, append=TRUE) if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n", file=LogFile, append=TRUE) CPUs <- detectedCores} cat("\nLaplace's Demon is preparing environments for CPUs...", file=LogFile, append=TRUE) cat("\n##################################################\n", file=LogFile, append=TRUE) cl <- makeCluster(CPUs) cat("\n##################################################\n", file=LogFile, append=TRUE) on.exit(stopCluster(cl)) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) wd <- getwd() clusterExport(cl, varlist=c("Packages", "Dyn.libs", "wd"), envir=environment()) for (iter in 1:Iterations) { if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) for (j in sample.int(LIV)) { if(j %in% dparm) Mo0 <- .mcmcggdpp(Model, Data, j, Mo0, Grid, Debug, LogFile, cl) else { agg <- AGGCPP(Model, Data, j, Mo0, Grid, tuning, smax, Debug, LogFile, cl) Mo0 <- agg$Mo0 tuning[j] <- agg$tuning[j]} } if(iter %% Thinning == 0) { t.iter <- floor(iter/Thinning) + 1 thinned[t.iter, ] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter, ] <- Mo0[["Monitor"]] DiagCovar <- rbind(DiagCovar, tuning)}}} DiagCovar <- DiagCovar[-1,] out <- list(Acceptance=Iterations, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcahmc <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { epsilon <- Specs[["epsilon"]] L <- Specs[["L"]] m <- Specs[["m"]] invm <- as.inverse(m) U <- chol(m) Periodicity <- Specs[["Periodicity"]] post <- matrix(Mo0[["parm"]], Iterations, LIV, byrow=TRUE) DiagCovar <- matrix(epsilon, floor(Iterations/Periodicity), LIV, byrow=TRUE) gr0 <- partial(Model, post[1,], Data) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose new parameter values prop <- post[iter,] <- Mo0[["parm"]] momentum0 <- as.vector(rnorm(LIV) %*% U) kinetic0 <- t(momentum0) %*% invm %*% momentum0 / 2 momentum1 <- momentum0 + (epsilon / 2) * gr0 Mo0.1 <- Mo0 for (l in 1:L) { prop <- prop + as.vector(epsilon %*% invm) * momentum1 Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog", l, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", l, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1} if(any(Mo0.1[["parm"]] == Mo1[["parm"]])) { nomove <- which(Mo0.1[["parm"]] == Mo1[["parm"]]) momentum1[nomove] <- -momentum1[nomove] prop[nomove] <- prop[nomove] + momentum1[nomove] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog", l, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","), ")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", l, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","), ")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1}} Mo0.1 <- Mo1 prop <- Mo1[["parm"]] gr1 <- partial(Model, prop, Data) if(l < L) momentum1 <- momentum1 + epsilon * gr1} momentum1 <- momentum1 + (epsilon / 2) * gr1 momentum1 <- -momentum1 kinetic1 <- t(momentum1) %*% invm %*% momentum1 / 2 ### Accept/Reject H0 <- -Mo0[["LP"]] + kinetic0 H1 <- -Mo1[["LP"]] + kinetic1 delta <- H1 - H0 alpha <- min(1, exp(-delta)) if(!is.finite(alpha)) alpha <- 0 if(runif(1) < alpha) { Mo0 <- Mo1 post[iter,] <- Mo1[["parm"]] kinetic0 <- kinetic1 gr0 <- gr1 Acceptance <- Acceptance + 1 } ### Adaptation if(iter %% Periodicity == 0) { if(iter > 10) { acceptances <- length(unique(post[(iter-9):iter,1])) if(acceptances <= 1) epsilon <- epsilon * 0.8 else if(acceptances > 7) epsilon <- epsilon * 1.2} a.iter <- floor(iter / Periodicity) DiagCovar[a.iter,] <- epsilon} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=cov(thinned)) return(out) } .mcmcaies <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { Nc <- Specs[["Nc"]] Z <- Specs[["Z"]] beta <- Specs[["beta"]] CPUs <- Specs[["CPUs"]] Packages <- Specs[["Packages"]] Dyn.libs <- Specs[["Dyn.libs"]] Mo0 <- list(Mo0=Mo0) if(is.null(Z)) { Z <- matrix(Mo0[[1]][["parm"]], Nc, LIV, byrow=TRUE) for (i in 2:Nc) { if(!is.null(Data[["PGF"]])) { Z[i,] <- GIV(Model, Data, PGF=TRUE) } else Z[i,] <- GIV(Model, Data) } } for (i in 2:Nc) Mo0[[i]] <- Model(Z[i,], Data) if(CPUs == 1) { for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[[1]][["parm"]] Dev[t.iter] <- Mo0[[1]][["Dev"]] Mon[t.iter,] <- Mo0[[1]][["Monitor"]]} for (i in 1:Nc) { ### Propose new parameter values with stretch move z <- 1 / sqrt(runif(1, 1 / beta, beta)) s <- sample(c(1:Nc)[-i], 1) prop <- Mo0[[s]][["parm"]] + z*(Mo0[[i]][["parm"]] - Mo0[[s]][["parm"]]) if(i == 1 & iter %% Status == 0) cat(", Proposal: Multivariate, LP: ", round(Mo0[[1]][["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in walker", i, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","), ")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0[[i]] } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in walker", i, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","), ")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0[[i]]} ### Accept/Reject log.u <- log(runif(1)) log.alpha <- (LIV-1)*log(z) + Mo1[["LP"]] - Mo0[[i]][["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 else if(log.u < log.alpha) { Mo0[[i]] <- Mo1 if(i == 1) { Acceptance <- Acceptance + 1 if(iter %% Thinning == 0) { thinned[t.iter,] <- Mo1[["parm"]] Dev[t.iter] <- Mo1[["Dev"]] Mon[t.iter,] <- Mo1[["Monitor"]]} } } } } } else { detectedCores <- detectCores() cat("\n\nCPUs Detected:", detectedCores, "\n", file=LogFile, append=TRUE) if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n", file=LogFile, append=TRUE) CPUs <- detectedCores} cat("\nLaplace's Demon is preparing environments for CPUs...", file=LogFile, append=TRUE) cat("\n##################################################\n", file=LogFile, append=TRUE) cl <- makeCluster(CPUs) cat("\n##################################################\n", file=LogFile, append=TRUE) on.exit(stopCluster(cl)) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) wd <- getwd() clusterExport(cl, varlist=c("Packages", "Dyn.libs", "wd"), envir=environment()) model.wrapper <- function(x, ...) { if(!is.null(Packages)) { sapply(Packages, function(x) library(x, character.only=TRUE, quietly=TRUE))} if(!is.null(Dyn.libs)) { sapply(Dyn.libs, function(x) dyn.load(paste(wd, x, sep = "/"))) on.exit(sapply(Dyn.libs, function(x) dyn.unload(paste(wd, x, sep = "/"))))} Model(prop[x,], Data) } prop <- Z batch1 <- 1:(Nc/2) batch2 <- batch1 + (Nc/2) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[[1]][["parm"]] Dev[t.iter] <- Mo0[[1]][["Dev"]] Mon[t.iter,] <- Mo0[[1]][["Monitor"]]} for (i in 1:Nc) { ### Propose new parameter values with stretch move z <- 1 / sqrt(runif(1, 1 / beta, beta)) if(i <= (Nc/2)) s <- sample(batch2, 1) else s <- sample(batch1, 1) prop[i,] <- Mo0[[s]][["parm"]] + z*(Mo0[[i]][["parm"]] - Mo0[[s]][["parm"]]) if(i == 1 & iter %% Status == 0) cat(", Proposal: Multivariate\n", file=LogFile, append=TRUE)} ### Log-Posterior of the proposed state Mo1 <- clusterApply(cl, 1:Nc, model.wrapper, Model, Data, prop) for (i in 1:Nc) { if(any(!is.finite(c(Mo1[[i]][["LP"]], Mo1[[i]][["Dev"]], Mo1[[i]][["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in walker", i, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[i,], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1[[i]] <- Mo0[[i]]} ### Accept/Reject log.u <- log(runif(1)) log.alpha <- (LIV-1)*log(z) + Mo1[[i]][["LP"]] - Mo0[[i]][["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 else if(log.u < log.alpha) { Mo0[[i]] <- Mo1[[i]] if(i == 1) { Acceptance <- Acceptance + 1 if(iter %% Thinning == 0) { thinned[t.iter,] <- Mo1[[i]][["parm"]] Dev[t.iter] <- Mo1[[i]][["Dev"]] Mon[t.iter,] <- Mo1[[i]][["Monitor"]]} } } } } } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcam <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile) { Adaptive <- Specs[["Adaptive"]] Periodicity <- Specs[["Periodicity"]] post <- matrix(Mo0[["parm"]], Iterations, LIV, byrow=TRUE) Iden.Mat <- diag(LIV) DiagCovar <- matrix(diag(VarCov), floor(Iterations/Periodicity), LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Current Posterior if(iter > 1) post[iter,] <- post[iter-1,] ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- post[iter,] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} ### Propose new parameter values MVNz <- try(rbind(rnorm(LIV)) %*% chol(VarCov), silent=!Debug[["DB.chol"]]) if(!inherits(MVNz, "try-error") & ((Acceptance / iter) >= 0.05)) { if(iter %% Status == 0) cat(", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) MVNz <- as.vector(MVNz) prop <- t(post[iter,] + t(MVNz))} else { if(iter %% Status == 0) cat(", Proposal: Single-Component, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal in iteration", iter, ".\n", file=LogFile, append=TRUE) prop <- post[iter,] j <- ceiling(runif(1,0,LIV)) prop[j] <- rnorm(1, post[iter,j], tuning[j])} ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 else if(log.u < log.alpha) { Mo0 <- Mo1 post[iter,] <- Mo1[["parm"]] Acceptance <- Acceptance + 1 if(iter %% Thinning == 0) { thinned[t.iter,] <- Mo1[["parm"]] Dev[t.iter] <- Mo1[["Dev"]] Mon[t.iter,] <- Mo1[["Monitor"]]}} ### Shrinkage of Adaptive Proposal Variance if({Adaptive < Iterations} & {Acceptance > 5} & {Acceptance / iter < 0.05}) { VarCov <- VarCov * {1 - {1 / Iterations}} tuning <- tuning * {1 - {1 / Iterations}}} ### Adapt the Proposal Variance if({iter >= Adaptive} & {iter %% Periodicity == 0}) { ### Covariance Matrix (Preferred if it works) VarCov <- {ScaleF * cov(post[1:iter,])} + {ScaleF * 1.0E-5 * Iden.Mat} a.iter <- floor(iter / Periodicity) DiagCovar[a.iter,] <- diag(VarCov) ### Univariate Standard Deviations tuning <- sqrt(ScaleF * .colVars(post[1:iter,]) + ScaleF * 1.0E-5) } } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcamm <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile) { Adaptive <- Specs[["Adaptive"]] Block <- Specs[["B"]] n <- Specs[["n"]] Periodicity <- Specs[["Periodicity"]] w <- Specs[["w"]] obs.sum <- matrix(Mo0[["parm"]]*n, LIV, 1) obs.scatter <- tcrossprod(Mo0[["parm"]])*n if(all(upper.triangle(VarCov) == 0)) prop.R <- NULL else prop.R <- ScaleF * chol(VarCov) tuning <- sqrt(0.0001 * ScaleF) DiagCovar <- matrix(diag(VarCov), floor(Iterations/Periodicity), LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Propose new parameter values from a mixture if(is.null(prop.R) || runif(1) < w) { prop <- rnorm(LIV, Mo0[["parm"]], tuning) if(iter %% Status == 0) cat(", Proposal: Non-Adaptive Component, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE)} else { prop <- Mo0[["parm"]] + as.vector(rbind(rnorm(LIV)) %*% prop.R) if(iter %% Status == 0) cat(", Proposal: Adaptive Component, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE)} ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1}} ### Update Sample and Scatter Sum obs.sum <- obs.sum + Mo0[["parm"]] obs.scatter <- obs.scatter + tcrossprod(Mo0[["parm"]]) ### Adapt the Proposal Variance if({iter >= Adaptive} & {iter %% Periodicity == 0}) { VarCov <- obs.scatter/{n + iter} - tcrossprod(obs.sum/{n + iter}) diag(VarCov) <- diag(VarCov) + 1e-05 a.iter <- floor(iter / Periodicity) DiagCovar[a.iter,] <- diag(VarCov) prop.R <- try(ScaleF * chol(VarCov), silent=!Debug[["DB.chol"]]) if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal covariance in iteration", iter, ".\n", file=LogFile, append=TRUE) if(!is.matrix(prop.R)) prop.R <- NULL} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcamm.b <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile) { Adaptive <- Specs[["Adaptive"]] Block <- Specs[["B"]] n <- Specs[["n"]] Periodicity <- Specs[["Periodicity"]] w <- Specs[["w"]] B <- length(Block) if(!identical(length(VarCov), B)) stop("Number of components in Covar differs from ", "number of blocks.", file=LogFile, append=TRUE) obs.scatter <- obs.sum <- prop.R <- list() for (b in 1:B) { if(!identical(length(Block[[b]]), length(diag(VarCov[[b]])))) stop("Diagonal of Covar[[",b,"]] differs from ", "block length.", file=LogFile, append=TRUE) obs.sum[[b]] <- matrix(Mo0[["parm"]][Block[[b]]]*n, length(Block[[b]]), 1) obs.scatter[[b]] <- matrix(tcrossprod(Mo0[["parm"]][Block[[b]]])*n, length(Block[[b]]), length(Block[[b]])) if(all(upper.triangle(VarCov[[b]]) == 0)) prop.R[[b]] <- NA else prop.R[[b]] <- ScaleF * chol(VarCov[[b]])} tuning <- sqrt(0.0001 * ScaleF) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Proceed by Block for (b in 1:B) { ### Propose new parameter values from a mixture prop <- Mo0[["parm"]] if(any(is.na(prop.R[[b]])) || runif(1) < w) { prop[Block[[b]]] <- rnorm(length(Block[[b]]), Mo0[["parm"]][Block[[b]]], tuning) if(b == 1 & iter %% Status == 0) cat(", Proposal: Blockwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE)} else { prop[Block[[b]]] <- Mo0[["parm"]][Block[[b]]] + as.vector(rbind(rnorm(length(Block[[b]]))) %*% prop.R[[b]]) if(b == 1 & iter %% Status == 0) cat(", Proposal: Blockwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE)} ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + length(Block[[b]]) / LIV}} ### Update Sample and Scatter Sum obs.sum[[b]] <- obs.sum[[b]] + Mo0[["parm"]][Block[[b]]] obs.scatter[[b]] <- obs.scatter[[b]] + tcrossprod(Mo0[["parm"]][Block[[b]]]) ### Adapt the Proposal Variance if({iter >= Adaptive} & {iter %% Periodicity == 0}) { VarCov[[b]] <- obs.scatter[[b]]/{n + iter} - tcrossprod(obs.sum[[b]]/{n + iter}) diag(VarCov[[b]]) <- diag(VarCov[[b]]) + 1e-05 if(b == 1) DiagCovar <- rbind(DiagCovar, rep(0,LIV)) DiagCovar[nrow(DiagCovar),Block[[b]]] <- diag(VarCov[[b]]) prop.R[[b]] <- try(ScaleF * chol(VarCov[[b]]), silent=!Debug[["DB.chol"]]) if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal covariance in iteration", iter, ".\n", file=LogFile, append=TRUE) if(!is.matrix(prop.R[[b]])) prop.R[[b]] <- NA} } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcamwg <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, Debug, LogFile) { Block <- Specs[["B"]] n <- Specs[["n"]] Periodicity <- Specs[["Periodicity"]] Acceptance <- rep(0, LIV) B <- length(Block) DiagCovar <- matrix(tuning, floor(Iterations/Periodicity), LIV, byrow=TRUE) if(B == 0) { for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Random-Scan Componentwise Estimation propdraw <- rnorm(LIV,0,tuning) for (j in sample.int(LIV)) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- prop[j] + propdraw[j] ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < {Mo1[["LP"]] - Mo0[["LP"]]} if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}} ### Adapt the Proposal Variance if(iter %% Periodicity == 0) { size <- 1 / min(100, sqrt(n + iter)) Acceptance.Rate <- Acceptance / iter log.tuning <- log(tuning) tuning.num <- which(Acceptance.Rate > 0.44) log.tuning[tuning.num] <- log.tuning[tuning.num] + size tuning.num <- which(Acceptance.Rate <= 0.44) log.tuning[tuning.num] <- log.tuning[tuning.num] - size tuning <- exp(log.tuning) a.iter <- floor(iter / Periodicity) DiagCovar[a.iter,] <- tuning} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } else { for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Random-Scan Componentwise Estimation propdraw <- rnorm(LIV,0,tuning) for (b in 1:B) { for (j in sample(Block[[b]])) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- prop[j] + propdraw[j] ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < {Mo1[["LP"]] - Mo0[["LP"]]} if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}}} ### Adapt the Proposal Variance if(iter %% Periodicity == 0) { size <- 1 / min(100, sqrt(n + iter)) Acceptance.Rate <- Acceptance / iter log.tuning <- log(tuning) tuning.num <- which(Acceptance.Rate > 0.44) log.tuning[tuning.num] <- log.tuning[tuning.num] + size tuning.num <- which(Acceptance.Rate <= 0.44) log.tuning[tuning.num] <- log.tuning[tuning.num] - size tuning <- exp(log.tuning) a.iter <- floor(iter / Periodicity) DiagCovar[a.iter,] <- tuning} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } ### Output out <- list(Acceptance=mean(Acceptance), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=tuning) return(out) } .mcmccharm <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { alpha.star <- Specs[["alpha.star"]] if(is.na(alpha.star)) { Acceptance <- matrix(0, 1, LIV) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Random-Scan Componentwise Estimation theta <- rnorm(LIV) theta <- theta / sqrt(sum(theta*theta)) lambda <- runif(1) for (j in sample.int(LIV)) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- prop[j] + lambda*theta[j] ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]]) if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=mean(as.vector(Acceptance)), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } else { tau <- rep(1, LIV) Acceptance <- matrix(0, 1, LIV) DiagCovar <- matrix(tau, nrow(thinned), LIV) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Random-Scan Componentwise Estimation theta <- rnorm(LIV) theta <- theta / sqrt(sum(theta*theta)) lambda <- runif(1) for (j in sample.int(LIV)) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- prop[j] + tau[j]*lambda*theta[j] ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]]) if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1 tau[j] <- tau[j] + (tau[j] / (alpha.star * (1 - alpha.star))) * (1 - alpha.star) / iter } else { tau[j] <- abs(tau[j] - (tau[j] / (alpha.star * (1 - alpha.star))) * alpha.star / iter)}}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]] DiagCovar[t.iter,] <- tau} } ### Output out <- list(Acceptance=mean(as.vector(Acceptance)), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } } .mcmcdemc <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { Nc <- Specs[["Nc"]] Z <- Specs[["Z"]] gamma <- Specs[["gamma"]] w <- Specs[["w"]] const <- 2.381204 / sqrt(2) Mo0 <- list(Mo0=Mo0) if(is.null(Z)) { cat("\nGenerating Z...\n", file=LogFile, append=TRUE) Z <- array(0, dim=c(floor(Iterations/Thinning)+1, LIV, Nc)) for (t in 1:dim(Z)[1]) { for (i in 1:Nc) { if(t == 1 & i == 1) { Z[t,,i] <- Mo0[[1]][["parm"]] } else { if(!is.null(Data[["PGF"]])) { Z[t,,i] <- GIV(Model, Data, PGF=TRUE)} else Z[t,,i] <- GIV(Model, Data) } } } } else Z[1,,1] <- Mo0[[1]][["parm"]] for (i in 2:Nc) Mo0[[i]] <- Model(Z[1,,i], Data) for (iter in 1:Iterations) { ### Thinned Iteration t.iter <- floor(iter / Thinning) + 1 ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Save Thinned Samples if(iter %% Thinning == 0) { Z[t.iter,,] <- Z[t.iter-1,,] thinned[t.iter,] <- Mo0[[1]][["parm"]] Dev[t.iter] <- Mo0[[1]][["Dev"]] Mon[t.iter,] <- Mo0[[1]][["Monitor"]]} omega <- runif(1) for (i in 1:Nc) { r <- sample(dim(Z)[1], 2) s <- sample(c(1:Nc)[-i], 2) if(omega > w) { ### Parallel Direction Move prop <- Mo0[[i]][["parm"]] + gamma*(Z[r[1],,s[1]] - Z[r[2],,s[2]]) + runif(LIV, -0.001, 0.001)^LIV } else { ### Snooker Move si <- sample(c(1:Nc)[-i], 1) prop <- Mo0[[i]][["parm"]] + const* ({Mo0[[si]][["parm"]] - Z[r[1],,s[1]]} - {Mo0[[si]][["parm"]] - Z[r[2],,s[2]]})} if(i == 1 & iter %% Status == 0) cat(", Proposal: Multivariate, LP: ", round(Mo0[[1]][["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in chain", i, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0[[i]] } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in chain", i, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0[[i]] } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[[i]][["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0[[i]] <- Mo1 Z[t.iter,,i] <- Mo1[["parm"]] if(i == 1) { Acceptance <- Acceptance + 1 if(iter %% Thinning == 0) { thinned[t.iter,] <- Mo1[["parm"]] Dev[t.iter] <- Mo1[["Dev"]] Mon[t.iter,] <- Mo1[["Monitor"]]} } } } } } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=thinned, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcdram <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile) { Adaptive <- Specs[["Adaptive"]] DR <- 1 Periodicity <- Specs[["Periodicity"]] post <- matrix(Mo0[["parm"]], Iterations, LIV, byrow=TRUE) Iden.Mat <- diag(LIV) DiagCovar <- matrix(diag(VarCov), floor(Iterations/Periodicity), LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Current Posterior if(iter > 1) post[iter,] <- post[iter-1,] ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- post[iter,] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} ### Propose new parameter values MVNz <- try(rbind(rnorm(LIV)) %*% chol(VarCov), silent=!Debug[["DB.chol"]]) if(!inherits(MVNz, "try-error") & ((Acceptance / iter) >= 0.05)) { if(iter %% Status == 0) cat(", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) MVNz <- as.vector(MVNz) prop <- t(post[iter,] + t(MVNz))} else { if(iter %% Status == 0) cat(", Proposal: Single-Component, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal 1 in iteration", iter, ".\n", file=LogFile, append=TRUE) prop <- post[iter,] j <- ceiling(runif(1,0,LIV)) prop[j] <- rnorm(1, post[iter,j], tuning[j])} ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal 1 failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal 1 resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 post[iter,] <- Mo1[["parm"]] Acceptance <- Acceptance + 1 if(iter %% Thinning == 0) { thinned[t.iter,] <- Mo1[["parm"]] Dev[t.iter] <- Mo1[["Dev"]] Mon[t.iter,] <- Mo1[["Monitor"]]} } ### Delayed Rejection: Second Stage Proposals else if(log.u >= log.alpha) { MVNz <- try(rbind(rnorm(LIV)) %*% chol(VarCov * 0.5), silent=!Debug[["DB.chol"]]) if(!inherits(MVNz, "try-error") & ((Acceptance / iter) >= 0.05)) { MVNz <- as.vector(MVNz) prop <- t(post[iter,] + t(MVNz))} else { if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal 2 in iteration", iter, ".\n", file=LogFile, append=TRUE) prop <- post[iter,] j <- ceiling(runif(1,0,LIV)) prop[j] <- rnorm(1, post[iter,j], tuning[j])} ### Log-Posterior of the proposed state Mo2 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo2, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal 2 failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo2 <- Mo0 } else if(any(!is.finite(c(Mo2[["LP"]], Mo2[["Dev"]], Mo2[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal 2 resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo2 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) options(warn=-1) log.alpha.comp <- log(1 - exp(Mo1[["LP"]] - Mo2[["LP"]])) options(warn=0) if(!is.finite(log.alpha.comp)) log.alpha.comp <- 0 log.alpha <- Mo2[["LP"]] + log.alpha.comp - {Mo0[["LP"]] + log(1 - exp(Mo1[["LP"]] - Mo0[["LP"]]))} if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo2 post[iter,] <- Mo2[["parm"]] Acceptance <- Acceptance + 1 if(iter %% Thinning == 0) { thinned[t.iter,] <- Mo1[["parm"]] Dev[t.iter] <- Mo1[["Dev"]] Mon[t.iter,] <- Mo1[["Monitor"]]} } } } ### Shrinkage of Adaptive Proposal Variance if({Adaptive < Iterations} & {Acceptance > 5} & {Acceptance / iter < 0.05}) { VarCov <- VarCov * {1 - {1 / Iterations}} tuning <- tuning * {1 - {1 / Iterations}}} ### Adapt the Proposal Variance if({iter >= Adaptive} & {iter %% Periodicity == 0}) { ### Covariance Matrix (Preferred if it works) VarCov <- {ScaleF * cov(post[1:iter,])} + {ScaleF * 1.0E-5 * Iden.Mat} a.iter <- floor(iter / Periodicity) DiagCovar[a.iter,] <- diag(VarCov) ### Univariate Standard Deviations tuning <- sqrt(ScaleF * .colVars(post[1:iter,]) + ScaleF * 1.0E-5) } } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcdrm <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile) { DR <- 1 U <- chol(VarCov) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Propose new parameter values MVNz <- try(rbind(rnorm(LIV)) %*% U, silent=TRUE) if(!inherits(MVNz, "try-error") & ((Acceptance / iter) >= 0.05)) { if(iter %% Status == 0) cat(", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) MVNz <- as.vector(MVNz) prop <- t(as.vector(Mo0[["parm"]]) + t(MVNz))} else { if(iter %% Status == 0) cat(", Proposal: Single-Component, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) prop <- Mo0[["parm"]] j <- ceiling(runif(1,0,LIV)) prop[j] <- rnorm(1, Mo0[["parm"]][j], tuning[j])} ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal 1 failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal 1 resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1} ### Delayed Rejection: Second Stage Proposals else if(log.u >= log.alpha) { MVNz <- try(rbind(rnorm(LIV)) %*% chol(VarCov * 0.5), silent=!Debug[["DB.chol"]]) if(!inherits(MVNz, "try-error") & ((Acceptance / iter) >= 0.05)) { MVNz <- as.vector(MVNz) prop <- t(as.vector(Mo0[["parm"]]) + t(MVNz))} else { if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal 2 in iteration", iter, ".\n", file=LogFile, append=TRUE) prop <- Mo0[["parm"]] j <- ceiling(runif(1,0,LIV)) prop[j] <- rnorm(1, Mo0[["parm"]][j], tuning[j])} ### Log-Posterior of the proposed state Mo2 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo2, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal 2 failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo2 <- Mo0 } else if(any(!is.finite(c(Mo2[["LP"]], Mo2[["Dev"]], Mo2[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal 2 resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""),"\n", file=LogFile, append=TRUE)} Mo2 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) options(warn=-1) log.alpha.comp <- log(1 - exp(Mo1[["LP"]] - Mo2[["LP"]])) options(warn=0) if(!is.finite(log.alpha.comp)) log.alpha.comp <- 0 log.alpha <- Mo2[["LP"]] + log.alpha.comp - {Mo0[["LP"]] + log(1 - exp(Mo1[["LP"]] - Mo0[["LP"]]))} if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo2 Acceptance <- Acceptance + 1}} } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcess <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { Block <- Specs[["B"]] if(length(Block) == 0) { if(!is.symmetric.matrix(VarCov)) { cat("\nAsymmetric Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.symmetric.matrix(VarCov)} if(!is.positive.definite(VarCov)) { cat("\nNon-Positive-Definite Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.positive.definite(VarCov)} nu <- rnorm(LIV, 0, diag(VarCov)) U <- chol(VarCov) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose new parameter values nu <- as.vector(rbind(rnorm(LIV)) %*% U) theta <- theta.max <- runif(1, 0, 2*pi) theta.min <- theta - 2*pi shrink <- TRUE log.u <- log(runif(1)) ### Rejection Sampling while (shrink == TRUE) { prop <- Mo0[["parm"]] * cos(theta) + nu*sin(theta) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling resulted", "in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} ### Accept/Reject log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 shrink <- FALSE } else { if(theta < 0) theta.min <- theta else theta.max <- theta theta <- runif(1, theta.min, theta.max)}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } else { B <- length(Block) if(!identical(length(VarCov), B)) stop("Number of components in Covar differs from ", "number of blocks.", file=LogFile, append=TRUE) nu <- rep(NA, LIV) for (b in 1:B) { if(!identical(length(Block[[b]]), length(diag(VarCov[[b]])))) stop("Diagonal of Covar[[",b,"]] differs from ", "block length.", file=LogFile, append=TRUE) if(!is.symmetric.matrix(VarCov[[b]])) { cat("\nAsymmetric Covar block, correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.symmetric.matrix(VarCov[[b]])} if(!is.positive.definite(VarCov[[b]])) { cat("\nNon-Positive-Definite Covar block,", "correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.positive.definite(VarCov[[b]])} nu[Block[[b]]] <- rnorm(length(Block[[b]]), 0, diag(VarCov[[b]]))} for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Blockwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Proceed by Block for (b in 1:B) { ### Propose new parameter values blen <- length(Block[[b]]) nu[Block[[b]]] <- as.vector(rbind(rnorm(blen)) %*% chol(VarCov[[b]])) theta <- theta.max <- runif(1, 0, 2*pi) theta.min <- theta - 2*pi shrink <- TRUE log.u <- log(runif(1)) ### Rejection Sampling while (shrink == TRUE) { prop <- Mo0[["parm"]] prop[Block[[b]]] <- Mo0[["parm"]][Block[[b]]] * cos(theta) + nu[Block[[b]]]*sin(theta) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling resulted", "in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} ### Accept/Reject log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 shrink <- FALSE } else { if(theta < 0) theta.min <- theta else theta.max <- theta theta <- runif(1, theta.min, theta.max)}} } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } ### Output out <- list(Acceptance=Iterations, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=cov(thinned)) return(out) } .mcmcgibbs <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, Debug, LogFile) { FC <- Specs[["FC"]] MWG <- Specs[["MWG"]] if(is.null(MWG)) { Acceptance <- Iterations MWGlen <- 0} else { MWGlen <- length(MWG) Acceptance <- matrix(0, 1, LIV)} for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Gibbs Sampling of Full Conditionals prop <- try(FC(Mo0[["parm"]], Data), silent=!Debug[["DB.Model"]]) if(inherits(prop, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Gibbs proposal for full conditionals", "failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]], collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} prop <- Mo0[["parm"]]} Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Gibbs proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} Mo0 <- Mo1 ### Metropolis-within-Gibbs if(MWGlen > 0) { ### Random-Scan Componentwise Estimation for (j in sample(MWG)) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- rnorm(1, prop[j], tuning[j]) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: MWG proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: MWG proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]]) if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}} } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } if(MWGlen > 0) Acceptance <- mean(as.vector(Acceptance[,MWG])) ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=tuning) return(out) } .mcmcgg <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { Grid <- Specs[["Grid"]] dparm <- Specs[["dparm"]] CPUs <- Specs[["CPUs"]] Packages <- Specs[["Packages"]] Dyn.libs <- Specs[["Dyn.libs"]] if(CPUs == 1) { for (iter in 1:Iterations) { if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) for (j in sample.int(LIV)) { if(j %in% dparm) Mo0 <- .mcmcggdp(Model, Data, j, Mo0, Grid, Debug, LogFile) else Mo0 <- .mcmcggcp(Model, Data, j, Mo0, Grid, Debug, LogFile) } if(iter %% Thinning == 0) { t.iter <- floor(iter/Thinning) + 1 thinned[t.iter, ] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter, ] <- Mo0[["Monitor"]]}} } else { detectedCores <- detectCores() cat("\n\nCPUs Detected:", detectedCores, "\n", file=LogFile, append=TRUE) if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n", file=LogFile, append=TRUE) CPUs <- detectedCores} cat("\nLaplace's Demon is preparing environments for CPUs...", file=LogFile, append=TRUE) cat("\n##################################################\n", file=LogFile, append=TRUE) cl <- makeCluster(CPUs) cat("\n##################################################\n", file=LogFile, append=TRUE) on.exit(stopCluster(cl)) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) wd <- getwd() clusterExport(cl, varlist=c("Packages", "Dyn.libs", "wd"), envir=environment()) for (iter in 1:Iterations) { if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) for (j in sample.int(LIV)) { if(j %in% dparm) Mo0 <- .mcmcggdpp(Model, Data, j, Mo0, Grid, Debug, LogFile, cl) else Mo0 <- .mcmcggcpp(Model, Data, j, Mo0, Grid, Debug, LogFile, cl) } if(iter %% Thinning == 0) { t.iter <- floor(iter/Thinning) + 1 thinned[t.iter, ] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter, ] <- Mo0[["Monitor"]]}}} out <- list(Acceptance=Iterations, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } ### Griddy-Gibbs Continuous Parameter (Non-Parallelized) .mcmcggcp <- function(Model, Data, j, Mo0, Grid, Debug, LogFile) { G <- length(Grid[[j]]) LP.grid <- rep(0, G) prop <- Mo0[["parm"]] theta <- prop[j] + Grid[[j]] for (g in 1:G) { prop[j] <- theta[g] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) Mo1 <- Mo0} LP.grid[g] <- Mo1[["LP"]] theta[g] <- Mo1[["parm"]][j]} if(all(!is.finite(LP.grid))) LP.grid <- rep(0, G) LP.grid[which(!is.finite(LP.grid))] <- min(LP.grid[which(is.finite(LP.grid))]) LP.grid <- exp(LP.grid - logadd(LP.grid)) LP.grid <- LP.grid / sum(LP.grid) s <- spline(theta, LP.grid, n=1000) s$y <- interval(s$y, 0, Inf, reflect=FALSE) if(length(which(s$y > 0)) == 0) prop[j] <- theta[which.max(LP.grid)[1]] else prop[j] <- sample(s$x, 1, prob=s$y) Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) Mo1 <- Mo0} Mo0 <- Mo1 return(Mo0) } ### Griddy-Gibbs Continuous Parameter (Parallelized) .mcmcggcpp <- function(Model, Data, j, Mo0, Grid, Debug, LogFile, cl) { G <- length(Grid[[j]]) LP.grid <- rep(0, G) LIV <- length(Mo0[["parm"]]) prop <- matrix(Mo0[["parm"]], G, LIV, byrow=TRUE) prop[, j] <- prop[, j] + Grid[[j]] Mo1 <- parLapply(cl, 1:G, function(x) Model(prop[x,], Data)) LP.grid <- as.vector(unlist(lapply(Mo1, function(x) x[["LP"]]))) prop <- matrix(as.vector(unlist(lapply(Mo1, function(x) x[["parm"]]))), G, LIV, byrow=TRUE) theta <- prop[, j] if(all(!is.finite(LP.grid))) LP.grid <- rep(0, G) LP.grid[which(!is.finite(LP.grid))] <- min(LP.grid[which(is.finite(LP.grid))]) LP.grid <- exp(LP.grid - logadd(LP.grid)) LP.grid <- LP.grid / sum(LP.grid) s <- spline(theta, LP.grid, n=1000) s$y <- interval(s$y, 0, Inf, reflect=FALSE) prop <- Mo0[["parm"]] if(length(which(s$y > 0)) == 0) prop[j] <- theta[which.max(LP.grid)[1]] else prop[j] <- sample(s$x, 1, prob=s$y) Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) Mo1 <- Mo0} Mo0 <- Mo1 return(Mo0) } ### Griddy-Gibbs Discrete Parameter (Non-Parallelized) #where j is which parameter, and Grid are discrete values .mcmcggdp <- function(Model, Data, j, Mo0, Grid, Debug, LogFile) { G <- length(Grid[[j]]) LP.grid <- rep(0, G) prop <- Mo0[["parm"]] theta <- Grid[[j]] for (g in 1:G) { prop[j] <- theta[g] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) Mo1 <- Mo0} LP.grid[g] <- Mo1[["LP"]] theta[g] <- Mo1[["parm"]][j]} if(all(!is.finite(LP.grid))) LP.grid <- rep(0, G) LP.grid[which(!is.finite(LP.grid))] <- min(LP.grid[which(is.finite(LP.grid))]) LP.grid <- exp(LP.grid - logadd(LP.grid)) LP.grid <- LP.grid / sum(LP.grid) prop[j] <- sample(theta, 1, prob=LP.grid) Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) Mo1 <- Mo0} Mo0 <- Mo1 return(Mo0) } ### Griddy-Gibbs Discrete Parameter (Parallelized) .mcmcggdpp <- function(Model, Data, j, Mo0, Grid, Debug, LogFile, cl) { G <- length(Grid[[j]]) LP.grid <- rep(0, G) LIV <- length(Mo0[["parm"]]) prop <- matrix(Mo0[["parm"]], G, LIV, byrow=TRUE) prop[, j] <- prop[, j] + Grid[[j]] Mo1 <- parLapply(cl, 1:G, function(x) Model(prop[x,], Data)) LP.grid <- as.vector(unlist(lapply(Mo1, function(x) x[["LP"]]))) prop <- matrix(as.vector(unlist(lapply(Mo1, function(x) x[["parm"]]))), G, LIV, byrow=TRUE) theta <- prop[, j] prop <- Mo0[["parm"]] if(all(!is.finite(LP.grid))) LP.grid <- rep(0, G) LP.grid[which(!is.finite(LP.grid))] <- min(LP.grid[which(is.finite(LP.grid))]) LP.grid <- exp(LP.grid - logadd(LP.grid)) LP.grid <- LP.grid / sum(LP.grid) prop[j] <- sample(theta, 1, prob=LP.grid) Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) Mo1 <- Mo0} Mo0 <- Mo1 return(Mo0) } .mcmcharm <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { alpha.star <- Specs[["alpha.star"]] Block <- Specs[["B"]] if(is.na(alpha.star) & {length(Block) == 0}) { for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Propose new parameter values theta <- rnorm(LIV) d <- theta / sqrt(sum(theta*theta)) prop <- Mo0[["parm"]] + runif(1) * d if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } else if(is.na(alpha.star) & {length(Block) > 0}) { B <- length(Block) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Proceed by Block for (b in 1:B) { ### Propose new parameter values theta <- rnorm(length(Block[[b]])) d <- theta / sqrt(sum(theta*theta)) prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + runif(1) * d if({b == 1} & {iter %% Status == 0}) cat(", Proposal: Blockwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in", "non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + length(Block[[b]]) / LIV}} } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } else if(length(Block) == 0) { tau <- 1 DiagCovar <- matrix(tau, nrow(thinned), LIV) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Propose new parameter values theta <- rnorm(LIV) d <- theta / sqrt(sum(theta*theta)) prop <- Mo0[["parm"]] + runif(1,0,tau) * d if(iter %% Status == 0) cat(", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1 tau <- tau + (tau / (alpha.star * (1 - alpha.star))) * (1 - alpha.star) / iter } else { tau <- abs(tau - (tau / (alpha.star * (1 - alpha.star))) * alpha.star / iter)}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]] DiagCovar[t.iter,] <- tau} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } else { B <- length(Block) tau <- rep(1,B) DiagCovar <- matrix(1, nrow(thinned), LIV) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} ### Proceed by Block for (b in 1:B) { ### Propose new parameter values theta <- rnorm(length(Block[[b]])) d <- theta / sqrt(sum(theta*theta)) prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + runif(1,0,tau[b]) * d if({b == 1} & {iter %% Status == 0}) cat(", Proposal: Blockwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in", "non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + length(Block[[b]]) / LIV tau[b] <- tau[b] + (tau[b] / (alpha.star * (1 - alpha.star))) * (1 - alpha.star) / iter if(iter %% Thinning == 0) { thinned[t.iter,] <- Mo1[["parm"]] Dev[t.iter] <- Mo1[["Dev"]] Mon[t.iter,] <- Mo1[["Monitor"]] DiagCovar[t.iter, Block[[b]]] <- tau[b]} } else { tau[b] <- abs(tau[b] - (tau[b] / (alpha.star * (1 - alpha.star))) * alpha.star / iter) if(iter %% Thinning == 0) DiagCovar[t.iter, Block[[b]]] <- tau[b]} } } } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } } .mcmchmc <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { epsilon <- Specs[["epsilon"]] L <- Specs[["L"]] m <- Specs[["m"]] invm <- as.inverse(m) U <- chol(m) gr0 <- partial(Model, Mo0[["parm"]], Data) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose new parameter values prop <- Mo0[["parm"]] momentum0 <- as.vector(rnorm(LIV) %*% U) kinetic0 <- t(momentum0) %*% invm %*% momentum0 / 2 momentum1 <- momentum0 + (epsilon/2) * gr0 Mo0.1 <- Mo0 for (l in 1:L) { prop <- prop + as.vector(epsilon %*% invm) * momentum1 Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog", l, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", l, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1} if(any(Mo0.1[["parm"]] == Mo1[["parm"]])) { nomove <- which(Mo0.1[["parm"]] == Mo1[["parm"]]) momentum1[nomove] <- -momentum1[nomove] prop[nomove] <- prop[nomove] + momentum1[nomove] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog", l, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", l, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1}} Mo0.1 <- Mo1 prop <- Mo1[["parm"]] gr1 <- partial(Model, prop, Data) if(l < L) momentum1 <- momentum1 + epsilon * gr1} momentum1 <- momentum1 + (epsilon/2) * gr1 momentum1 <- -momentum1 kinetic1 <- t(momentum1) %*% invm %*% momentum1 / 2 ### Accept/Reject H0 <- -Mo0[["LP"]] + kinetic0 H1 <- -Mo1[["LP"]] + kinetic1 delta <- H1 - H0 alpha <- min(1, exp(-delta)) if(!is.finite(alpha)) alpha <- 0 if(runif(1) < alpha) { Mo0 <- Mo1 kinetic0 <- kinetic1 gr0 <- gr1 Acceptance <- Acceptance + 1} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=matrix(epsilon, 1, LIV), Mon=Mon, thinned=thinned, VarCov=cov(thinned)) return(out) } .mcmchmcda <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { A <- Specs[["A"]] delta <- Specs[["delta"]] epsilon <- Specs[["epsilon"]] Lmax <- Specs[["Lmax"]] lambda <- Specs[["lambda"]] leapfrog <- function(theta, r, grad, epsilon, Model, Data, Mo0, Debug) { rprime <- r + 0.5 * epsilon * grad thetaprime <- theta + epsilon * rprime Mo1 <- try(Model(thetaprime, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(thetaprime, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(thetaprime, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} thetaprime <- Mo1[["parm"]] gradprime <- partial(Model, thetaprime, Data) rprime <- rprime + 0.5 * epsilon * gradprime out <- list(thetaprime=thetaprime, rprime=rprime, gradprime=gradprime, Mo1=Mo1) return(out) } find.reasonable.epsilon <- function(theta0, grad0, Mo0, Model, Data, LogFile) { cat("\nFinding a reasonable initial value for epsilon...", file=LogFile, append=TRUE) epsilon <- 0.001 r0 <- runif(length(theta0)) ### Figure out which direction to move epsilon leap <- leapfrog(theta0, r0, grad0, epsilon, Model, Data, Mo0, Debug) if(!is.finite(leap$Mo1[["LP"]])) stop("LP is not finite in find.reasonable.epsilon().", file=LogFile, append=TRUE) acceptprob <- exp(leap$Mo1[["LP"]] - Mo0[["LP"]] - 0.5 * (as.vector(leap$rprime %*% leap$rprime) - as.vector(r0 %*% r0))) a <- 2 * (acceptprob > 0.5) - 1 ### Keep moving epsilon in that direction until acceptprob ### crosses 0.5 while (acceptprob^a > 2^(-a)) { epsilon <- epsilon * 2^a leap <- leapfrog(theta0, r0, grad0, epsilon, Model, Data, Mo0, Debug) if(!is.finite(leap$Mo1[["LP"]])) stop("LP is not finite in find.reasonable.epsilon().", file=LogFile, append=TRUE) acceptprob <- exp(leap$Mo1[["LP"]] - Mo0[["LP"]] - 0.5 * (as.vector(leap$rprime %*% leap$rprime) - as.vector(r0 %*% r0))) } cat("\nepsilon: ", round(max(epsilon,0.001),5), "\n\n", sep="", file=LogFile, append=TRUE) return(epsilon) } gr0 <- partial(Model, Mo0[["parm"]], Data) if(is.null(epsilon)) epsilon <- find.reasonable.epsilon(Mo0[["parm"]], gr0, Mo0, Model, Data, LogFile) DiagCovar[1,] <- epsilon L <- max(1, round(lambda / epsilon)) L <- min(L, Lmax) ### Dual-Averaging Parameters epsilonbar <- 1 gamma <- 0.05 Hbar <- 0 kappa <- 0.75 mu <- log(10*epsilon) t0 <- 10 ### Begin HMCDA for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose new parameter values prop <- Mo0[["parm"]] momentum1 <- momentum0 <- runif(LIV) joint <- Mo0[["LP"]] - 0.5 * as.vector(momentum0 %*% momentum0) L <- max(1, round(lambda / epsilon)) L <- min(L, Lmax) gr1 <- gr0 Mo0.1 <- Mo0 ### Leapfrog Function for (l in 1:L) { momentum1 <- momentum1 + 0.5 * epsilon * gr1 prop <- prop + epsilon * momentum1 Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog", l, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""),"\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", l, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1} if(any(Mo0.1[["parm"]] == Mo1[["parm"]])) { nomove <- which(Mo0.1[["parm"]] == Mo1[["parm"]]) momentum1[nomove] <- -momentum1[nomove] prop[nomove] <- prop[nomove] + momentum1[nomove] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog", l, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", l, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1}} Mo0.1 <- Mo1 prop <- Mo1[["parm"]] gr1 <- partial(Model, prop, Data) momentum1 <- momentum1 + epsilon * gr1} ### Accept/Reject alpha <- min(1, exp(prop - 0.5 * as.vector(momentum1 %*% momentum1) - joint)) if(!is.finite(alpha)) alpha <- 0 if(runif(1) < alpha) { Mo0 <- Mo1 gr0 <- gr1 Acceptance <- Acceptance + 1} ### Adaptation if(iter > 1) { eta <- 1 / (iter - 1 + t0) Hbar <- (1 - eta) * Hbar + eta * (delta - alpha) if(iter <= A) { epsilon <- exp(mu - sqrt(iter-1)/gamma * Hbar) eta <- (iter-1)^-kappa epsilonbar <- exp((1 - eta) * log(epsilonbar) + eta * log(epsilon)) DiagCovar <- rbind(DiagCovar, epsilon)} else epsilon <- epsilonbar} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcim <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { mu <- Specs[["mu"]] VarCov <- as.positive.definite(as.symmetric.matrix(VarCov * 1.1)) Omega <- as.inverse(VarCov) U <- chol(VarCov) d <- eigen(VarCov, symmetric=TRUE)$values for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Propose new parameter values MVNz <- try(rbind(rnorm(LIV)) %*% U, silent=TRUE) if(!inherits(MVNz, "try-error")) { if(iter %% Status == 0) cat(", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) prop <- as.vector(mu) + as.vector(MVNz)} else {prop <- as.vector(Mo0[["parm"]])} ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } ### Importance Densities (dmvn) ss <- prop - mu z <- rowSums({ss %*% Omega} * ss) d1 <- sum(-0.5 * (LIV * log(2*pi) + sum(log(d))) - (0.5*z)) ss <- Mo0[["parm"]] - mu z <- rowSums({ss %*% Omega} * ss) d0 <- sum(-0.5 * (LIV * log(2*pi) + sum(log(d))) - (0.5*z)) ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] + d1 - d0 if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=cov(thinned)) return(out) } .mcmcinca <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile) { Adaptive <- Specs[["Adaptive"]] Periodicity <- Specs[["Periodicity"]] post <- matrix(Mo0[["parm"]], Iterations, LIV, byrow=TRUE) Iden.Mat <- diag(LIV) con <- get("con") Chains <- get("Chains") DiagCovar <- matrix(0, floor(Iterations/Periodicity), LIV) ### Store all posteriors INCA_iter <- 1 INCA_first <- TRUE tmpMean <- numeric(LIV) tmpCov <- matrix(0, LIV, LIV) tmpAlpha <- numeric(Periodicity) lambda <- ScaleF for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Current Posterior if(iter > 1) post[iter,] <- post[iter-1,] ### Propose new parameter values MVNz <- try(rbind(rnorm(LIV)) %*% chol(VarCov), silent=!Debug[["DB.chol"]]) if(!inherits(MVNz, "try-error") & ((Acceptance / iter) >= 0.05)) { if(iter %% Status == 0) cat(", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) prop <- as.vector(post[iter,]) + as.vector(MVNz)} else { if(iter %% Status == 0) cat(", Proposal: Single-Component, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal in iteration", iter, ".\n", file=LogFile, append=TRUE) prop <- post[iter,] j <- ceiling(runif(1,0,LIV)) prop[j] <- rnorm(1, post[iter,j], tuning[j])} ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 post[iter,] <- Mo1[["parm"]] Acceptance <- Acceptance + 1}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- post[iter,] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} ### Save log.alpha if({iter %% Periodicity} == 0) tmpAlpha[Periodicity] <- min(1, exp(log.alpha)) else tmpAlpha[(iter %% Periodicity)] <- min(1, exp(log.alpha)) ### Shrinkage of Adaptive Proposal Variance if({iter < Adaptive} & {Acceptance > 5} & {Acceptance / iter < 0.05}) { VarCov <- VarCov * {1 - {1 / Iterations}} tuning <- tuning * {1 - {1 / Iterations}}} ### Adapt the Proposal Variance if({iter >= Adaptive} & {iter %% Periodicity == 0}) { select_post <- cbind(post[(iter-Periodicity+1):iter,], tmpAlpha) ### Ask for last posteriors to hpc_server tmp <- unserialize(con) ### Send new posteriors matrix to hpc_server serialize(select_post, con) if(is.matrix(tmp) && INCA_first == FALSE) { for (i in 1:nrow(select_post)) { tmpMean <- tmpMean + 1/(INCA_iter+1) * (select_post[i, 1:LIV]-tmpMean) tmpCov <- (INCA_iter-1)/INCA_iter * tmpCov + 1/INCA_iter * tcrossprod(select_post[i, 1:LIV]-tmpMean) INCA_iter <- INCA_iter + 1} for (i in 1:nrow(tmp)) { tmpMean <- tmpMean + 1/(INCA_iter+1) * (tmp[i, 1:LIV]-tmpMean) tmpCov <- (INCA_iter-1)/INCA_iter * tmpCov + 1/INCA_iter * tcrossprod(tmp[i, 1:LIV]-tmpMean) INCA_iter <- INCA_iter + 1} eta <- INCA_iter^-0.6 m1 <- median(select_post[, LIV+1]) m2 <- median(tmp[, LIV+1]) lambda <- exp(log(lambda) + eta * (m1 - 0.234)) lambda <- exp(log(lambda) + eta * (m2 - 0.234))} if(INCA_first == TRUE) { for (i in 1:iter) { tmpMean <- tmpMean + 1/(INCA_iter+1) * (post[i, ]-tmpMean) tmpCov <- (INCA_iter-1)/INCA_iter * tmpCov + 1/INCA_iter * tcrossprod(post[i, ] - tmpMean) INCA_iter <- INCA_iter + 1} INCA_first <- FALSE} VarCov <- lambda * (tmpCov + 1e-9 * Iden.Mat) a.iter <- floor(iter / Periodicity) DiagCovar[a.iter,] <- diag(VarCov) ### Univariate Standard Deviations tuning <- sqrt(diag(VarCov))} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcmala <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { A <- Specs[["A"]] alpha.star <- Specs[["alpha.star"]] delta <- Specs[["delta"]] gamma.const <- Specs[["gamma"]] epsilon <- Specs[["epsilon"]] Gamm <- as.positive.definite(VarCov) mu <- Mo0[["parm"]] sigma2 <- 1 / (LIV*LIV) DiagCovar <- matrix(diag(Gamm), nrow(thinned), LIV) Iden <- diag(LIV) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose new parameter values gr <- partial(Model, Mo0[["parm"]], Data) Dx <- {delta/max(delta, abs(gr))}*gr gamm <- min(gamma.const/iter, 1) Lambda <- Gamm + epsilon[2]*Iden U <- try(chol(sigma2*Lambda), silent=!Debug[["DB.chol"]]) if(inherits(U, "try-error")) { if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal in iteration", iter, ".\n", file=LogFile, append=TRUE) U <- chol(as.positive.definite(sigma2*Lambda))} prop <- as.vector((Mo0[["parm"]] + {sigma2/2}*as.vector(Lambda %*% Dx)*Dx) + rbind(rnorm(LIV)) %*% U) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1}} ### Adapt Gamma (first, since it uses mu[t] not [t+1]) xmu <- Mo0[["parm"]] - mu Gamm.prop <- Gamm + gamm*{xmu %*% t(xmu) - Gamm} norm.Gamm <- norm(Gamm.prop, type="F") if(norm.Gamm <= A) Gamm <- Gamm.prop else if(!is.finite(norm.Gamm)) Gamm <- sigma2*Iden else Gamm <- {A/norm.Gamm}*Gamm.prop ### Adapt mu mu.prop <- mu + gamm*(Mo0[["parm"]] - mu) norm.mu <- sqrt(sum(mu.prop*mu.prop)) if(norm.mu <= A) mu <- mu.prop else mu <- {A/norm.mu}*mu.prop ### Adapt sigma sigma2 <- interval(sqrt(sigma2) + gamm*(min(exp(log.alpha),1) - alpha.star), epsilon[1], A, reflect=FALSE)^2 ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]] DiagCovar[t.iter,] <- diag(Lambda)} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=Lambda) return(out) } .mcmcmcmcmc <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile) { lambda <- Specs[["lambda"]] CPUs <- Specs[["CPUs"]] Packages <- Specs[["Packages"]] Dyn.libs <- Specs[["Dyn.libs"]] detectedCores <- detectCores() cat("\n\nCPUs Detected:", detectedCores, "\n", file=LogFile, append=TRUE) if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n", file=LogFile, append=TRUE) CPUs <- detectedCores} cat("\nLaplace's Demon is preparing environments for CPUs...", file=LogFile, append=TRUE) cat("\n##################################################\n", file=LogFile, append=TRUE) cl <- makeCluster(CPUs) cat("\n##################################################\n", file=LogFile, append=TRUE) on.exit(stopCluster(cl)) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) wd <- getwd() clusterExport(cl, varlist=c("Packages", "Dyn.libs", "wd"), envir=environment()) if(length(lambda) == 1) Temperature <- 1/(1 + lambda*(c(1:CPUs) - 1)) else if(length(lambda) == LIV) Temperature <- lambda else Temperature <- 1/(1 + lambda[1]*(c(1:CPUs) - 1)) coolest <- which.max(Temperature)[1] temp <- Mo0 Mo0 <- list() for (i in 1:CPUs) Mo0[[i]] <- temp prop <- matrix(Mo0[[1]][["parm"]], CPUs, LIV, byrow=TRUE) Acceptance.swap <- 0 U <- chol(VarCov) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[[coolest]][["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[[coolest]][["parm"]] Dev[t.iter] <- Mo0[[coolest]][["Dev"]] Mon[t.iter,] <- Mo0[[coolest]][["Monitor"]]} ### Propose new parameter values for (i in 1:CPUs) prop[i,] <- Mo0[[i]][["parm"]] + rbind(rnorm(LIV)) %*% U ### Log-Posterior of the proposed state Mo1 <- parLapply(cl, 1:CPUs, function(x) try(Model(prop[x,], Data), silent=!Debug[["DB.Model"]])) for (i in 1:CPUs) { if(inherits(Mo1[[i]], "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in chain", i, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[i,], collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1[[i]] <- Mo0[[i]] } else if(any(!is.finite(c(Mo1[[i]][["LP"]], Mo1[[i]][["Dev"]], Mo1[[i]][["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in chain", i, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[i,], collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1[[i]] <- Mo0[[i]] } } ### Accept/Reject for (i in 1:CPUs) { log.u <- log(runif(1)) log.alpha <- (Mo1[[i]][["LP"]] - Mo0[[i]][["LP"]]) / Temperature[i] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0[[i]] <- Mo1[[i]] if(i == coolest) { Acceptance <- Acceptance + 1 if(iter %% Thinning == 0) { thinned[t.iter,] <- Mo1[[i]][["parm"]] Dev[t.iter] <- Mo1[[i]][["Dev"]] Mon[t.iter,] <- Mo1[[i]][["Monitor"]]}}}} ### Swap swap <- sample.int(CPUs, 2) log.u <- log(runif(1)) log.alpha <- {(Mo0[[swap[1]]][["LP"]] - Mo0[[swap[2]]][["LP"]]) / Temperature[swap[2]]} + {(Mo0[[swap[2]]][["LP"]] - Mo0[[swap[1]]][["LP"]]) / Temperature[swap[1]]} if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Acceptance.swap <- Acceptance.swap + 1 temp <- Mo0[[swap[2]]] Mo0[[swap[2]]] <- Mo0[[swap[1]]] Mo0[[swap[1]]] <- temp if({swap[1] == coolest} & {iter %% Thinning == 0}) { thinned[t.iter,] <- Mo0[[swap[1]]][["parm"]] Dev[t.iter] <- Mo0[[swap[1]]][["Dev"]] Mon[t.iter,] <- Mo0[[swap[1]]][["Monitor"]]}} } cat("\nSwap Acceptance Rate:", round(Acceptance.swap / Iterations, 5), "\n", file=LogFile, append=TRUE) ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcmtm <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, thinned, tuning, Debug, LogFile) { K <- Specs[["K"]] CPUs <- Specs[["CPUs"]] Packages <- Specs[["Packages"]] Dyn.libs <- Specs[["Dyn.libs"]] if(CPUs > 1) { detectedCores <- detectCores() cat("\n\nCPUs Detected:", detectedCores, "\n", file=LogFile, append=TRUE) if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n", file=LogFile, append=TRUE) CPUs <- detectedCores} cat("\nLaplace's Demon is preparing environments for CPUs...", file=LogFile, append=TRUE) cat("\n##################################################\n", file=LogFile, append=TRUE) cl <- makeCluster(CPUs) cat("\n##################################################\n", file=LogFile, append=TRUE) on.exit(stopCluster(cl)) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) wd <- getwd() clusterExport(cl, varlist=c("Packages", "Dyn.libs", "wd"), envir=environment())} Acceptance <- matrix(0, 1, LIV) Mo1 <- list() for (k in 1:K) Mo1[[k]] <- Mo0 LW <- LP <- rep(0, K) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Random-Scan Componentwise Estimation for (j in sample.int(LIV)) { ### Propose new parameter values prop1 <- matrix(Mo0[["parm"]], K, LIV, byrow=TRUE) prop1[,j] <- rnorm(K, prop1[,j], tuning[j]) ### Log-Posterior of the proposed states if(CPUs == 1) { ### Non-parallel for (k in 1:K) { Mo1[[k]] <- try(Model(prop1[k,], Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1[[k]], "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal ", k, "failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop1[k,j],5), file=LogFile, append=TRUE)} Mo1[[k]] <- Mo0 } else if(any(!is.finite(c(Mo1[[k]][["LP"]], Mo1[[k]][["Dev"]], Mo1[[k]][["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal ", k, "resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop1[k,j],5), file=LogFile, append=TRUE)} Mo1[[k]] <- Mo0} LP[k] <- LW[k] <- Mo1[[k]][["LP"]] prop1[k,] <- Mo1[[k]][["parm"]]} } else { ### Parallel Mo1 <- parLapply(cl, 1:K, function(x) try(Model(prop1[x,], Data), silent=!Debug[["DB.Model"]])) for (k in 1:K) { if(inherits(Mo1[[k]], "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal ", k, "failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop1[k,j],5), file=LogFile, append=TRUE)} Mo1[[k]] <- Mo0 } else if(any(!is.finite(c(Mo1[[k]][["LP"]], Mo1[[k]][["Dev"]], Mo1[[k]][["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal ", k, "resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop1[k,j],5), file=LogFile, append=TRUE)} Mo1[[k]] <- Mo0} LP[k] <- LW[k] <- Mo1[[k]][["LP"]] prop1[k,] <- Mo1[[k]][["parm"]]} } ### Normalize Weights w <- exp(LW - logadd(LW)) if(all(w == 0)) w <- rep(1/K, K) ### Sample a Proposal prop5 <- Mo0[["parm"]] prop2 <- sample(prop1[,j], size=1, prob=w) prop5[j] <- prop2 ### Create Reference Set Mo2 <- try(Model(prop5, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo2, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop5[j],5), file=LogFile, append=TRUE)} Mo2 <- Mo0} prop3 <- c(rnorm(K-1, Mo2[["parm"]][j], tuning[j]), Mo2[["parm"]][j]) prop4 <- prop1 prop4[,j] <- prop3 ### Calculate Acceptance Probability numerator <- logadd(LP) denom <- rep(0, K) if(CPUs == 1) { ### Non-parallel for (k in 1:K) { Mo1[[k]] <- try(Model(prop4[k,], Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1[[k]], "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal ", k, "failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop4[k,j],5), file=LogFile, append=TRUE)} Mo1[[k]] <- Mo0 } else if(any(!is.finite(c(Mo1[[k]][["LP"]], Mo1[[k]][["Dev"]], Mo1[[k]][["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal ", k, "resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop4[k,j],5), file=LogFile, append=TRUE)} Mo1[[k]] <- Mo0} denom[k] <- Mo1[[k]][["LP"]]} } else { ### Parallel Mo1 <- parLapply(cl, 1:K, function(x) try(Model(prop4[x,], Data), silent=!Debug[["DB.Model"]])) for (k in 1:K) { if(inherits(Mo1[[k]], "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal ", k, "failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop4[k,j],5), file=LogFile, append=TRUE)} Mo1[[k]] <- Mo0 } else if(any(!is.finite(c(Mo1[[k]][["LP"]], Mo1[[k]][["Dev"]], Mo1[[k]][["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal ", k, "resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop4[k,j],5), file=LogFile, append=TRUE)} Mo1[[k]] <- Mo0} denom[k] <- Mo1[[k]][["LP"]]}} denom <- logadd(denom) ### Accept/Reject u <- log(runif(1)) < (numerator - denom) if(u == TRUE) { Mo0 <- Mo2 Acceptance[j] <- Acceptance[j] + 1}} if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=mean(as.vector(Acceptance)), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcmwg <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, Debug, LogFile) { Block <- Specs[["B"]] B <- length(Block) Acceptance <- matrix(0, 1, LIV) if(B == 0) { for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Random-Scan Componentwise Estimation propdraw <- rnorm(LIV,0,tuning) for (j in sample.int(LIV)) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- prop[j] + propdraw[j] ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < {Mo1[["LP"]] - Mo0[["LP"]]} if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } else { for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Random-Scan Componentwise Estimation propdraw <- rnorm(LIV,0,tuning) ### Proceed by Block for (b in 1:B) { for (j in sample(Block[[b]])) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- prop[j] + propdraw[j] ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < {Mo1[["LP"]] - Mo0[["LP"]]} if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } ### Output out <- list(Acceptance=mean(as.vector(Acceptance)), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=tuning) return(out) } .mcmcnuts <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { A <- Specs[["A"]] delta <- Specs[["delta"]] epsilon <- Specs[["epsilon"]] Lmax <- Specs[["Lmax"]] post <- matrix(Mo0[["parm"]], Iterations, LIV, byrow=TRUE) leapfrog <- function(theta, r, grad, epsilon, Model, Data, Mo0, Debug) { rprime <- r + 0.5 * epsilon * grad thetaprime <- theta + epsilon * rprime Mo1 <- try(Model(thetaprime, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(thetaprime, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(thetaprime, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} thetaprime <- Mo1[["parm"]] gradprime <- partial(Model, thetaprime, Data) rprime <- rprime + 0.5 * epsilon * gradprime out <- list(thetaprime=thetaprime, rprime=rprime, gradprime=gradprime, Mo1=Mo1) return(out) } stop.criterion <- function(thetaminus, thetaplus, rminus, rplus) { thetavec <- thetaplus - thetaminus criterion <- (thetavec %*% rminus >= 0) && (thetavec %*% rplus >= 0) return(criterion) } build.tree <- function(theta, r, grad, logu, v, j, epsilon, joint0, Mo0) { if(j == 0) { ### Base case: Take a single leapfrog step in direction v leap <- leapfrog(theta=theta, r=r, grad=grad, epsilon=v*epsilon, Model=Model, Data=Data, Mo0=Mo0, Debug=Debug) rprime <- leap$rprime thetaprime <- leap$thetaprime Mo1 <- leap$Mo1 gradprime <- leap$gradprime joint <- Mo1[["LP"]] - 0.5 * as.vector(rprime %*% rprime) ### Is the new point in the slice? nprime <- logu < joint ### Is the simulation wildly inaccurate? sprime <- logu - 1000 < joint # Set the return values---minus=plus for all things here, # since the "tree" is of depth 0. thetaminus <- thetaprime thetaplus <- thetaprime rminus <- rprime rplus <- rprime gradminus <- gradprime gradplus <- gradprime ### Compute the acceptance probability alphaprime <- min(1, exp(Mo1[["LP"]] - 0.5 * as.vector(rprime %*% rprime) - joint0)) nalphaprime <- 1} else { # Recursion: Implicitly build the height j-1 left and # right subtrees tree <- build.tree(theta=theta, r=r, grad=grad, logu=logu, v=v, j=j-1, epsilon=epsilon, joint=joint0, Mo0=Mo0) thetaminus <- tree$thetaminus rminus <- tree$rminus gradminus <- tree$gradminus thetaplus <- tree$thetaplus rplus <- tree$rplus gradplus <- tree$gradplus thetaprime <- tree$thetaprime gradprime <- tree$gradprime Mo1 <- tree$Mo1 nprime <- tree$nprime sprime <- tree$sprime alphaprime <- tree$alphaprime nalphaprime <- tree$nalphaprime ### If the first subtree stopping criterion is met, then stop if(sprime == 1) { if(v == -1) { tree <- build.tree(theta=thetaminus, r=rminus, grad=gradminus, logu=logu, v=v, j=j-1, epsilon=epsilon, joint0=joint0, Mo0=Mo0) thetaminus <- tree$thetaminus rminus <- tree$rminus gradminus <- tree$gradminus thetaprime2 <- tree$thetaprime gradprime2 <- tree$gradprime Mo12 <- tree$Mo1 nprime2 <- tree$nprime sprime2 <- tree$sprime alphaprime2 <- tree$alphaprime nalphaprime2 <- tree$nalphaprime } else { tree <- build.tree(theta=thetaplus, r=rplus, grad=gradplus, logu=logu, v=v, j=j-1, epsilon=epsilon, joint0=joint0, Mo0=Mo0) thetaplus <- tree$thetaplus rplus <- tree$rplus gradplus <- tree$gradplus thetaprime2 <- tree$thetaprime gradprime2 <- tree$gradprime Mo12 <- tree$Mo1 nprime2 <- tree$nprime sprime2 <- tree$sprime alphaprime2 <- tree$alphaprime nalphaprime2 <- tree$nalphaprime } ### Choose a subtree to propagate a sample up from temp <- nprime2 / (nprime + nprime2) if(!is.finite(temp)) temp <- 0 if(runif(1) < temp) { thetaprime <- thetaprime2 gradprime <- gradprime2 Mo1 <- Mo12} ### Update the number of valid points nprime <- nprime + nprime2 ### Update the stopping criterion sprime <- sprime && sprime2 && stop.criterion(thetaminus, thetaplus, rminus, rplus) ### Update acceptance probability statistics alphaprime <- alphaprime + alphaprime2 nalphaprime <- nalphaprime + nalphaprime2}} out <- list(thetaminus=thetaminus, rminus=rminus, gradminus=gradminus, thetaplus=thetaplus, rplus=rplus, gradplus=gradplus, thetaprime=thetaprime, gradprime=gradprime, Mo1=Mo1, nprime=nprime, sprime=sprime, alphaprime=alphaprime, nalphaprime=nalphaprime) return(out) } find.reasonable.epsilon <- function(theta0, grad0, Mo0, Model, Data, LogFile) { cat("\nFinding a reasonable initial value for epsilon...", file=LogFile, append=TRUE) epsilon <- 0.001 r0 <- runif(length(theta0)) ### Figure out which direction to move epsilon leap <- leapfrog(theta=theta0, r=r0, grad=grad0, epsilon=epsilon, Model=Model, Data=Data, Mo0=Mo0, Debug=Debug) if(!is.finite(leap$Mo1[["LP"]])) stop("LP is not finite in find.reasonable.epsilon().", file=LogFile, append=TRUE) acceptprob <- exp(leap$Mo1[["LP"]] - Mo0[["LP"]] - 0.5 * (as.vector(leap$rprime %*% leap$rprime) - as.vector(r0 %*% r0))) a <- 2 * (acceptprob > 0.5) - 1 ### Keep moving epsilon in that direction until acceptprob ### crosses 0.5 while (acceptprob^a > 2^(-a)) { epsilon <- epsilon * 2^a leap <- leapfrog(theta=theta0, r=r0, grad=grad0, epsilon=epsilon, Model=Model, Data=Data, Mo0=Mo0, Debug=Debug) if(!is.finite(leap$Mo1[["LP"]])) stop("LP is not finite in find.reasonable.epsilon().", file=LogFile, append=TRUE) acceptprob <- exp(leap$Mo1[["LP"]] - Mo0[["LP"]] - 0.5 * (as.vector(leap$rprime %*% leap$rprime) - as.vector(r0 %*% r0))) } cat("\nepsilon: ", round(max(epsilon,0.001),5), "\n\n", sep="", file=LogFile, append=TRUE) return(epsilon) } Count <- 0 evals <- 0 grad <- partial(Model, post[1,], Data) if(is.null(epsilon)) epsilon <- find.reasonable.epsilon(theta0=post[1,], grad0=grad, Mo0=Mo0, Model=Model, Data=Data, LogFile=LogFile) DiagCovar[1,] <- epsilon ### Dual-Averaging Parameters epsilonbar <- 1 gamma <- 0.05 Hbar <- 0 kappa <- 0.75 mu <- log(10*epsilon) t0 <- 10 ### Reset Dev, Mon, and thinned if(A < Iterations) { Dev <- matrix(Dev[1:(floor((Iterations-A)/Thinning)+1),]) Mon <- matrix(Mo0[["Monitor"]], floor((Iterations-A)/Thinning)+1, length(Mo0[["Monitor"]]), byrow=TRUE) thinned <- matrix(0, floor((Iterations-A)/Thinning)+1, LIV)} ### Begin NUTS for (iter in 2:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Current Posterior if(iter > 1) post[iter,] <- post[iter-1,] ### Save Thinned Samples if(iter > A) { if((iter-A) %% Thinning == 0) { thinned[((iter-A)/Thinning+1),] <- post[iter,] Dev[((iter-A)/Thinning+1)] <- Mo0[["Dev"]] Mon[((iter-A)/Thinning+1),] <- Mo0[["Monitor"]]}} else if(A >= Iterations) { if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- post[iter,] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]}} prop <- post[iter,] r0 <- runif(LIV) ### r0 is momenta ### Joint log-probability of theta and momenta r joint <- Mo0[["LP"]] - 0.5 * as.vector(r0 %*% r0) ### Resample u ~ U([0, exp(joint)]) logu <- joint - rexp(1) ### Initialize Tree thetaminus <- prop thetaplus <- prop rminus <- r0 rplus <- r0 gradminus <- grad gradplus <- grad j <- 0 ### Initial height j=0 n <- 1 ### Initially, the only valid point is the initial point s <- 1 ### Loop until s == 0 while (s == 1) { ### Choose a direction: -1=backward, 1=forward. v <- 2*(runif(1) < 0.5) - 1 ### Double the size of the tree. if(v == -1) { tree <- build.tree(theta=thetaminus, r=rminus, grad=gradminus, logu=logu, v=v, j=j, epsilon=epsilon, joint0=joint, Mo0=Mo0) thetaminus <- tree$thetaminus rminus <- tree$rminus gradminus <- tree$gradminus thetaprime <- tree$thetaprime gradprime <- tree$gradprime Mo1 <- tree$Mo1 nprime <- tree$nprime sprime <- tree$sprime alpha <- tree$alphaprime nalpha <- tree$nalphaprime} else { tree <- build.tree(theta=thetaplus, r=rplus, grad=gradplus, logu, v=v, j=j, epsilon=epsilon, joint0=joint, Mo0=Mo0) thetaplus <- tree$thetaplus rplus <- tree$rplus gradplus <- tree$gradplus thetaprime <- tree$thetaprime gradprime <- tree$gradprime Mo1 <- tree$Mo1 nprime <- tree$nprime sprime <- tree$sprime alpha <- tree$alphaprime nalpha <- tree$nalphaprime} ### Accept/Reject Count <- Count + 1 if((sprime == 1) && (runif(1) < nprime/n)) { post[iter,] <- thetaprime Mo0 <- Mo1 grad <- gradprime Acceptance <- Acceptance + 1 if(iter > A) { if((iter-A) %% Thinning == 0) { thinned[((iter-A)/Thinning+1),] <- Mo1[["parm"]] Dev[((iter-A)/Thinning+1)] <- Mo1[["Dev"]] Mon[((iter-A)/Thinning+1),] <- Mo1[["Monitor"]]}} else if(A >= Iterations) { if(iter %% Thinning == 0) { thinned[t.iter,] <- Mo1[["parm"]] Dev[t.iter] <- Mo1[["Dev"]] Mon[t.iter,] <- Mo1[["Monitor"]]}}} ### Update number of observed valid points n <- n + nprime ### Decide if it is time to stop s <- sprime && stop.criterion(thetaminus, thetaplus, rminus, rplus) ### Increment depth j <- j + 1 if(j*j >= Lmax) s <- 0} ### Adaptation of epsilon eta <- 1 / (iter - 1 + t0) Hbar <- (1 - eta) * Hbar + eta * (delta - alpha / nalpha) if(iter <= A) { epsilon <- exp(mu - sqrt(iter-1)/gamma * Hbar) eta <- (iter-1)^-kappa epsilonbar <- exp((1 - eta) * log(epsilonbar) + eta * log(epsilon)) DiagCovar <- rbind(DiagCovar, epsilon)} else epsilon <- epsilonbar } Acceptance <- round(Acceptance / Count * Iterations) ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcohss <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { A <- Specs[["A"]] n <- Specs[["n"]] w <- 0.05 # as with Roberts & Rosenthal if(!is.symmetric.matrix(VarCov)) { cat("\nAsymmetric Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.symmetric.matrix(VarCov)} if(!is.positive.definite(VarCov)) { cat("\nNon-Positive-Definite Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.positive.definite(VarCov)} decomp.freq <- max(floor(Iterations / Thinning / 100), 10) cat("\nEigendecomposition will occur every", decomp.freq, "iterations.\n\n", file=LogFile, append=TRUE) S.eig <-try(eigen(VarCov), silent=!Debug[["DB.eigen"]]) if(inherits(S.eig, "try-error")) { if(Debug[["DB.eigen"]] == TRUE) cat("\nWARNING: Eigendecomposition failed.\n", file=LogFile, append=TRUE) S.eig <- NULL DiagCovar <- matrix(0, floor(Iterations/Thinning)+1, LIV) } else DiagCovar <- matrix(diag(S.eig$vectors), floor(Iterations/Thinning)+1, LIV, byrow=TRUE) tuning <- 1 #Tuning edge.scale <- 5 #Tuning if(A > Iterations) post <- matrix(Mo0[["parm"]], Iterations, LIV, byrow=TRUE) else post <- matrix(Mo0[["parm"]], A, LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Eigenvectors of the Sample Covariance Matrix if({iter %% decomp.freq == 0} & {iter > 2} & {iter <= A}) { VarCov2 <- try({VarCov*n + cov(post[1:(iter-1),,drop=FALSE])*(iter-1)}/{n+iter-1}, silent=TRUE) if(inherits(VarCov2, "try-error")) VarCov2 <- VarCov if(!is.symmetric.matrix(VarCov2)) VarCov2 <- as.symmetric.matrix(VarCov2) if(!is.positive.definite(VarCov2)) VarCov2 <- as.positive.definite(VarCov2) S.eig <- try(eigen(VarCov2), silent=!Debug[["DB.eigen"]]) if(inherits(S.eig, "try-error")) { if(Debug[["DB.eigen"]] == TRUE) cat("\nWARNING: Eigendecomposition failed in", "iteration", iter, ".\n", file=LogFile, append=TRUE) S.eig <- eigen(VarCov)}} ### Hypercube or Eigenvector if(runif(1) < w || is.null(S.eig)) { vals <- rep(tuning, LIV) vecs <- diag(1, nrow=LIV) } else { vals <- S.eig$values vecs <- S.eig$vectors} ### Slice Interval Mo0.1 <- try(Model(Mo0[["parm"]], Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo0.1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]], collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo0.1 <- Mo0} Mo0 <- Mo0.1 y.slice <- Mo0[["LP"]] - rexp(1) L <- -1 * runif(LIV) U <- L + 1 ### Rejection Sampling repeat { wt <- runif(LIV, min=L, max=U) v <- as.numeric(vecs %*% {edge.scale * wt * vals}) prop <- Mo0[["parm"]] + v Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling resulted", "in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} if(Mo1[["LP"]] >= y.slice) break else if(all(abs(wt) < 1e-100)) { Mo1 <- Mo0 break} L[wt < 0] <- wt[wt < 0] U[wt > 0] <- wt[wt > 0]} Mo0 <- Mo1 if(iter <= A) post[iter,] <- Mo0[["parm"]] ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]] DiagCovar[t.iter,] <- diag(S.eig$vectors)} } if(A > 0) VarCov <- VarCov2 ### Output out <- list(Acceptance=Iterations, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcpcn <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { beta <- Specs[["beta"]] U <- chol(VarCov) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose new parameter values prop <- as.vector(sqrt(1 - beta*beta)*Mo0[["parm"]] + beta*(rbind(rnorm(LIV)) %*% U)) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcram <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { alpha.star <- Specs[["alpha.star"]] Block <- Specs[["B"]] Dist <- Specs[["Dist"]] gamma <- Specs[["gamma"]] n <- Specs[["n"]] B <- length(Block) if(B == 0) { if(!is.symmetric.matrix(VarCov)) { cat("\nAsymmetric Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.symmetric.matrix(VarCov)} if(!is.positive.definite(VarCov)) { cat("\nNon-Positive-Definite Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.positive.definite(VarCov)} Iden.Mat <- diag(LIV) S.z <- try(t(chol(VarCov)), silent=!Debug[["DB.chol"]]) if(!inherits(S.z, "try-error")) { if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal.\n", file=LogFile, append=TRUE) S <- S.z} else S <- Iden.Mat DiagCovar <- matrix(diag(VarCov), floor(Iterations/Thinning)+1, LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose New Parameter Values if(Dist == "t") U <- rt(LIV, df=5) else U <- rnorm(LIV) prop <- Mo0[["parm"]] + rbind(U) %*% S ### Log-Posterior Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1}} ### Adaptation eta <- min(1, LIV*{n + iter}^(-gamma)) VarCov.test <- S %*% {Iden.Mat + eta*(min(1, exp(log.alpha)) - alpha.star) * U %*% t(U) / sum(U*U)} %*% t(S) if(missing(VarCov.test) || !all(is.finite(VarCov.test)) || !is.matrix(VarCov.test)) {VarCov.test <- VarCov} if(!is.symmetric.matrix(VarCov.test)) VarCov.test <- as.symmetric.matrix(VarCov.test) if(is.positive.definite(VarCov.test)) { S.z <- try(t(chol(VarCov)), silent=!Debug[["DB.chol"]]) if(!inherits(S.z, "try-error")) { VarCov <- VarCov.test S <- S.z } else if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal in iteration", iter, ".\n", file=LogFile, append=TRUE)} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]] DiagCovar[t.iter,] <- diag(VarCov)} } } else { if(!identical(length(VarCov), B)) stop("Number of components in Covar differs from ", "number of blocks.", file=LogFile, append=TRUE) DiagCovar <- rep(0, LIV) Iden.Mat <- S <- S.z <- list() for (b in 1:B) { if(!identical(length(Block[[b]]), length(diag(VarCov[[b]])))) stop("Diagonal of Covar[[",b,"]] differs from ", "block length.", file=LogFile, append=TRUE) if(!is.symmetric.matrix(VarCov[[b]])) { cat("\nAsymmetric Covar block, correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.symmetric.matrix(VarCov[[b]])} if(!is.positive.definite(VarCov[[b]])) { cat("\nNon-Positive-Definite Covar block,", "correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.positive.definite(VarCov[[b]])} Iden.Mat[[b]] <- diag(length(diag(VarCov[[b]]))) S.z[[b]] <- try(t(chol(VarCov[[b]])), silent=!Debug[["DB.chol"]]) if(!inherits(S.z[[b]], "try-error")) S[[b]] <- S.z[[b]] else { if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition failed for", "proposal in block", b, ".\n", file=LogFile, append=TRUE) S[[b]] <- Iden.Mat[[b]]} DiagCovar[Block[[b]]] <- diag(VarCov[[b]]) } DiagCovar <- matrix(DiagCovar, floor(Iterations/Thinning)+1, LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Blockwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Proceed by Block for (b in 1:B) { ### Propose New Parameter Values if(Dist == "t") U <- rt(length(Block[[b]]), df=5) else U <- rnorm(length(Block[[b]])) prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + rbind(U) %*% S[[b]] ### Log-Posterior Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in block", b, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + length(Block[[b]]) / LIV}} ### Adaptation eta <- min(1, length(Block[[b]])*{n + iter}^(-gamma)) VarCov.test <- S[[b]] %*% {Iden.Mat[[b]] + eta*(min(1, exp(log.alpha)) - alpha.star) * U %*% t(U) / sum(U*U)} %*% t(S[[b]]) if(missing(VarCov.test) || !all(is.finite(VarCov.test)) || !is.matrix(VarCov.test)) {VarCov.test <- VarCov[[b]]} if(!is.symmetric.matrix(VarCov.test)) VarCov.test <- as.symmetric.matrix(VarCov.test) if(is.positive.definite(VarCov.test)) { S.z[[b]] <- try(t(chol(VarCov[[b]])), silent=!Debug[["DB.chol"]]) if(!inherits(S.z[[b]], "try-error")) { VarCov[[b]] <- VarCov.test S[[b]] <- S.z[[b]]} else if(Debug[["DB.chol"]] == TRUE) cat("\nWARNING: Cholesky decomposition", "failed for proposal in block", b, "in iteration", iter, ".\n", file=LogFile, append=TRUE)} DiagCovar[floor(iter / Thinning)+1,Block[[b]]] <- diag(VarCov[[b]]) } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcrdmh <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { Acceptance <- matrix(0, 1, LIV) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) s <- sample(c(-1,1), LIV, replace=TRUE) u1 <- runif(LIV, -1, 1) epsilon1 <- u1^s ### Random-Scan Componentwise Estimation for (j in sample.int(LIV)) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- prop[j]*epsilon1[j] ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { epsilon2 <- log(abs(Mo1[["parm"]][j] / Mo0[["parm"]][j])) if(!is.finite(epsilon2)) epsilon2 <- 0 ### Accept/Reject u2 <- log(runif(1)) < (epsilon2 + Mo1[["LP"]] - Mo0[["LP"]]) if(u2 == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=mean(as.vector(Acceptance)), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcrefractive <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, thinned, Debug, LogFile) { Adaptive <- Specs[["Adaptive"]] m <- Specs[["m"]] w <- Specs[["w"]] r <- Specs[["r"]] alpha.star <- 0.65 if(Adaptive < Iterations) DiagCovar <- matrix(w, nrow(thinned), LIV) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) prop <- Mo0[["parm"]] p <- rnorm(LIV) a <- 1 g <- partial(Model, prop, Data) for (i in 1:m) { if(t(p) %*% g > 0) { u <- g / sqrt(sum(g*g)) r1 <- 1 r2 <- r } else { u <- -g / sqrt(sum(g*g)) r1 <- r r2 <- 1} cos.theta.1 <- (t(p) %*% u) / sqrt(sum(p*p)) cos.2.theta.1 <- cos.theta.1 * cos.theta.1 cos.2.theta.2 <- 1 - (r1^2 / r2^2)*(1 - cos.2.theta.1) if(cos.2.theta.2 > 0) cos.theta.2 <- sqrt(cos.2.theta.2) else cos.theta.2 <- -sqrt(abs(cos.2.theta.2)) if(cos.2.theta.2 < 0) p <- as.vector(p - 2*(t(p) %*% u) %*% u) else { p <- (r1 / r2)*p - sqrt(sum(p*p))*((r1 / r2)*cos.theta.1 - cos.theta.2)*u a <- (r1 / r2)^(LIV-1)*(cos.theta.1 / cos.theta.2)*a} prop <- prop + w*p Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } prop <- Mo1[["parm"]]} ### Accept/Reject log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] + exp(a) if(!is.finite(log.alpha)) log.alpha <- 0 if(log(runif(1)) < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1 if(Adaptive < Iterations) w <- w + (w / (alpha.star * (1 - alpha.star))) * (1 - alpha.star) / iter } else if(Adaptive < Iterations) w <- abs(w - (w / (alpha.star * (1 - alpha.star))) * alpha.star / iter) ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]] if(Adaptive < Iterations) DiagCovar[t.iter,] <- w} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcrj <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { bin.n <- Specs[["bin.n"]] bin.p <- Specs[["bin.p"]] parm.p <- Specs[["parm.p"]] selectable <- Specs[["selectable"]] selected <- Specs[["selected"]] cur.parm <- cur.sel <- selected cur.parm[which(selectable == 0)] <- 1 nonzero.post <- rep(0, LIV) p <- parm.p for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose a variable to include/exclude v.change <- sample(LIV, 1, prob=selectable) prop.sel <- cur.sel prop.parm <- cur.parm ### Change proposed size, but not above bin.n if(sum(cur.sel) < bin.n) { prop.sel[v.change] <- 1 - prop.sel[v.change] prop.parm[v.change] <- 1 - prop.parm[v.change]} else if(prop.sel[v.change] == 1) prop.parm[v.change] <- prop.sel[v.change] <- 0 ### Priors prior.cur <- sum(dbern(cur.sel, p[which(selectable == 1)], log=TRUE), dbinom(sum(cur.sel), bin.n, bin.p, log=TRUE)) prior.prop <- sum(dbern(prop.sel, p[which(selectable == 1)], log=TRUE), dbinom(sum(prop.sel), bin.n, bin.p, log=TRUE)) ### Hit-And-Run Proposal Parameters theta <- rnorm(LIV) theta <- theta / sqrt(sum(theta*theta)) lambda <- runif(1) ### Random-Scan Componentwise Estimation (Within-Model) for (j in sample(which(cur.parm == 1))) { ### Propose new parameter values temp.post <- Mo0[["parm"]] temp.post[which(temp.post == 0)] <- nonzero.post[which(temp.post == 0)] temp.post[which(cur.parm == 0)] <- 0 prop <- Mo0[["parm"]] <- temp.post prop[j] <- prop[j] + lambda*theta[j] ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Within-model proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Within-model proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } ### Accept/Reject (Within-Model Move) u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]]) if(u == TRUE) Mo0 <- Mo1 if(Mo0[["parm"]][j] != 0) nonzero.post[j] <- Mo0[["parm"]][j] Acceptance <- Acceptance + (u * (1 / sum(cur.parm)))} ### Random-Scan Componentwise Estimation (Between-Models) prop <- Mo0[["parm"]] prop[v.change] <- prop.sel[v.change]*(prop[v.change] + lambda*theta[v.change]) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Between-models proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Between-models proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } ### Accept/Reject (Between-Models Move) u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]] + prior.prop - prior.cur) if(u == TRUE) { Mo0 <- Mo1 cur.sel <- prop.sel cur.parm <- prop.parm} if(Mo0[["parm"]][v.change] != 0) nonzero.post[v.change] <- Mo0[["parm"]][v.change] Acceptance <- Acceptance + (u * (1 / sum(prop.parm))) ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcrss <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, thinned, Debug, LogFile) { m <- Specs[["m"]] w <- Specs[["w"]] reflections <- 0 Norm <- function(x) return(sqrt(sum(x*x))) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} prop <- Mo0[["parm"]] y.slice <- Mo0[["LP"]] - rexp(1) g <- partial(Model, prop, Data) p <- rnorm(LIV) reflections <- 0 ### Take m Steps for (i in 1:m) { prop0 <- prop prop <- prop + w*p Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out proposal failed", "in step", i, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out proposal resulted", "in non-finite value(s) in step", i, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} prop <- Mo1[["parm"]] ### Reflect at boundary if(y.slice > Mo1[["LP"]]) { reflections <- reflections + 1 prop <- prop0 g <- partial(Model, prop, Data) p <- p - 2*g*{(t(p) %*% g) / Norm(g)^2}}} Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Final proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Final proposal resulted", "in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } Mo0 <- Mo1 ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Iterations, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcrwm <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, VarCov, Debug, LogFile) { Block <- Specs[["B"]] if(length(Block) == 0) { if(!is.symmetric.matrix(VarCov)) { cat("\nAsymmetric Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.symmetric.matrix(VarCov)} if(!is.positive.definite(VarCov)) { cat("\nNon-Positive-Definite Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.positive.definite(VarCov)} U <- chol(VarCov) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose new parameter values prop <- as.vector(Mo0[["parm"]] + rbind(rnorm(LIV)) %*% U) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted", "in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + 1}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } else { B <- length(Block) if(!identical(length(VarCov), B)) stop("Number of components in Covar differs from ", "number of blocks.", file=LogFile, append=TRUE) for (b in 1:B) { if(!identical(length(Block[[b]]), length(diag(VarCov[[b]])))) stop("Diagonal of Covar[[",b,"]] differs from ", "block length.", file=LogFile, append=TRUE) if(!is.symmetric.matrix(VarCov[[b]])) { cat("\nAsymmetric Covar block, correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.symmetric.matrix(VarCov[[b]])} if(!is.positive.definite(VarCov[[b]])) { cat("\nNon-Positive-Definite Covar block,", "correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.positive.definite(VarCov[[b]])}} for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, sep="", file=LogFile, append=TRUE) ### Proceed by Block for (b in 1:B) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[Block[[b]]] <- Mo0[["parm"]][Block[[b]]] + rbind(rnorm(length(Block[[b]]))) %*% chol(VarCov[[b]]) if({b == 1} & {iter %% Status == 0}) cat(", Proposal: Blockwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in block", b, "failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in block", b, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject log.u <- log(runif(1)) log.alpha <- Mo1[["LP"]] - Mo0[["LP"]] if(!is.finite(log.alpha)) log.alpha <- 0 if(log.u < log.alpha) { Mo0 <- Mo1 Acceptance <- Acceptance + length(Block[[b]]) / LIV}} } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcsamwg <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, parm.names, Debug, LogFile) { Dyn <- Specs[["Dyn"]] Periodicity <- Specs[["Periodicity"]] Acceptance <- matrix(0, 1, LIV) for (k in 1:ncol(Dyn)) {for (t in 1:nrow(Dyn)) { Dyn[t,k] <- which(parm.names == Dyn[t,k])}} Dyn <- matrix(as.numeric(Dyn), nrow(Dyn), ncol(Dyn)) staticparms <- c(1:LIV)[-as.vector(Dyn)] DiagCovar <- matrix(tuning, floor(Iterations/Periodicity), LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Select Order of Parameters if(length(staticparms) == 1) staticsample <- staticparms else staticsample <- sample(staticparms) if(ncol(Dyn) == 1) dynsample <- sample(Dyn) else dynsample <- as.vector(apply(Dyn, 1, sample)) totsample <- c(staticsample, dynsample) ### Componentwise Estimation for (j in totsample) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- rnorm(1, prop[j], tuning[j]) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]]) if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}} ### Adapt the Proposal Variance if(iter %% Periodicity == 0) { size <- 1 / min(100, sqrt(iter)) Acceptance.Rate <- Acceptance / iter log.tuning <- log(tuning) tuning.num <- which(Acceptance.Rate > 0.44) log.tuning[tuning.num] <- log.tuning[tuning.num] + size log.tuning[-tuning.num] <- log.tuning[-tuning.num] - size tuning <- exp(log.tuning) a.iter <- floor(iter / Periodicity) DiagCovar[a.iter,] <- tuning} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=mean(as.vector(Acceptance)), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=tuning) return(out) } .mcmcsgld <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { epsilon <- Specs[["epsilon"]] file <- Specs[["file"]] Nr <- Specs[["Nr"]] Nc <- Specs[["Nc"]] size <- Specs[["size"]] Acceptance <- matrix(Iterations, 1, LIV) con <- file(file, open="r") on.exit(close(con)) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Sample Data seek(con, 0) skip.rows <- sample.int(Nr - size, size=1) Data[["X"]] <- matrix(scan(file=con, sep=",", skip=skip.rows, nlines=size, quiet=TRUE), size, Nc, byrow=TRUE) ### Propose new parameter values g <- partial(Model, Mo0[["parm"]], Data) eta <- rnorm(LIV, 0, epsilon[iter]) prop <- Mo0[["parm"]] + {epsilon[iter]/2}*g + eta ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal resulted in non-finite", "value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } Mo0 <- Mo1 ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcslice <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { Block <- Specs[["B"]] B <- length(Block) Bounds <- Specs[["Bounds"]] m <- Specs[["m"]] Type <- Specs[["Type"]] w <- Specs[["w"]] for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Proceed by Block for (b in 1:B) { ### Random-Scan Componentwise Estimation if(Type[[b]] == "Continuous") { for (j in sample(Block[[b]])) { y.slice <- Mo0[["LP"]] - rexp(1) u <- runif(1,0,w[[b]]) intL <- intR <- prop <- Mo0[["parm"]] L <- intL[j] - u R <- intR[j] + (w[[b]] - u) ### Unlimited number of steps if(is.infinite(m[[b]])) { repeat { if(L <= Bounds[[b]][1]) break intL[j] <- L MoL <- try(Model(intL, Data), silent=!Debug[["DB.Model"]]) if(inherits(MoL, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) L <- L + w[[b]] break} else if(!is.finite(MoL[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound for", Data[["parm.names"]][j], "resulted in a non-finite", "LP.\n", file=LogFile, append=TRUE) L <- L + w[[b]] break} if(MoL[["LP"]] <= y.slice) break L <- L - w[[b]]} repeat { if(R >= Bounds[[b]][2]) break intR[j] <- R MoR <- try(Model(intR, Data), silent=!Debug[["DB.Model"]]) if(inherits(MoR, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the upper bound failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) R <- R - w[[b]] break} else if(!is.finite(MoR[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the upper bound for", Data[["parm.names"]][j], "resulted in a non-finite", "LP.\n", file=LogFile, append=TRUE) R <- R - w[[b]] break} if(MoR[["LP"]] <= y.slice) break R <- R + w[[b]]} } else if(m[[b]] > 1) { ### Limited number of steps J <- floor(runif(1,0,m[[b]])) K <- (m[[b]] - 1) - J while (J > 0) { if(L <= Bounds[[b]][1]) break intL[j] <- L MoL <- try(Model(intL, Data), silent=!Debug[["DB.Model"]]) if(inherits(MoL, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) L <- L + w[[b]] break} else if(!is.finite(MoL[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound for", Data[["parm.names"]][j], "resulted in a non-finite", "LP.\n", file=LogFile, append=TRUE) L <- L + w[[b]] break} if(MoL[["LP"]] <= y.slice) break L <- L - w[[b]] J <- J - 1} while (K > 0) { if(R >= Bounds[[b]][2]) break intR[j] <- R MoR <- try(Model(intR, Data), silent=!Debug[["DB.Model"]]) if(inherits(MoR, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the upper bound failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) R <- R - w[[b]] break} else if(!is.finite(MoR[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound for", Data[["parm.names"]][j], "resulted in a non-finite", "LP.\n", file=LogFile, append=TRUE) R <- R - w[[b]] break} R <- R + w[[b]] K <- K - 1} } ### Shrink the interval to lower and upper bounds if(L < Bounds[[b]][1]) L <- Bounds[[b]][1] if(R > Bounds[[b]][2]) R <- Bounds[[b]][2] ### Rejection Sampling repeat { L <- min(L,R) R <- max(L,R) prop[j] <- runif(1,L,R) Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling", "failed for", Data[["parm.names"]][j], "\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} if(Mo1[["LP"]] >= y.slice) break else if(abs(R-L) < 1e-100) break if(Mo1[["parm"]][j] > Mo0[["parm"]][j]) R <- Mo1[["parm"]][j] else L <- Mo1[["parm"]][j]} Mo0 <- Mo1 } } else if(Type[[b]] == "Nominal") { for (j in sample(Block[[b]])) { y.slice <- Mo0[["LP"]] - rexp(1) LP.grid <- theta <- Bounds[[b]][1]:Bounds[[b]][2] for (i in 1:length(LP.grid)) { prop[j] <- theta[i] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "failed.\n", file=LogFile, append=TRUE) LP.grid[i] <- 0 } else if(!is.finite(Mo1[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Evaluating", Data[["parm.names"]][j], "at", round(prop[j],5), "resulted", "in non-finite value(s).\n", file=LogFile, append=TRUE) LP.grid[i] <- 0 } else if(Mo1[["LP"]] < y.slice) LP.grid[i] <- 0 else LP.grid[i] <- exp(Mo1[["LP"]])} if(sum(LP.grid) > 0) LP.grid <- LP.grid / sum(LP.grid) else LP.grid <- rep(1/length(LP.grid), length(LP.grid)) ### Rejection Sampling repeat { prop[j] <- theta[sample(1:length(LP.grid),1, prob=LP.grid)] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(is.finite(Mo1[["LP"]])) { if(Mo1[["LP"]] >= y.slice) break}} Mo0 <- Mo1 } } else { ### Ordinal for (j in sample(Block[[b]])) { y.slice <- Mo0[["LP"]] - rexp(1) intL <- intR <- prop <- Mo0[["parm"]] L <- intL[j] - w[[b]] R <- intR[j] + w[[b]] ### Unlimited number of steps if(is.infinite(m[[b]])) { repeat { if(L <= Bounds[[b]][1]) break intL[j] <- L MoL <- try(Model(intL, Data), silent=!Debug[["DB.Model"]]) if(inherits(MoL, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) L <- L + w[[b]] break} else if(!is.finite(MoL[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound for", Data[["parm.names"]][j], "resulted in a non-finite", "LP.\n", file=LogFile, append=TRUE) L <- L + w[[b]] break} if(MoL[["LP"]] <= y.slice) break L <- L - w[[b]]} repeat { if(R >= Bounds[[b]][2]) break intR[j] <- R MoR <- try(Model(intR, Data), silent=!Debug[["DB.Model"]]) if(inherits(MoR, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the upper bound failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) R <- R - w[[b]] break} else if(!is.finite(MoR[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the upper bound for", Data[["parm.names"]][j], "resulted in a non-finite", "LP.\n", file=LogFile, append=TRUE) R <- R - w[[b]] break} if(MoR[["LP"]] <= y.slice) break R <- R + w[[b]]} } else if(m[[b]] > 1) { ### Limited number of steps J <- floor(runif(1,0,m[[b]])) K <- (m[[b]] - 1) - J while (J > 0) { if(L <= Bounds[[b]][1]) break intL[j] <- L MoL <- try(Model(intL, Data), silent=!Debug[["DB.Model"]]) if(inherits(MoL, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) L <- L + w[[b]] break} else if(!is.finite(MoL[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound for", Data[["parm.names"]][j], "resulted in a non-finite", "LP.\n", file=LogFile, append=TRUE) L <- L + w[[b]] break} if(MoL[["LP"]] <= y.slice) break L <- L - w[[b]] J <- J - 1} while (K > 0) { if(R >= Bounds[[b]][2]) break intR[j] <- R MoR <- try(Model(intR, Data), silent=!Debug[["DB.Model"]]) if(inherits(MoR, "try-error")) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the upper bound failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) R <- R - w[[b]] break} if(!is.finite(MoR[["LP"]])) { if(Debug[["DB.Model"]] == TRUE) cat("\nWARNING: Stepping out", "the lower bound for", Data[["parm.names"]][j], "resulted in a non-finite", "LP.\n", file=LogFile, append=TRUE) R <- R - w[[b]] break} R <- R + w[[b]] K <- K - 1} } ### Shrink the interval to lower and upper bounds if(L < Bounds[[b]][1]) L <- Bounds[[b]][1] if(R > Bounds[[b]][2]) R <- Bounds[[b]][2] ### Rejection Sampling repeat { prop[j] <- sample(L:R,1) Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling", "failed for", Data[["parm.names"]][j], "\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} if(Mo1[["LP"]] >= y.slice) break else if(abs(R-L) < 1e-100) break if(Mo1[["parm"]][j] > Mo0[["parm"]][j]) R <- Mo1[["parm"]][j] else L <- Mo1[["parm"]][j]} Mo0 <- Mo1 } } if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } } ### Output out <- list(Acceptance=Iterations, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } .mcmcsmwg <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, parm.names, Debug, LogFile) { Dyn <- Specs[["Dyn"]] Acceptance <- matrix(0, 1, LIV) for (k in 1:ncol(Dyn)) {for (t in 1:nrow(Dyn)) { Dyn[t,k] <- which(parm.names == Dyn[t,k])}} Dyn <- matrix(as.numeric(Dyn), nrow(Dyn), ncol(Dyn)) staticparms <- c(1:LIV)[-as.vector(Dyn)] for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Select Order of Parameters if(length(staticparms) == 1) staticsample <- staticparms else staticsample <- sample(staticparms) if(ncol(Dyn) == 1) dynsample <- sample(Dyn) else dynsample <- as.vector(apply(Dyn, 1, sample)) totsample <- c(staticsample, dynsample) ### Componentwise Estimation for (j in totsample) { ### Propose new parameter values prop <- Mo0[["parm"]] prop[j] <- rnorm(1, prop[j], tuning[j]) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]]) if(u == TRUE) { Mo0 <- Mo1 Acceptance[j] <- Acceptance[j] + 1}}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=mean(as.vector(Acceptance)), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=tuning) return(out) } .mcmcthmc <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { epsilon <- Specs[["epsilon"]] L <- Specs[["L"]] m <- Specs[["m"]] invm <- as.inverse(m) U <- chol(m) Temperature <- Specs[["Temperature"]] gr <- partial(Model, Mo0[["parm"]], Data) sqrt.Temp <- sqrt(Temperature) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Propose new parameter values prop <- Mo0[["parm"]] momentum1 <- momentum0 <- as.vector(rnorm(LIV) %*% U) kinetic0 <- t(momentum0) %*% invm %*% momentum0 / 2 Mo0.1 <- Mo0 for (l in 1:L) { if(2*(l-1) < L) momentum1 <- momentum1 * sqrt.Temp else momentum1 <- momentum1 / sqrt.Temp momentum1 <- momentum1 + (epsilon/2) * gr prop <- prop + as.vector(epsilon %*% invm) * momentum1 Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog", l, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", l, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1} if(any(Mo0.1[["parm"]] == Mo1[["parm"]])) { nomove <- which(Mo0.1[["parm"]] == Mo1[["parm"]]) momentum1[nomove] <- -momentum1[nomove] prop[nomove] <- prop[nomove] + momentum1[nomove] Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed in leapfrog", l, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal in leapfrog", l, "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0.1}} Mo0.1 <- Mo1 prop <- Mo1[["parm"]] gr <- partial(Model, prop, Data) momentum1 <- momentum1 + (epsilon/2) * gr if(2*l > L) momentum1 <- momentum1 / sqrt.Temp else momentum1 <- momentum1 * sqrt.Temp} momentum1 <- -momentum1 kinetic1 <- t(momentum1) %*% invm %*% momentum1 / 2 ### Accept/Reject H0 <- -Mo0[["LP"]] + kinetic0 H1 <- -Mo1[["LP"]] + kinetic1 delta <- H1 - H0 alpha <- min(1, exp(-delta)) if(!is.finite(alpha)) alpha <- 0 if(runif(1) < alpha) { Mo0 <- Mo1 kinetic0 <- kinetic1 Acceptance <- Acceptance + 1} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=matrix(epsilon, 1, LIV), Mon=Mon, thinned=thinned, VarCov=cov(thinned)) return(out) } .mcmctwalk <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, Debug, LogFile) { xp0 <- SIV <- Specs[["SIV"]] n1 <- Specs[["n1"]] at <- Specs[["at"]] aw <- Specs[["aw"]] IntProd <- function(x) {return(sum(x*x))} DotProd <- function(x, y) {return(sum(x*y))} Simh1 <- function(dim, pphi, x, xp, beta) { phi <- runif(dim) < pphi rt <- NULL for (i in 1:dim) if(phi[i]) rt <- append(rt, xp[i] + beta*(xp[i] - x[i])) else rt <- append(rt, x[i]) return(list(rt=rt, nphi=sum(phi))) } Simfbeta <- function(at) { if(runif(1) < (at-1)/(2*at)) return(exp(1/(at + 1)*log(runif(1)))) else return(exp(1/(1 - at)*log(runif(1)))) } Simh2 <- function(dim, pphi, aw, x, xp) { u <- runif(dim) phi <- runif(dim) < pphi z <- (aw/(1+aw))*(aw*u^2 + 2*u -1) z <- z*phi return(list(rt=x + (x - xp)*z, nphi=sum(phi))) } Simh3 <- function(dim, pphi, x, xp) { phi <- runif(dim) < pphi sigma <- max(phi*abs(xp - x)) x + sigma*rnorm(dim)*phi return(list(rt=x + sigma*rnorm(dim)*phi, nphi=sum(phi), sigma=sigma)) } G3U <- function(nphi, sigma, h, x, xp) { if(nphi > 0) return((nphi/2)*log(2*pi) + nphi*log(sigma) + 0.5*IntProd(h - xp)/(sigma^2)) else return(0) } Simh4 <- function(dim, pphi, x, xp) { phi <- runif(dim) < pphi sigma <- max(phi*abs(xp - x))/3 rt <- NULL for (i in 1:dim) if(phi[i]) rt <- append(rt, xp[i] + sigma*rnorm(1)) else rt <- append(rt, x[i]) return(list(rt=rt, nphi=sum(phi), sigma=sigma)) } G4U <- function(nphi, sigma, h, x, xp) { if(nphi > 0) return((nphi/2)*log(2*pi) + nphi*log(sigma) + 0.5*IntProd((h - x))/(sigma^2)) else return(0) } OneMove <- function(dim, Model, Data, x, U, xp, Up, at=at, aw=aw, pphi=pphi, F1=0.4918, F2=0.9836, F3=0.9918, Mo0.1, Mo0.2) { dir <- runif(1) ### Determine which set of points ker <- runif(1) ### Choose a kernel if(ker < F1) { ### Kernel h1: Traverse funh <- 1 if(dir < 0.5) { beta <- Simfbeta(at) tmp <- Simh1(dim, pphi, xp, x, beta) yp <- tmp$rt nphi <- tmp$nphi y <- x propU <- U Mo1.2 <- try(Model(yp, Data), silent=!Debug[["DB.Model"]]) check1 <- check2 <- FALSE if(!inherits(Mo1.2, "try-error")) { check1 <- TRUE if(is.finite(Mo1.2[["LP"]]) & identical(yp, as.vector(Mo1.2[["LP"]]))) check2 <- TRUE} if(check1 & check2) { propUp <- Mo1.2[["LP"]] * -1 ### Symmetric Proposal if(nphi == 0) A <- 1 ### Nothing moved else A <- exp((U - propU) + (Up - propUp) + (nphi-2)*log(beta))} else { propUp <- NULL A <- 0 ### Out of support, not accepted } } else { beta <- Simfbeta(at) tmp <- Simh1(dim, pphi, x, xp, beta) y <- tmp$rt nphi <- tmp$nphi yp <- xp propUp <- Up Mo1.1 <- try(Model(y, Data), silent=!Debug[["DB.Model"]]) check1 <- check2 <- FALSE if(!inherits(Mo1.1, "try-error")) { check1 <- TRUE if(is.finite(Mo1.1[["LP"]]) & identical(y, as.vector(Mo1.1[["parm"]]))) check2 <- TRUE} if(check1 & check2) { propU <- Mo1.1[["LP"]] * -1 ### Symmetric Proposal if(nphi == 0) A <- 1 ### Nothing moved else A <- exp((U - propU) + (Up - propUp) + (nphi-2)*log(beta))} else { propU <- NULL A <- 0 ### Out of support, not accepted } } } else if(ker < F2) { ### Kernel h2: Walk funh <- 2 if(dir < 0.5) { ### x as pivot tmp <- Simh2(dim, pphi, aw, xp, x) yp <- tmp$rt nphi <- tmp$nphi y <- x propU <- U Mo1.2 <- try(Model(yp, Data), silent=!Debug[["DB.Model"]]) check1 <- check2 <- FALSE if(!inherits(Mo1.2, "try-error")) { check1 <- TRUE if(is.finite(Mo1.2[["LP"]]) & identical(yp, as.vector(Mo1.2[["parm"]]))) check2 <- TRUE} if(check1 & check2 & !identical(yp, y)) { propUp <- Mo1.2[["LP"]] * -1 A <- exp((U - propU) + (Up - propUp))} else { propUp <- NULL A <- 0 ### Out of support, not accepted } } else { ### xp as pivot tmp <- Simh2(dim, pphi, aw, x, xp) y <- tmp$rt nphi <- tmp$nphi yp <- xp propUp <- Up Mo1.1 <- try(Model(y, Data), silent=!Debug[["DB.Model"]]) check1 <- check2 <- FALSE if(!inherits(Mo1.1, "try-error")) { check1 <- TRUE if(is.finite(Mo1.1[["LP"]]) & identical(y, as.vector(Mo1.1[["parm"]]))) check2 <- TRUE} if(check1 & check2 & !identical(yp, y)) { propU <- Mo1.1[["LP"]] * -1 A <- exp((U - propU) + (Up - propUp))} else { propU <- NULL A <- 0 ### Out of support, not accepted } } } else if(ker < F3) { ### Kernel h3: Blow funh <- 3 if(dir < 0.5) { ### x as pivot tmp <- Simh3(dim, pphi, xp, x) yp <- tmp$rt nphi <- tmp$nphi sigma <- tmp$sigma y <- x propU <- U Mo1.2 <- try(Model(yp, Data), silent=!Debug[["DB.Model"]]) check1 <- check2 <- FALSE if(!inherits(Mo1.2, "try-error")) { check1 <- TRUE if(is.finite(Mo1.2[["LP"]]) & identical(yp, as.vector(Mo1.2[["parm"]]))) check2 <- TRUE} if(check1 & check2 & !identical(yp, x)) { propUp <- Mo1.2[["LP"]] * -1 W1 <- G3U(nphi, sigma, yp, xp, x) W2 <- G3U(nphi, sigma, xp, yp, x) A <- exp((U - propU) + (Up - propUp) + (W1 - W2))} else { propUp <- NULL A <- 0 ### Out of support, not accepted } } else { ### xp as pivot tmp <- Simh3(dim, pphi, x, xp) y <- tmp$rt nphi <- tmp$nphi sigma <- tmp$sigma yp <- xp propUp <- Up Mo1.1 <- try(Model(y, Data), silent=!Debug[["DB.Model"]]) check1 <- check2 <- FALSE if(!inherits(Mo1.1, "try-error")) { check1 <- TRUE if(is.finite(Mo1.1[["LP"]]) & identical(y, as.vector(Mo1.1[["parm"]]))) check2 <- TRUE} if(check1 & check2 & !identical(y, xp)) { propU <- Mo1.1[["LP"]] * -1 W1 <- G3U(nphi, sigma, y, x, xp) W2 <- G3U(nphi, sigma, x, y, xp) A <- exp((U - propU) + (Up - propUp) + (W1 - W2))} else { propU <- NULL A <- 0 ### Out of support, not accepted } } } else { ## Kernel h4: Hop funh <- 4 if(dir < 0.5) { ### x as pivot tmp <- Simh4(dim, pphi, xp, x) yp <- tmp$rt nphi <- tmp$nphi sigma <- tmp$sigma y <- x propU <- U Mo1.2 <- try(Model(yp, Data), silent=!Debug[["DB.Model"]]) check1 <- check2 <- FALSE if(!inherits(Mo1.2, "try-error")) { check1 <- TRUE if(is.finite(Mo1.2[["LP"]]) & identical(yp, as.vector(Mo1.2[["parm"]]))) check2 <- TRUE} if(check1 & check2 & !identical(yp, x)) { propUp <- Mo1.2[["LP"]] * -1 W1 <- G4U(nphi, sigma, yp, xp, x) W2 <- G4U(nphi, sigma, xp, yp, x) A <- exp((U - propU) + (Up - propUp) + (W1 - W2))} else { propUp <- NULL A <- 0 ### Out of support, not accepted } } else { ### xp as pivot tmp <- Simh4(dim, pphi, x, xp) y <- tmp$rt nphi <- tmp$nphi sigma <- tmp$sigma yp <- xp propUp <- Up Mo1.1 <- try(Model(y, Data), silent=!Debug[["DB.Model"]]) check1 <- check2 <- FALSE if(!inherits(Mo1.1, "try-error")) { check1 <- TRUE if(is.finite(Mo1.1[["LP"]]) & identical(y, as.vector(Mo1.1[["parm"]]))) check2 <- TRUE} if(check1 & check2 & !identical(y, xp)) { propU <- Mo1.1[["LP"]] * -1 W1 <- G4U(nphi, sigma, y, x, xp) W2 <- G4U(nphi, sigma, x, y, xp) A <- exp((U - propU) + (Up - propUp) + (W1 - W2))} else { propU <- NULL A <- 0 ### Out of support, not accepted } } } if(check1 & check2 & is.finite(A) & (dir < 0.5)) Mo0.2 <- Mo1.2 else if(check1 & check2 & is.finite(A) & (dir >= 0.5)) Mo0.1 <- Mo1.1 else if(!is.finite(A)) A <- 0 return(list(y=y, propU=propU, yp=yp, propUp=propUp, A=A, funh=funh, nphi=nphi, Mo0.1=Mo0.1, Mo0.2=Mo0.2)) } Runtwalk <- function(Iterations, dim, x0, xp0, pphi, at, aw, F1=0.4918, F2=F1+0.4918, F3=F2+0.0082, Model, Data, Status, Thinning, Acceptance, Dev, Mon, Mo0, thinned, Debug, LogFile) { x <- x0 ### Primary vector of initial values xp <- xp0 ### Secondary vector of initial values Mo0.1 <- try(Model(x, Data), silent=!Debug[["DB.Model"]]) Mo0.2 <- try(Model(xp, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo0.1, "try-error") | inherits(Mo0.2, "try-error")) stop("Error in estimating the log-posterior.", file=LogFile, append=TRUE) if(any(!is.finite(c(Mo0.1[["LP"]], Mo0.2[["LP"]])))) stop("The log-posterior is non-finite.", file=LogFile, append=TRUE) if(identical(x, as.vector(Mo0.1[["parm"]])) & identical(xp, as.vector(Mo0.2[["parm"]]))) { U <- Mo0.1[["LP"]] * -1 Up <- Mo0.2[["LP"]] * -1} else { cat("\nInitial values are out of support.", file=LogFile, append=TRUE) cat("\n Initial.Values=", x, file=LogFile, append=TRUE) cat("\n SIV=", xp, file=LogFile, append=TRUE) stop("Try re-specifying initial values.", file=LogFile, append=TRUE)} if(any(abs(x - xp) <= 0)) stop("\nBoth vectors of initial values are not unique.", file=LogFile, append=TRUE) Acceptance <- 0 for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate Subset, LP: ", round(Mo0.1[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Assign x and xp x <- as.vector(Mo0.1[["parm"]]) xp <- as.vector(Mo0.2[["parm"]]) ### Propose New Parameter Values move <- OneMove(dim=dim, Model, Data, x, U, xp, Up, at=at, aw=aw, pphi=pphi, F1=F1, F2=F2, F3=F3, Mo0.1=Mo0.1, Mo0.2=Mo0.2) ### Accept/Reject if(runif(1) < move$A) { Mo0.1 <- move$Mo0.1 Mo0.2 <- move$Mo0.2 Acceptance <- Acceptance + 1 #move$nphi/dim x <- move$y U <- move$propU xp <- move$yp Up <- move$propUp } ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0.1[["parm"]] Dev[t.iter] <- Mo0.1[["Dev"]] Mon[t.iter,] <- Mo0.1[["Monitor"]]} } out <- list(Acceptance=Acceptance, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=.colVars(thinned)) return(out) } out <- Runtwalk(Iterations=Iterations, dim=LIV, x0=Mo0[["parm"]], xp0=xp0, pphi=min(LIV, n1)/LIV, at=6, aw=1.5, Model=Model, Data=Data, Status=Status, Thinning=Thinning, Acceptance=Acceptance, Dev=Dev, Mon=Mon, Mo0=Mo0, thinned=thinned, Debug=Debug, LogFile=LogFile) ### Output return(out) } .mcmcuess <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, VarCov, Debug, LogFile) { A <- Specs[["A"]] Block <- Specs[["B"]] m <- Specs[["m"]] n <- Specs[["n"]] w <- 0.05 B <- length(Block) if(B == 0) { if(!is.symmetric.matrix(VarCov)) { cat("\nAsymmetric Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.symmetric.matrix(VarCov)} if(!is.positive.definite(VarCov)) { cat("\nNon-Positive-Definite Covar, correcting now...\n", file=LogFile, append=TRUE) VarCov <- as.positive.definite(VarCov)} decomp.freq <- max(LIV * floor(Iterations / Thinning / 100), 10) cat("\nEigendecomposition will occur every", decomp.freq, "iterations.\n\n", file=LogFile, append=TRUE) S.eig <-try(eigen(VarCov), silent=!Debug[["DB.eigen"]]) if(inherits(S.eig, "try-error")) S.eig <- NULL obs.sum <- matrix(Mo0[["parm"]]*n, LIV, 1) obs.scatter <- tcrossprod(Mo0[["parm"]])*n DiagCovar <- matrix(diag(VarCov), floor(Iterations/Thinning)+1, LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Multivariate, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Eigenvectors of the Sample Covariance Matrix if({iter %% decomp.freq == 0} & {iter > 1} & {iter < A}) { VarCov <- obs.scatter/{n + iter} - tcrossprod(obs.sum/{n + iter}) S.eig <- eigen(VarCov)} ### Non-Adaptive or Adaptive if(runif(1) < w || is.null(S.eig)) { v <- rnorm(LIV) v <- v / sqrt(sum(v*v)) } else { which.eig <- floor(1 + LIV * runif(1)) v <- S.eig$vectors[,which.eig] * sqrt(abs(S.eig$values[which.eig]))} ### Slice Interval Mo0.1 <- try(Model(Mo0[["parm"]], Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo0.1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo0.1 <- Mo0} Mo0 <- Mo0.1 y.slice <- Mo0[["LP"]] - rexp(1) L <- -runif(1) U <- L + 1 if(m > 0) { L.y <- try(Model(Mo0[["parm"]] + v*L, Data)[["LP"]], silent=!Debug[["DB.Model"]]) if(inherits(L.y, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the lower", "bound failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]] + v*L, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} L.y <- Mo0[["LP"]] } else if(!is.finite(L.y)) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the lower", "bound resulted in non-finite LP.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]] + v*L, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} L.y <- Mo0[["LP"]]} U.y <- try(Model(Mo0[["parm"]] + v*U, Data)[["LP"]], silent=!Debug[["DB.Model"]]) if(inherits(U.y, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the upper", "bound failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]] + v*U, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} U.y <- Mo0[["LP"]] } else if(!is.finite(U.y)) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the upper", "bound resulted in non-finite LP.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]] + v*U, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} U.y <- Mo0[["LP"]]} step <- 0 while({L.y > y.slice || U.y > y.slice} && step < m) { step <- step + 1 if(runif(1) < 0.5) { L <- L - 1 L.y <- try(Model(Mo0[["parm"]] + v*L, Data)[["LP"]], silent=!Debug[["DB.Model"]]) if(inherits(L.y, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the lower", "bound failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]] + v*L, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} L.y <- Mo0[["LP"]] } else if(!is.finite(L.y)) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the lower", "bound resulted in non-finite LP.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]] + v*L, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} L.y <- Mo0[["LP"]] } } else { U <- U + 1 U.y <- try(Model(Mo0[["parm"]] + v*U, Data)[["LP"]], silent=!Debug[["DB.Model"]]) if(inherits(U.y, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the upper", "bound failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]] + v*U, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} U.y <- Mo0[["LP"]] } else if(!is.finite(U.y)) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the upper", "bound resulted in non-finite LP.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]] + v*U, collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} U.y <- Mo0[["LP"]]}}}} ### Rejection Sampling repeat { prop.offset <- runif(1, min=L, max=U) prop <- Mo0[["parm"]] + prop.offset * v Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling resulted", "in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop, collapse=","),")", sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} prop <- Mo1[["parm"]] if(Mo1[["LP"]] >= y.slice) break else if(abs(prop.offset < 1e-100)) { Mo1 <- Mo0 break} if(prop.offset < 0) L <- prop.offset else U <- prop.offset} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo1[["parm"]] Dev[t.iter] <- Mo1[["Dev"]] Mon[t.iter,] <- Mo1[["Monitor"]] DiagCovar[t.iter,] <- diag(S.eig$vectors)} obs.sum <- obs.sum + Mo1[["parm"]] obs.scatter <- obs.scatter + tcrossprod(Mo1[["parm"]]) Mo0 <- Mo1} } else { if(!identical(length(VarCov), B)) stop("Number of components in Covar differs from ", "number of blocks.", file=LogFile, append=TRUE) S.eig <- obs.sum <- obs.scatter <- list() decomp.freq <- rep(0, length(B)) DiagCovar <- rep(0, LIV) for (b in 1:B) { if(!identical(length(Block[[b]]), length(diag(VarCov[[b]])))) stop("Diagonal of Covar[[",b,"]] differs from block ", "length.", file=LogFile, append=TRUE) if(!is.symmetric.matrix(VarCov[[b]])) { cat("\nAsymmetric Covar block, correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.symmetric.matrix(VarCov[[b]])} if(!is.positive.definite(VarCov[[b]])) { cat("\nNon-Positive-Definite Covar block,", "correcting now...\n", file=LogFile, append=TRUE) VarCov[[b]] <- as.positive.definite(VarCov[[b]])} decomp.freq[b] <- max(length(Block[[b]]) * floor(Iterations / Thinning / 100), 10) S.eig[[b]] <-try(eigen(VarCov[[b]]), silent=!Debug[["DB.eigen"]]) if(inherits(S.eig[[b]], "try-error")) S.eig[[b]] <- NULL obs.sum[[b]] <- matrix(Mo0[["parm"]][Block[[b]]]*n, length(Block[[b]]), 1) obs.scatter[[b]] <- tcrossprod(Mo0[["parm"]][Block[[b]]])*n DiagCovar[Block[[b]]] <- diag(VarCov[[b]])} if(all(decomp.freq == decomp.freq[1])) cat("\nEigendecomposition will occur every", decomp.freq[1], "iterations.\n\n", file=LogFile, append=TRUE) else cat("\nEigendecomposition frequency varies by block,", "and will occur between\n", min(decomp.freq), "and", max(decomp.freq), "iterations.\n\n", file=LogFile, append=TRUE) DiagCovar <- matrix(DiagCovar, floor(Iterations / Thinning)+1, LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Blockwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Proceed by Block for (b in 1:B) { ### Eigenvectors of the Sample Covariance Matrix if({iter %% decomp.freq[b] == 0} & {iter > 1} & {iter < A}) { VarCov[[b]] <- obs.scatter[[b]]/{n + iter} - tcrossprod(obs.sum[[b]]/{n + iter}) S.eig[[b]] <- eigen(VarCov[[b]])} ### Non-Adaptive or Adaptive if(runif(1) < w || is.null(S.eig[[b]])) { v <- rnorm(length(Block[[b]])) v <- v / sqrt(sum(v*v)) } else { which.eig <- floor(1 + length(Block[[b]]) * runif(1)) v <- S.eig[[b]]$vectors[,which.eig] * sqrt(abs(S.eig[[b]]$values[which.eig]))} ### Slice Interval Mo0.1 <- try(Model(Mo0[["parm"]][Block[[b]]], Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo0.1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for block", b, "failed.\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(Mo0[["parm"]][Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo0.1 <- Mo0} Mo0 <- Mo0.1 y.slice <- Mo0[["LP"]] - rexp(1) L <- -runif(1) U <- L + 1 if(m > 0) { prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + v*L L.y <- try(Model(prop, Data)[["LP"]], silent=!Debug[["DB.Model"]]) if(inherits(L.y, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the lower", "bound failed for block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} L.y <- Mo0[["LP"]] } else if(!is.finite(L.y)) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the lower", "bound resulted in non-finite LP", "for block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} L.y <- Mo0[["LP"]]} prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + v*U U.y <- try(Model(prop, Data)[["LP"]], silent=!Debug[["DB.Model"]]) if(inherits(U.y, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the upper", "bound failed for block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} U.y <- Mo0[["LP"]] } else if(!is.finite(U.y)) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the upper", "bound resulted in non-finite LP", "for block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} U.y <- Mo0[["LP"]]} step <- 0 while({L.y > y.slice || U.y > y.slice} && step < m) { step <- step + 1 if(runif(1) < 0.5) { L <- L - 1 prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + v*L L.y <- try(Model(prop, Data)[["LP"]], silent=!Debug[["DB.Model"]]) if(inherits(L.y, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the", "lower bound failed for", "block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(", paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} L.y <- Mo0[["LP"]] } else if(!is.finite(L.y)) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the", "lower bound resulted in ", "non-finite LP for block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(", paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} L.y <- Mo0[["LP"]] } } else { U <- U + 1 prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + v*U U.y <- try(Model(prop, Data)[["LP"]], silent=!Debug[["DB.Model"]]) if(inherits(U.y, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the", "upper bound failed for", "block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(", paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} U.y <- Mo0[["LP"]] } else if(!is.finite(U.y)) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Stepping out the", "upper bound resulted in", "non-finite LP for block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(", paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} U.y <- Mo0[["LP"]]}}}} ### Rejection Sampling repeat { prop.offset <- runif(1, min=L, max=U) prop <- Mo0[["parm"]] prop[Block[[b]]] <- prop[Block[[b]]] + prop.offset*v Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling", "failed for block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Rejection sampling", "resulted in non-finite", "value(s) for block", b, ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Proposal:\n", paste("c(",paste(prop[Block[[b]]], collapse=","),")",sep=""), "\n", file=LogFile, append=TRUE)} Mo1 <- Mo0} prop <- Mo1[["parm"]] if(Mo1[["LP"]] >= y.slice) break else if(abs(prop.offset < 1e-100)) { Mo1 <- Mo0 break} if(prop.offset < 0) L <- prop.offset else U <- prop.offset} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo1[["parm"]] Dev[t.iter] <- Mo1[["Dev"]] Mon[t.iter,] <- Mo1[["Monitor"]] DiagCovar[t.iter,Block[[b]]] <- diag(S.eig[[b]]$vectors)} obs.sum[[b]] <- obs.sum[[b]] + Mo1[["parm"]][Block[[b]]] obs.scatter[[b]] <- obs.scatter[[b]] + tcrossprod(Mo1[["parm"]][Block[[b]]]) Mo0 <- Mo1} } } ### Output out <- list(Acceptance=Iterations, Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=VarCov) return(out) } .mcmcusamwg <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, parm.names, Debug, LogFile) { Dyn <- Specs[["Dyn"]] Periodicity <- Specs[["Periodicity"]] Fit <- Specs[["Fit"]] Begin <- Specs[["Begin"]] Acceptance <- matrix(0, 1, LIV) for (k in 1:ncol(Dyn)) {for (t in 1:nrow(Dyn)) { Dyn[t,k] <- which(parm.names == Dyn[t,k])}} Dyn <- matrix(as.numeric(Dyn), nrow(Dyn), ncol(Dyn)) Dyn <- matrix(Dyn[-c(1:(Begin-1)),], nrow(Dyn)-Begin+1, ncol(Dyn)) n.samples <- nrow(Fit$Posterior1) mults <- Iterations / n.samples samps <- rep(1:n.samples, each=mults) if(Iterations != length(samps)) stop("Iterations not a multiple of posterior samples.", file=LogFile, append=TRUE) ivs <- Mo0[["parm"]] post <- Fit$Posterior1[samps,] post[1,as.vector(Dyn)] <- ivs[as.vector(Dyn)] DiagCovar <- matrix(tuning, floor(Iterations/Periodicity), LIV, byrow=TRUE) for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Store Current Posterior if(iter > 1) post[iter,as.vector(Dyn)] <- post[iter-1,as.vector(Dyn)] ### Select Order of Parameters if(ncol(Dyn) == 1) dynsample <- sample(Dyn) else dynsample <- as.vector(apply(Dyn, 1, sample)) ### Componentwise Estimation for (j in dynsample) { ### Propose new parameter values prop <- post[iter,] prop[j] <- rnorm(1, prop[j], tuning[j]) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]]) if(u == TRUE) { Mo0 <- Mo1 post[iter,] <- Mo0[["parm"]] Acceptance[j] <- Acceptance[j] + 1}}} ### Adapt the Proposal Variance if(iter %% Periodicity == 0) { size <- 1 / min(100, sqrt(iter)) Acceptance.Rate <- Acceptance / iter log.tuning <- log(tuning) tuning.num <- which(Acceptance.Rate > 0.44) log.tuning[tuning.num] <- log.tuning[tuning.num] + size log.tuning[-tuning.num] <- log.tuning[-tuning.num] - size tuning <- exp(log.tuning) a.iter <- floor(iter / Periodicity) DiagCovar[a.iter,] <- tuning} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- post[iter,] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=mean(as.vector(Acceptance[dynsample])), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=tuning) return(out) } .mcmcusmwg <- function(Model, Data, Iterations, Status, Thinning, Specs, Acceptance, Dev, DiagCovar, LIV, Mon, Mo0, ScaleF, thinned, tuning, parm.names, Debug, LogFile) { Dyn <- Specs[["Dyn"]] Fit <- Specs[["Fit"]] Begin <- Specs[["Begin"]] Acceptance <- matrix(0, 1, LIV) for (k in 1:ncol(Dyn)) {for (t in 1:nrow(Dyn)) { Dyn[t,k] <- which(parm.names == Dyn[t,k])}} Dyn <- matrix(as.numeric(Dyn), nrow(Dyn), ncol(Dyn)) Dyn <- matrix(Dyn[-c(1:(Begin-1)),], nrow(Dyn)-Begin+1, ncol(Dyn)) n.samples <- nrow(Fit$Posterior1) mults <- Iterations / n.samples samps <- rep(1:n.samples, each=mults) if(Iterations != length(samps)) stop("Iterations not a multiple of posterior samples.", file=LogFile, append=TRUE) ivs <- Mo0[["parm"]] post <- Fit$Posterior1[samps,] post[1,as.vector(Dyn)] <- ivs[as.vector(Dyn)] for (iter in 1:Iterations) { ### Print Status if(iter %% Status == 0) cat("Iteration: ", iter, ", Proposal: Componentwise, LP: ", round(Mo0[["LP"]],1), "\n", sep="", file=LogFile, append=TRUE) ### Store Current Posterior if(iter > 1) post[iter,as.vector(Dyn)] <- post[iter-1,as.vector(Dyn)] ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} ### Select Order of Parameters if(ncol(Dyn) == 1) dynsample <- sample(Dyn) else dynsample <- as.vector(apply(Dyn, 1, sample)) ### Componentwise Estimation for (j in dynsample) { ### Propose new parameter values prop <- post[iter,] prop[j] <- rnorm(1, prop[j], tuning[j]) ### Log-Posterior of the proposed state Mo1 <- try(Model(prop, Data), silent=!Debug[["DB.Model"]]) if(inherits(Mo1, "try-error")) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal failed for", Data[["parm.names"]][j], ".\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else if(any(!is.finite(c(Mo1[["LP"]], Mo1[["Dev"]], Mo1[["Monitor"]])))) { if(Debug[["DB.Model"]] == TRUE) { cat("\nWARNING: Proposal for", Data[["parm.names"]][j], "resulted in non-finite value(s).\n", file=LogFile, append=TRUE) cat(" Iteration:", iter, "Current:", round(Mo0[["parm"]][j]), "Proposed:", round(prop[j],5), file=LogFile, append=TRUE)} Mo1 <- Mo0 } else { ### Accept/Reject u <- log(runif(1)) < (Mo1[["LP"]] - Mo0[["LP"]]) if(u == TRUE) { Mo0 <- Mo1 post[iter,] <- Mo0[["parm"]] Acceptance[j] <- Acceptance[j] + 1}}} ### Save Thinned Samples if(iter %% Thinning == 0) { t.iter <- floor(iter / Thinning) + 1 thinned[t.iter,] <- Mo0[["parm"]] Dev[t.iter] <- Mo0[["Dev"]] Mon[t.iter,] <- Mo0[["Monitor"]]} } ### Output out <- list(Acceptance=mean(as.vector(Acceptance[dynsample])), Dev=Dev, DiagCovar=DiagCovar, Mon=Mon, thinned=thinned, VarCov=tuning) return(out) } #End LaplacesDemon/R/plot.demonoid.R0000755000176200001440000001616115144316355016077 0ustar liggesusers########################################################################### # plot.demonoid # # # # The purpose of the plot.demonoid function is to plot an object of class # # demonoid. # ########################################################################### plot.demonoid <- function(x, BurnIn=0, Data=NULL, PDF=FALSE, Parms=NULL, FileName = paste0("laplacesDemon-plot_", format(Sys.time(), "%Y-%m-%d_%T"), ".pdf"), ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(is.null(Data)) stop("The Data argument is NULL.") if(BurnIn >= nrow(x$Posterior1)) BurnIn <- 0 Stat.at <- BurnIn + 1 ### Selecting Parms if(is.null(Parms)) {Posterior <- x$Posterior1} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], colnames(x$Posterior1))) == 0) stop("Parameter in Parms does not exist.") keepcols <- grep(Parms[1], colnames(x$Posterior1)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], colnames(x$Posterior1))) == 0) stop("Parameter in Parms does not exist.") keepcols <- c(keepcols, grep(Parms[i], colnames(x$Posterior1)))}} Posterior <- as.matrix(x$Posterior1[,keepcols]) colnames(Posterior) <- colnames(x$Posterior1)[keepcols]} if(PDF == TRUE) { pdf(FileName) par(mfrow=c(3,3)) } else {par(mfrow=c(3,3), ask=TRUE)} ### Plot Parameters for (j in 1:ncol(Posterior)) { plot(Stat.at:x$Thinned.Samples, Posterior[Stat.at:x$Thinned.Samples,j], type="l", xlab="Thinned Samples", ylab="Value", main=colnames(Posterior)[j]) panel.smooth(Stat.at:x$Thinned.Samples, Posterior[Stat.at:x$Thinned.Samples,j], pch="") plot(density(Posterior[Stat.at:x$Thinned.Samples,j]), xlab="Value", main=colnames(Posterior)[j]) polygon(density(Posterior[Stat.at:x$Thinned.Samples,j]), col="black", border="black") abline(v=0, col="red", lty=2) ### Only plot an ACF if there's > 1 unique values if(!is.constant(Posterior[Stat.at:x$Thinned.Samples,j])) { z <- acf(Posterior[Stat.at:x$Thinned.Samples,j], plot=FALSE) se <- 1/sqrt(length(Posterior[Stat.at:x$Thinned.Samples,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=colnames(Posterior)[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } else {plot(0,0, main=paste(colnames(Posterior)[j], "is a constant."))} } ### Plot Deviance plot(Stat.at:length(x$Deviance), x$Deviance[Stat.at:length(x$Deviance)], type="l", xlab="Thinned Samples", ylab="Value", main="Deviance") panel.smooth(Stat.at:length(x$Deviance), x$Deviance[Stat.at:length(x$Deviance)], pch="") plot(density(x$Deviance[Stat.at:length(x$Deviance)]), xlab="Value", main="Deviance") polygon(density(x$Deviance[Stat.at:length(x$Deviance)]), col="black", border="black") abline(v=0, col="red", lty=2) ### Only plot an ACF if there's > 1 unique values if(!is.constant(x$Deviance[Stat.at:length(x$Deviance)])) { z <- acf(x$Deviance[Stat.at:length(x$Deviance)], plot=FALSE) se <- 1/sqrt(length(x$Deviance[Stat.at:length(x$Deviance)])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main="Deviance", xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } else {plot(0,0, main="Deviance is a constant.")} ### Plot Monitored Variables if(is.vector(x$Monitor)) {J <- 1; nn <- length(x$Monitor)} else if(is.matrix(x$Monitor)) { J <- ncol(x$Monitor); nn <- nrow(x$Monitor)} for (j in 1:J) { plot(Stat.at:nn, x$Monitor[Stat.at:nn,j], type="l", xlab="Thinned Samples", ylab="Value", main=Data[["mon.names"]][j]) panel.smooth(Stat.at:nn, x$Monitor[Stat.at:nn,j], pch="") plot(density(x$Monitor[Stat.at:nn,j]), xlab="Value", main=Data[["mon.names"]][j]) polygon(density(x$Monitor[Stat.at:nn,j]), col="black", border="black") abline(v=0, col="red", lty=2) ### Only plot an ACF if there's > 1 unique values if(!is.constant(x$Monitor[Stat.at:nn,j])) { z <- acf(x$Monitor[Stat.at:nn,j], plot=FALSE) se <- 1/sqrt(length(x$Monitor[Stat.at:nn,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=Data[["mon.names"]][j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } else {plot(0,0, main=paste(Data[["mon.names"]][j], "is a constant."))} } ### Diminishing Adaptation if(nrow(x$CovarDHis) > 1) { if(x$Algorithm %in% c("Adaptive Hamiltonian Monte Carlo", "Hamiltonian Monte Carlo with Dual-Averaging", "No-U-Turn Sampler")) { plot(x$CovarDHis[,1], type="l", xlab="Adaptations", main="Step-Size", ylab=expression(epsilon))} else { if(x$Algorithm %in% c("Oblique Hyperrectangle Slice Sampler", "Univariate Eigenvector Slice Sampler")) title <- "Eigenvectors" else if(x$Algorithm %in% c("Metropolis-Adjusted Langevin Algorithm")) title <- "Lambda" else if(x$Algorithm %in% c("Componentwise Hit-And-Run Metropolis", "Hit-And-Run Metropolis")) title <- "Proposal Distance" else if(x$Algorithm %in% c("Adaptive Griddy-Gibbs", "Adaptive Metropolis-within-Gibbs", "Sequential Adaptive Metropolis-within-Gibbs", "Updating Sequential Adaptive Metropolis-within-Gibbs")) title <- "Proposal S.D." else if(x$Algorithm %in% c("Differential Evolution Markov Chain")) title <- "Z" else if(x$Algorithm %in% c("Adaptive Factor Slice Sampler", "Refractive Sampler")) title <- "Step-Size" else title <- "Proposal Variance" Diff <- abs(diff(x$CovarDHis)) adaptchange <- matrix(NA, nrow(Diff), 3) for (i in 1:nrow(Diff)) { adaptchange[i,1:3] <- as.vector(quantile(Diff[i,], probs=c(0.025, 0.500, 0.975)))} plot(1:nrow(Diff), adaptchange[,2], ylim=c(min(adaptchange), max(adaptchange)), type="l", col="red", xlab="Adaptations", ylab="Absolute Difference", main=title, sub="Median=Red, Interval=Transparent Red") polygon(c(1:nrow(Diff),rev(1:nrow(Diff))), c(adaptchange[,1], rev(adaptchange[,3])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(adaptchange[,2], col="red")} } if(PDF == TRUE) dev.off() } # End LaplacesDemon/R/MinnesotaPrior.R0000644000176200001440000000205015144316355016262 0ustar liggesusers########################################################################### # MinnesotaPrior # # # # The purpose of the MinnesotaPrior function is to return prior # # covariance matrices for autoregressive parameters in vector # # autoregression (VAR) models. # ########################################################################### MinnesotaPrior <- function(J, lags=c(1,2), lambda=1, theta=0.5, sigma) { theta <- max(min(theta, 1), 0) Iden <- diag(J) L <- length(lags) V <- array(0, dim=c(J,J,length(lags))) for (l in 1:L) { ### Diagonal elements V[,,l] <- V[,,l] + Iden * (lambda/lags[l])^2 ### Off-diagonal elements V[,,l] <- V[,,l] + (1 - Iden) * ((lambda*theta*matrix(sigma, J, J, byrow=TRUE)) / (lags[l]*matrix(sigma, J, J)))^2} return(V) } #End LaplacesDemon/R/is.constrained.R0000755000176200001440000000167015144316355016246 0ustar liggesusers########################################################################### # is.constrained # # # # The purpose of the is.constrained function is to provide a logical test # # of whether or not initial values change as they are passed through the # # Model specification function, given data. # ########################################################################### is.constrained <- function(Model, Initial.Values, Data) { if(missing(Model)) stop("The Model argument is required.") if(missing(Initial.Values)) stop("The Initial.Values argument is required.") if(missing(Data)) stop("The Data argument is required.") Mo <- Model(Initial.Values, Data) constr <- Initial.Values != Mo[["parm"]] return(constr) } #End LaplacesDemon/R/predict.iterquad.R0000755000176200001440000000740415144316355016573 0ustar liggesusers########################################################################### # predict.iterquad # # # # The purpose of the predict.iterquad function is to predict y[new] or # # y[rep], and later provide posterior predictive checks for objects of # # class iterquad. # ########################################################################### predict.iterquad <- function(object, Model, Data, CPUs=1, Type="PSOCK", ...) { ### Initial Checks if(missing(object)) stop("The object argument is required.") if(object$Converged == FALSE) stop("IterativeQuadrature did not converge.") if(missing(Model)) stop("The Model argument is required.") if(missing(Data)) stop("The Data argument is required.") if(is.null(Data[["y"]]) & is.null(Data[["Y"]])) stop("Data must have y or Y.") if(!is.null(Data[["y"]])) y <- as.vector(Data[["y"]]) if(!is.null(Data[["Y"]])) y <- as.vector(Data[["Y"]]) CPUs <- abs(round(CPUs)) ### p(y[rep] | y), Deviance, and Monitors Dev <- rep(NA, nrow(object$Posterior)) monitor <- matrix(NA, length(Data[["mon.names"]]), nrow(object$Posterior)) lengthcomp <- as.vector(Model(object$Posterior[1,], Data)[["yhat"]]) if(!identical(length(lengthcomp), length(y))) stop("y and yhat differ in length.") yhat <- matrix(NA, length(y), nrow(object$Posterior)) ### Non-Parallel Processing if(CPUs == 1) { for (i in 1:nrow(object$Posterior)) { mod <- Model(object$Posterior[i,], Data) Dev[i] <- as.vector(mod[["Dev"]]) monitor[,i] <- as.vector(mod[["Monitor"]]) yhat[,i] <- as.vector(mod[["yhat"]])} } else { ### Parallel Processing detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cl <- makeCluster(CPUs, Type) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) mod <- parLapply(cl, 1:nrow(object$Posterior), function(x) Model(object$Posterior[x,], Data)) stopCluster(cl) Dev <- unlist(lapply(mod, function(x) x[["Dev"]]))[1:nrow(object$Posterior)] monitor <- matrix(unlist(lapply(mod, function(x) x[["Monitor"]])), length(Data[["mon.names"]]), nrow(object$Posterior)) yhat <- matrix(unlist(lapply(mod, function(x) x[["yhat"]])), length(y), nrow(object$Posterior)) rm(mod)} rownames(monitor) <- Data[["mon.names"]] ### Warnings if(any(is.na(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.na(yhat)), " missing values.") if(any(is.nan(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.nan(yhat)), " non-numeric (NaN) values.") if(any(is.infinite(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.infinite(yhat)), " infinite values.") if(any(!is.finite(Dev))) cat("\nWARNING: Deviance has non-finite values.") ### Create Output predicted <- list(y=y, yhat=yhat, Deviance=Dev, monitor=monitor) class(predicted) <- "iterquad.ppc" return(predicted) } #End LaplacesDemon/R/IterativeQuadrature.R0000755000176200001440000012200215144316355017306 0ustar liggesusers########################################################################### # IterativeQuadrature # # # # The purpose of the IterativeQuadrature function is to perform iterative # # quadrature on a Bayesian model. # ########################################################################### IterativeQuadrature <- function(Model, parm, Data, Covar=NULL, Iterations=100, Algorithm="CAGH", Specs=NULL, Samples=1000, sir=TRUE, Stop.Tolerance=c(1e-5,1e-15), CPUs=1, Type="PSOCK") { cat("\nIterativeQuadrature was called on ", date(), "\n", sep="") time1 <- proc.time() IQ.call <- match.call() ########################## Initial Checks ########################## cat("\nPerforming initial checks...\n") if(missing(Model)) stop("Model is a required argument.") if(!is.function(Model)) stop("Model must be a function.") if(missing(Data)) stop("Data is a required argument.") if(missing(parm)) { cat("Initial values were not supplied, and\n") cat("have been set to zero prior to LaplaceApproximation().\n") parm <- rep(0, length(Data[["parm.names"]]))} for (i in 1:length(Data)) { if(is.matrix(Data[[i]])) { if(all(is.finite(Data[[i]]))) { mat.rank <- qr(Data[[i]], tol=1e-10)$rank if(mat.rank < ncol(Data[[i]])) { cat("WARNING: Matrix", names(Data)[[i]], "may be rank-deficient.\n")}}}} Iterations <- min(max(round(Iterations), 2), 1000000) "%!in%" <- function(x,table) return(match(x, table, nomatch=0) == 0) if(Algorithm %!in% c("AGH","AGHSG","CAGH")) stop("Algorithm is unknown.") if(Algorithm == "AGH") { Algorithm <- "Adaptive Gauss-Hermite" if(missing(Specs)) stop("The Specs argument is required.") if(length(Specs) != 4) stop("The Specs argument is incorrect.") if(Specs[["N"]] == Specs[[1]]) N <- max(abs(round(Specs[[1]])), 2) if(Specs[["Nmax"]] == Specs[[2]]) Nmax <- max(abs(round(Specs[[2]])), N) Packages <- NULL if(!is.null(Specs[["Packages"]])) Packages <- Specs[["Packages"]] Dyn.libs <- NULL if(!is.null(Specs[["Dyn.libs"]])) Dyn.libs <- Specs[["Dyn.libs"]] } else if(Algorithm == "AGHSG") { Algorithm <- "Adaptive Gauss-Hermite Sparse Grid" if(missing(Specs)) stop("The Specs argument is required.") if(length(Specs) != 4) stop("The Specs argument is incorrect.") if(Specs[["K"]] == Specs[[1]]) K <- max(abs(round(Specs[[1]])), 2) if(Specs[["Kmax"]] == Specs[[2]]) Kmax <- max(abs(round(Specs[[2]])), K) Packages <- NULL if(!is.null(Specs[["Packages"]])) Packages <- Specs[["Packages"]] Dyn.libs <- NULL if(!is.null(Specs[["Dyn.libs"]])) Dyn.libs <- Specs[["Dyn.libs"]] } else if(Algorithm == "CAGH") { Algorithm <- "Componentwise Adaptive Gauss-Hermite" if(missing(Specs)) stop("The Specs argument is required.") if(length(Specs) != 4) stop("The Specs argument is incorrect.") if(Specs[["N"]] == Specs[[1]]) N <- max(abs(round(Specs[[1]])), 2) if(Specs[["Nmax"]] == Specs[[2]]) Nmax <- max(abs(round(Specs[[2]])), N) Packages <- NULL if(!is.null(Specs[["Packages"]])) Packages <- Specs[["Packages"]] Dyn.libs <- NULL if(!is.null(Specs[["Dyn.libs"]])) Dyn.libs <- Specs[["Dyn.libs"]] } if(any(Stop.Tolerance <= 0)) Stop.Tolerance <- c(1e-5,1e-15) as.character.function <- function(x, ... ) { fname <- deparse(substitute(x)) f <- match.fun(x) out <- c(sprintf('"%s" <- ', fname), capture.output(f)) if(grepl("^[<]", tail(out,1))) out <- head(out, -1) return(out) } acount <- length(grep("apply", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, " possible instance(s) of apply functions\n") cat( "were found in the Model specification. Iteration speed will\n") cat(" increase if apply functions are vectorized in R or coded\n") cat(" in a faster language such as C++ via the Rcpp package.\n")} acount <- length(grep("for", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, " possible instance(s) of for loops\n") cat(" were found in the Model specification. Iteration speed will\n") cat(" increase if for loops are vectorized in R or coded in a\n") cat(" faster language such as C++ via the Rcpp package.\n")} ########################### Preparation ############################ m.old <- Model(parm, Data) if(!is.list(m.old)) stop("Model must return a list.") if(length(m.old) != 5) stop("Model must return five components.") if(any(names(m.old) != c("LP","Dev","Monitor","yhat","parm"))) stop("Name mismatch in returned list of Model function.") if(length(m.old[["LP"]]) > 1) stop("Multiple joint posteriors exist!") if(!identical(length(parm), length(m.old[["parm"]]))) stop("The number of initial values and parameters differs.") if(!is.finite(m.old[["LP"]])) { cat("Generating initial values due to a non-finite posterior.\n") if(!is.null(Data[["PGF"]])) Initial.Values <- GIV(Model, Data, PGF=TRUE) else Initial.Values <- GIV(Model, Data, PGF=FALSE) m.old <- Model(Initial.Values, Data) } if(!is.finite(m.old[["LP"]])) stop("The posterior is non-finite.") if(!is.finite(m.old[["Dev"]])) stop("The deviance is non-finite.") parm <- m.old[["parm"]] LIV <- length(parm) ScaleF <- 2.381204 * 2.381204 / LIV if(is.null(Covar)) Covar <- diag(LIV) * ScaleF if(is.vector(Covar)) if(identical(length(Covar), LIV)) Covar <- diag(LIV) * Covar if(!is.matrix(Covar)) stop("Covar must be a matrix.") if(!is.square.matrix(Covar)) stop("Covar must be a square matrix.") if(!is.symmetric.matrix(Covar)) Covar <- as.symmetric.matrix(Covar) #################### Begin Iterative Quadrature #################### cat("Algorithm:", Algorithm, "\n") cat("\nIterativeQuadrature is beginning to update...\n") if(Algorithm == "Adaptive Gauss-Hermite") { IQ <- .iqagh(Model, parm, Data, Covar, Iterations, Stop.Tolerance, CPUs, m.old, N, Nmax, Packages, Dyn.libs) } else if(Algorithm == "Adaptive Gauss-Hermite Sparse Grid") { IQ <- .iqaghsg(Model, parm, Data, Covar, Iterations, Stop.Tolerance, CPUs, m.old, K, Kmax, Packages, Dyn.libs) } else if(Algorithm == "Componentwise Adaptive Gauss-Hermite") { IQ <- .iqcagh(Model, parm, Data, Covar, Iterations, Stop.Tolerance, CPUs, m.old, N, Nmax, Packages, Dyn.libs) } VarCov <- IQ$Covar Dev <- as.vector(IQ$Dev) iter <- IQ$iter LPw <- IQ$LPw M <- IQ$M mu <- IQ$mu N <- IQ$N parm.len <- ncol(mu) parm.new <- mu[nrow(mu),] parm.old <- IQ$parm.old tol <- IQ$tol Z <- IQ$Z rm(IQ) if(iter == 1) stop("IterativeQuadrature stopped at iteration 1.") converged <- FALSE if({tol[1] <= Stop.Tolerance[1]} & {tol[2] <= Stop.Tolerance[2]}) converged <- TRUE ### Column names to samples if(ncol(mu) == length(Data[["parm.names"]])) colnames(mu) <- Data[["parm.names"]] rownames(mu) <- 1:nrow(mu) cat("\n\n") ################# Sampling Importance Resampling ################## if({sir == TRUE} & {converged == TRUE}) { cat("Sampling from Posterior with Sampling Importance Resampling\n") posterior <- SIR(Model, Data, mu=parm.new, Sigma=VarCov, n=Samples, CPUs=CPUs, Type=Type) Mon <- matrix(0, nrow(posterior), length(Data[["mon.names"]])) dev <- rep(0, nrow(posterior)) for (i in 1:nrow(posterior)) { mod <- Model(posterior[i,], Data) dev[i] <- mod[["Dev"]] Mon[i,] <- mod[["Monitor"]] } colnames(Mon) <- Data[["mon.names"]]} else { if({sir == TRUE} & {converged == FALSE}) cat("Posterior samples are not drawn due to Converge=FALSE\n") posterior <- NA; Mon <- NA} ##################### Summary, Point-Estimate ###################### cat("Creating Summary from Point-Estimates\n") Summ1 <- matrix(NA, parm.len, 4, dimnames=list(Data[["parm.names"]], c("Mean","SD","LB","UB"))) Summ1[,1] <- parm.new Summ1[,2] <- sqrt(diag(VarCov)) Summ1[,3] <- parm.new - 2*Summ1[,2] Summ1[,4] <- parm.new + 2*Summ1[,2] ################### Summary, Posterior Samples #################### Summ2 <- NA if({sir == TRUE} & {converged == TRUE}) { cat("Creating Summary from Posterior Samples\n") Summ2 <- matrix(NA, ncol(posterior), 7, dimnames=list(Data[["parm.names"]], c("Mean","SD","MCSE","ESS","LB","Median","UB"))) Summ2[,1] <- colMeans(posterior) Summ2[,2] <- sqrt(.colVars(posterior)) Summ2[,3] <- Summ2[,2] / sqrt(nrow(posterior)) Summ2[,4] <- rep(nrow(posterior), ncol(posterior)) Summ2[,5] <- apply(posterior, 2, quantile, c(0.025)) Summ2[,6] <- apply(posterior, 2, quantile, c(0.500)) Summ2[,7] <- apply(posterior, 2, quantile, c(0.975)) Deviance <- rep(0, 7) Deviance[1] <- mean(dev) Deviance[2] <- sd(dev) Deviance[3] <- sd(dev) / sqrt(nrow(posterior)) Deviance[4] <- nrow(posterior) Deviance[5] <- as.numeric(quantile(dev, probs=0.025, na.rm=TRUE)) Deviance[6] <- as.numeric(quantile(dev, probs=0.500, na.rm=TRUE)) Deviance[7] <- as.numeric(quantile(dev, probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Deviance) for (j in 1:ncol(Mon)) { Monitor <- rep(NA,7) Monitor[1] <- mean(Mon[,j]) Monitor[2] <- sd(as.vector(Mon[,j])) Monitor[3] <- sd(as.vector(Mon[,j])) / sqrt(nrow(Mon)) Monitor[4] <- nrow(Mon) Monitor[5] <- as.numeric(quantile(Mon[,j], probs=0.025, na.rm=TRUE)) Monitor[6] <- as.numeric(quantile(Mon[,j], probs=0.500, na.rm=TRUE)) Monitor[7] <- as.numeric(quantile(Mon[,j], probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Monitor) rownames(Summ2)[nrow(Summ2)] <- Data[["mon.names"]][j] } } ############### Logarithm of the Marginal Likelihood ############### LML <- list(LML=NA, VarCov=VarCov) if({sir == TRUE} & {converged == TRUE}) { cat("Estimating Log of the Marginal Likelihood\n") lml <- LML(theta=posterior, LL=(dev*(-1/2)), method="NSIS") LML[[1]] <- lml[[1]]} else if({sir == FALSE} & {converged == TRUE}) { cat("Estimating Log of the Marginal Likelihood\n") LML <- LML(Model, Data, Modes=parm.new, Covar=VarCov, method="LME")} colnames(VarCov) <- rownames(VarCov) <- Data[["parm.names"]] time2 <- proc.time() ############################# Output ############################## cat("Creating Output\n") IQ <- list(Algorithm=Algorithm, Call=IQ.call, Converged=converged, Covar=VarCov, Deviance=as.vector(Dev), History=mu, Initial.Values=parm, Iterations=iter, LML=LML[[1]], LP.Final=as.vector(Model(parm.new, Data)[["LP"]]), LP.Initial=m.old[["LP"]], LPw=LPw, M=M, Minutes=round(as.vector(time2[3] - time1[3]) / 60, 2), Monitor=Mon, N=N, Posterior=posterior, Summary1=Summ1, Summary2=Summ2, Tolerance.Final=tol, Tolerance.Stop=Stop.Tolerance, Z=Z) class(IQ) <- "iterquad" cat("\nIterativeQuadrature is finished.\n") return(IQ) } .iqagh <- function(Model, parm, Data, Covar, Iterations, Stop.Tolerance, CPUs, m.old, N, Nmax, Packages, Dyn.libs) { if(CPUs == 1) { Dev <- matrix(m.old[["Dev"]],1,1) LPworst <- m.old[["LP"]] parm.len <- length(parm) if(parm.len > 10) warning("The number of parameters may be too large.") mu <- rbind(parm) parm.old <- parm colnames(mu) <- Data[["parm.names"]] sigma <- sqrt(diag(Covar)) rule <- GaussHermiteCubeRule(N=N, dims=parm.len) X <- rule$nodes W <- rule$weights n <- length(W) count <- 0 expand <- FALSE IE <- 1 tol <- c(1,1) ### Begin Iterative Quadrature options(warn=-1) cat("\nIteration: 1, Univariate Nodes: ", N, ", Multivariate Nodes: ", n, sep="") for (iter in 2:Iterations) { ### New Quadrature Rule if({expand == TRUE} & {N < Nmax}) { N <- min(N+1, Nmax) rule <- GaussHermiteCubeRule(N=N, dims=parm.len) X <- rule$nodes W <- rule$weights n <- length(W)} adjust <- FALSE expand <- FALSE cat("\nIteration: ", iter, ", Univariate Nodes: ", N, ", Multivariate Nodes: ", n, sep="") LP <- rep(LPworst, n) LPw <- M <- Z <- matrix(0, n, parm.len) mu <- rbind(mu, 0) ### Evaluate at the Nodes for (i in 1:n) { Z[i,] <- mu[iter-1,] + sqrt(2)*sigma*X[i,] mod <- Model(Z[i,], Data) if(all(is.finite(c(mod[["LP"]], mod[["Dev"]], mod[["Monitor"]])))) LP[i] <- mod[["LP"]] Z[i,] <- mod[["parm"]]} ### Weights LPw <- matrix(exp(LP - logadd(LP)), n, parm.len) LPw <- LPw / matrix(colSums(LPw), n, parm.len) LPw[which(!is.finite(LPw))] <- 0 if(all(LPw == 0)) { expand <- TRUE LPw <- rep(.Machine$double.eps, n)} ### Adapt mu and Sigma mu[iter,] <- colSums(LPw * Z) temp <- cov.wt(Z, wt=LPw[,1])$cov if(all(is.finite(temp))) Covar <- as.symmetric.matrix(temp) else expand <- TRUE diag(Covar) <- abs(diag(Covar)) diag(Covar)[which(diag(Covar) < .Machine$double.eps)] <- .Machine$double.eps M <- W * exp(X) * sqrt(2) * matrix(sigma, n, parm.len, byrow=TRUE) sigma <- sqrt(diag(Covar)) mod <- Model(mu[iter,], Data) Dev <- rbind(Dev, mod[["Dev"]]) ### Accept Only Improved mu m.old <- Model(mu[iter-1,], Data) if(all(is.finite(c(mod[["LP"]], mod[["Dev"]], mod[["Monitor"]])))) { if(m.old[["LP"]] >= mod[["LP"]]) { expand <- TRUE mu[iter,] <- mu[iter-1,]} } else { expand <- TRUE mu[iter,] <- mu[iter-1,]} ### Integration Error and Tolerance Mw <- M / matrix(colSums(M), n, parm.len, byrow=TRUE) IE <- c(IE, mean(abs(Mw - LPw))) tol[1] <- sqrt(sum({mu[iter,] - mu[iter-1,]}^2)) tol[2] <- abs(IE[iter] - IE[iter-1]) if(tol[1] <= Stop.Tolerance[1]) { expand <- TRUE if(tol[2] <= Stop.Tolerance[2]) { if(count > 0) break count <- count + 1} } else count <- 0 } } else { detectedCores <- detectCores() cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cat("\nLaplace's Demon is preparing environments for CPUs...") cat("\n##################################################\n") cl <- makeCluster(CPUs) cat("\n##################################################\n") on.exit(stopCluster(cl)) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) wd <- getwd() clusterExport(cl, varlist=c("Packages", "Dyn.libs", "wd"), envir=environment()) Dev <- matrix(m.old[["Dev"]],1,1) LPworst <- m.old[["LP"]] parm.len <- length(parm) if(parm.len > 10) warning("The number of parameters may be too large.") mu <- rbind(parm) parm.old <- parm colnames(mu) <- Data[["parm.names"]] sigma <- sqrt(diag(Covar)) rule <- GaussHermiteCubeRule(N=N, dims=parm.len) X <- rule$nodes W <- rule$weights n <- length(W) count <- 0 expand <- FALSE IE <- 1 tol <- c(1,1) ### Begin Iterative Quadrature options(warn=-1) cat("\nIteration: 1, Univariate Nodes: ", N, ", Multivariate Nodes: ", n, sep="") for (iter in 2:Iterations) { ### New Quadrature Rule if({expand == TRUE} & {N < Nmax}) { N <- min(N+1, Nmax) rule <- GaussHermiteCubeRule(N=N, dims=parm.len) X <- rule$nodes W <- rule$weights n <- length(W)} adjust <- FALSE expand <- FALSE cat("\nIteration: ", iter, ", Univariate Nodes: ", N, ", Multivariate Nodes: ", n, sep="") LP <- rep(LPworst, n) LPw <- M <- Z <- matrix(0, n, parm.len) mu <- rbind(mu, 0) ### Evaluate at the Nodes Z <- matrix(mu[iter-1,], n, parm.len, byrow=TRUE) + sqrt(2) * matrix(sigma, n, parm.len, byrow=TRUE) * X mod <- parLapply(cl, 1:n, function(x) Model(Z[x,], Data)) LP <- as.vector(unlist(lapply(mod, function(x) x[["LP"]]))) Z <- matrix(as.vector(unlist(lapply(mod, function(x) x[["parm"]]))), n, parm.len, byrow=TRUE) LP[which(!is.finite(LP))] <- LPworst ### Weights LPw <- matrix(exp(LP - logadd(LP)), n, parm.len) LPw <- LPw / matrix(colSums(LPw), n, parm.len) LPw[which(!is.finite(LPw))] <- 0 if(all(LPw == 0)) { expand <- TRUE LPw <- rep(.Machine$double.eps, n)} ### Adapt mu and Sigma mu[iter,] <- colSums(LPw * Z) temp <- cov.wt(Z, wt=LPw[,1])$cov if(all(is.finite(temp))) Covar <- as.symmetric.matrix(temp) else expand <- TRUE diag(Covar) <- abs(diag(Covar)) diag(Covar)[which(diag(Covar) < .Machine$double.eps)] <- .Machine$double.eps M <- W * exp(X) * sqrt(2) * matrix(sigma, n, parm.len, byrow=TRUE) sigma <- sqrt(diag(Covar)) mod <- Model(mu[iter,], Data) Dev <- rbind(Dev, mod[["Dev"]]) ### Accept Only Improved mu m.old <- Model(mu[iter-1,], Data) if(all(is.finite(c(mod[["LP"]], mod[["Dev"]], mod[["Monitor"]])))) { if(m.old[["LP"]] >= mod[["LP"]]) { expand <- TRUE mu[iter,] <- mu[iter-1,]} } else { expand <- TRUE mu[iter,] <- mu[iter-1,]} ### Integration Error and Tolerance Mw <- M / matrix(colSums(M), n, parm.len, byrow=TRUE) IE <- c(IE, mean(abs(Mw - LPw))) tol[1] <- sqrt(sum({mu[iter,] - mu[iter-1,]}^2)) tol[2] <- abs(IE[iter] - IE[iter-1]) if(tol[1] <= Stop.Tolerance[1]) { expand <- TRUE if(tol[2] <= Stop.Tolerance[2]) { if(count > 0) break count <- count + 1} } else count <- 0 } } options(warn=0) ### Output IQ <- list(Covar=Covar, Dev=Dev, iter=iter, LPw=LPw, M=M, mu=mu, N=n, parm.old=parm.old, tol=tol, Z=Z) return(IQ) } .iqaghsg <- function(Model, parm, Data, Covar, Iterations, Stop.Tolerance, CPUs, m.old, K, Kmax, Packages, Dyn.libs) { if(CPUs == 1) { Dev <- matrix(m.old[["Dev"]],1,1) LPworst <- m.old[["LP"]] parm.len <- length(parm) if(parm.len > 10) warning("The number of parameters may be too large.") mu <- rbind(parm) parm.old <- parm colnames(mu) <- Data[["parm.names"]] sigma <- sqrt(diag(Covar)) rule <- SparseGrid(J=parm.len, K=K) X <- rule$nodes W <- rule$weights N <- length(W) count <- 0 expand <- FALSE IE <- 1 tol <- c(1,1) ### Begin Iterative Quadrature options(warn=-1) cat("\nIteration: 1, K: ", K, ", Nodes: ", N, sep="") for (iter in 2:Iterations) { ### New Quadrature Rule if({expand == TRUE} & {K < Kmax}) { K <- min(K+1, Kmax) rule <- SparseGrid(J=parm.len, K=K) X <- rule$nodes W <- rule$weights N <- length(W)} expand <- FALSE cat("\nIteration: ", iter, ", K: ", K, ", Nodes: ", N, sep="") LP <- rep(LPworst, N) LPw <- M <- Z <- matrix(0, N, parm.len) mu <- rbind(mu, 0) ### Evaluate at the Nodes for (i in 1:N) { Z[i,] <- mu[iter-1,] + sqrt(2)*sigma*X[i,] mod <- Model(Z[i,], Data) if(all(is.finite(c(mod[["LP"]], mod[["Dev"]], mod[["Monitor"]])))) LP[i] <- mod[["LP"]] Z[i,] <- mod[["parm"]]} ### Weights LPw <- matrix(exp(LP - logadd(LP)), N, parm.len) LPw <- LPw / matrix(colSums(LPw), N, parm.len) LPw[which(!is.finite(LPw))] <- 0 if(all(LPw == 0)) { expand <- TRUE LPw <- rep(.Machine$double.eps, N)} ### Adapt mu and Sigma mu[iter,] <- colSums(LPw * Z) temp <- cov.wt(Z, wt=LPw[,1])$cov if(all(is.finite(temp))) Covar <- as.symmetric.matrix(temp) else expand <- TRUE diag(Covar) <- abs(diag(Covar)) diag(Covar)[which(diag(Covar) < .Machine$double.eps)] <- .Machine$double.eps M <- W * exp(X) * sqrt(2) * matrix(sigma, N, parm.len, byrow=TRUE) sigma <- sqrt(diag(Covar)) mod <- Model(mu[iter,], Data) Dev <- rbind(Dev, mod[["Dev"]]) ### Accept Only Improved mu m.old <- Model(mu[iter-1,], Data) if(all(is.finite(c(mod[["LP"]], mod[["Dev"]], mod[["Monitor"]])))) { if(m.old[["LP"]] >= mod[["LP"]]) { expand <- TRUE mu[iter,] <- mu[iter-1,]} } else { expand <- TRUE mu[iter,] <- mu[iter-1,]} ### Integration Error and Tolerance Mw <- M / matrix(colSums(M), N, parm.len, byrow=TRUE) IE <- c(IE, mean(abs(Mw - LPw))) tol[1] <- sqrt(sum({mu[iter,] - mu[iter-1,]}^2)) tol[2] <- abs(IE[iter] - IE[iter-1]) if(tol[1] <= Stop.Tolerance[1]) { expand <- TRUE if(tol[2] <= Stop.Tolerance[2]) { if(count > 0) break count <- count + 1} } else count <- 0 } } else { detectedCores <- detectCores() cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cat("\nLaplace's Demon is preparing environments for CPUs...") cat("\n##################################################\n") cl <- makeCluster(CPUs) cat("\n##################################################\n") on.exit(stopCluster(cl)) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) wd <- getwd() clusterExport(cl, varlist=c("Packages", "Dyn.libs", "wd"), envir=environment()) Dev <- matrix(m.old[["Dev"]],1,1) LPworst <- m.old[["LP"]] parm.len <- length(parm) if(parm.len > 10) warning("The number of parameters may be too large.") mu <- rbind(parm) parm.old <- parm colnames(mu) <- Data[["parm.names"]] sigma <- sqrt(diag(Covar)) rule <- SparseGrid(J=parm.len, K=K) X <- rule$nodes W <- rule$weights N <- length(W) count <- 0 expand <- FALSE IE <- 1 tol <- c(1,1) ### Begin Iterative Quadrature options(warn=-1) cat("\nIteration: 1, K: ", K, ", Nodes: ", N, sep="") for (iter in 2:Iterations) { ### New Quadrature Rule if({expand == TRUE} & {K < Kmax}) { K <- min(K+1, Kmax) rule <- SparseGrid(J=parm.len, K=K) X <- rule$nodes W <- rule$weights N <- length(W)} expand <- FALSE cat("\nIteration: ", iter, ", K: ", K, ", Nodes: ", N, sep="") LP <- rep(LPworst, N) LPw <- M <- Z <- matrix(0, N, parm.len) mu <- rbind(mu, 0) ### Evaluate at the Nodes Z <- matrix(mu[iter-1,], N, parm.len, byrow=TRUE) + sqrt(2) * matrix(sigma, N, parm.len, byrow=TRUE) * X mod <- parLapply(cl, 1:N, function(x) Model(Z[x,], Data)) LP <- as.vector(unlist(lapply(mod, function(x) x[["LP"]]))) Z <- matrix(as.vector(unlist(lapply(mod, function(x) x[["parm"]]))), N, parm.len, byrow=TRUE) LP[which(!is.finite(LP))] <- LPworst ### Weights LPw <- matrix(exp(LP - logadd(LP)), N, parm.len) LPw <- LPw / matrix(colSums(LPw), N, parm.len) LPw[which(!is.finite(LPw))] <- 0 if(all(LPw == 0)) { expand <- TRUE LPw <- rep(.Machine$double.eps, N)} ### Adapt mu and Sigma mu[iter,] <- colSums(LPw * Z) temp <- cov.wt(Z, wt=LPw[,1])$cov if(all(is.finite(temp))) Covar <- as.symmetric.matrix(temp) else expand <- TRUE diag(Covar) <- abs(diag(Covar)) diag(Covar)[which(diag(Covar) < .Machine$double.eps)] <- .Machine$double.eps M <- W * exp(X) * sqrt(2) * matrix(sigma, N, parm.len, byrow=TRUE) sigma <- sqrt(diag(Covar)) mod <- Model(mu[iter,], Data) Dev <- rbind(Dev, mod[["Dev"]]) ### Accept Only Improved mu m.old <- Model(mu[iter-1,], Data) if(all(is.finite(c(mod[["LP"]], mod[["Dev"]], mod[["Monitor"]])))) { if(m.old[["LP"]] >= mod[["LP"]]) { expand <- TRUE mu[iter,] <- mu[iter-1,]} } else { expand <- TRUE mu[iter,] <- mu[iter-1,]} ### Integration Error and Tolerance Mw <- M / matrix(colSums(M), N, parm.len, byrow=TRUE) IE <- c(IE, mean(abs(Mw - LPw))) tol[1] <- sqrt(sum({mu[iter,] - mu[iter-1,]}^2)) tol[2] <- abs(IE[iter] - IE[iter-1]) if(tol[1] <= Stop.Tolerance[1]) { expand <- TRUE if(tol[2] <= Stop.Tolerance[2]) { if(count > 0) break count <- count + 1} } else count <- 0 } } options(warn=0) ### Output IQ <- list(Covar=Covar, Dev=Dev, iter=iter, LPw=LPw, M=M, mu=mu, N=N, parm.old=parm.old, tol=tol, Z=Z) return(IQ) } .iqcagh <- function(Model, parm, Data, Covar, Iterations, Stop.Tolerance, CPUs, m.old, N, Nmax, Packages, Dyn.libs) { if(CPUs == 1) { Dev <- matrix(m.old[["Dev"]],1,1) LPworst <- m.old[["LP"]] parm.len <- length(parm) mu <- rbind(parm) parm.old <- parm colnames(mu) <- Data[["parm.names"]] sigma <- sqrt(diag(Covar)) LP <- rep(LPworst, N) LPw <- M <- Z <- matrix(0, N, parm.len) rule <- GaussHermiteQuadRule(N) count <- 0 expand <- matrix(0, 4, parm.len) IE <- 1 tol <- c(1,1) ### Begin Iterative Quadrature options(warn=-1) cat("\nIteration: 1, Nodes: ", N, ", LP:", round(m.old[["LP"]],3), sep="") for (iter in 2:Iterations) { cat("\nIteration: ", iter, ", Nodes: ", N, ", LP:", round(m.old[["LP"]],3), sep="") mu <- rbind(mu, 0) ### New Quadarature Rule if({any(rowSums(expand) == parm.len)} & {N < Nmax}) { N <- min(N + 1, Nmax) LPw <- M <- Z <- matrix(0, N, parm.len) LP <- rep(LPworst, N) rule <- GaussHermiteQuadRule(N)} expand <- matrix(0, 4, parm.len) X <- matrix(rule$nodes, N, parm.len) W <- matrix(rule$weights, N, parm.len) for (j in sample(parm.len)) { ### Evaluate at the Nodes Z[,j] <- m.old[["parm"]][j] + sqrt(2)*sigma[j]*X[,j] for (i in 1:N) { prop <- m.old[["parm"]] prop[j] <- Z[i,j] m.new <- Model(prop, Data) if(all(is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) LP[i] <- m.new[["LP"]] Z[i,j] <- m.new[["parm"]][j]} ### Correct for Constraints X[,j] <- (Z[,j] - m.old[["parm"]][j]) / (sqrt(2)*sigma[j]) W[,j] <- (2^(N-1) * factorial(N) * sqrt(pi)) / (N^2 * Hermite(X[,j], N-1, prob=FALSE)^2) W[,j][which(!is.finite(W[,j]))] <- 0 if(all(W[,j] == 0)) W[,j] <- 1/N ### Weights LPw[,j] <- exp(LP - logadd(LP)) LPw[,j] <- LPw[,j] / sum(LPw[,j]) if(any(!is.finite(LPw[,j]))) { LPw[,j] <- rep(0, N) expand[1,j] <- 1} ### Adapt mu and sigma if(all(LPw[,j] == 0)) { LPw[,j] <- .Machine$double.eps mu[iter,j] <- m.old[["parm"]][j] + rnorm(1,0,1e-5) expand[2,j] <- 1 } else { LPmax <- which.max(LP)[1] if({LPmax == 1} | {LPmax == N}) mu[iter,j] <- Z[LPmax,j] else mu[iter,j] <- sum(LPw[,j] * Z[,j]) M[,j] <- W[,j] * exp(X[,j]) * sqrt(2) * sigma[j] sigma[j] <- min(max(sqrt(sum(LPw[,j] * {sqrt(2)*sigma[j]*X[,j]}^2)), .Machine$double.eps), 1e5)} ### Accept Increases Only m.new <- Model(mu[iter,], Data) mu[iter,] <- m.new[["parm"]] if(all(is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) { if(m.old[["LP"]] >= m.new[["LP"]]) { expand[3,j] <- 1 mu[iter,] <- m.old[["parm"]] } else m.old <- m.new } else { expand[3,j] <- 1 mu[iter,] <- m.old[["parm"]] } } Dev <- rbind(Dev, m.old[["Dev"]]) ### Integration Error, Parameter Change, and Tolerance Mw <- M / matrix(colSums(M), N, parm.len, byrow=TRUE) IE <- c(IE, mean(abs(Mw - LPw))) tol[1] <- sqrt(sum({mu[iter,] - mu[iter-1,]}^2)) tol[2] <- abs(IE[iter] - IE[iter-1]) if(tol[1] <= Stop.Tolerance[1]) { expand[4,] <- 1 if(tol[2] <= Stop.Tolerance[2]) { if(count > 0) break count <- count + 1} } else count <- 0 } } else { detectedCores <- detectCores() cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cat("\nLaplace's Demon is preparing environments for CPUs...") cat("\n##################################################\n") cl <- makeCluster(CPUs) cat("\n##################################################\n") on.exit(stopCluster(cl)) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) wd <- getwd() clusterExport(cl, varlist=c("Packages", "Dyn.libs", "wd"), envir=environment()) Dev <- matrix(m.old[["Dev"]],1,1) LPworst <- m.old[["LP"]] parm.len <- length(parm) mu <- rbind(parm) parm.old <- parm colnames(mu) <- Data[["parm.names"]] sigma <- sqrt(diag(Covar)) LPbest <- rep(-Inf, parm.len) LP <- rep(LPworst, N) LPw <- M <- Z <- matrix(0, N, parm.len) rule <- GaussHermiteQuadRule(N) count <- 0 expand <- matrix(0, 4, parm.len) IE <- 1 tol <- c(1,1) ### Begin Iterative Quadrature options(warn=-1) cat("\nIteration: 1, Nodes: ", N, ", LP:", round(m.old[["LP"]],3), sep="") for (iter in 2:Iterations) { cat("\nIteration: ", iter, ", Nodes: ", N, ", LP:", round(m.old[["LP"]],3), sep="") mu <- rbind(mu, 0) ### New Quadarature Rule if({any(rowSums(expand) == parm.len)} & {N < Nmax}) { N <- min(N + 1, Nmax) LPw <- M <- Z <- matrix(0, N, parm.len) LP <- rep(LPworst, N) rule <- GaussHermiteQuadRule(N)} expand <- matrix(0, 4, parm.len) X <- matrix(rule$nodes, N, parm.len) W <- matrix(rule$weights, N, parm.len) for (j in sample(parm.len)) { ### Evaluate at the Nodes Z[,j] <- m.old[["parm"]][j] + sqrt(2)*sigma[j]*X[,j] prop <- matrix(m.old[["parm"]], N, parm.len, byrow=TRUE) prop[,j] <- Z[,j] m.new <- parLapply(cl, 1:N, function(x) Model(prop[x,], Data)) LP <- as.vector(unlist(lapply(m.new, function(x) x[["LP"]]))) Z[,j] <- as.vector(unlist(lapply(m.new, function(x) x[["parm"]][j]))) LP[which(!is.finite(LP))] <- LPworst ### Correct for Constraints X[,j] <- (Z[,j] - m.old[["parm"]][j]) / (sqrt(2)*sigma[j]) W[,j] <- (2^(N-1) * factorial(N) * sqrt(pi)) / (N^2 * Hermite(X[,j], N-1, prob=FALSE)^2) W[,j][which(!is.finite(W[,j]))] <- 0 if(all(W[,j] == 0)) W[,j] <- 1/N ### Weights LPw[,j] <- exp(LP - logadd(LP)) LPw[,j] <- LPw[,j] / sum(LPw[,j]) if(any(!is.finite(LPw[,j]))) { LPw[,j] <- rep(0, N) expand[1,j] <- 1} ### Adapt mu and sigma if(all(LPw[,j] == 0)) { LPw[,j] <- .Machine$double.eps mu[iter,j] <- m.old[["parm"]][j] + rnorm(1,0,1e-5) expand[2,j] <- 1 } else { LPmax <- which.max(LP)[1] if({LPmax == 1} | {LPmax == N}) mu[iter,j] <- Z[LPmax,j] else mu[iter,j] <- sum(LPw[,j] * Z[,j]) M[,j] <- W[,j] * exp(X[,j]) * sqrt(2) * sigma[j] sigma[j] <- min(max(sqrt(sum(LPw[,j] * {sqrt(2)*sigma[j]*X[,j]}^2)), .Machine$double.eps), 1e5)} ### Accept Increases Only m.new <- Model(mu[iter,], Data) mu[iter,] <- m.new[["parm"]] if(all(is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) { if(m.old[["LP"]] >= m.new[["LP"]]) { expand[3,j] <- 1 mu[iter,] <- m.old[["parm"]] } else m.old <- m.new } else { expand[3,j] <- 1 mu[iter,] <- m.old[["parm"]] } } Dev <- rbind(Dev, m.old[["Dev"]]) ### Integration Error, Parameter Change, and Tolerance Mw <- M / matrix(colSums(M), N, parm.len, byrow=TRUE) IE <- c(IE, mean(abs(Mw - LPw))) tol[1] <- sqrt(sum({mu[iter,] - mu[iter-1,]}^2)) tol[2] <- abs(IE[iter] - IE[iter-1]) if(tol[1] <= Stop.Tolerance[1]) { expand[4,] <- 1 if(tol[2] <= Stop.Tolerance[2]) { if(count > 0) break count <- count + 1} } else count <- 0 } } options(warn=0) ### Output IQ <- list(Covar=diag(sigma^2), Dev=Dev, iter=iter, LPw=LPw, M=M, mu=mu, N=N, parm.old=parm.old, tol=tol, Z=Z) return(IQ) } #End LaplacesDemon/R/logit.R0000755000176200001440000000261615144316355014442 0ustar liggesusers########################################################################### # logit # # # # The logit function is the inverse of the sigmoid or logistic function, # # and transforms a continuous value (usually probability p) in the # # interval [0,1] to the real line (where it usually is the logarithm of # # the odds). The invlogit function (called either the inverse logit or # # the logistic function) transforms a real number (usually the logarithm # # of the odds) to a value (usually probability p) in the interval [0,1]. # # If p is a probability, then p/(1-p) is the corresponding odds, while # # logit of p is the logarithm of the odds. The difference between the # # logits of two probabilities is the logarithm of the odds ratio. The # # derivative of probability p in a logistic function is: # # (d / dx) = p * (1 - p). # ########################################################################### invlogit <- function(x) { InvLogit <- 1 / {1 + exp(-x)} return(InvLogit) } logit <- function(p) { if({any(p < 0)} || {any(p > 1)}) stop("p must be in [0,1].") Logit <- log(p / {1 - p}) return(Logit) } #End LaplacesDemon/R/LPL.interval.R0000755000176200001440000000655115144316355015600 0ustar liggesusers########################################################################### # LPL.interval # # # # The purpose of the LPL.interval function is to estimate the lowest # # posterior loss (LPL) interval. # ########################################################################### LPL.interval <- function(Prior, Posterior, prob=0.95, plot=FALSE, PDF=FALSE) { ### Initial Checks if(missing(Prior)) stop("Prior is required.") if(missing(Posterior)) stop("Posterior is required.") if(!is.vector(Prior)) Prior <- as.vector(Prior) if(!is.vector(Posterior)) Posterior <- as.vector(Posterior) if(length(Prior) != length(Posterior)) stop("Length mismatch between Prior and Posterior.") if(any(!is.finite(Prior) | !is.finite(Posterior))) stop("Non-finite values found in Prior or Posterior.") name <- names(Posterior) if(is.null(name)) name <- "Value" ### Expected Posterior Loss ord <- order(Posterior) Prior <- Prior[ord] Posterior <- Posterior[ord] loss <- KLD(Prior, Posterior)[[3]] ### Plot Expected Posterior Loss if(plot == TRUE) { if(PDF == TRUE) pdf("LPL.Plot.pdf") par(mfrow=c(2,1)) plot(Posterior, loss, type="l", main="Posterior Loss", xlab=name, ylab="E(Posterior Loss)") polygon(c(min(Posterior), Posterior, max(Posterior)), c(min(loss), loss, min(loss)), col="gray", border="gray")} ### Find LPL Interval n <- length(loss) gap <- max(1, min(n - 1, round(n * prob))) loss.sum <- init <- 1:(n - gap) for (i in 1:length(init)) { loss.sum[i] <- sum(loss[init[i]:(init[i]+gap)])} min.init <- init[which.min(loss.sum)] ans <- cbind(Posterior[min.init], Posterior[min.init+gap]) colnames(ans) <- c("Lower","Upper") attr(ans, "LPL.Interval") <- prob ### Shade LPL Area if(plot == TRUE) { polygon(c(min(Posterior[min.init]), Posterior[min.init:(min.init+gap)], max(Posterior[min.init+gap])), c(min(loss[min.init:(min.init+gap)]), loss[min.init:(min.init+gap)], min(loss[min.init:(min.init+gap)])), col="black", border="black") abline(v=0, col="red", lty=2) kde <- kde.low <- kde.high <- density(Posterior) kde.low$x <- kde$x[kde$x < ans[1,1]] kde.low$y <- kde$y[which(kde$x < ans[1,1])] kde.high$x <- kde$x[kde$x > ans[1,2]] kde.high$y <- kde$y[which(kde$x > ans[1,2])] plot(kde, xlab=name, ylab="Density", main="LPL Probability Interval") polygon(kde, col="black", border="black") polygon(c(min(kde.low$x), kde.low$x, max(kde.low$x)), c(min(kde.low$y), kde.low$y, min(kde.low$y)), col="gray", border="gray") polygon(c(min(kde.high$x), kde.high$x, max(kde.high$x)), c(min(kde.high$y), kde.high$y, min(kde.high$y)), col="gray", border="gray") abline(v=0, col="red", lty=2) if(PDF == TRUE) dev.off()} return(ans) } #End LaplacesDemon/R/RejectionSampling.R0000755000176200001440000000511715144316355016740 0ustar liggesusers########################################################################### # RejectionSampling # # # # The purpose of the RejectionSampling function is to perform rejection # # sampling. # ########################################################################### RejectionSampling <- function(Model, Data, mu, S, df=Inf, logc, n=1000, CPUs=1, Type="PSOCK") { ### Initial Checks if(missing(Model)) stop("The Model argument is required.") if(missing(Data)) stop("The Data argument is required.") if(missing(mu)) stop("The mu argument is required.") if(missing(S)) stop("The S argument is required.") if(missing(df)) stop("The df argument is required.") if(missing(logc)) stop("The logc argument is required.") df <- abs(df) ### Rejection Sampling k <- length(mu) if(df == Inf) theta <- rmvn(n, mu, S) else theta <- rmvt(n, mu, S, df) lf <- rep(0, nrow(theta)) ### Non-Parallel Processing if(CPUs == 1) { for (i in 1:nrow(theta)) { mod <- Model(theta[i,], Data) lf[i] <- mod[["LP"]] theta[i,] <- mod[["parm"]]} } else { ### Parallel Processing detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cl <- makeCluster(CPUs, Type) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) mod <- parLapply(cl, 1:nrow(theta), function(x) Model(theta[x,], Data)) stopCluster(cl) lf <- unlist(lapply(mod, function(x) x[["LP"]]))[1:nrow(theta)] theta <- matrix(unlist(lapply(mod, function(x) x[["parm"]])), nrow(theta), ncol(theta)) rm(mod)} if(df == Inf) lg <- dmvn(theta, mu, S, log=TRUE) else lg <- dmvt(theta, mu, S, df, log=TRUE) prob <- exp(lf - lg - logc) if(k == 1) theta <- theta[runif(n) < prob] else theta <- theta[runif(n) < prob,] theta <- class("rejection") return(theta) } #End LaplacesDemon/R/KLD.R0000755000176200001440000000356715144316355013744 0ustar liggesusers########################################################################### # Kullback-Leibler Divergence (KLD) # # # # The purpose of the KLD function is to calculate the Kullback-Leibler # # divergences between two probability distributions, p(x) and p(y). # ########################################################################### KLD <- function(px, py, base=exp(1)) { ### Initial Checks if(!is.vector(px)) px <- as.vector(px) if(!is.vector(py)) py <- as.vector(py) n1 <- length(px) n2 <- length(py) if(!identical(n1, n2)) stop("px and py must have the same length.") if(any(!is.finite(px)) || any(!is.finite(py))) stop("px and py must have finite values.") if(any(px <= 0)) px <- exp(px) if(any(py <= 0)) py <- exp(py) px[which(px < .Machine$double.xmin)] <- .Machine$double.xmin py[which(py < .Machine$double.xmin)] <- .Machine$double.xmin ### Normalize px <- px / sum(px) py <- py / sum(py) ### Kullback-Leibler Calculations KLD.px.py <- px * (log(px, base=base)-log(py, base=base)) KLD.py.px <- py * (log(py, base=base)-log(px, base=base)) sum.KLD.px.py <- sum(KLD.px.py) sum.KLD.py.px <- sum(KLD.py.px) mean.KLD <- (KLD.px.py + KLD.py.px) / 2 mean.sum.KLD <- (sum.KLD.px.py + sum.KLD.py.px) / 2 ### Output out <- list(KLD.px.py=KLD.px.py, #KLD[i](p(x[i]) || p(y[i])) KLD.py.px=KLD.py.px, #KLD[i](p(y[i]) || p(x[i])) mean.KLD=mean.KLD, sum.KLD.px.py=sum.KLD.px.py, #KLD(p(x) || p(y)) sum.KLD.py.px=sum.KLD.py.px, #KLD(p(y) || p(x)) mean.sum.KLD=mean.sum.KLD, intrinsic.discrepancy=min(sum.KLD.px.py, sum.KLD.py.px)) return(out) } #End LaplacesDemon/R/Stick.R0000755000176200001440000000127515144316355014401 0ustar liggesusers########################################################################### # Stick # # # # The purpose of the Stick function is provide the utility of truncated # # stick-breaking regarding the vector theta. # ########################################################################### Stick <- function(theta) { M <- length(theta) + 1 theta <- c(theta, 1) p <- rep(theta[1], length(theta)) for (m in 1:(M-1)) { p[m+1] <- theta[m+1] * (1-theta[m]) * p[m] / theta[m]} return(p) } #End LaplacesDemon/R/as.parm.names.R0000755000176200001440000000743715144316355015775 0ustar liggesusers########################################################################### # as.parm.names # # # # The purpose of the as.parm.names function is to create the vector of # # names for the parameters from a list of parameters, which may be any # # combination of scalars, vectors, matrices, and upper-triangular # # matrices. # ########################################################################### as.parm.names <- function(x, uppertri=NULL) { ### Initial Checks if(missing(x)) stop("x is required.") if(!is.list(x)) stop("x must be a list.") parm.length <- length(x) if(is.null(uppertri)) uppertri <- rep(0, parm.length) if(!identical(length(uppertri), parm.length)) stop("Length of uppertri and list attributes differs.") ### Length of parm.names totlen <- 0 for (i in 1:parm.length) { if(uppertri[i] == 0) { xlen <- length(as.vector(which(!is.na(x[[i]])))) totlen <- totlen + xlen } else if(uppertri[i] == 1) { if(is.vector(x[[i]])) stop("uppertri=1 found for a vector.") xlen <- length(which(!is.na(x[[i]][upper.tri(x[[i]], diag=TRUE)]))) totlen <- totlen + xlen}} ### Assign parm.names parm.names <- rep(NA, totlen) cnt <- 1 for (i in 1:parm.length) { xname <- names(x)[i] xlen <- length(as.vector(x[[i]])) ### Scalar if(xlen == 1) { if(is.na(x[[i]])) stop("scalar has NA.") parm.names[cnt] <- paste(xname) cnt <- cnt + 1 } ### Vector else if(is.vector(x[[i]]) & {xlen > 1}) { for (j in which(!is.na(x[[i]]))) { parm.names[cnt] <- paste(xname, "[", j, "]", sep="") cnt <- cnt + 1} } ### Matrix else if(is.matrix(x[[i]]) & (uppertri[i] == 0)) { for (k in 1:ncol(x[[i]])) {for (j in 1:nrow(x[[i]])) { if(!is.na(x[[i]][j,k])) { parm.names[cnt] <- paste(xname, "[", j, ",", k, "]", sep = "") cnt <- cnt + 1}}} } ### Matrix, Upper Triangular else if(is.matrix(x[[i]]) & (uppertri[i] == 1)) { nr <- nrow(x[[i]]) nc <- ncol(x[[i]]) U <- upper.tri(x[[i]], diag=TRUE) U[which(is.na(matrix(x[[i]], nr, nc)))] <- FALSE for (k in 1:nc) {for (j in 1:nr) { if(U[j, k] == TRUE) { parm.names[cnt] <- paste(xname, "[", j, ",", k, "]", sep = "") cnt <- cnt + 1}}} } ### Array else if(is.array(x[[i]]) & (uppertri[i] == 0)) { arrayx <- array(1:prod(dim(x[[i]])), dim(x[[i]])) for (j in 1:prod(dim(x[[i]]))) { position <- which(arrayx == j, arr.ind=TRUE) if(!is.na(x[[i]][position])) { parm.names[cnt] <- paste(xname, "[", paste(as.vector(position), sep="", collapse=","), "]", sep="") cnt <- cnt + 1}} } ### Array, Upper Triangular else if(is.array(x[[i]]) & (uppertri[i] == 1)) stop("upper.tri does not function with arrays.") } return(parm.names) } #End LaplacesDemon/R/print.raftery.R0000755000176200001440000000260215144316355016126 0ustar liggesusers########################################################################### # print.raftery # # # # The purpose of the print.raftery function is to print the contents of # # an object of class raftery to the screen. # ########################################################################### print.raftery <- function(x, digits=3, ...) { cat("\nQuantile (q) =", x$params["q"]) cat("\nAccuracy (r) = +/-", x$params["r"]) cat("\nProbability (s) =", x$params["s"], "\n") if(x$resmatrix[1] == "Error") cat("\nYou need a sample size of at least", x$resmatrix[2], "with these values of q, r and s.\n") else { out <- x$resmatrix for (i in ncol(out)) out[, i] <- format(out[, i], digits=digits) out <- rbind(matrix(c("Burn-in ", "Total", "Lower bound ", "Dependence", "(M)", "(N)", "(Nmin)", "factor (I)"), byrow=TRUE, nrow=2), out) if(!is.null(rownames(x$resmatrix))) out <- cbind(c("", "", rownames(x$resmatrix)), out) dimnames(out) <- list(rep("", nrow(out)), rep("", ncol(out))) print.default(out, quote=FALSE, ...) cat("\n")} invisible(x) } #End LaplacesDemon/R/Levene.Test.R0000755000176200001440000002544115144316355015461 0ustar liggesusers########################################################################### # Levene.Test # # # # The purpose of the Levene.Test function is to apply Levene's test to # # residuals as a test of homoegeneity. # ########################################################################### Levene.Test <- function(x, Method="U", G=NULL, Data=NULL) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if({class(x) != "demonoid.ppc"} & {class(x) != "iterquad.ppc"} & {class(x) != "laplace.ppc"} & {class(x) != "pmc.ppc"} & {class(x) != "vb.ppc"}) stop("x is not of class demonoid.ppc, iterquad.ppc, laplace.ppc, pmc.ppc, or vb.ppc.") if({Method == "C"} & is.null(Data)) stop("Data is required for Method C.") if({Method == "R"} & is.null(Data)) stop("Data is required for Method R.") if({Method == "C" | Method == "R"} & is.null(Data[["Y"]])) stop("Y is required in Data.") y <- x[["y"]] yhat <- x[["yhat"]] if(is.null(Data) & is.null(G)) { G <- rep(1:4, each=round(nrow(yhat)/4), len=nrow(yhat)) if(length(G) != length(y)) stop("Lengths of G and y differ.")} if(!is.null(Data) & is.null(G) & {Method == "C" || Method == "R"}) { if(Method == "C") { G <- matrix(rep(1:4, each=round(nrow(Data[["Y"]])/4), len=nrow(Data[["Y"]])), nrow(Data[["Y"]]), ncol(Data[["Y"]]))} if(Method == "R") { G <- matrix(rep(1:4, each=round(ncol(Data[["Y"]])/4), len=ncol(Data[["Y"]])), nrow(Data[["Y"]]), ncol(Data[["Y"]]), byrow=TRUE)}} if(Method == "U") K <- length(unique(G)) if(Method == "C") K <- length(unique(G[,1])) if(Method == "R") K <- length(unique(G[1,])) N <- nrow(yhat) S <- ncol(yhat) epsilon.obs <- y - yhat if(Method == "U") { epsilon.rep <- matrix(rnorm(N*S, mean(epsilon.obs, na.rm=TRUE), sd(as.vector(epsilon.obs), na.rm=TRUE)), N, S)} if(Method == "C") { epsilon.rep <- epsilon.obs for (j in 1:ncol(Data[["Y"]])) { point <- matrix(FALSE, nrow(Data[["Y"]]), ncol(Data[["Y"]])) point[,j] <- TRUE point <- as.vector(point) epsilon.rep[point,] <- rnorm(nrow(Data[["Y"]])*S, mean(epsilon.obs[point,], na.rm=TRUE), sd(as.vector(epsilon.obs[point,]), na.rm=TRUE))}} if(Method == "R") { epsilon.rep <- epsilon.obs for (i in 1:nrow(Data[["Y"]])) { point <- matrix(FALSE, nrow(Data[["Y"]]), ncol(Data[["Y"]])) point[i,] <- TRUE point <- as.vector(point) epsilon.rep[point,] <- rnorm(ncol(Data[["Y"]])*S, mean(epsilon.obs[point,], na.rm=TRUE), sd(as.vector(epsilon.obs[point,]), na.rm=TRUE))}} ### Levene Test if(Method == "U") { W.obs <- W.rep <- rep(0, S) for (s in 1:S) { epsilon.G.obs <- as.vector(by(epsilon.obs[,s], G, mean, na.rm=TRUE)) epsilon.G.rep <- as.vector(by(epsilon.rep[,s], G, mean, na.rm=TRUE)) Z.obs <- abs(epsilon.obs[,s] - epsilon.G.obs[G]) Z.rep <- abs(epsilon.rep[,s] - epsilon.G.rep[G]) Zbar.obs <- mean(Z.obs, na.rm=TRUE) Zbar.rep <- mean(Z.rep, na.rm=TRUE) Zbar.G.obs <- as.vector(by(Z.obs, G, mean, na.rm=TRUE)) Zbar.G.rep <- as.vector(by(Z.rep, G, mean, na.rm=TRUE)) W.obs[s] <- ((N-K)*sum((Zbar.G.obs[G] - Zbar.obs)^2, na.rm=TRUE)) / ((K-1)*sum((Z.obs - Zbar.G.obs[G])^2, na.rm=TRUE)) W.rep[s] <- ((N-K)*sum((Zbar.G.rep[G] - Zbar.rep)^2, na.rm=TRUE)) / ((K-1)*sum((Z.rep - Zbar.G.rep[G])^2, na.rm=TRUE))} p <- round(mean(W.obs > W.rep, na.rm=TRUE),3) result <- "Homoskedastic" if((p < 0.025) | (p > 0.975)) result <- "Heteroskedastic" par(mfrow=c(1,1)) d.W.obs <- density(W.obs) d.W.rep <- density(W.rep) plot(d.W.obs, xlim=c(min(d.W.obs$x, d.W.rep$x), max(d.W.obs$x, d.W.rep$x)), ylim=c(0, max(d.W.obs$y, d.W.rep$y)), col=rgb(0,0,0,50,maxColorValue=255), main="Levene's Test", xlab="W", sub=paste("W.obs=", round(mean(W.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(W.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(W.obs, probs=0.975, na.rm=TRUE)),2), "), p(W.obs > W.rep) = ", p, " = ", result, sep=""), ylab="Density") polygon(d.W.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.W.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Method == "C") { par(mfrow=c(1,1), ask=TRUE) p <- rep(0, ncol(Data[["Y"]])) for (j in 1:ncol(Data[["Y"]])) { point <- matrix(FALSE, nrow(Data[["Y"]]), ncol(Data[["Y"]])) point[,j] <- TRUE point <- as.vector(point) W.obs <- W.rep <- rep(0, S) for (s in 1:S) { epsilon.G.obs <- as.vector(by(epsilon.obs[point,s], G[,j], mean, na.rm=TRUE)) epsilon.G.rep <- as.vector(by(epsilon.rep[point,s], G[,j], mean, na.rm=TRUE)) Z.obs <- abs(epsilon.obs[point,s] - epsilon.G.obs[G[,j]]) Z.rep <- abs(epsilon.rep[point,s] - epsilon.G.rep[G[,j]]) Zbar.obs <- mean(Z.obs, na.rm=TRUE) Zbar.rep <- mean(Z.rep, na.rm=TRUE) Zbar.G.obs <- as.vector(by(Z.obs, G[,j], mean, na.rm=TRUE)) Zbar.G.rep <- as.vector(by(Z.rep, G[,j], mean, na.rm=TRUE)) W.obs[s] <- ((N-K)*sum((Zbar.G.obs[G[,j]] - Zbar.obs)^2, na.rm=TRUE)) / ((K-1)*sum((Z.obs - Zbar.G.obs[G[,j]])^2, na.rm=TRUE)) W.rep[s] <- ((N-K)*sum((Zbar.G.rep[G[,j]] - Zbar.rep)^2, na.rm=TRUE)) / ((K-1)*sum((Z.rep - Zbar.G.rep[G[,j]])^2, na.rm=TRUE))} p[j] <- round(mean(W.obs > W.rep, na.rm=TRUE),3) result <- "Homoskedastic" if((p[j] < 0.025) | (p[j] > 0.975)) result <- "Heteroskedastic" d.W.obs <- density(W.obs) d.W.rep <- density(W.rep) plot(d.W.obs, xlim=c(min(d.W.obs$x, d.W.rep$x), max(d.W.obs$x, d.W.rep$x)), ylim=c(0, max(d.W.obs$y, d.W.rep$y)), col=rgb(col2rgb(j)[1], col2rgb(j)[2], col2rgb(j)[3], 50, maxColorValue=255), main="Levene's Test", xlab=paste("W.obs=", round(mean(W.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(W.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(W.obs, probs=0.975, na.rm=TRUE)),2), "), p(W.obs > W.rep) = ", p[j], " = ", result, sep=""), sub=paste("Y[,", j, "]", sep=""), ylab="Density") polygon(d.W.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.W.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)}} if(Method == "R") { par(mfrow=c(1,1), ask=TRUE) p <- rep(0, nrow(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { point <- matrix(FALSE, nrow(Data[["Y"]]), ncol(Data[["Y"]])) point[i,] <- TRUE point <- as.vector(point) W.obs <- W.rep <- rep(0, S) for (s in 1:S) { epsilon.G.obs <- as.vector(by(epsilon.obs[point,s], G[i,], mean, na.rm=TRUE)) epsilon.G.rep <- as.vector(by(epsilon.rep[point,s], G[i,], mean, na.rm=TRUE)) Z.obs <- abs(epsilon.obs[point,s] - epsilon.G.obs[G[i,]]) Z.rep <- abs(epsilon.rep[point,s] - epsilon.G.rep[G[i,]]) Zbar.obs <- mean(Z.obs, na.rm=TRUE) Zbar.rep <- mean(Z.rep, na.rm=TRUE) Zbar.G.obs <- as.vector(by(Z.obs, G[i,], mean, na.rm=TRUE)) Zbar.G.rep <- as.vector(by(Z.rep, G[i,], mean, na.rm=TRUE)) W.obs[s] <- ((N-K)*sum((Zbar.G.obs[G[i,]] - Zbar.obs)^2, na.rm=TRUE)) / ((K-1)*sum((Z.obs - Zbar.G.obs[G[i,]])^2, na.rm=TRUE)) W.rep[s] <- ((N-K)*sum((Zbar.G.rep[G[i,]] - Zbar.rep)^2, na.rm=TRUE)) / ((K-1)*sum((Z.rep - Zbar.G.rep[G[i,]])^2, na.rm=TRUE))} p[i] <- round(mean(W.obs > W.rep, na.rm=TRUE),3) result <- "Homoskedastic" if((p[i] < 0.025) | (p[i] > 0.975)) result <- "Heteroskedastic" d.W.obs <- density(W.obs) d.W.rep <- density(W.rep) plot(d.W.obs, xlim=c(min(d.W.obs$x, d.W.rep$x), max(d.W.obs$x, d.W.rep$x)), ylim=c(0, max(d.W.obs$y, d.W.rep$y)), col=rgb(col2rgb(j)[1], col2rgb(j)[2], col2rgb(j)[3], 50, maxColorValue=255), main="Levene's Test", xlab=paste("W.obs=", round(mean(W.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(W.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(W.obs, probs=0.975, na.rm=TRUE)),2), "), p(W.obs > W.rep) = ", p[i], " = ", result, sep=""), sub=paste("Y[", i, ",]", sep=""), ylab="Density") polygon(d.W.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.W.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)}} return(p) } #End LaplacesDemon/R/plot.laplace.R0000755000176200001440000000631715144343070015676 0ustar liggesusers########################################################################### # plot.laplace # # # # The purpose of the plot.laplace function is to plot an object of class # # laplace. # ########################################################################### plot.laplace <- function(x, Data=NULL, PDF=FALSE, Parms=NULL, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "laplace")) stop("x must be of class laplace.") if(is.null(Data)) stop("The Data argument is NULL.") if(any(is.na(x$History))) stop("There is no history to plot.") ### Selecting Parms if(is.null(Parms)) { History <- x$History Posterior <- x$Posterior} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], colnames(x$History))) == 0) stop("Parameter in Parms does not exist.") keepcols <- grep(Parms[1], colnames(x$History)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], colnames(x$History))) == 0) stop("Parameter in Parms does not exist.") keepcols <- c(keepcols, grep(Parms[i], colnames(x$History)))}} History <- as.matrix(x$History[,keepcols]) colnames(History) <- colnames(x$History)[keepcols] if(all(!is.na(x$Posterior))) { Posterior <- as.matrix(x$Posterior[,keepcols]) colnames(Posterior) <- colnames(History)} else Posterior <- x$Posterior } if(PDF == TRUE) { pdf("LaplaceApproximation.Plots.pdf") par(mfrow=c(2,2)) } else {par(mfrow=c(2,2), ask=TRUE)} ### Plot Parameter for (j in 1:ncol(History)) { plot(1:nrow(History), History[,j], type="l", xlab="Iterations", ylab="Value", main=colnames(History)[j]) if({x$Converged == TRUE} & !any(is.na(Posterior))) { plot(density(Posterior[,j]), xlab="Value", main=colnames(Posterior)[j]) polygon(density(Posterior[,j]), col="black", border="black") abline(v=0, col="red", lty=2)} } ### Plot Deviance History plot(1:length(x$Deviance), x$Deviance, type="l", xlab="Iterations", ylab="Value", main="Deviance") ### Plot Monitor if({x$Converged == TRUE} & !any(is.na(x$Monitor))) { for (j in 1:ncol(x$Monitor)) { plot(density(x$Monitor[,j]), xlab="Value", main=Data[["mon.names"]][j]) polygon(density(x$Monitor[,j]), col="black", border="black") abline(v=0, col="red", lty=2)} } if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/as.ppc.R0000755000176200001440000000216515144316355014507 0ustar liggesusers########################################################################### # as.ppc # # # # The purpose of the as.ppc function is to convert an object of class # # demonoid.val to an object of class demonoid.ppc, after which the object # # is ready for posterior predictive checks. # ########################################################################### as.ppc <- function(x, set=3) { ### Initial Checks if(missing(x)) stop("x is required.") if(!identical(class(x), "demonoid.val")) stop("x is not of class demonoid.val.") set <- round(abs(set)) if(set < 1) set <- 1 else if(set > 3) set <- 3 ### ppc if(set == 1) ppc <- list(y=x[[1]]$y, yhat=x[[1]]$yhat) else if(set == 2) ppc <- list(y=x[[2]]$y, yhat=x[[2]]$yhat) else ppc <- list(y=c(x[[1]]$y, x[[2]]$y), yhat=rbind(x[[1]]$yhat, x[[2]]$yhat)) class(ppc) <- "demonoid.ppc" return(ppc) } #End LaplacesDemon/R/GIV.R0000755000176200001440000000603115144316355013744 0ustar liggesusers########################################################################### # GIV # # # # GIV stands for ``generate initial values'', and the purpose of the GIV # # function is to generate initial values for the IterativeQuadrature, # # LaplaceApproximation, LaplacesDemon, PMC, and VariationalBayes # # functions. # ########################################################################### GIV <- function(Model, Data, n=1000, PGF=FALSE) { if(missing(Model)) stop("The Model argument is required.") if(!is.function(Model)) stop("Model must be a function.") if(missing(Data)) stop("The Data argument is required.") if(!is.list(Data)) stop("Data must be a list.") if(is.null(Data[["parm.names"]])) stop("parm.names missing in Data.") LIV <- length(Data[["parm.names"]]) iv <- rep(NA, LIV) if(PGF == TRUE) { if(is.null(Data[["PGF"]])) stop("PGF missing in Data.") for (i in 1:n) { IV <- as.vector(Data$PGF(Data)) M <- try(Model(IV, Data), silent=TRUE) if(!inherits(M, "try-error") & is.finite(M[["LP"]]) & is.finite(M[["Dev"]]) & identical(as.vector(M[["parm"]]), as.vector(IV))) { iv <- IV; break} } } else if(PGF == FALSE) { high <- 100; low <- -100 a <- try(Model(rep(low, LIV), Data)[["parm"]], silent=TRUE) b <- try(Model(rep(high, LIV), Data)[["parm"]], silent=TRUE) if(inherits(a, "try-error") | inherits(b, "try-error")) { for (i in 1:n) { IV <- rnorm(LIV, runif(1,-100,100), runif(1,0.1,1000)) M <- try(Model(IV, Data), silent=TRUE) if(!inherits(M, "try-error") & is.finite(M[["LP"]]) & is.finite(M[["Dev"]]) & identical(as.vector(M[["parm"]]), as.vector(IV))) { iv <- IV; break} } } else { ab.range <- b - a ab.mu <- a + ab.range / 2 ab.mu <- ifelse({a == 0} & {b == high}, 10, ab.mu) Scale <- 1 / ab.range Scale[which(ab.range == 0)] <- 0 for (i in 1:n) { IV <- rnorm(LIV, ab.mu, ab.range * Scale) M <- try(Model(IV, Data), silent=TRUE) if(!inherits(M, "try-error") & is.finite(M[["LP"]]) & is.finite(M[["Dev"]]) & identical(as.vector(M[["parm"]]), as.vector(IV))) { iv <- IV; break} Scale <- Scale + ab.range / n / 2} } } if((i == n) | any(is.na(iv))) cat("\nWARNING: Acceptable initial values were not generated.\n") return(iv) } #End LaplacesDemon/R/PosteriorChecks.R0000755000176200001440000002702315144316355016432 0ustar liggesusers########################################################################### # PosteriorChecks # # # # The purpose of the PosteriorChecks function is to provide additional # # checks of the posterior, including the probability that each theta is # # greater than zero, kurtosis, and skewness. This function requires an # # object of class demonoid, laplace, or pmc. The kurtosis and skewness # # checks return nothing (NA) for classes laplace and vb, because # # parameters from Laplace Approximation and Variational Bayes are # # normally distributed, by definition. # ########################################################################### PosteriorChecks <- function(x, Parms=NULL) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!identical(class(x), "demonoid") & !identical(class(x), "iterquad") & !identical(class(x), "laplace") & !identical(class(x), "pmc") & !identical(class(x), "vb")) stop("An object of class demonoid, iterquad, laplace, pmc, or vb is required.") ### Kurtosis and Skewness Functions kurtosis <- function(x) { m4 <- mean((x - mean(x))^4) kurt <- m4 / (sd(x)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x - mean(x))^3) skew <- m3 / (sd(x)^3) return(skew)} ### Posterior Checks if(identical(class(x), "demonoid")) { ### Posterior and Monitors if(is.matrix(x$Posterior2) == FALSE) { post <- cbind(x$Posterior1, x$Monitor) cat("\nWARNING: Non-stationary samples used.\n\n")} else { post <- cbind(x$Posterior2, x$Monitor[(x$Rec.BurnIn.Thinned+1):nrow(x$Monitor),])} colnames(post) <- c(colnames(x$Posterior1), colnames(x$Monitor)) ### Selecting Parms if(is.null(Parms)) {keepcols <- 1:ncol(post)} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], colnames(post))) == 0) stop("Parameter in Parms does not exist.") keepcols <- grep(Parms[1], colnames(post)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], colnames(post))) == 0) stop("Parameter in Parms does not exist.") keepcols <- c(keepcols, grep(Parms[i], colnames(post)))}}} temp <- colnames(post)[keepcols] post <- post[,keepcols] colnames(post) <- temp ### Correlation Table options(warn=-1); postcor <- cor(post); options(warn=0) ### Summary Table Summ <- matrix(NA, ncol(post), 8) rownames(Summ) <- colnames(post) colnames(Summ) <- c("p(theta > 0)", "N.Modes", "Kurtosis", "Skewness", "Burn-In", "IAT", "ISM", "AR") options(warn=-1) for (i in 1:ncol(post)) { Summ[i,1] <- mean(post[,i] > 0) Summ[i,2] <- length(Modes(post[,i])[[1]]) Summ[i,3] <- round(kurtosis(post[,i]),3) Summ[i,4] <- round(skewness(post[,i]),3) Summ[i,6] <- round(IAT(post[,i]),3)} Summ[,5] <- burnin(post) Summ[,7] <- round(ESS(post)/x$Min, 3) Summ[,8] <- AcceptanceRate(post) options(warn=0) } else if(identical(class(x), "iterquad")) { ### Posterior if(any(is.na(x$Posterior))) stop("Posterior samples do not exist.") post <- x$Summary1 ### Selecting Parms if(is.null(Parms)) {keeprows <- 1:nrow(post)} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(post))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(post)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(post))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(post)))}}} temp <- rownames(post)[keeprows] post <- post[keeprows,] rownames(post) <- temp Posterior <- x$Posterior colnames(Posterior) <- rownames(post) ### Correlation Table options(warn=-1); postcor <- cor(Posterior); options(warn=0) ### Summary Table Summ <- matrix(NA, nrow(post), 8) rownames(Summ) <- rownames(post) colnames(Summ) <- c("p(theta > 0)", "N.Modes", "Kurtosis", "Skewness", "Burn-In", "IAT", "ISM", "AR") options(warn=-1) for (i in 1:ncol(Posterior)) { Summ[i,1] <- mean(Posterior[,i] > 0) Summ[i,2] <- length(Modes(Posterior[,i])[[1]]) Summ[i,3] <- round(kurtosis(Posterior[,i]),3) Summ[i,4] <- round(skewness(Posterior[,i]),3) Summ[i,5] <- 0 Summ[i,6] <- round(IAT(Posterior[,i]),3)} Summ[,7] <- NA Summ[,8] <- 1 options(warn=0) } else if(identical(class(x), "laplace")) { ### Posterior if(any(is.na(x$Posterior))) stop("Posterior samples do not exist.") post <- x$Summary1 ### Selecting Parms if(is.null(Parms)) {keeprows <- 1:nrow(post)} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(post))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(post)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(post))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(post)))}}} temp <- rownames(post)[keeprows] post <- post[keeprows,] rownames(post) <- temp Posterior <- x$Posterior colnames(Posterior) <- rownames(post) ### Correlation Table options(warn=-1); postcor <- cor(Posterior); options(warn=0) ### Summary Table Summ <- matrix(NA, nrow(post), 8) rownames(Summ) <- rownames(post) colnames(Summ) <- c("p(theta > 0)", "N.Modes", "Kurtosis", "Skewness", "Burn-In", "IAT", "ISM", "AR") options(warn=-1) for (i in 1:ncol(Posterior)) { Summ[i,1] <- mean(Posterior[,i] > 0) Summ[i,2] <- length(Modes(Posterior[,i])[[1]]) Summ[i,3] <- round(kurtosis(Posterior[,i]),3) Summ[i,4] <- round(skewness(Posterior[,i]),3) Summ[i,5] <- 0 Summ[i,6] <- round(IAT(Posterior[,i]),3)} Summ[,7] <- NA Summ[,8] <- 1 options(warn=0) } else if(identical(class(x), "vb")) { ### Posterior if(any(is.na(x$Posterior))) stop("Posterior samples do not exist.") post <- x$Summary1 ### Selecting Parms if(is.null(Parms)) {keeprows <- 1:nrow(post)} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(post))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(post)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(post))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(post)))}}} temp <- rownames(post)[keeprows] post <- post[keeprows,] rownames(post) <- temp Posterior <- x$Posterior colnames(Posterior) <- rownames(post) ### Correlation Table options(warn=-1); postcor <- cor(Posterior); options(warn=0) ### Summary Table Summ <- matrix(NA, nrow(post), 8) rownames(Summ) <- rownames(post) colnames(Summ) <- c("p(theta > 0)", "N.Modes", "Kurtosis", "Skewness", "Burn-In", "IAT", "ISM", "AR") options(warn=-1) for (i in 1:ncol(Posterior)) { Summ[i,1] <- mean(Posterior[,i] > 0) Summ[i,2] <- length(Modes(Posterior[,i])[[1]]) Summ[i,3] <- round(kurtosis(Posterior[,i]),3) Summ[i,4] <- round(skewness(Posterior[,i]),3) Summ[i,5] <- 0 Summ[i,6] <- round(IAT(Posterior[,i]),3)} Summ[,7] <- NA Summ[,8] <- 1 options(warn=0) } if(identical(class(x), "pmc")) { ### Posterior and Monitors post <- cbind(x$Posterior2, x$Monitor) colnames(post) <- c(colnames(x$Posterior2), colnames(x$Monitor)) ### Selecting Parms if(is.null(Parms)) {keepcols <- 1:ncol(post)} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], colnames(post))) == 0) stop("Parameter in Parms does not exist.") keepcols <- grep(Parms[1], colnames(post)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], colnames(post))) == 0) stop("Parameter in Parms does not exist.") keepcols <- c(keepcols, grep(Parms[i], colnames(post)))}}} temp <- colnames(post)[keepcols] post <- post[,keepcols] colnames(post) <- temp ### Correlation Table options(warn=-1); postcor <- cor(post); options(warn=0) ### Summary Table Summ <- matrix(NA, ncol(post), 8) rownames(Summ) <- colnames(post) colnames(Summ) <- c("p(theta > 0)", "N.Modes", "Kurtosis", "Skewness", "Burn-In", "IAT", "ISM", "AR") options(warn=-1) for (i in 1:ncol(post)) { Summ[i,1] <- mean(post[,i] > 0) Summ[i,2] <- length(Modes(post[,i])[[1]]) Summ[i,3] <- round(kurtosis(post[,i]),3) Summ[i,4] <- round(skewness(post[,i]),3) Summ[i,6] <- round(IAT(post[,i]),3)} Summ[,5] <- rep(1, nrow(Summ)) Summ[,7] <- NA Summ[,8] <- 1 options(warn=0) } ### Output out <- list(Posterior.Correlation=postcor, Posterior.Summary=Summ) class(out) <- "posteriorchecks" return(out) } #End LaplacesDemon/R/plot.juxtapose.R0000755000176200001440000000440415144316355016320 0ustar liggesusers########################################################################### # plot.juxtapose # # # # The purpose of the plot.juxtapose function is to plot a comparison of # # MCMC algorithms according either to IAT or ISM. # ########################################################################### plot.juxtapose <- function(x, Style="ISM", ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!identical(class(x), "juxtapose")) stop("The x argument is not of class juxtapose.") if((Style != "IAT") & (Style != "ISM")) stop("Style must be IAT or ISM") Title <- "MCMC Juxtaposition" if(identical(Style, "IAT")) { ### Basic Plot plot(0, 0, ylim=c(0, ncol(x) + 1), xlim=c(1, max(x[6,])), main=Title, sub="", xlab="Integrated Autocorrelation Time", ylab="", type="n", ann=TRUE, yaxt="n") abline(v=1, col="gray") ### Add Medians points(x[5,], ncol(x):1, pch=20) ### Add Horizontal Lines for 2.5%-97.5% Quantiles for (i in 1:ncol(x)) { lines(x[c(4,6),i], c(ncol(x)-i+1, ncol(x)-i+1))} ### Add y-axis labels yy <- ncol(x):1 cex.labels <- 1 / {log(ncol(x))/5 + 1} axis(2, labels=colnames(x), tick=FALSE, las=1, at=yy, cex.axis=cex.labels)} else { ### Basic Plot plot(0, 0, ylim=c(0, ncol(x) + 1), xlim=c(0, max(x[9,])), main=Title, sub="", xlab="Independent Samples per Minute", ylab="", type="n", ann=TRUE, yaxt="n") abline(v=0, col="gray") ### Add Medians points(x[8,], ncol(x):1, pch=20) ### Add Horizontal Lines for 2.5%-97.5% Quantiles for (i in 1:ncol(x)) { lines(x[c(7,9),i], c(ncol(x)-i+1, ncol(x)-i+1))} ### Add y-axis labels yy <- ncol(x):1 cex.labels <- 1 / {log(ncol(x))/5 + 1} axis(2, labels=colnames(x), tick=FALSE, las=1, at=yy, cex.axis=cex.labels)} } #End LaplacesDemon/R/Validate.R0000755000176200001440000001272715144341327015056 0ustar liggesusers########################################################################### # Validate # # # # The purpose of the Validate function is to perform hold-out validation # # with BPIC. # ########################################################################### Validate <- function(object, Model, Data, plot=FALSE, PDF=FALSE) { ### Initial Checks if(missing(object)) stop("The object argument is required.") if(missing(Model)) stop("The Model argument is required.") if(missing(Data)) stop("The Data argument is required.") if(!identical(class(object), "demonoid") & !identical(class(object), "pmc")) stop("object must be of class demonoid or pmc.") if(!is.list(Data)) stop("Data must be a list.") if(length(Data) != 2) stop("Data must have length 2.") if(is.null(Data[[1]][["y"]]) & is.null(Data[[1]][["Y"]])) stop("Data must have y or Y.") if(!is.null(Data[[1]][["y"]])) y1 <- as.vector(Data[[1]][["y"]]) if(!is.null(Data[[1]][["Y"]])) y1 <- as.vector(Data[[1]][["Y"]]) if(!is.null(Data[[2]][["y"]])) y2 <- as.vector(Data[[2]][["y"]]) if(!is.null(Data[[2]][["Y"]])) y2 <- as.vector(Data[[2]][["Y"]]) ### p(y[rep] | y) if(identical(class(object), "demonoid")) { post <- as.matrix(object$Posterior1) if(is.matrix(object$Posterior2) == TRUE) { post <- as.matrix(object$Posterior2)}} else {post <- as.matrix(object$Posterior2)} dev1 <- dev2 <- rep(NA, nrow(post)) yhat1 <- matrix(NA, length(y1), nrow(post)) yhat2 <- matrix(NA, length(y2), nrow(post)) lengthcomp <- as.vector(Model(post[1,], Data[[1]])[["yhat"]]) if(!identical(length(lengthcomp), length(y1))) stop("y and yhat differ in length.") for (i in 1:nrow(post)) { temp1 <- Model(post[i,], Data[[1]]) temp2 <- Model(post[i,], Data[[2]]) dev1[i] <- temp1[["Dev"]] dev2[i] <- temp2[["Dev"]] yhat1[,i] <- as.vector(temp1[["yhat"]]) yhat2[,i] <- as.vector(temp2[["yhat"]])} ### BPIC Dbar.M <- round(mean(dev1, na.rm=TRUE),3) pD.M <- round(var(dev1, na.rm=TRUE)/2,3) BPIC.M <- Dbar.M + 2*pD.M Dbar.V <- round(mean(dev2, na.rm=TRUE),3) pD.V <- round(var(dev2, na.rm=TRUE)/2,3) BPIC.V <- Dbar.V + 2*pD.V bpic <- matrix(c(Dbar.M, pD.M, BPIC.M, Dbar.V, pD.V, BPIC.V), 3, 2) rownames(bpic) <- c("Dbar","pD","BPIC") colnames(bpic) <- c("Modeled","Validation") cat("\n") print(bpic) shorter <- min(length(dev1),length(dev2)) cat("\np(Deviance.V > Deviance.M):", round(mean(dev2[1:shorter] > dev1[1:shorter], na.rm=TRUE),3)) cat("\nE(Change in Deviance):", round(mean(dev2[1:shorter] - dev1[1:shorter], na.rm=TRUE),3), "\n\n") ### Warnings if(is.matrix(object$Posterior2) == FALSE) { warning("Non-stationary samples were used.")} if(any(is.na(yhat1))) cat("\nWARNING: Output matrix yhat.M has ", sum(is.na(yhat1)), " missing values.\n") if(any(is.na(yhat2))) cat("\nWARNING: Output matrix yhat.V has ", sum(is.na(yhat2)), " missing values.\n") if(any(is.nan(yhat1))) cat("\nWARNING: Output matrix yhat.M has ", sum(is.nan(yhat1)), " non-numeric (NaN) values.\n") if(any(is.nan(yhat2))) cat("\nWARNING: Output matrix yhat.V has ", sum(is.nan(yhat2)), " non-numeric (NaN) values.\n") if(any(is.infinite(yhat1))) cat("\nWARNING: Output matrix yhat.M has ", sum(is.infinite(yhat1)), " infinite values.\n") if(any(is.infinite(yhat2))) cat("\nWARNING: Output matrix yhat.V has ", sum(is.infinite(yhat2)), " infinite values.\n") ### Plot if(plot == TRUE) { if(PDF == TRUE) pdf("Validation.Plot.pdf") par(mfrow=c(2,1)) kde1 <- density(dev1) kde2 <- density(dev2) plot(kde1, xlim=c(min(kde1$x,kde2$x),max(kde1$x,kde2$x)), ylim=c(min(kde1$y,kde2$y),max(kde1$y,kde2$y)), main="", xlab="Deviance: Modeled (Black), Validation (Red)", ylab="Density") polygon(kde1, col="black", border="black") lines(kde2, col="red") polygon(kde2, col="red", border="red") lines(kde1, col="black") dens.diff <- dev2[1:shorter] - dev1[1:shorter] kde <- density(dens.diff, na.rm=TRUE) plot(kde, col="gray", xlab="Change in Deviance", ylab="Density", main="", sub=paste("(D.V-D.M)=", round(mean(dens.diff, na.rm=TRUE),2), " (", round(as.vector(quantile(dens.diff, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(dens.diff, probs=0.975, na.rm=TRUE)),2), "), p(D.V > D.M) = ", round(mean(dev2[1:shorter] > dev1[1:shorter], na.rm=TRUE),2), sep="")) polygon(kde, col="gray", border="gray") abline(v=0, col="red", lty=2) if(PDF == TRUE) dev.off()} ### Create Output predicted <- list(list(y=y1, yhat=yhat1, Deviance=dev1), list(y=y2, yhat=yhat2, Deviance=dev2), BPIC=bpic) names(predicted) <- c("Modeled","Validation","BPIC") if(inherits(object, "demonoid")) class(predicted) <- "demonoid.val" else class(predicted) <- "pmc.val" return(predicted) } #End LaplacesDemon/R/CenterScale.R0000755000176200001440000000460015144316355015507 0ustar liggesusers########################################################################### # CenterScale # # # # The purpose of the CenterScale function is to center and scale a # # continuous variable. Options are also provided for binary variables. # # This function is very similar to Gelman's rescale function in his arm # # package. # ########################################################################### CenterScale <- function(x, Binary="none", Inverse=FALSE, mu, sigma, Range, Min) { if(identical(Inverse, FALSE)) { ### Initial Checks if(!is.numeric(x)){ x <- as.numeric(factor(x)) x.obs <- x[is.finite(x)]} x.obs <- x[is.finite(x)] ### Binary Variables if(identical(length(unique(x.obs)), 2)){ if(identical(Binary, "none")){ return((x-min(x.obs)) / (max(x.obs)-min(x.obs)))} else if(identical(Binary, "center")) { return(x-mean(x.obs))} else if(identical(Binary, "center0")) { x <- (x-min(x.obs)) / (max(x.obs)-min(x.obs)) return(x-0.5)} else if(identical(Binary, "centerscale")) { return({x-mean(x.obs)} / {2*sd(x.obs)})} } ### Continuous Variables else {return({x-mean(x.obs)} / {2*sd(x.obs)})}} else { ### Initial Checks if(!is.numeric(x)){ x <- as.numeric(factor(x)) x.obs <- x[is.finite(x)]} x.obs <- x[is.finite(x)] ### Binary Variables if(identical(length(unique(x.obs)), 2)){ if(identical(Binary, "none")) { return(x * Range + Min)} else if(identical(Binary, "center")) { return(x + mu)} else if(identical(Binary, "center0")) { return(x * Range + Min)} else if(identical(Binary, "centerscale")) { return(x * (2*sigma) + mu)} } ### Continuous Variables else {return(x * (2*sigma) + mu)} } } #End LaplacesDemon/R/predict.laplace.R0000755000176200001440000000740315144316355016355 0ustar liggesusers########################################################################### # predict.laplace # # # # The purpose of the predict.laplace function is to predict y[new] or # # y[rep], and later provide posterior predictive checks for objects of # # class laplace. # ########################################################################### predict.laplace <- function(object, Model, Data, CPUs=1, Type="PSOCK", ...) { ### Initial Checks if(missing(object)) stop("The object argument is required.") if(object$Converged == FALSE) stop("LaplaceApproximation did not converge.") if(missing(Model)) stop("The Model argument is required.") if(missing(Data)) stop("The Data argument is required.") if(is.null(Data[["y"]]) & is.null(Data[["Y"]])) stop("Data must have y or Y.") if(!is.null(Data[["y"]])) y <- as.vector(Data[["y"]]) if(!is.null(Data[["Y"]])) y <- as.vector(Data[["Y"]]) CPUs <- abs(round(CPUs)) ### p(y[rep] | y), Deviance, and Monitors Dev <- rep(NA, nrow(object$Posterior)) monitor <- matrix(NA, length(Data[["mon.names"]]), nrow(object$Posterior)) lengthcomp <- as.vector(Model(object$Posterior[1,], Data)[["yhat"]]) if(!identical(length(lengthcomp), length(y))) stop("y and yhat differ in length.") yhat <- matrix(NA, length(y), nrow(object$Posterior)) ### Non-Parallel Processing if(CPUs == 1) { for (i in 1:nrow(object$Posterior)) { mod <- Model(object$Posterior[i,], Data) Dev[i] <- as.vector(mod[["Dev"]]) monitor[,i] <- as.vector(mod[["Monitor"]]) yhat[,i] <- as.vector(mod[["yhat"]])} } else { ### Parallel Processing detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cl <- makeCluster(CPUs, Type) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) mod <- parLapply(cl, 1:nrow(object$Posterior), function(x) Model(object$Posterior[x,], Data)) stopCluster(cl) Dev <- unlist(lapply(mod, function(x) x[["Dev"]]))[1:nrow(object$Posterior)] monitor <- matrix(unlist(lapply(mod, function(x) x[["Monitor"]])), length(Data[["mon.names"]]), nrow(object$Posterior)) yhat <- matrix(unlist(lapply(mod, function(x) x[["yhat"]])), length(y), nrow(object$Posterior)) rm(mod)} rownames(monitor) <- Data[["mon.names"]] ### Warnings if(any(is.na(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.na(yhat)), " missing values.") if(any(is.nan(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.nan(yhat)), " non-numeric (NaN) values.") if(any(is.infinite(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.infinite(yhat)), " infinite values.") if(any(!is.finite(Dev))) cat("\nWARNING: Deviance has non-finite values.") ### Create Output predicted <- list(y=y, yhat=yhat, Deviance=Dev, monitor=monitor) class(predicted) <- "laplace.ppc" return(predicted) } #End LaplacesDemon/R/MCSE.R0000755000176200001440000000633115144316355014051 0ustar liggesusers########################################################################### # MCSE # # # # The purpose of the MCSE function is to estimate the Monte Carlo # # Standard Error of a vector of posterior samples. Multiple methods are # # provided. The purpose of the MCSS function is to calculate the required # # sample size `n' to achieve acceptable error `a' given a vector `x' of # # Monte Carlo samples and the sample variance (rather than the asymptotic # # variance). # ########################################################################### MCSE <- function(x, method="IMPS", batch.size="sqrt", warn=FALSE) { if(missing(x)) stop("The x argument is required.") if(method == "sample.variance") { ess <- try(ESS(x), silent=TRUE) if(inherits(ess, "try-error")) ess <- length(x) se <- sd(x) / sqrt(ess) return(se)} else if(method == "batch.means") { N <- length(x) if(N < 1000) if(warn) warning("Samples must be >= 1000.") if(N < 10) return(NA) if(batch.size == "sqrt") { b <- floor(sqrt(N)) # batch size a <- floor(N/b) # number of batches } else if(batch.size == "cuberoot") { b <- floor(N^(1/3)) # batch size a <- floor(N/b) # number of batches } else { #Batch size is provided numerically stopifnot(is.numeric(batch.size)) b <- floor(batch.size) # batch size if(b > 1) a <- floor(N/b) # number of batches else stop("batch.size is invalid.") } Ys <- sapply(1:a, function(k) return(mean(x[((k-1)*b+1):(k*b)]))) muhat <- mean(Ys) sigmahatsq <- b*sum((Ys - muhat)^2) / (a-1) bmse <- sqrt(sigmahatsq / N) return(list(est=muhat, se=bmse)) } else if(method == "IMPS") { chainAC <- acf(x, type="covariance" ,plot=FALSE)$acf AClen <- length(chainAC) gammaAC <- chainAC[1:(AClen-1)] + chainAC[2:AClen] m <- 1 currgamma <- gammaAC[1] k <- 1 while ((k < length(gammaAC)) && (gammaAC[k+1] > 0) && (gammaAC[k] >= gammaAC[k+1])) k <- k + 1 if({k == length(gammaAC)} & {warn == TRUE}) warning("May need to compute more autocovariances for IMPS.") options(warn=-1) sigmasq <- -chainAC[1] + 2*sum(gammaAC[1:k]) se <- sqrt(sigmasq / length(x)) options(warn=0) return(se) } else stop("The method is unknown.") } MCSS <- function(x, a) { if(missing(x)) stop("The x argument is required.") if(missing(a)) stop("The a argument is required.") ess <- ESS(x) ratio <- length(x) / ess fx <- function(sdx, n, a) ((sdx / sqrt(n)) - a)^2 optimized <- optimize(f=fx, interval=c(0, .Machine$integer.max), maximum=FALSE, a=a, sdx=sd(x)) return(round(optimized$minimum * ratio)) } #End LaplacesDemon/R/Consort.R0000755000176200001440000015033215144316355014752 0ustar liggesusers########################################################################### # Consort # # # # The purpose of the Consort function is to consort with Laplace's Demon # # regarding an object of class demonoid. # ########################################################################### Consort <- function(object=NULL) { if(is.null(object)) stop("The object argument is empty.") if(!identical(class(object), "demonoid")) stop("Consort requires an object of class demonoid.") oname <- deparse(substitute(object)) dname <- as.vector(strsplit(as.character(object$Call), "=")[3][[1]]) cat("\n#############################################################\n") cat("# Consort with Laplace's Demon #\n") cat("#############################################################\n") print.demonoid(object) ### Check Acceptance.Rate Acc.Rate.Level <- 2 if((object$Algorithm == "Adaptive Hamiltonian Monte Carlo") | (object$Algorithm == "Tempered Hamiltonian Monte Carlo")) { L <- object$Specs[["L"]] if(L == 1) { Acc.Rate.Low <- 0.5 Acc.Rate.High <- 0.65} else { Acc.Rate.Low <- 0.6 Acc.Rate.High <- 0.7}} else if(object$Algorithm %in% c("Adaptive Griddy-Gibbs", "Automated Factor Slice Sampler", "Elliptical Slice Sampler", "Griddy-Gibbs", "Oblique Hyperrectangle Slice Sampler", "Reflective Slice Sampler", "Slice Sampler", "Stochastic Gradient Langevin Dynamics", "Univariate Eigenvector Slice Sampler")) { Acc.Rate.Low <- 1 Acc.Rate.High <- 1 } else if(object$Algorithm == "Gibbs Sampler") { if(is.null(object$Specs[["MWG"]])) Acc.Rate.Low <- Acc.Rate.High <- 1 else { Acc.Rate.Low <- 0.15 Acc.Rate.High <- 0.5} } else if((object$Algorithm == "Metropolis-Adjusted Langevin Algorithm")) { Acc.Rate.Low <- 0.40 Acc.Rate.High <- 0.80 } else if(object$Algorithm == "Hamiltonian Monte Carlo") { L <- object$Specs[["L"]] if(L == 1) { Acc.Rate.Low <- 0.4 Acc.Rate.High <- 0.8} else { Acc.Rate.Low <- 0.6 Acc.Rate.High <- 0.7} } else if(object$Algorithm == "Hamiltonian Monte Carlo with Dual-Averaging") { A <- object$Specs[["A"]] delta <- object$Specs[["delta"]] Lmax <- object$Specs[["Lmax"]] lambda <- object$Specs[["lambda"]] Acc.Rate.Low <- max(round(delta - 0.05, 2), 0.01) Acc.Rate.High <- min(round(delta + 0.05, 2), 1) } else if(object$Algorithm == "No-U-Turn Sampler") { A <- object$Specs[["A"]] delta <- object$Specs[["delta"]] Acc.Rate.Low <- max(round(delta - 0.05, 2), 0.01) Acc.Rate.High <- min(round(delta + 0.05, 2), 1) } else if(object$Algorithm == "Refractive Sampler") { m <- object$Specs[["m"]] Acc.Rate.Low <- 0.6 Acc.Rate.High <- 0.7 } else if((object$Algorithm %in% c("Reversible-Jump", "Multiple-Try Metropolis"))) { Acc.Rate.Low <- 0.10 Acc.Rate.High <- 0.90 } else { Acc.Rate.Low <- 0.15 Acc.Rate.High <- 0.5} if(any(object$Acceptance.Rate == 0)) { cat("\nWARNING: Acceptance Rate = 0\n\n") cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=100000, Status=1000, ", "Thinning=100,\n", sep="") cat(" Algorithm=\"AMM\", Specs=list(Adaptive=500, ", "B=NULL, Periodicity=100, w=0.05))\n\n", sep="") stop("Try the above code before consorting again.")} if(any(object$Acceptance.Rate < Acc.Rate.Low)) {Acc.Rate.Level <- 1} else if(any(object$Acceptance.Rate > Acc.Rate.High)) {Acc.Rate.Level <- 3} LIV <- object$Parameters ### Check MCSE MCSE.crit <- 0.0627 MCSE.temp <- object$Summary2[1:object$Parameters,"MCSE"] / object$Summary2[1:LIV,"SD"] MCSE.temp2 <- sum(!is.finite(MCSE.temp)) MCSE.temp[which(!is.finite(MCSE.temp))] <- 0 MCSE.tot <- 0 if(MCSE.temp2 < LIV) MCSE.tot <- sum(MCSE.temp < MCSE.crit) ### Check ESS ESS.temp <- object$Summary2[1:LIV,"ESS"] ESS.temp[which(!is.finite(ESS.temp))] <- 0 ESS.min <- min(ESS.temp) if(all(is.finite(object$Summary2[1:LIV,"ESS"]))) ESS.worst <- which.min(object$Summary2[1:LIV,"ESS"]) else ESS.worst <- which.min(object$Summary1[1:LIV,"ESS"]) ESS.crit <- 100 ### Check Stationarity Stationarity <- FALSE if(object$Rec.BurnIn.Thinned < object$Thinned.Samples) Stationarity <- TRUE ### Check Diminishing Adaptation (If Adaptive) if(nrow(object$CovarDHis) > 1) Dim.Adapt <- sum(diff(object$CovarDHis)) <= 0 else Dim.Adapt <- TRUE ### Suggested Values Rec.Iterations <- trunc(object$Rec.Thinning / object$Thinning * object$Iterations) if(any(object$Acceptance.Rate == 0)) { Rec.Adaptive <- round(LIV * 1.0E7) Rec.Periodicity <- round(object$Rec.Thinning * 1.0E7)} else if(all(object$Acceptance.Rate > 0)) { Rec.Adaptive <- round(LIV / mean(object$Acceptance.Rate)) Rec.Periodicity <- round(object$Rec.Thinning / mean(object$Acceptance.Rate))} if(Rec.Adaptive > Rec.Iterations) Rec.Adaptive <- Rec.Iterations - 1 if(Rec.Periodicity > Rec.Iterations) Rec.Periodicity <- Rec.Iterations - 1 Status.temp <- trunc(Rec.Iterations / {object$Minutes * Rec.Iterations / object$Iterations}) if(Status.temp < Rec.Iterations) Rec.Status <- Status.temp else Rec.Status <- trunc(sqrt(Rec.Iterations)) if(Rec.Status > Rec.Iterations) Rec.Status <- Rec.Iterations Rec.Thinning <- object$Rec.Thinning ### The Demonic Suggestion of Laplace's Demon cat("\nDemonic Suggestion\n\n") cat("Due to the combination of the following conditions,\n\n") cat("1. ", object$Algorithm, "\n", sep="") if(Acc.Rate.Level == 1) { cat("2. The acceptance rate (", min(object$Acceptance.Rate), ") is below ", Acc.Rate.Low, ".\n", sep="")} else if(Acc.Rate.Level == 2) { cat("2. The acceptance rate (", mean(object$Acceptance.Rate), ") is within the interval [", Acc.Rate.Low, ",", Acc.Rate.High, "].\n", sep="")} else { cat("2. The acceptance rate (", max(object$Acceptance.Rate), ") is above ", Acc.Rate.High, ".\n", sep="")} if(MCSE.tot < LIV) { cat("3. At least one target MCSE is >= ", MCSE.crit * 100,"% of its marginal posterior\n", sep="") cat(" standard deviation.\n")} else { cat("3. Each target MCSE is < ", MCSE.crit * 100, "% of its marginal posterior\n", sep="") cat(" standard deviation.\n")} if(ESS.min < ESS.crit) { cat("4. At least one target distribution has an ", "effective sample size\n", sep="") cat(" (ESS) less than ", ESS.crit, ". The worst mixing chain is: ", rownames(object$Summary1)[ESS.worst], " (ESS=", object$Summary1[ESS.worst,"ESS"], ").\n", sep="")} else { cat("4. Each target distribution has an effective ", "sample size (ESS)\n", sep="") cat(" of at least ", ESS.crit, ".\n", sep="")} if(Stationarity == FALSE) { cat("5. At least one target distribution is not ", "stationary.\n\n", sep="")} else if(Stationarity == TRUE & object$Rec.BurnIn.Thinned > 0) { cat("5. Each target distribution became stationary by\n") cat(" ", object$Rec.BurnIn.Thinned + 1, " iterations.\n\n", sep="")} else { cat("5. Each target distribution became stationary by\n") cat(" ", object$Rec.BurnIn.Thinned + 1, " iteration.\n\n", sep="")} ### Determine if Laplace's Demon is appeased... Appeased <- FALSE if(!is.null(object$Specs[["Adaptive"]])) Adaptive <- object$Specs[["Adaptive"]] else Adaptive <- object$Iterations + 1 if({Adaptive > object$Iterations} & {Acc.Rate.Level == 2} & {MCSE.tot >= LIV} & {ESS.min >= ESS.crit} & {Stationarity == TRUE}) { Appeased <- TRUE cat("Laplace's Demon has been appeased, and suggests\n") cat("the marginal posterior samples should be plotted\n") cat("and subjected to any other MCMC diagnostic deemed\n") cat("fit before using these samples for inference.\n\n") } else { if(object$Algorithm %in% c("Adaptive Directional Metropolis-within-Gibbs", "Adaptive Griddy-Gibbs", "Adaptive Metropolis-within-Gibbs", "Componentwise Hit-And-Run Metropolis", "Gibbs Sampler", "Griddy-Gibbs", "Metropolis-within-Gibbs", "Multiple-Try Metropolis", "Random Dive Metropolis-Hastings", "Reversible-Jump", "Sequential Adaptive Metropolis-within-Gibbs", "Sequential Metropolis-within-Gibbs", "Slice Sampler", "Updating Sequential Adaptive Metropolis-within-Gibbs", "Updating Sequential Metropolis-within-Gibbs")) { options(warn=-1) postcor <- try(cor(object$Posterior1), silent=TRUE) options(warn=0) if(!inherits(postcor, "try-error")) { postcor <- try(quantile(abs(postcor)), silent=TRUE) if(!inherits(postcor, "try-error")) { cat("Quantiles of Absolute Posterior1 Correlation:\n") print(postcor) if(postcor["75%"] >= 0.5) cat("\nPossibly excessive posterior correlation for a componentwise algorithm.") cat("\n\n")}}} if(Dim.Adapt == FALSE) { cat("WARNING: Diminishing adaptation did not occur.\n") if(!object$Algorithm %in% c("Automated Factor Slice Sampler", "Interchain Adaptation", "Metropolis-Adjusted Langevin Algorithm", "No-U-Turn Sampler", "Refractive Sampler", "Sequential Adaptive Metropolis-within-Gibbs", "Univariate Eigenvector Slice Sampler", "Updating Sequential Adaptive Metropolis-within-Gibbs")) cat(" A new algorithm will be suggested.\n\n")} cat("Laplace's Demon has not been appeased, and suggests\n") cat("copy/pasting the following R code into the R", " console,\n", sep="") cat("and running it.\n\n") if(object$Algorithm != "Interchain Adaptation") cat("Initial.Values <- as.initial.values(", oname, ")\n", sep="") if(object$Algorithm %in% c("Adaptive Metropolis-within-Gibbs", "Metropolis-within-Gibbs")) Time <- object$Iterations / object$Minutes else Time <- object$Iterations / object$Minutes / LIV if(Time >= 100) Fast <- TRUE else Fast <- FALSE if({Acc.Rate.Level == 2} & {MCSE.tot >= LIV} & {ESS.min >= ESS.crit} & {Stationarity == TRUE}) Ready <- TRUE else Ready <- FALSE Alg <- switch(object$Algorithm, "Adaptive Directional Metropolis-within-Gibbs"="ADMG", "Adaptive Griddy-Gibbs"="AGG", "Adaptive Hamiltonian Monte Carlo"="AHMC", "Adaptive Metropolis"="AM", "Adaptive Metropolis-within-Gibbs"="AMWG", "Adaptive-Mixture Metropolis"="AMM", "Affine-Invariant Ensemble Sampler"="AIES", "Automated Factor Slice Sampler"="AFSS", "Componentwise Hit-And-Run Metropolis"="CHARM", "Delayed Rejection Adaptive Metropolis"="DRAM", "Delayed Rejection Metropolis"="DRM", "Differential Evolution Markov Chain"="DEMC", "Elliptical Slice Sampler"="ESS", "Experimental"="Exper", "Gibbs Sampler"="Gibbs", "Griddy-Gibbs"="GG", "Hamiltonian Monte Carlo"="HMC", "Hamiltonian Monte Carlo with Dual-Averaging"="HMCDA", "Hit-And-Run Metropolis"="HARM", "Independence Metropolis"="IM", "Interchain Adaptation"="INCA", "Metropolis-Adjusted Langevin Algorithm"="MALA", "Metropolis-Coupled Markov Chain Monte Carlo"="MCMCMC", "Metropolis-within-Gibbs"="MWG", "Multiple-Try Metropolis"="MTM", "No-U-Turn Sampler"="NUTS", "Oblique Hyperrectangle Slice Sampler"="OHSS", "Preconditioned Crank-Nicolson"="pCN", "Random Dive Metropolis-Hastings"="RDMH", "Random-Walk Metropolis"="RWM", "Reflective Slice Sampler"="RSS", "Refractive Sampler"="Refractive", "Reversible-Jump"="RJ", "Robust Adaptive Metropolis"="RAM", "Sequential Adaptive Metropolis-within-Gibbs"="SAMWG", "Sequential Metropolis-within-Gibbs"="SMWG", "Slice Sampler"="Slice", "Stochastic Gradient Langevin Dynamics"="SGLD", "Tempered Hamiltonian Monte Carlo"="THMC", "t-walk"="t-walk", "Univariate Eigenvector Slice Sampler"="UESS", "Updating Sequential Adaptive Metropolis-within-Gibbs"="USAMWG", "Updating Sequential Metropolis-within-Gibbs"="USMWG") Componentwise <- 0 if(Alg %in% c("ADMG","AFSS","AGG","AMWG","CHARM","GG","Gibbs", "MWG","RJ","SAMWG","SMWG","Slice","USAMWG","USMWG")) Componentwise <- 1 if({(Alg == "ADMG") & !Dim.Adapt} | {(Alg == "ADMG") & !Ready}) { ### ADMG n <- object$Specs[["n"]] + object$Iterations cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"ADMG\", ", "Specs=list(n=", n, ", Periodicity=", Rec.Periodicity, "))\n\n", sep="") } else if({Alg == "AFSS"} | {(Alg == "AMWG") & Dim.Adapt & Fast & !Ready} | {(Alg == "AMWG") & Dim.Adapt & !Fast & !Ready} | {(Alg == "AMWG") & !Dim.Adapt & Fast & !Ready} | {(Alg == "AMWG") & !Dim.Adapt & !Fast & !Ready}) { ### AFSS if(Ready == TRUE) A <- 0 else if(Alg == "AFSS") A <- object$Specs[["A"]] else A <- Inf block <- "NULL" if(Alg == "AFSS") m <- paste(oname, "$Specs$m", sep="") else m <- 100 if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]],list())) block <- "Block" if(Alg == "AFSS") n <- object$Specs[["n"]] + object$Iterations else n <- 0 if(Alg == "AFSS") w <- paste(oname, "$CovarDHis[nrow(", oname, "$CovarDHis),]", sep="") else w <- 1 cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"AFSS\", ", "Specs=list(A=", A, ", B=", block, ", m=", m, ",\n", sep="") cat(" n=", n, ", w=", w, "))\n\n", sep="") } else if(Alg == "AGG") { ### AGG Grid <- "GaussHermiteQuadRule(3)$nodes" CPUs <- substr(object$Call, 1, nchar(object$Call))[10] CPUs <- strsplit(CPUs, " ") pos <- grep("CPUs", CPUs[[1]]) CPUs <- as.numeric(strsplit(CPUs[[1]][pos+2], ",")) cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"AGG\", Specs=", oname, "$Specs))\n\n", sep="") } else if({(Alg == "AHMC") & Dim.Adapt & !Ready} | {(Alg == "HMC") & Dim.Adapt & !Ready}) { ### AHMC if(L > 1) { L <- round(L*(Rec.Iterations/object$Iterations)) Rec.Iterations <- object$Iterations Rec.Status <- object$Status Rec.Thinning <- object$Thinning} m <- "NULL" if(!is.null(object$Specs[["m"]]) & !identical(object$Specs[["m"]],list())) m <- paste(oname, "$Specs$m", sep="") cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"AHMC\",\n", sep="") cat(" Specs=list(epsilon=", oname, "$CovarDHis[nrow(", oname, "$CovarDHis),],\n", sep="") cat(" L=", object$Specs[["L"]], ", m=", m, ", Periodicity=", Rec.Periodicity, "))\n\n", sep="") } else if({Alg == "AIES"}) { Nc <- 2*LIV if(Acc.Rate.Level == 1) Nc <- 2 + 20*(0.15 - object$Acceptance.Rate) if(is.null(object$Specs[["Z"]])) Z <- "NULL" else Z <- "object$Specs[[\"Z\"]]" cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"AIES\", Specs=list(Nc=", Nc, ", Z=", Z, ",\n", sep="") cat(" beta=", object$Specs[["beta"]], ", CPUs=", object$Specs[["CPUs"]], ", Packages=NULL, Dyn.libs=NULL))\n\n", sep="") } else if({(Alg == "AM") & Dim.Adapt & Fast & !Ready} | {(Alg == "AM") & Dim.Adapt & !Fast & !Ready}) { ### AM cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"AM\", ", "Specs=list(Adaptive=", Rec.Adaptive, ", Periodicity=", Rec.Periodicity, "))\n\n", sep="") } else if({(Alg == "AHMC") & !Dim.Adapt} | {(Alg == "AM") & !Dim.Adapt & !Fast & Ready} | {(Alg == "AMM") & Dim.Adapt & Fast & !Ready} | {(Alg == "AMM") & Dim.Adapt & !Fast & !Ready} | {(Alg == "DRAM") & !Dim.Adapt & !Fast & Ready} | {(Alg == "DRM") & Dim.Adapt & Fast & !Ready} | {(Alg == "DRM") & Dim.Adapt & !Fast & !Ready} | {(Alg == "RAM") & !Dim.Adapt & !Fast & !Ready} | {(Alg == "RAM") & !Dim.Adapt & Fast & !Ready} | {(Alg == "RWM") & Dim.Adapt & Fast & !Ready} | {(Alg == "RWM") & Dim.Adapt & !Fast & !Ready}) { ### AMM block <- "NULL" if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]],list())) block <- paste(oname, "$Specs$B", sep="") if(Rec.Status > Rec.Iterations) Rec.Status <- Rec.Iterations n <- object$Iterations if(!is.null(object$Specs[["n"]])) n <- object$Specs[["n"]] + object$Iterations w <- 0.05 if(!is.null(object$Specs[["w"]])) w <- object$Specs[["w"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"AMM\", ", "Specs=list(Adaptive=", Rec.Adaptive, ", B=", block, ", n=", n, ",\n", sep="") cat(" Periodicity=", Rec.Periodicity, ", w=", w, "))\n\n", sep="") } else if({(Alg == "AM") & !Dim.Adapt & Fast & Ready} | {(Alg == "AM") & !Dim.Adapt & Fast & !Ready} | {(Alg == "AMM") & !Dim.Adapt & Fast & Ready} | {(Alg == "AMM") & !Dim.Adapt & Fast & !Ready} | {(Alg == "DRAM") & !Dim.Adapt & Fast & Ready} | {(Alg == "DRAM") & !Dim.Adapt & Fast & !Ready} | {(Alg == "MWG") & Dim.Adapt & Fast & !Ready} | {(Alg == "MWG") & Dim.Adapt & !Fast & !Ready}) { ### AMWG if(Componentwise == 0) { Rec.Iterations <- max(nrow(object$Posterior1), trunc(Rec.Iterations / LIV)) Rec.Status <- trunc(interval(trunc(Rec.Status / LIV), 1, Rec.Iterations)) Rec.Thinning <- trunc(Rec.Iterations / nrow(object$Posterior1)) Rec.Iterations <- nrow(object$Posterior1) * Rec.Thinning} if(Rec.Periodicity > Rec.Iterations) Rec.Periodicity <- max(trunc(Rec.Iterations * 0.01),1) block <- "NULL" if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]],list())) block <- paste(oname, "$Specs$B", sep="") n <- object$Iterations if(!is.null(object$Specs[["n"]])) n <- object$Specs[["n"]] + object$Iterations cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"AMWG\", ", "Specs=list(B=", block, ", n=", n, ", Periodicity=", Rec.Periodicity, "))\n\n", sep="") } else if(Alg == "CHARM" & Acc.Rate.Level == 2) { ### CHARM cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"CHARM\", ", "Specs=NULL)\n\n", sep="") } if(Alg == "CHARM" & Acc.Rate.Level != 2) { ### CHARM (Adaptive) al <- 0.44 if(!is.na(object$Specs[["alpha.star"]])) al <- object$Specs[["alpha.star"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"CHARM\", ", "Specs=list(alpha.star=", al, "))\n\n", sep="") } else if(Alg == "DEMC" & Dim.Adapt & !Ready) { ### DEMC Nc <- max(3, round(LIV * 0.03)) gamma <- "NULL" if(!is.null(object$Specs[["gamma"]])) gamma <- object$Specs[["gamma"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"DEMC\", ", "Specs=list(Nc=", Nc, ", Z=", oname, "$Posterior1, ", "gamma=", gamma, ", w=", object$Specs[["w"]],"))\n\n", sep="") } else if({(Alg == "DRAM") & Dim.Adapt & Fast & !Ready} | {(Alg == "DRAM") & Dim.Adapt & !Fast & !Ready}) { ### DRAM cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"DRAM\", ", "Specs=list(Adaptive=", Rec.Adaptive, ", Periodicity=", Rec.Periodicity, "))\n\n", sep="") } else if({(Alg == "DRM") & Dim.Adapt & Fast & Ready} | {(Alg == "DRM") & Dim.Adapt & !Fast & Ready}) { ### DRM cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"DRM\", ", "Specs=NULL))\n\n", sep="") } else if(Alg == "ESS") { ### ESS block <- "NULL" if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]],list())) block <- "Block" cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"ESS\", Specs=list(B=", block, "))\n\n", sep="") } else if(Alg == "GG") { ### GG Grid <- object$Specs[["Grid"]] dparm <- object$Specs[["dparm"]] CPUs <- object$Specs[["CPUs"]] Packages <- object$Specs[["Packages"]] Dyn.libs <- object$Specs[["Dyn.libs"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"GG\", Specs=", oname, "$Specs)\n\n", sep="") } else if(Alg == "Gibbs") { ### Gibbs cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"Gibbs\", ", "Specs=", oname, "$Specs)\n\n", sep="") } else if(Alg == "HARM") { ### HARM al <- 0.234 if(is.na(object$Specs[["alpha.star"]]) | !is.null(object$Specs[["alpha.star"]])) al <- object$Specs[["alpha.star"]] block <- "NULL" if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]],list())) block <- "Block" cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"HARM\", ", "Specs=list(alpha.star=", al, ", B=", block, ")\n\n", sep="") } else if({(Alg == "AHMC") & Dim.Adapt & Ready} | {(Alg == "HMC") & Dim.Adapt & Ready}) { ### HMC if(L > 1) { L <- round(L*(Rec.Iterations/object$Iterations)) Rec.Iterations <- object$Iterations Rec.Status <- object$Status Rec.Thinning <- object$Thinning} m <- "NULL" if(!is.null(object$Specs[["m"]]) & !identical(object$Specs[["m"]],list())) m <- paste(oname, "$Specs$m", sep="") cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"HMC\", ", "Specs=list(epsilon=", oname, "$CovarDHis[1,], ", sep="") cat("L=", L, ", m=", m, "))\n\n", sep="") } else if(Alg == "HMCDA" & Dim.Adapt) { ### HMCDA cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"HMCDA\", ", "Specs=list(A=", round(Rec.Iterations/2), ", delta=", object$Specs[["delta"]], ",\n", sep="") cat(" epsilon=", round(object$CovarDHis[nrow(object$CovarDHis),1],3), ", Lmax=", object$Specs[["Lmax"]], ", lambda=", object$Specs[["lambda"]], "))\n\n", sep="") } else if(Alg == "IM") { ### IM cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"IM\", ", "Specs=list(mu=apply(", oname, "$Posterior1, 2, mean)))\n\n", sep="") } else if(Alg == "INCA") { ### INCA detectedcores <- detectCores() cat(oname, " <- LaplacesDemon.hpc(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"INCA\", ", "Specs=list(Adaptive=", Rec.Adaptive, ", Periodicity=", Rec.Periodicity, "),\n", sep="") cat(" Chains=",detectedcores, ", CPUs=", detectedcores, ", Packages=NULL, Dyn.libs=NULL)\n\n", sep="") } else if(Alg == "MALA") { ### MALA A <- object$Specs[["A"]] alpha.star <- object$Specs[["alpha.star"]] if(Dim.Adapt & Ready) gamma <- 0 else gamma <- object$Specs[["gamma"]] delta <- object$Specs[["delta"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"MALA\", ", "Specs=list(A=", A, ", alpha.star=", alpha.star, ",\n", sep="") cat(" gamma=", gamma, ", delta=", delta, ", epsilon=c(1e-6, 1e-7)))\n\n", sep="") } else if(Alg == "MCMCMC") { ### MCMCMC lambda <- object$Specs[["lambda"]] CPUs <- object$Specs[["CPUs"]] Packages <- object$Specs[["Packages"]] Dyn.libs <- object$Specs[["Dyn.libs"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname,"$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"MCMCMC\", Specs=list(lambda=", lambda, ", CPUs=", CPUs, ", Packages=NULL, Dyn.libs=NULL))\n\n", sep="") } else if(Alg == "MTM") { ### MTM K <- object$Specs[["K"]] CPUs <- object$Specs[["CPUs"]] Packages <- object$Specs[["Packages"]] Dyn.libs <- object$Specs[["Dyn.libs"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname,"$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"MTM\", Specs=list(K=", K, ", CPUs=", CPUs, ", Packages=NULL, Dyn.libs=NULL))\n\n", sep="") } else if({(Alg == "ADMG") & Dim.Adapt & Fast & Ready} | {(Alg == "ADMG") & Dim.Adapt & !Fast & Ready} | {(Alg == "AMWG") & Dim.Adapt & Fast & Ready} | {(Alg == "AMWG") & Dim.Adapt & !Fast & Ready} | {(Alg == "MWG") & Dim.Adapt & Fast & Ready} | {(Alg == "MWG") & Dim.Adapt & !Fast & Ready}) { ### MWG block <- "NULL" if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]],list())) block <- paste(oname, "$Specs$B", sep="") cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"MWG\", ", "Specs=list(B=", block, "))\n\n", sep="") } else if({Alg == "NUTS"} | {(Alg == "HMCDA") & !Dim.Adapt}) { ### NUTS if(Alg == "HMCDA") delta <- 0.6 else delta <- object$Specs[["delta"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"NUTS\", ", "Specs=list(A=", round(Rec.Iterations/2), ", delta=", delta, ",\n", sep="") cat(" epsilon=", max(round(object$CovarDHis[nrow(object$CovarDHis),1],3), 1e-10), ", Lmax=", object$Specs[["Lmax"]], "))\n\n", sep="") } else if(Alg == "OHSS") { ### OHSS if(Ready == TRUE) A <- 0 else A <- object$Specs[["A"]] n <- object$Specs[["n"]] + object$Iterations cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"OHSS\", ", "Specs=list(A=", A, ", n=", n,"))\n\n", sep="") } else if(Alg == "pCN") { ### pCN beta <- object$Specs[["beta"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"RWM\", ", "Specs=list(beta=", beta, "))\n\n", sep="") } else if({(Alg == "AM") & !Dim.Adapt & !Fast & !Ready} | {(Alg == "AMM") & !Dim.Adapt & !Fast & Ready} | {(Alg == "AMM") & !Dim.Adapt & !Fast & !Ready} | {(Alg == "DRAM") & !Dim.Adapt & !Fast & !Ready} | {(Alg == "RAM") & Dim.Adapt & Fast & !Ready} | {(Alg == "RAM") & Dim.Adapt & !Fast & !Ready}) { ### RAM al <- 0.234 if(!is.null(object$Specs[["alpha.star"]])) al <- object$Specs[["alpha.star"]] block <- "NULL" if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]],list())) block <- paste(oname, "$Specs$B", sep="") Dist <- "N" if(!is.null(object$Specs[["Dist"]])) Dist <- object$Specs[["Dist"]] gamma <- 0.66 if(!is.null(object$Specs[["gamma"]])) gamma <- object$Specs[["gamma"]] n <- object$Iterations if(!is.null(object$Specs[["n"]])) n <- object$Specs[["n"]] + object$Iterations if(Rec.Status > Rec.Iterations) Rec.Status <- Rec.Iterations cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"RAM\", ", "Specs=list(alpha.star=", al, ", B=", block, ", Dist=\"", Dist, "\",\n", sep="") cat(" gamma=", gamma, ", n=", n, "))\n\n", sep="") } else if(Alg == "RDMH") { ### RDMH cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"RDMH\", ", "Specs=NULL)\n\n", sep="") } else if(Alg == "Refractive") { ### Refractive Adaptive <- object$Specs[["Adaptive"]] m <- object$Specs[["m"]] w <- object$Specs[["w"]] if(Adaptive < object$Iterations) w <- object$CovarDHis[nrow(object$CovarDHis),1] if(!Dim.Adapt) Adaptive <- 1 else Adaptive <- Rec.Iterations + 1 cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"Refractive\", ", "Specs=list(Adaptive=", Adaptive, ", m=", m, ", w=", w, ", r=1.3))\n\n", sep="") } else if(Alg == "RJ" & (Acc.Rate.Level > 1)) { ### RJ cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"RJ\", ", "Specs=list(bin.n=", object$Specs[["bin.n"]], ", bin.p=", object$Specs[["bin.p"]], ",\n", sep="") cat(" parm.p=", paste("c(", paste(object$Specs[["parm.p"]], collapse=","), ")", sep=""), ",\n", sep="") cat(" selectable=", paste("c(", paste(object$Specs[["selectable"]], collapse=","), ")", sep=""), ",\n", sep="") cat(" selected=1*(Initial.Values != 0)))\n\n", sep="") } else if(Alg == "RSS") { ### RSS cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"RSS\", ", "Specs=", oname, "$Specs)\n\n", sep="") } else if({(Alg == "AM") & Dim.Adapt & Fast & Ready} | {(Alg == "AM") & Dim.Adapt & !Fast & Ready} | {(Alg == "AMM") & Dim.Adapt & Fast & Ready} | {(Alg == "AMM") & Dim.Adapt & !Fast & Ready} | {(Alg == "DRAM") & Dim.Adapt & Fast & Ready} | {(Alg == "DRAM") & Dim.Adapt & !Fast & Ready} | {(Alg == "RAM") & !Dim.Adapt & !Fast & Ready} | {(Alg == "RAM") & !Dim.Adapt & Fast & Ready} | {(Alg == "RAM") & Dim.Adapt & Fast & Ready} | {(Alg == "RAM") & Dim.Adapt & !Fast & Ready} | {(Alg == "RWM") & Dim.Adapt & Fast & Ready} | {(Alg == "RWM") & Dim.Adapt & !Fast & Ready}) { ### RWM block <- "NULL" if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]], list())) block <- "Block" cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"RWM\", ", "Specs=list(B=", block, "))\n\n", sep="") } else if({(Alg == "DEMC") & Dim.Adapt & Fast & Ready} | {(Alg == "DEMC") & Dim.Adapt & !Fast & Ready}) { ### RWM from DEMC cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=cov(", oname, "$Posterior2), Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"RWM\", ", "Specs=NULL)\n\n", sep="") } else if({(Alg == "SAMWG") & !Ready} | {(Alg == "SMWG") & !Ready}) { ### SAMWG cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"SAMWG\", ", "Specs=list(Dyn=Dyn, Periodicity=", Rec.Periodicity, "))\n\n", sep="") } else if({(Alg == "SAMWG") & Ready} | {(Alg == "SMWG") & Ready}) { ### SMWG cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"SMWG\", ", "Specs=list(Dyn=Dyn))\n\n", sep="") } else if(Alg == "SGLD") { ### SGLD eps <- object$Specs[["epsilon"]] Fi <- object$Specs[["file"]] nr <- object$Specs[["Nr"]] nc <- object$Specs[["Nc"]] size <- object$Specs[["size"]] cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"SGLD\", ", "Specs=", oname, "$Specs)\n\n", sep="") } else if(Alg == "Slice") { ### Slice block <- "NULL" if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]],list())) block <- paste(oname, "$Specs$B", sep="") Bounds <- "c(-Inf,Inf)" if(!is.null(object$Specs[["Bounds"]]) & !identical(object$Specs[["Bounds"]],list())) Bounds <- paste(oname, "$Specs$Bounds", sep="") m <- "Inf" if(!is.null(object$Specs[["m"]]) & !identical(object$Specs[["m"]],list())) m <- paste(oname, "$Specs$m", sep="") Type <- "\"Continuous\"" if(!is.null(object$Specs[["Type"]]) & !identical(object$Specs[["Type"]],list())) Type <- paste(oname, "$Specs$Type", sep="") w <- 1 if(!is.null(object$Specs[["w"]]) & !identical(object$Specs[["w"]],list())) w <- paste(oname, "$Specs$w", sep="") cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"Slice\", ", "Specs=list(B=", block, ", Bounds=", Bounds, ",\n", sep="") cat(" m=", m, ", Type=", Type, ", w=", w, "))\n\n", sep="") } else if(Alg == "THMC") { ### THMC if(L > 1) { L <- round(L*(Rec.Iterations/object$Iterations)) Rec.Iterations <- object$Iterations Rec.Status <- object$Status Rec.Thinning <- object$Thinning} m <- "NULL" if(!is.null(object$Specs[["m"]]) & !identical(object$Specs[["m"]],list())) m <- paste(oname, "$Specs$m", sep="") cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"THMC\", ", "Specs=list(epsilon=", oname, "$CovarDHis[1,],\n", sep="") cat(" L=", L, ", m=", m, ", Temperature=", object$Specs[["Temperature"]], "))\n\n", sep="") } else if(Alg == "t-walk" | {(Alg == "DEMC") & !Dim.Adapt}) { ### twalk if(Alg == "DEMC") { n1 <- 4 at <- 6 aw <- 1.5 } else { n1 <- object$Specs[["n1"]] at <- object$Specs[["at"]] aw <- object$Specs[["aw"]]} cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=NULL, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"twalk\", ", "Specs=list(SIV=NULL, n1=", n1, ", at=", at, ", aw=", aw, "))\n\n", sep="") } else if(Alg == "UESS") { ### UESS if(Ready == TRUE) A <- 0 else A <- object$Specs[["A"]] block <- "NULL" if(!is.null(object$Specs[["B"]]) & !identical(object$Specs[["B"]],list())) block <- "Block" m <- object$Specs[["m"]] n <- object$Specs[["n"]] + object$Iterations cat(oname, " <- LaplacesDemon(Model, Data=", dname, ", Initial.Values,\n", sep="") cat(" Covar=", oname, "$Covar, Iterations=", Rec.Iterations, ", Status=", Rec.Status, ", ", "Thinning=", Rec.Thinning, ",\n", sep="") cat(" Algorithm=\"UESS\", ", "Specs=list(A=", A, ", B=", block, ", m=", m, ", n=", n, "))\n\n", sep="") } else if((Alg == "USAMWG") | (Alg == "USMWG")) { ### USAMWG or USMWG cat("A Demonic Suggestion will not be made.\n\n") } } cat("Laplace's Demon is finished consorting.\n") } #End LaplacesDemon/R/Combine.R0000755000176200001440000002647415144316355014710 0ustar liggesusers########################################################################### # Combine # # # # The purpose of the Combine function is to combine multiple objects of # # class demonoid. # ########################################################################### Combine <- function(x, Data, Thinning=1) { ### Initial Checks if(missing(x)) stop("x is a required argument.") if(missing(Data)) stop("Data is a required argument.") Thinning <- abs(round(Thinning)) len.x <- length(x) if(!all(sapply(x, class) == "demonoid")) { stop("At least one item in list x is not of class demonoid.")} Acceptance.Rate <- round(sum(sapply(x, with, Acceptance.Rate) * sapply(x, with, Iterations)) / sum(sapply(x, with, Iterations)),5) Algorithm <- x[[1]]$Algorithm Covar <- x[[len.x]]$Covar Iterations <- sum(sapply(x, with, Iterations)) Model <- x[[1]]$Model Minutes <- sum(sapply(x, with, Minutes)) Status <- round(mean(sapply(x, with, Status))) LIV <- x[[1]]$Parameters ### Combine thinned <- x[[1]]$Posterior1 Dev <- matrix(x[[1]]$Deviance) Mon <- x[[1]]$Monitor for (i in 2:len.x) { thinned <- rbind(thinned, x[[i]]$Posterior1) Dev <- rbind(Dev, matrix(x[[i]]$Deviance)) Mon <- rbind(Mon, x[[i]]$Monitor) } ### Thinning if(Thinning > 1) { thinned <- Thin(thinned, By=Thinning) Dev <- matrix(Thin(Dev, By=Thinning)) Mon <- Thin(Mon, By=Thinning)} thinned.rows <- nrow(thinned) ### Assess Stationarity cat("\nAssessing Stationarity\n") if(thinned.rows %% 10 == 0) thinned2 <- thinned if(thinned.rows %% 10 != 0) thinned2 <- thinned[1:(10*trunc(thinned.rows/10)),] HD <- BMK.Diagnostic(thinned2, batches=10) Ind <- 1 * (HD > 0.5) BurnIn <- thinned.rows batch.list <- seq(from=1, to=nrow(thinned2), by=floor(nrow(thinned2)/10)) for (i in 1:9) { if(sum(Ind[,i:9]) == 0) { BurnIn <- batch.list[i] - 1 break } } Stat.at <- BurnIn + 1 rm(batch.list, HD, Ind, thinned2) ### Assess Thinning and ESS Size for all parameter samples cat("Assessing Thinning and ESS\n") acf.rows <- trunc(10*log10(thinned.rows)) acf.temp <- matrix(1, acf.rows, LIV) ESS1 <- Rec.Thin <- rep(1, LIV) for (j in 1:LIV) { temp0 <- acf(thinned[,j], lag.max=acf.rows, plot=FALSE) if(length(temp0$acf[-1,1,1]) == acf.rows) acf.temp[,j] <- abs(temp0$acf[-1,1,1]) ESS1[j] <- ESS(thinned[,j]) Rec.Thin[j] <- which(acf.temp[,j] <= 0.1)[1]*Thinning} Rec.Thin[which(is.na(Rec.Thin))] <- nrow(acf.temp) ### Assess ESS for all deviance and monitor samples ESS2 <- ESS(Dev) ESS3 <- ESS(Mon) ### Assess ESS for stationary samples if(Stat.at < thinned.rows) { ESS4 <- ESS(thinned[Stat.at:thinned.rows,]) ESS5 <- ESS(Dev[Stat.at:thinned.rows,]) ESS6 <- ESS(Mon[Stat.at:thinned.rows,]) } ### Posterior Summary Table 1: All Thinned Samples cat("Creating Summaries\n") Num.Mon <- ncol(Mon) Summ1 <- matrix(NA, LIV, 7, dimnames=list(Data[["parm.names"]], c("Mean","SD","MCSE","ESS","LB","Median","UB"))) Summ1[,1] <- colMeans(thinned) Summ1[,2] <- sqrt(.colVars(thinned)) Summ1[,3] <- 0 Summ1[,4] <- ESS1 Summ1[,5] <- apply(thinned, 2, quantile, c(0.025), na.rm=TRUE) Summ1[,6] <- apply(thinned, 2, quantile, c(0.500), na.rm=TRUE) Summ1[,7] <- apply(thinned, 2, quantile, c(0.975), na.rm=TRUE) for (i in 1:ncol(thinned)) { temp <- try(MCSE(thinned[,i]), silent=TRUE) if(!inherits(temp, "try-error")) Summ1[i,3] <- temp else Summ1[i,3] <- MCSE(thinned[,i], method="sample.variance")} Deviance <- rep(NA,7) Deviance[1] <- mean(Dev) Deviance[2] <- sd(as.vector(Dev)) temp <- try(MCSE(as.vector(Dev)), silent=TRUE) if(inherits(temp, "try-error")) temp <- MCSE(as.vector(Dev), method="sample.variance") Deviance[3] <- temp Deviance[4] <- ESS2 Deviance[5] <- as.numeric(quantile(Dev, probs=0.025, na.rm=TRUE)) Deviance[6] <- as.numeric(quantile(Dev, probs=0.500, na.rm=TRUE)) Deviance[7] <- as.numeric(quantile(Dev, probs=0.975, na.rm=TRUE)) Summ1 <- rbind(Summ1, Deviance) for (j in 1:Num.Mon) { Monitor <- rep(NA,7) Monitor[1] <- mean(Mon[,j]) Monitor[2] <- sd(as.vector(Mon[,j])) temp <- try(MCSE(as.vector(Mon[,j])), silent=TRUE) if(inherits(temp, "try-error")) temp <- MCSE(Mon[,j], method="sample.variance") Monitor[3] <- temp Monitor[4] <- ESS3[j] Monitor[5] <- as.numeric(quantile(Mon[,j], probs=0.025, na.rm=TRUE)) Monitor[6] <- as.numeric(quantile(Mon[,j], probs=0.500, na.rm=TRUE)) Monitor[7] <- as.numeric(quantile(Mon[,j], probs=0.975, na.rm=TRUE)) Summ1 <- rbind(Summ1, Monitor) rownames(Summ1)[nrow(Summ1)] <- Data[["mon.names"]][j] } ### Posterior Summary Table 2: Stationary Samples Summ2 <- matrix(NA, LIV, 7, dimnames=list(Data[["parm.names"]], c("Mean","SD","MCSE","ESS","LB","Median","UB"))) if(Stat.at < thinned.rows) { thinned2 <- matrix(thinned[Stat.at:thinned.rows,], thinned.rows-Stat.at+1, ncol(thinned)) Dev2 <- matrix(Dev[Stat.at:thinned.rows,], thinned.rows-Stat.at+1, ncol(Dev)) Mon2 <- matrix(Mon[Stat.at:thinned.rows,], thinned.rows-Stat.at+1, ncol(Mon)) Summ2[,1] <- colMeans(thinned2) Summ2[,2] <- sqrt(.colVars(thinned2)) Summ2[,3] <- 0 Summ2[,4] <- ESS4 Summ2[,5] <- apply(thinned2, 2, quantile, c(0.025), na.rm=TRUE) Summ2[,6] <- apply(thinned2, 2, quantile, c(0.500), na.rm=TRUE) Summ2[,7] <- apply(thinned2, 2, quantile, c(0.975), na.rm=TRUE) for (i in 1:ncol(thinned2)) { temp <- try(MCSE(thinned2[,i]), silent=TRUE) if(!inherits(temp, "try-error")) Summ2[i,3] <- temp else Summ2[i,3] <- MCSE(thinned2[,i], method="sample.variance")} Deviance <- rep(NA,7) Deviance[1] <- mean(Dev2) Deviance[2] <- sd(as.vector(Dev2)) temp <- try(MCSE(as.vector(Dev2)), silent=TRUE) if(inherits(temp, "try-error")) temp <- MCSE(as.vector(Dev2), method="sample.variance") Deviance[3] <- temp Deviance[4] <- ESS5 Deviance[5] <- as.numeric(quantile(Dev2, probs=0.025, na.rm=TRUE)) Deviance[6] <- as.numeric(quantile(Dev2, probs=0.500, na.rm=TRUE)) Deviance[7] <- as.numeric(quantile(Dev2, probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Deviance) for (j in 1:Num.Mon) { Monitor <- rep(NA,7) Monitor[1] <- mean(Mon2[,j]) Monitor[2] <- sd(as.vector(Mon2[,j])) temp <- try(MCSE(as.vector(Mon[,j])), silent=TRUE) if(inherits(temp, "try-error")) temp <- MCSE(as.vector(Mon[,j]), method="sample.variance") Monitor[3] <- temp Monitor[4] <- ESS6[j] Monitor[5] <- as.numeric(quantile(Mon2[,j], probs=0.025, na.rm=TRUE)) Monitor[6] <- as.numeric(quantile(Mon2[,j], probs=0.500, na.rm=TRUE)) Monitor[7] <- as.numeric(quantile(Mon2[,j], probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Monitor) rownames(Summ2)[nrow(Summ2)] <- Data[["mon.names"]][j]} } ### Column names to samples if(identical(ncol(Mon), length(Data[["mon.names"]]))) colnames(Mon) <- Data[["mon.names"]] if(identical(ncol(thinned), length(Data[["parm.names"]]))) { colnames(thinned) <- Data[["parm.names"]]} ### Logarithm of the Marginal Likelihood LML <- list(LML=NA, VarCov=NA) if(Algorithm %in% c("Adaptive Griddy-Gibbs", "Affine-Invariant Ensemble Sampler", "Automated Factor Slice Sampler", "Componentwise Hit-And-Run Metropolis", "Delayed Rejection Metropolis", "Elliptical Slice Sampler", "Gibbs Sampler", "Griddy-Gibbs", "Hamiltonian Monte Carlo", "Hit-And-Run Metropolis", "Independence Metropolis", "Metropolis-Adjusted Langevin Algorithm", "Metropolis-Coupled Markov Chain Monte Carlo", "Metropolis-within-Gibbs", "Multiple-Try Metropolis", "No-U-Turn Sampler", "Oblique Hyperrectangle Slice Sampler", "Preconditioned Crank-Nicolson", "Random Dive Metropolis-Hastings", "Random-Walk Metropolis", "Reflective Slice Sampler", "Refractive Sampler", "Reversible-Jump", "Sequential Metropolis-within-Gibbs", "Slice Sampler", "Stochastic Gradient Langevin Dynamics", "Tempered Hamiltonian Monte Carlo", "t-walk", "Univariate Eigenvector Slice Sampler") & {Stat.at < thinned.rows}) { cat("Estimating Log of the Marginal Likelihood\n") LML <- LML(theta=thinned2, LL=as.vector(Dev2)*(-1/2), method="NSIS")} ### Compile Output cat("Creating Output\n") LaplacesDemon.out <- list(Acceptance.Rate=Acceptance.Rate, Algorithm=Algorithm, Call=x[[1]]$Call, Covar=Covar, CovarDHis=x[[len.x]]$CovarDHis, Deviance=as.vector(Dev), DIC1=c(mean(as.vector(Dev)), var(as.vector(Dev))/2, mean(as.vector(Dev)) + var(as.vector(Dev))/2), DIC2=if(Stat.at < thinned.rows) { c(mean(as.vector(Dev2)), var(as.vector(Dev2))/2, mean(as.vector(Dev2)) + var(as.vector(Dev2))/2)} else rep(NA,3), Initial.Values=x[[len.x]]$Initial.Values, Iterations=Iterations, LML=LML[[1]], Minutes=Minutes, Model=Model, Monitor=Mon, Parameters=LIV, Posterior1=thinned, Posterior2=if(Stat.at < thinned.rows) { thinned[Stat.at:thinned.rows,]} else thinned[thinned.rows,], Rec.BurnIn.Thinned=BurnIn, Rec.BurnIn.UnThinned=BurnIn*Thinning, Rec.Thinning=min(1000, max(Rec.Thin)), Specs=x[[1]]$Specs, Status=Status, Summary1=Summ1, Summary2=Summ2, Thinned.Samples=thinned.rows, Thinning=Thinning) class(LaplacesDemon.out) <- "demonoid" cat("\nLaplace's Demon has finished.\n") return(LaplacesDemon.out) } #End LaplacesDemon/R/plot.iterquad.R0000755000176200001440000001123115144342743016110 0ustar liggesusers########################################################################### # plot.iterquad # # # # The purpose of the plot.iterquad function is to plot an object of class # # iterquad. # ########################################################################### plot.iterquad <- function(x, Data=NULL, PDF=FALSE, Parms=NULL, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "iterquad")) stop("x must be of class iterquad.") if(is.null(Data)) stop("The Data argument is NULL.") if(any(is.na(x$History))) stop("There is no history to plot.") ### Selecting Parms if(is.null(Parms)) { History <- x$History Posterior <- x$Posterior} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], colnames(x$History))) == 0) stop("Parameter in Parms does not exist.") keepcols <- grep(Parms[1], colnames(x$History)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], colnames(x$History))) == 0) stop("Parameter in Parms does not exist.") keepcols <- c(keepcols, grep(Parms[i], colnames(x$History)))}} History <- as.matrix(x$History[,keepcols]) colnames(History) <- colnames(x$History)[keepcols] if(all(!is.na(x$Posterior))) { Posterior <- as.matrix(x$Posterior[,keepcols]) colnames(Posterior) <- colnames(History)} else Posterior <- x$Posterior } if(PDF == TRUE) { pdf("IterativeQuadrature.Plots.pdf") par(mfrow=c(2,2)) } else {par(mfrow=c(2,2), ask=TRUE)} ### Plot Parameter for (j in 1:ncol(History)) { plot(1:nrow(History), History[,j], type="l", xlab="Iterations", ylab="Value", main=colnames(History)[j]) LPw <- x$LPw[,j] Mw <- x$M[,j] if(sum(Mw) > 0) Mw <- Mw / sum(Mw) Z <- x$Z[,j] LPw <- as.vector(by(LPw, Z, max)) Mw <- as.vector(by(Mw, Z, max)) Z <- unique(Z) o <- order(Z) LPw <- LPw[o] Mw <- Mw[o] Z <- Z[o] covdens <- dnorm(Z, History[nrow(History),j], sqrt(diag(x$Covar))[j]) if(sum(covdens) > 0) covdens <- covdens / sum(covdens) if({x$Converged == TRUE} & !any(is.na(Posterior))) { dens <- density(Posterior[,j]) if(sum(dens$y) > 0) dens$y <- dens$y / sum(dens$y) x.lim <- range(c(Z,dens$x)) y.lim <- c(0, max(Mw, LPw, covdens, dens$y)) } else { x.lim <- range(Z) y.lim <- c(0, max(Mw, LPw, covdens)) } plot(Z, Mw, type="h", xlim=x.lim, ylim=y.lim, col="white", main=colnames(History)[j], xlab="Value", ylab="Normalized Density") polygon(c(Z, rev(Z)), c(rep(0,length(LPw)), rev(covdens)), col=rgb(0,255,0,50,maxColorValue=255), border=NA) if({x$Converged == TRUE} & !any(is.na(Posterior))) polygon(dens, col=rgb(0,0,255,50,maxColorValue=255), border=NA) polygon(c(Z, rev(Z)), c(rep(0,length(Mw)),rev(Mw)), col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(c(Z, rev(Z)), c(rep(0,length(LPw)),rev(LPw)), col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=0, col="red", lty=2) lines(Z, Mw, type="h") lines(Z, LPw, type="h", col="red") } ### Plot Deviance History plot(1:length(x$Deviance), x$Deviance, type="l", xlab="Iterations", ylab="Value", main="Deviance") ### Plot Monitor if({x$Converged == TRUE} & !any(is.na(x$Monitor))) { for (j in 1:ncol(x$Monitor)) { plot(density(x$Monitor[,j]), xlab="Value", main=Data[["mon.names"]][j]) polygon(density(x$Monitor[,j]), col="black", border="black") abline(v=0, col="red", lty=2)} } if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/plotMatrix.R0000755000176200001440000001324415144316355015466 0ustar liggesusers########################################################################### # plotMatrix # # # # The purpose of the plotMatrix function is to plot a numerical matrix. # ########################################################################### plotMatrix <- function(x, col=colorRampPalette(c("red","black","green"))(100), cex=1, circle=TRUE, order=FALSE, zlim=NULL, title="", PDF=FALSE, ...) { ### Initial Checks if(missing(x)) stop("x is a required argument.") if(identical(class(x), "bayesfactor")) { x <- x$B title <- "Bayes Factors"} else if(identical(class(x), "demonoid")) { if(is.null(x$Covar) | is.list(x$Covar) | is.vector(x$Covar)) stop("Covar=NULL.") x <- x$Covar title <- "Covariance"} else if(identical(class(x), "iterquad")) { if(is.null(x$Covar)) stop("Covar=NULL.") x <- x$Covar title <- "Covariance"} else if(identical(class(x), "laplace")) { if(is.null(x$Covar)) stop("Covar=NULL.") x <- x$Covar title <- "Covariance"} else if(identical(class(x), "pmc")) { if(is.null(x$Covar)) stop("Covar=NULL.") x <- x$Covar title <- "Covariance"} else if(identical(class(x), "posteriorchecks")) { x <- x$Posterior.Correlation title <- "Posterior Correlation"} else if(identical(class(x), "vb")) { if(is.null(x$Covar)) stop("Covar=NULL.") x <- x$Covar title <- "Covariance"} else if(!is.matrix(x)) x <- as.matrix(x) min <- min(x) max <- max(x) yLabels <- rownames(x) xLabels <- colnames(x) if(is.null(rownames(x))) xLabels <- 1:nrow(x) if(is.null(colnames(x))) yLabels <- 1:ncol(x) if(!is.null(zlim)) { if(length(zlim) != 2) stop("zlim must have length 2.") if(zlim[1] >= zlim[2]) stop("zlim[1] must be lower than zlim[2].") min <- zlim[1] max <- zlim[2]} if(circle == TRUE & order == TRUE) { if(!nrow(x) == ncol(x)) stop("The matrix must be square if order is TRUE.") x.eigen <- eigen(x)$vectors[, 1:2] e1 <- x.eigen[, 1] e2 <- x.eigen[, 2] alpha <- ifelse(e1 > 0, atan(e2/e1), atan(e2/e1) + pi) x <- x[order(alpha), order(alpha)] yLabels <- rownames(x) xLabels <- colnames(x)} ### Plot Matrix if(PDF == TRUE) pdf("plotMatrix.pdf") if(circle == FALSE) { ### Layout and Colors layout(matrix(data=c(1,2), nrow=1, ncol=2), widths=c(4,1), heights=c(1,1)) ColorRamp <- col ColorLevels <- seq(min, max, length=length(ColorRamp)) ### Reverse y-axis reverse <- nrow(x):1 yLabels <- yLabels[reverse] x <- x[reverse,] ### Data Map par(mar = c(3,5,2.5,2)) image(1:length(xLabels), 1:length(yLabels), t(x), col=ColorRamp, xlab="", ylab="", axes=FALSE, zlim=c(min,max)) if(!is.null(title)) title(main=title) axis(BELOW<-1, at=1:length(xLabels), labels=xLabels, cex.axis=0.7) axis(LEFT <-2, at=1:length(yLabels), labels=yLabels, las=HORIZONTAL<-1, cex.axis=0.7) par(mar=c(3,2.5,2.5,2)) image(1, ColorLevels, matrix(data=ColorLevels, ncol=length(ColorLevels), nrow=1), col=ColorRamp, xlab="", ylab="", xaxt="n") layout(1)} else { col <- col[length(col):1] ### Scale Covariance/Precision Matrices maxel <- max(abs(x)) if(maxel > 1) x <- x * (1/maxel) ### Plot Setup par(mar=c(0, 0, 2, 0), bg="white") plot.new() plot.window(c(0, ncol(x)), c(0, nrow(x)), asp=1) cex.x <- 1 / {log(length(xLabels))/5 + 1} cex.y <- 1 / {log(length(yLabels))/5 + 1} xlabwidth <- max(strwidth(yLabels, cex=cex)) ylabwidth <- max(strwidth(xLabels, cex=cex)) plot.window(c(-xlabwidth + 0.5, ncol(x) + 0.5), c(0, nrow(x) + 1 + ylabwidth), asp=1, xlab="", ylab="") bg <- "gray10" rect(0.5, 0.5, ncol(x) + 0.5, nrow(x) + 0.5, col=bg) text(rep(-xlabwidth/2, nrow(x)), nrow(x):1, xLabels, col="black", cex=cex.x) text(1:ncol(x), rep(nrow(x) + 1 + ylabwidth/2, ncol(x)), yLabels, srt=90, col="black", cex=cex.y) ### Add grid lines <- "gray30" segments(rep(0.5, nrow(x) + 1), 0.5 + 0:nrow(x), rep(ncol(x) + 0.5, nrow(x) + 1), 0.5 + 0:nrow(x), col=lines) segments(0.5 + 0:ncol(x), rep(0.5, ncol(x) + 1), 0.5 + 0:ncol(x), rep(nrow(x) + 0.5, ncol(x)), col=lines) ### Assign circles' fill color nc <- length(col) if(nc==1) bg <- rep(col, prod(dim(x))) else { ff <- seq(-1,1, length=nc+1) bg2 <- rep(0, prod(dim(x))) for (i in 1:prod(dim((x)))) { bg2[i] <- rank(c(ff[2:nc], as.vector(x)[i]), ties.method="random")[nc]} bg <- (col[nc:1])[bg2]} ### Plot n*m circles using vector language, suggested by Yihui Xie ### the area of circles denotes the absolute value of coefficient symbols(rep(1:ncol(x), each=nrow(x)), rep(nrow(x):1, ncol(x)), add=TRUE, inches=F, circles=as.vector(sqrt(abs(x))/2), bg=as.vector(bg)) } if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/is.proper.R0000755000176200001440000000225015144341567015242 0ustar liggesusers########################################################################### # is.proper # # # # The purpose of the is.proper function is to provide a logical check of # # whether or not a probability distribution is proper, meaning whether or # # not it integrates to one. # ########################################################################### is.proper <- function(f, a, b, tol=1e-5) { ### Initial Checks if(!is.function(f) & !inherits(f, "demonoid") & !inherits(f, "iterquad") & !inherits(f, "laplace") & !inherits(f, "pmc")) stop("f is not a function or object of class demonoid, iterquad, laplace, or pmc.") ### Propriety propriety <- FALSE if(is.function(f)) { if(a >= b) stop("a >= b.") area <- integrate(f,a,b)$value if((area >= (1-tol)) & (area <= (1+tol))) propriety <- TRUE } else if(is.finite(f$LML)) propriety <- TRUE return(propriety) } #End LaplacesDemon/R/print.vb.R0000755000176200001440000000354115144316355015064 0ustar liggesusers########################################################################### # print.vb # # # # The purpose of the print.vb function is to print the contents of an # # object of class vb to the screen. # ########################################################################### print.vb <- function(x, ...) { if(missing(x)) stop("The x argument is required.") cat("\nCall:\n") print(x$Call) cat("\nConverged: ", x$Converged, "\n", sep="") cat("Covariance Matrix: (NOT SHOWN HERE; diagonal shown instead)\n") print(diag(x$Covar)) cat("\nDeviance (Final): ", x$Deviance[length(x$Deviance)], "\n") cat("History: (NOT SHOWN HERE)\n") cat("Initial Values:\n") print(x$Initial.Values) cat("\nIterations: ", x$Iterations, "\n", sep="") cat("Log(Marginal Likelihood): ", x$LML, "\n", sep="") cat("Log-Posterior (Final): ", x$LP.Final, "\n", sep="") cat("Log-Posterior (Initial): ", x$LP.Initial, "\n", sep="") cat("Minutes of run-time: ", x$Minutes, "\n", sep="") cat("Monitor: (NOT SHOWN HERE)\n") cat("Posterior: (NOT SHOWN HERE)\n") cat("Step Size (Final): ") print(x$Step.Size.Final) cat("Step Size (Initial): ", x$Step.Size.Initial, "\n", sep="") cat("Summary1: (SHOWN BELOW)\n") cat("Summary2: (SHOWN BELOW)\n") cat("Tolerance (Final): ", x$Tolerance.Final, "\n", sep="") cat("Tolerance (Stop): ", x$Tolerance.Stop, "\n", sep="") cat("\nSummary1:\n") print(x$Summary1) if({x$Converged == TRUE} && !any(is.na(x$Posterior))) { cat("\nSummary2:\n") print(x$Summary2)} invisible(x) } #End LaplacesDemon/R/PMC.R0000755000176200001440000004244015144316355013742 0ustar liggesusers########################################################################### # PMC # # # # The purpose of the PMC function is update a model with Population # # Monte Carlo. # ########################################################################### PMC <- function(Model, Data, Initial.Values, Covar=NULL, Iterations=10, Thinning=1, alpha=NULL, M=1, N=1000, nu=9, CPUs=1, Type="PSOCK") { cat("\nPMC was called on ", date(), "\n", sep="") time1 <- proc.time() pmc.call <- match.call() ########################## Initial Checks ########################## cat("\nPerforming initial checks...\n") if(missing(Model)) stop("A function must be entered for Model.") if(!is.function(Model)) stop("Model must be a function.") if(missing(Data)) stop("A list containing data must be entered for Data.") if(is.null(Data[["mon.names"]])) stop("In Data, mon.names is NULL.") if(is.null(Data[["parm.names"]])) stop("In Data, parm.names is NULL.") for (i in 1:length(Data)) { if(is.matrix(Data[[i]])) { if(all(is.finite(Data[[i]]))) { mat.rank <- qr(Data[[i]], tol=1e-10)$rank if(mat.rank < ncol(Data[[i]])) { cat("WARNING: Matrix", names(Data)[[i]], "may be rank-deficient.\n")}}}} M <- max(round(abs(M)), 1) N <- max(round(abs(N)), 1) if(missing(Initial.Values)) { cat("WARNING: Initial Values were not supplied.\n") Initial.Values <- matrix(0, M, length(Data[["parm.names"]]))} if(is.vector(Initial.Values)) { if(!identical(length(Initial.Values), length(Data[["parm.names"]]))) { cat("WARNING: The length of Initial Values differed from", "Data$parm.names.\n") Initial.Values <- matrix(0, M, length(Data[["parm.names"]]))}} else { if(!identical(ncol(Initial.Values), length(Data[["parm.names"]]))) { cat("WARNING: Columns in Initial Values differed from", "Data$parm.names.\n") Initial.Values <- matrix(0, M, length(Data[["parm.names"]]))}} if(any(!is.finite(Initial.Values))) { cat("WARNING: Initial Values contain non-finite values.\n") Initial.Values <- matrix(0, M, length(Data[["parm.names"]]))} if(is.vector(Initial.Values)) { LIV <- length(Initial.Values) Initial.Values <- matrix(Initial.Values, M, LIV, byrow=TRUE)} else if(nrow(Initial.Values) != M) stop("nrow(Initial.Values != M.") else LIV <- ncol(Initial.Values) ### Covar ScaleF <- 2.381204 * 2.381204 / LIV if(is.null(Covar)) Covar <- array(diag(LIV)*ScaleF, dim=c(LIV,LIV,Iterations,M)) else Covar <- array(Covar, dim=c(LIV, LIV, Iterations, M)) ### Iterations and Thinning Iterations <- max(round(abs(Iterations)), 1) Thinning <- min(max(round(abs(Thinning)), 1), N*M/2) ### alpha if(is.null(alpha)) alpha <- matrix(rep(1/M, M), M, Iterations) else if(any(!is.finite(alpha))) { stop("\nWARNING: alpha had non-finite values. Creating alpha...\n.") alpha <- matrix(rep(1/M, M), M, Iterations)} if(is.vector(alpha)) alpha <- matrix(alpha, M, Iterations, byrow=TRUE) if(nrow(alpha) != M) stop("nrow(alpha) != M.") else if(ncol(alpha) != Iterations) stop("ncol(alpha) != Iterations.") if(any(colSums(alpha) != 1)) alpha <- alpha / matrix(colSums(alpha), M, Iterations, byrow=TRUE) ### mu mu <- array(0, dim=c(Iterations, LIV, M)) for (m in 1:M) { mu[,,m] <- matrix(Initial.Values[m,], Iterations, LIV, byrow=TRUE)} ### Miscellaneous nu <- max(abs(nu), 2.01) post <- array(0, dim=c(N, LIV, Iterations, M)) LH <- LP <- array(0, dim=c(N, Iterations, M)) LW <- matrix(0, N, Iterations) essn <- perp <- rep(0, Iterations) ########################## Test the Model ########################## for (m in 1:M) { M0 <- Model(as.vector(Initial.Values[m,]), Data) if(!is.list(M0)) stop("Model must return a list.") if(length(M0) != 5) stop("Model must return five components.") if(length(M0[["LP"]]) > 1) stop("Multiple joint posteriors exist!") if(!identical(length(M0[["Monitor"]]), length(Data[["mon.names"]]))) stop("Length of mon.names differs from length of monitors.") if(any(!is.finite(c(M0[["LP"]],M0[["Dev"]],M0[["parm"]])))) stop("Model produces non-finite results.")} ### Looking for apply functions and for loops as.character.function <- function(x, ... ) { fname <- deparse(substitute(x)) f <- match.fun(x) out <- c(sprintf('"%s" <- ', fname), capture.output(f)) if(grepl("^[<]", tail(out, 1))) out <- head(out, -1) return(out) } acount <- length(grep("apply", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, "possible instance(s) of apply functions\n") cat(" were found in the Model specification. Sampling speed will\n") cat(" increase if apply functions are vectorized in R or coded\n") cat(" in a faster language such as C++ via the Rcpp package.\n")} acount <- length(grep("for", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, "possible instance(s) of for loops\n") cat(" were found in the Model specification. Sampling speed will\n") cat(" increase if for loops are vectorized in R or coded in a\n") cat(" faster language such as C++ via the Rcpp package.\n")} ###################### Laplace Approximation ####################### ### Sample Size of Data if(!is.null(Data[["n"]])) if(length(Data[["n"]]) == 1) NN <- Data[["n"]] if(!is.null(Data[["N"]])) if(length(Data[["N"]]) == 1) NN <- Data[["N"]] if(!is.null(Data[["y"]])) NN <- nrow(matrix(Data[["y"]])) if(!is.null(Data[["Y"]])) NN <- nrow(matrix(Data[["Y"]])) if(is.null(NN)) stop("Sample size of Data not found in n, N, y, or Y.") if({sum(abs(Initial.Values[1,]) == 0) == ncol(Initial.Values)} & {NN >= 5*ncol(Initial.Values)}) { cat("\nLaplace Approximation will be used on initial values.\n") Fit.LA <- LaplaceApproximation(Model, Initial.Values[1,], Data, Method="SPG", CovEst="Hessian", sir=FALSE) Covar <- array(Fit.LA$Covar, dim=c(LIV, LIV, Iterations, M)) Initial.Values <- matrix(Fit.LA$Summary1[1:ncol(Initial.Values),1], M, LIV)} ### Covar symmetry and positive-definiteness for (m in 1:M) { if(!is.symmetric.matrix(Covar[,,1,m])) Covar[,,1,m] <- as.symmetric.matrix(Covar[,,1,m]) if(!is.positive.definite(Covar[,,1,m])) Covar[,,1,m] <- as.positive.definite(Covar[,,1,m])} ################### Prepare for Parallelization #################### CPUs <- abs(round(CPUs)) if(CPUs > 1) { detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores}} ############################ Begin PMC ############################# cat("\nPMC is beginning to update...\n") for (iter in 1:Iterations) { cat("Iteration: ", iter, sep="") bad <- FALSE ### Importance Sampling for (m in 1:M) { S <- nu/(nu-2) * Covar[,,iter,m] if(!is.symmetric.matrix(S)) S <- as.symmetric.matrix(S) if(!is.positive.definite(S)) S <- as.positive.definite(S) post[,,iter,m] <- rmvt(N, mu[iter,,m], S, nu) if(sum(!is.finite(post[,,iter,m]) > 0)) stop("Bad draws from importance distribution.") ### Non-Parallel Processing if(CPUs == 1) { for (i in 1:N) { mod <- Model(post[i,,iter,m], Data) if(all(is.finite(c(mod[["LP"]], mod[["Dev"]], mod[["parm"]])))) M0 <- mod LP[i,iter,m] <- M0[["LP"]] post[i,,iter,m] <- M0[["parm"]]} } else { ### Parallel Processing cl <- makeCluster(CPUs, Type) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) mod <- parLapply(cl, 1:nrow(post), function(x) Model(post[x,,iter,m], Data)) stopCluster(cl) LP[,iter,m] <- unlist(lapply(mod, function(x) x[["LP"]]))[1:nrow(post)] post[,,iter,m] <- matrix(unlist(lapply(mod, function(x) x[["parm"]])), dim(post)[1], dim(post)[2], byrow=TRUE)} ### Proposal Sampling Distribution H(theta) ~ MVT LH[,iter,m] <- dmvt(post[,,iter,m], mu[iter,,m], S, nu, log=TRUE) if(any(!is.finite(LH[,iter,m]))) { if(iter > 1) LH[,iter,m] <- LH[,iter-1,m] else stop("Sampling density H has non-finite values.")}} ### Weights LW[,iter] <- apply(LP[,iter,] - matrix(apply(matrix(alpha[,iter], N, M, byrow=TRUE) + LH[,iter,], 1, logadd), N, M, byrow=TRUE), 1, logadd) if(all(!is.finite(LW[,iter]))) { bad <- TRUE; LW[,iter] <- 0} else if(any(!is.finite(LW[,iter]))) { w <- which(!is.finite(LW[,iter])) LW[w,iter] <- 1e-800} ### Normalize Weights LW[,iter] <- LW[,iter] - logadd(LW[,iter]) if(any(!is.finite(LW[,iter]))){ bad <- TRUE if(iter == 1) { cat(", WARNING: Bad weights, setting to 1/N.\n") LW[,iter] <- rep(log(1/N), N)} else { cat(", WARNING: Bad weights, using last iteration.\n") alpha[,iter] <- alpha[,iter-1] for (m in 1:M) Covar[,,iter,m] <- Covar[,,iter-1,m] LH[,iter,] <- LH[,iter-1,] LP[,iter,] <- LP[,iter-1,] post[,,iter,] <- post[,,iter-1,] LW[,iter] <- LW[,iter-1]}} ### Convergence essn[iter] <- (1 / sum(exp(LW[,iter])^2)) / N perp[iter] <- exp(-sum(exp(LW[,iter]) * LW[,iter])) / N if(all(LW[,iter] == log(1/N))) essn[iter] <- perp[iter] <- 0 if(bad == FALSE) cat(", ESSN: ", round(essn[iter],5), ", Perplexity: ", round(perp[iter],5), "\n", sep="") ### Adaptation LpM <- matrix(log(alpha[,iter]), N, M, byrow=TRUE) + LH[,iter,] LpM <- LpM - matrix(apply(LpM, 1, logadd), N, M) if(iter < Iterations) { alpha[,iter+1] <- exp(apply(LW[,iter] + LpM, 2, logadd)) if(any(!is.finite(alpha[,iter+1]))) alpha[,iter+1] <- ifelse(!is.finite(alpha[,iter+1]), alpha[,iter], alpha[,iter+1]) alpha[which(alpha[,iter+1] < 0.001),iter+1] <- 0.001 alpha[,iter+1] <- alpha[,iter+1] / sum(alpha[,iter+1]) for (m in 1:M) { mu[iter+1,,m] <- colSums(exp(LW[,iter]) * post[,,iter,m] * exp(LpM[,m])) / alpha[m,iter+1] if(any(!is.finite(mu[iter+1,,m]))) mu[iter+1,,m] <- mu[iter,,m]} for (m in 1:M) { Covar[,,iter+1,m] <- 0 for (i in 1:N) { Covar[,,iter+1,m] <- Covar[,,iter+1,m] + (exp(LW[i,iter] + LpM[i,m]) * ((post[i,,iter,m] - mu[iter+1,,m]) %*% t(post[i,,iter,m] - mu[iter+1,,m]))) / alpha[m,iter+1]} if(any(!is.finite(diag(Covar[,,iter+1,m])))) Covar[,,iter+1,m] <- Covar[,,iter,m] if(any(diag(Covar[,,iter+1,m] < 1e-100))) Covar[,,iter+1,m] <- Covar[,,iter,m] Covar[,,iter+1,m] <- as.symmetric.matrix(Covar[,,iter+1,m]) if(!is.positive.definite(Covar[,,iter+1,m])) Covar[,,iter+1,m] <- Covar[,,iter,m] if(bad == TRUE) Covar[,,iter+1,m] <- Covar[,,iter,m]}} } ### Combine Samples from Mixture Components Posterior2 <- post[,,Iterations,1] colnames(Posterior2) <- Data[["parm.names"]] if(M > 1) { for (m in 2:M) { if(alpha[m,Iterations] >= 0.002) Posterior2 <- rbind(Posterior2, post[,,Iterations,m])}} Posterior2 <- Thin(Posterior2, By=Thinning) ### Final Sampling cat("Final Sampling\n") Dev <- rep(0, nrow(Posterior2)) Mon <- matrix(0, nrow(Posterior2), length(Data[["mon.names"]])) colnames(Mon) <- Data[["mon.names"]] for (i in 1:nrow(Posterior2)) { temp <- Model(Posterior2[i,], Data) Dev[i] <- temp[["Dev"]] Mon[i,] <- temp[["Monitor"]]} ### Posterior Summary Table cat("Creating Summaries\n") Summ <- matrix(NA, LIV, 7, dimnames=list(Data[["parm.names"]], c("Mean","SD","MCSE","ESS","LB","Median","UB"))) Summ[,1] <- colMeans(Posterior2) Summ[,2] <- sqrt(.colVars(Posterior2)) Summ[,3] <- 0 Summ[,4] <- ESS(Posterior2) Summ[,5] <- apply(Posterior2, 2, quantile, c(0.025), na.rm=TRUE) Summ[,6] <- apply(Posterior2, 2, quantile, c(0.500), na.rm=TRUE) Summ[,7] <- apply(Posterior2, 2, quantile, c(0.975), na.rm=TRUE) for (i in 1:ncol(Posterior2)) { temp <- try(MCSE(Posterior2[,i]), silent=TRUE) if(!inherits(temp, "try-error")) Summ[i,3] <- temp else Summ[i,3] <- MCSE(Posterior2[,i], method="sample.variance")} Deviance <- rep(NA,7) Deviance[1] <- mean(Dev) Deviance[2] <- sd(as.vector(Dev)) temp <- try(MCSE(as.vector(Dev))) if(inherits(temp, "try-error")) temp <- MCSE(as.vector(Dev), method="sample.variance") Deviance[3] <- temp Deviance[4] <- ESS(Dev) Deviance[5] <- as.numeric(quantile(Dev, probs=0.025, na.rm=TRUE)) Deviance[6] <- as.numeric(quantile(Dev, probs=0.500, na.rm=TRUE)) Deviance[7] <- as.numeric(quantile(Dev, probs=0.975, na.rm=TRUE)) Summ <- rbind(Summ, Deviance) for (j in 1:ncol(Mon)) { Monitor <- rep(NA,7) Monitor[1] <- mean(Mon[,j]) Monitor[2] <- sd(as.vector(Mon[,j])) temp <- try(MCSE(Mon[,j]), silent=TRUE) if(inherits(temp, "try-error")) temp <- MCSE(Mon[,j], method="sample.variance") Monitor[3] <- temp Monitor[4] <- ESS(Mon[,j]) Monitor[5] <- as.numeric(quantile(Mon[,j], probs=0.025, na.rm=TRUE)) Monitor[6] <- as.numeric(quantile(Mon[,j], probs=0.5, na.rm=TRUE)) Monitor[7] <- as.numeric(quantile(Mon[,j], probs=0.975, na.rm=TRUE)) Summ <- rbind(Summ, Monitor) rownames(Summ)[nrow(Summ)] <- Data[["mon.names"]][j]} ### Logarithm of the Marginal Likelihood LML <- list(LML=NA, VarCov=NA) cat("Estimating Log of the Marginal Likelihood\n") LML <- LML(theta=Posterior2, LL=as.vector(Dev)*(-1/2), method="NSIS") time2 <- proc.time() ### Compile Output cat("Creating Output\n") pmc.out <- (list(alpha=alpha, Call=pmc.call, Covar=Covar, Deviance=Dev, DIC=c(mean(as.vector(Dev)), var(as.vector(Dev))/2, mean(as.vector(Dev)) + var(as.vector(Dev))/2), ESSN=essn, Initial.Values=Initial.Values, Iterations=Iterations, LML=LML[[1]], M=M, Minutes=round(as.vector(time2[3] - time1[3]) / 60,2), Model=Model, N=N, nu=nu, Mu=mu, Monitor=Mon, Parameters=LIV, Perplexity=perp, Posterior1=post, Posterior2=Posterior2, Summary=Summ, Thinned.Samples=nrow(Posterior2), Thinning=Thinning, W=exp(LW))) class(pmc.out) <- "pmc" return(pmc.out) } #End LaplacesDemon/R/print.laplace.R0000755000176200001440000000354615144316355016063 0ustar liggesusers########################################################################### # print.laplace # # # # The purpose of the print.laplace function is to print the contents of # # an object of class laplace to the screen. # ########################################################################### print.laplace <- function(x, ...) { if(missing(x)) stop("The x argument is required.") cat("\nCall:\n") print(x$Call) cat("\nConverged: ", x$Converged, "\n", sep="") cat("Covariance Matrix: (NOT SHOWN HERE; diagonal shown instead)\n") print(diag(x$Covar)) cat("\nDeviance (Final): ", x$Deviance[length(x$Deviance)], "\n") cat("History: (NOT SHOWN HERE)\n") cat("Initial Values:\n") print(x$Initial.Values) cat("\nIterations: ", x$Iterations, "\n", sep="") cat("Log(Marginal Likelihood): ", x$LML, "\n", sep="") cat("Log-Posterior (Final): ", x$LP.Final, "\n", sep="") cat("Log-Posterior (Initial): ", x$LP.Initial, "\n", sep="") cat("Minutes of run-time: ", x$Minutes, "\n", sep="") cat("Monitor: (NOT SHOWN HERE)\n") cat("Posterior: (NOT SHOWN HERE)\n") cat("Step Size (Final): ") print(x$Step.Size.Final) cat("Step Size (Initial): ", x$Step.Size.Initial, "\n", sep="") cat("Summary1: (SHOWN BELOW)\n") cat("Summary2: (SHOWN BELOW)\n") cat("Tolerance (Final): ", x$Tolerance.Final, "\n", sep="") cat("Tolerance (Stop): ", x$Tolerance.Stop, "\n", sep="") cat("\nSummary1:\n") print(x$Summary1) if({x$Converged == TRUE} && !any(is.na(x$Posterior))) { cat("\nSummary2:\n") print(x$Summary2)} invisible(x) } #End LaplacesDemon/R/print.heidelberger.R0000755000176200001440000000223215144316355017072 0ustar liggesusers########################################################################### # print.heidelberger # # # # The purpose of the print.heidelberger function is to print the contents # # of an object of class raftery to the screen. # ########################################################################### print.heidelberger <- function(x, digits=3, ...) { HW.title <- matrix(c("Stationarity", "test", "start", "iteration", "p-value", "", "Halfwidth", "test", "Mean", "", "Halfwidth", ""), nrow=2) y <- matrix("", nrow=nrow(x), ncol=6) for (j in 1:ncol(y)) y[,j] <- format(x[,j], digits=digits) y[,c(1,4)] <- ifelse(x[,c(1,4)], "passed", "failed") y <- rbind(HW.title, y) vnames <- if(is.null(rownames(x))) paste("[,", 1:nrow(x), "]", sep="") else rownames(x) dimnames(y) <- list(c("", "", vnames), rep("", 6)) print.default(y[, 1:3], quote=FALSE, ...) print.default(y[, 4:6], quote=FALSE, ...) invisible(x) } #End LaplacesDemon/R/CSF.R0000755000176200001440000001646015144316355013741 0ustar liggesusers########################################################################### # CSF # # # # The purpose of the CSF function is to provide a visual MCMC diagnostic # # based on the cumulative sample function (CSF). # ########################################################################### CSF <- function(x, name, method="Quantiles", quantiles=c(.025,.5,.975), output=FALSE) { if(missing(x)) stop("The x argument is required.") if(missing(name)) name <- "x" if(is.constant(x)) stop("x must not be constant.") if(!is.vector(x)) x <- as.vector(x) if(method == "ESS") { y <- rep(0, length(x)) for (i in 1:length(x)) { test <- try(ESS(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test} plot(y, type="l", xlab="Cumulative Sample", ylab="ESS") if(output == TRUE) return(y)} if(method == "Geweke.Diagnostic") { y <- rep(0, length(x)) for (i in 1:length(x)) { test <- try(Geweke.Diagnostic(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test} par(mfrow=c(2,1)) plot(1:length(x), x, type="l", xlab="Iterations", ylab=name) panel.smooth(1:length(x), x, pch="") plot(y, type="l", xlab="Cumulative Sample", ylab="Geweke Diagnostic") abline(h=2, lty=2, col="red"); abline(h=-2, lty=2, col="red") if(output == TRUE) return(y)} if(method == "HPD") { Y <- matrix(0, length(x), 2) for (i in 1:length(x)) { test <- try(as.vector(p.interval(x[1:i], HPD=TRUE, MM=FALSE)[1,]), silent=TRUE) if(!inherits(test, "try-error")) Y[i,] <- test} plot(x, type="l", col="gray", xlab="Sample Size", ylab="HPD (95%)") for (i in 1:2) lines(Y[,i], col="black") if(output == TRUE) return(Y)} if(method == "is.stationary") { y <- rep(FALSE, length(x)) for (i in 1:length(x)) { test <- try(is.stationary(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test} par(mfrow=c(2,1)) plot(1:length(x), x, type="l", xlab="Iterations", ylab=name) panel.smooth(1:length(x), x, pch="") plot(y, type="l", xlab="Cumulative Sample", ylab="Stationary Indicator") if(output == TRUE) return(y)} if(method == "Kurtosis") { kurtosis <- function(x) { m4 <- mean((x-mean(x))^4) kurt <- m4/(sd(x)^4)-3 return(kurt)} y <- rep(0, length(x)) for (i in 1:length(x)) { test <- try(kurtosis(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test} par(mfrow=c(2,1)) plot(1:length(x), x, type="l", xlab="Iterations", ylab=name) panel.smooth(1:length(x), x, pch="") plot(y, type="l", xlab="Cumulative Sample", ylab="Kurtosis") if(output == TRUE) return(y)} if(method == "MCSE") { y <- rep(1, length(x)) for (i in 1:length(x)) { test <- try(MCSE(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test} y[which(!is.finite(y))] <- 1 y[which(y > 1)] <- 1 plot(y, type="l", xlab="Cumulative Sample", ylab="MCSE") if(output == TRUE) return(y)} if(method == "MCSE.bm") { y <- rep(1, length(x)) for (i in 1:length(x)) { test <- try(MCSE(x[1:i], method="batch.means"), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test} y[which(!is.finite(y))] <- 1 y[which(y > 1)] <- 1 plot(y, type="l", xlab="Cumulative Sample", ylab="MCSE") if(output == TRUE) return(y)} if(method == "MCSE.sv") { y <- rep(1, length(x)) for (i in 1:length(x)) { test <- try(MCSE(x[1:i], method="sample.variance"), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test} y[which(!is.finite(y))] <- 1 y[which(y > 1)] <- 1 plot(y, type="l", xlab="Cumulative Sample", ylab="MCSE") if(output == TRUE) return(y)} if(method == "Mean") { y <- rep(0, length(x)) for (i in 1:length(x)) { test <- try(mean(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test} par(mfrow=c(2,1)) plot(1:length(x), x, type="l", xlab="Iterations", ylab=name) panel.smooth(1:length(x), x, pch="") plot(y, type="l", xlab="Cumulative Sample", ylab="Mean") if(output == TRUE) return(y)} if(method == "Mode") { y <- rep(0, length(x)) for (i in 1:length(x)) { test <- try(Mode(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test[1]} par(mfrow=c(2,1)) plot(1:length(x), x, type="l", xlab="Iterations", ylab=name) panel.smooth(1:length(x), x, pch="") plot(y, type="l", xlab="Cumulative Sample", ylab="Mode") if(output == TRUE) return(y)} if(method == "N.Modes") { y <- rep(1, length(x)) for (i in 1:length(x)) { test <- try(Modes(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- length(test$modes)} par(mfrow=c(2,1)) plot(1:length(x), x, type="l", xlab="Iterations", ylab=name) panel.smooth(1:length(x), x, pch="") plot(y, type="l", xlab="Cumulative Sample", ylab="Number of Modes") if(output == TRUE) return(y)} if(method == "Precision") { y <- rep(0, length(x)) for (i in 1:length(x)) { test <- try(var(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- 1 / test} par(mfrow=c(2,1)) plot(1:length(x), x, type="l", xlab="Iterations", ylab=name) panel.smooth(1:length(x), x, pch="") plot(y, type="l", xlab="Cumulative Sample", ylab="Precision") if(output == TRUE) return(y)} if(method == "Quantiles") { Y <- matrix(0, length(x), length(quantiles)) for (i in 1:length(x)) { test <- try(quantile(x[1:i], probs=quantiles), silent=TRUE) if(!inherits(test, "try-error")) Y[i,] <- test} plot(x, type="l", col="gray", xlab="Sample Size", ylab="Quantiles") for (i in 1:ncol(Y)) lines(Y[,i], col="black") if(output == TRUE) return(Y)} if(method == "Skewness") { skewness <- function(x) { m3 <- mean((x-mean(x))^3) skew <- m3/(sd(x)^3) return(skew)} y <- rep(0, length(x)) for (i in 1:length(x)) { test <- try(skewness(x[1:i]), silent=TRUE) if(!inherits(test, "try-error")) y[i] <- test} par(mfrow=c(2,1)) plot(1:length(x), x, type="l", xlab="Iterations", ylab=name) panel.smooth(1:length(x), x, pch="") plot(y, type="l", xlab="Cumulative Sample", ylab="Skewness") if(output == TRUE) return(y)} } #End LaplacesDemon/R/plot.laplace.ppc.R0000755000176200001440000010632015144342763016462 0ustar liggesusers########################################################################### # plot.laplace.ppc # # # # The purpose of the plot.laplace.ppc function is to plot an object of # # class laplace.ppc. # ########################################################################### plot.laplace.ppc <- function(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "laplace.ppc")) stop("x is not of class laplace.ppc.") if(is.null(Style)) Style <- "Density" if(is.null(Rows)) Rows <- 1:nrow(x[["yhat"]]) ### Plots if(Style == "Covariates") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) { plot(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75, ylim=c(min(temp[Rows,c(1,4:6)]),max(temp[Rows,c(1,4:6)])), xlab=paste("X[,",i,"]", sep=""), ylab="yhat", sub="Gray lines are yhat at 2.5% and 95%.") panel.smooth(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75)}} if(Style == "Covariates, Categorical DV") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.Cat.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Categorical=TRUE, Quiet=TRUE)$Summary ncat <- length(table(temp[,1])) mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) {for (j in 2:(ncat+1)) { plot(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75, xlab=paste("X[,",i,"]", sep=""), ylab=colnames(temp)[j]) panel.smooth(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75)}}} if(Style == "Density") { if(PDF == TRUE) { pdf("PPC.Plots.Density.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) for (j in 1:length(Rows)) { plot(density(x[["yhat"]][Rows[j],]), main=paste("Post. Pred. Plot of yhat[", Rows[j], ",]", sep=""), xlab="Value", sub="Black=Density, Red=y") polygon(density(x[["yhat"]][Rows[j],]), col="black", border="black") abline(v=x[["y"]][Rows[j]], col="red")}} if(Style == "DW") { if(PDF == TRUE) pdf("PPC.Plots.DW.pdf") par(mfrow=c(1,1)) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[,s]))^2, na.rm=TRUE) / sum(epsilon.obs[,s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[,s]))^2, na.rm=TRUE) / sum(epsilon.rep[,s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")} if(Style == "DW, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.DW.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (j in 1:J) { for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.obs[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.rep[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep=""), sub=paste("Y[,",j,"]",sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")}} if(Style == "ECDF") { if(PDF == TRUE) pdf("PPC.Plots.ECDF.pdf") par(mfrow=c(1,1)) plot(ecdf(x[["y"]][Rows]), verticals=TRUE, do.points=FALSE, main="Cumulative Fit", xlab="y (black) and yhat (red; gray)", ylab="Cumulative Frequency") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.975)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.025)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.500)), verticals=TRUE, do.points=FALSE, col="red")} if(Style == "Fitted") { if(PDF == TRUE) pdf("PPC.Plots.Fitted.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75, ylim=c(min(temp[Rows,4], na.rm=TRUE), max(temp[Rows,6], na.rm=TRUE)), xlab="y", ylab="yhat", main="Fitted") for (i in Rows) { lines(c(temp[Rows[i],1], temp[Rows[i],1]), c(temp[Rows[i],4], temp[Rows[i],6]))} panel.smooth(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75)} if(Style == "Fitted, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:nrow(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Fitted, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:ncol(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Jarque-Bera") { if(PDF == TRUE) pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1)) epsilon.obs <- epsilon.rep <- x[["y"]][Rows] - x[["yhat"]][Rows,] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (s in 1:ncol(epsilon.obs)) { epsilon.rep[,s] <- rnorm(N, mean(epsilon.obs[,s], na.rm=TRUE), sd(epsilon.obs[,s], na.rm=TRUE)) K.obs <- kurtosis(epsilon.obs[,s]) S.obs <- skewness(epsilon.obs[,s]) K.rep <- kurtosis(epsilon.rep[,s]) S.rep <- skewness(epsilon.rep[,s]) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab="JB", ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Jarque-Bera, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Jarque-Bera, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- epsilon.rep <- x[["y"]] - x[["yhat"]] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (j in 1:J) { for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.rep <- rnorm(M, mean(e.obs[,j], na.rm=TRUE), sd(e.obs[,j], na.rm=TRUE)) K.obs <- kurtosis(e.obs[,j]) S.obs <- skewness(e.obs[,j]) K.rep <- kurtosis(e.rep) S.rep <- skewness(e.rep) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab=paste("JB for Y[,",j,"]", sep=""), ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)}} if(Style == "Mardia") { if(PDF == TRUE) pdf("PPC.Plots.Mardia.pdf") par(mfrow=c(2,1)) if(is.null(Data)) stop("Data is required for Style=Mardia, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Mardia, C.") epsilon.obs <- x[["y"]] - x[["yhat"]] M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) K3.obs <- K3.rep <- K4.obs <- K4.rep <- rep(0, ncol(epsilon.obs)) for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.obs.mu <- colMeans(e.obs) e.obs.mu.mat <- matrix(e.obs.mu, M, J, byrow=TRUE) e.obs.stand <- e.obs - e.obs.mu.mat S.obs <- var(e.obs) A.obs <- t(chol(S.obs)) A.inv.obs <- solve(A.obs) Z.obs <- t(A.inv.obs %*% t(e.obs.stand)) Dij.obs <- Z.obs %*% t(Z.obs) D2.obs <- diag(Dij.obs) K3.obs[s] <- mean(as.vector(Dij.obs)^3) K4.obs[s] <- mean(D2.obs^2) e.rep <- rmvn(M, e.obs.mu.mat, S.obs) e.rep.mu <- colMeans(e.rep) e.rep.mu.mat <- matrix(e.rep.mu, M, J, byrow=TRUE) e.rep.stand <- e.rep - e.rep.mu.mat S.rep <- var(e.rep) A.rep <- t(chol(S.rep)) A.inv.rep <- solve(A.rep) Z.rep <- t(A.inv.rep %*% t(e.rep.stand)) Dij.rep <- Z.rep %*% t(Z.rep) D2.rep <- diag(Dij.rep) K3.rep[s] <- mean(as.vector(Dij.rep)^3) K4.rep[s] <- mean(D2.rep^2)} p.K3 <- round(mean(K3.obs > K3.rep), 3) p.K4 <- round(mean(K4.obs > K4.rep), 3) K3.result <- K4.result <- "Non-Normality" if((p.K3 >= 0.025) & (p.K3 <= 0.975)) K3.result <- "Normality" if((p.K4 >= 0.025) & (p.K4 <= 0.975)) K4.result <- "Normality" d.K3.obs <- density(K3.obs) d.K3.rep <- density(K3.rep) d.K4.obs <- density(K4.obs) d.K4.rep <- density(K4.rep) plot(d.K3.obs, xlim=c(min(d.K3.obs$x, d.K3.rep$x), max(d.K3.obs$x, d.K3.rep$x)), ylim=c(0, max(d.K3.obs$y, d.K3.rep$y)), col="white", main="Mardia's Test of MVN Skewness", xlab="Skewness Test Statistic (K3)", ylab="Density", sub=paste("K3.obs=", round(mean(K3.obs, na.rm=TRUE), 2), " (", round(quantile(K3.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K3.obs, probs=0.975, na.rm=TRUE), 2), "), p(K3.obs > K3.rep) = ", p.K3, " = ", K3.result, sep="")) polygon(d.K3.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K3.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) plot(d.K4.obs, xlim=c(min(d.K4.obs$x, d.K4.rep$x), max(d.K4.obs$x, d.K4.rep$x)), ylim=c(0, max(d.K4.obs$y, d.K4.rep$y)), col="white", main="Mardia's Test of MVN Kurtosis", xlab="Kurtosis Test Statistic (K4)", ylab="Density", sub=paste("K4.obs=", round(mean(K4.obs, na.rm=TRUE), 2), " (", round(quantile(K4.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K4.obs, probs=0.975, na.rm=TRUE), 2), "), p(K4.obs > K4.rep) = ", p.K4, " = ", K4.result, sep="")) polygon(d.K4.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K4.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Predictive Quantiles") { if(PDF == TRUE) pdf("PPC.Plots.PQ.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) plot(temp[Rows,1], temp[Rows,7], ylim=c(0,1), col=mycol, pch=16, cex=0.75, xlab="y", ylab="PQ", main="Predictive Quantiles") panel.smooth(temp[Rows,1], temp[Rows,7], col=mycol, pch=16, cex=0.75) abline(h=0.025, col="gray") abline(h=0.975, col="gray")} if(Style == "Residual Density") { if(PDF == TRUE) pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) dens <- density(epsilon.summary[2,Rows], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=expression(epsilon), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")} if(Style == "Residual Density, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { dens <- density(epsilon.500[,i], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[,", i, "]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residual Density, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, R.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { dens <- density(epsilon.500[i,], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[", i, ",]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residuals") { if(PDF == TRUE) pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) plot(epsilon.summary[2,Rows], pch=16, cex=0.75, ylim=c(min(epsilon.summary[,Rows], na.rm=TRUE), max(epsilon.summary[,Rows], na.rm=TRUE)), xlab="y", ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.summary[,Rows])), col="red") for (i in Rows) { lines(c(i,i), c(epsilon.summary[1,Rows[i]], epsilon.summary[3,Rows[i]]), col="black")}} if(Style == "Residuals, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { plot(epsilon.500[,i], pch=16, cex=0.75, ylim=c(min(epsilon.025[,i], na.rm=TRUE), max(epsilon.975[,i], na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab=expression(epsilon)) lines(rep(0, nrow(epsilon.500)), col="red") for (j in 1:nrow(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[j,i], epsilon.975[j,i]), col="black")}}} if(Style == "Residuals, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { plot(epsilon.500[i,], pch=16, cex=0.75, ylim=c(min(epsilon.025[i,], na.rm=TRUE), max(epsilon.975[i,], na.rm=TRUE)), xlab=paste("Y[", i, ",]", sep=""), ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.500)), col="red") for (j in 1:ncol(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[i,j], epsilon.975[i,j]), col="black")}}} if(Style == "Space-Time by Space") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Space.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (s in 1:Data[["S"]]) { plot(matrix(temp[,1], Data[["S"]], Data[["T"]])[s,], ylim=c(min(c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE), max(c(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Space-Time at Space s=",s," of ", Data[["S"]], sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:Data[["T"]],rev(1:Data[["T"]])), c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], rev(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(matrix(temp[,5], Data[["S"]], Data[["T"]])[s,], col="red")}} if(Style == "Space-Time by Time") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Time.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") Heat <- (1-(x[["y"]]-min(x[["y"]], na.rm=TRUE)) / max(x[["y"]]-min(x[["y"]], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 Heat <- matrix(Heat, Data[["S"]], Data[["T"]]) for (t in 1:Data[["T"]]) { plot(Data[["longitude"]], Data[["latitude"]], col=heat.colors(120)[Heat[,t]], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main=paste("Space-Time at t=",t," of ", Data[["T"]], sep=""), sub="Red=High, Yellow=Low")}} if(Style == "Spatial") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- (1-(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE)) / max(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Plot", sub="Red=High, Yellow=Low")} if(Style == "Spatial Uncertainty") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.Unc.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial Uncertainty.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- apply(x[["yhat"]], 1, quantile, probs=c(0.025,0.975)) heat <- heat[2,] - heat[1,] heat <- (1-(heat[Rows]-min(heat[Rows])) / max(heat[Rows]-min(heat[Rows]))) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Uncertainty Plot", sub="Red=High, Yellow=Low")} if(Style == "Time-Series") { if(PDF == TRUE) pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(Rows, temp[Rows,1], ylim=c(min(temp[Rows,c(1,4)], na.rm=TRUE), max(temp[Rows,c(1,6)], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main="Plot of Fitted Time-Series", sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(Rows,rev(Rows)),c(temp[Rows,4],rev(temp[Rows,6])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(Rows, temp[Rows,1]) lines(Rows, temp[Rows,5], col="red")} if(Style == "Time-Series, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else {par(mfrow=c(1,1), ask=TRUE)} if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][,i], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE), max(Data[["Y"]][,i], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", ncol(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(Style == "Time-Series, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][i,], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE), max(Data[["Y"]][i,], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", nrow(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/log-log.R0000755000176200001440000000302215144316355014654 0ustar liggesusers########################################################################### # Log-Log # # # # The logit and probit links are symmetric, because the probabilities # # approach zero or one at the same rate. The log-log and complementary # # log-log links are asymmetric. Complementary log-log links approach zero # # slowly and one quickly. Log-log links approach zero quickly and one # # slowly. Either the log-log or complementary log-log link will tend to # # fit better than logistic and probit, and are frequently used when the # # probability of an event is small or large. A mixture of the two links, # # the log-log and complementary log-log is often used, where each link is # # weighted. The reason that logit is so prevalent is because logistic # # parameters can be interpreted as odds ratios. # ########################################################################### loglog <- function(p) { if({any(p < 0)} || {any(p > 1)}) stop("p must be in [0,1].") x <- log(-log(p)) return(x) } invloglog <- function(x) { p <- exp(-exp(x)) return(p) } cloglog <- function(p) { if({any(p < 0)} || {any(p > 1)}) stop("p must be in [0,1].") x <- log(-log(1 - p)) return(x) } invcloglog <- function(x) { p <- 1 - exp(-exp(x)) return(p) } #End LaplacesDemon/R/Heidelberger.Diagnostic.R0000755000176200001440000001077015144316355017770 0ustar liggesusers########################################################################### # Heidelberger.Diagnostic # # # # The purpose of the Heidelberger.Diagnostic function is to perform the # # Heidelberger and Welch MCMC convergence diagnostic on Markov chains. # ########################################################################### Heidelberger.Diagnostic <- function(x, eps=0.1, pvalue=0.05) { if(missing(x)) stop("x is a required argument") if(!identical(class(x), "demonoid")) stop("x must be an object of class demonoid.") if(all(is.na(x$Posterior2))) x <- x$Posterior1 else x <- x$Posterior2 HW.mat0 <- matrix(0, ncol=6, nrow=ncol(x)) dimnames(HW.mat0) <- list(colnames(x), c("stest", "start", "pvalue", "htest", "mean", "halfwidth")) HW.mat <- HW.mat0 spectrum0 <- function(x, max.freq=0.5, order=1, max.length=200) { x <- as.matrix(x) if(!is.null(max.length) && nrow(x) > max.length) { batch.size <- ceiling(nrow(x) / max.length) x <- aggregate(ts(x, frequency=batch.size), nfreq=1, FUN=mean) } else batch.size <- 1 out <- do.spectrum0(x, max.freq=max.freq, order=order) out$spec <- out$spec * batch.size return(out) } do.spectrum0 <- function(x, max.freq=0.5, order=1) { fmla <- switch(order+1, spec ~ one, spec ~ f1, spec ~ f1 + f2) if(is.null(fmla)) stop("invalid order") N <- nrow(x) Nfreq <- floor(N/2) freq <- seq(from=1/N, by=1/N, length=Nfreq) f1 <- sqrt(3) * (4 * freq - 1) f2 <- sqrt(5) * (24 * freq^2 - 12 * freq + 1) v0 <- numeric(ncol(x)) for (i in 1:ncol(x)) { y <- x[,i] v <- var(y, na.rm=TRUE) if(!is.finite(v)) v <- 0 if(v == 0) v0[i] <- 0 else { yfft <- fft(y) spec <- Re(yfft * Conj(yfft)) / N spec.data <- data.frame(one=rep(1, Nfreq), f1=f1, f2=f2, spec=spec[1 + (1:Nfreq)], inset=I(freq <= max.freq)) glm.out <- try(glm(fmla, family=Gamma(link="log"), data=spec.data), silent=TRUE) if(!inherits(glm.out, "try-error")) v0[i] <- predict(glm.out, type="response", newdata=data.frame(spec=0, one=1, f1=-sqrt(3), f2=sqrt(5))) else v0[i] <- 0}} return(list(spec=v0)) } pcramer <- function(q, eps=1.0e-5) { log.eps <- log(eps) y <- matrix(0, nrow=4, ncol=length(q)) for (k in 0:3) { z <- gamma(k + 0.5) * sqrt(4*k + 1) / (gamma(k+1) * pi^(3/2) * sqrt(q)) u <- (4*k + 1)^2/(16*q) y[k+1,] <- ifelse(u > -log.eps, 0, z * exp(-u) * besselK(x=u, nu=1/4))} return(colSums(y)) } ### Heidelberger and Welch Diagnostic for (j in 1:ncol(x)) { start.vec <- seq(from=1, to=nrow(x)/2, by=nrow(x)/10) Y <- x[, j, drop=TRUE] n1 <- length(Y) ### Schruben's test for convergence, applied sequentially S0 <- spectrum0(Y[(n1/2):n1])$spec converged <- FALSE for (i in seq(along=start.vec)) { Y <- Y[start.vec[i]:length(Y)] n <- length(Y) ybar <- mean(Y) B <- cumsum(Y) - ybar * (1:n) Bsq <- (B * B) / (n * S0) I <- sum(Bsq) / n if(converged <- !is.na(I) && pcramer(I) < 1 - pvalue) break} ### Recalculate S0 using section of chain that passed convergence test S0ci <- spectrum0(Y)$spec halfwidth <- 1.96 * sqrt(S0ci/n) passed.hw <- !is.na(halfwidth) & (abs(halfwidth/ybar) <= eps) if(!converged || is.na(I) || is.na(halfwidth)) { nstart <- NA passed.hw <- NA halfwidth <- NA ybar <- NA } else nstart <- start(Y)[1] HW.mat[j, ] <- c(converged, nstart, 1 - pcramer(I), passed.hw, ybar, halfwidth)} class(HW.mat) <- "heidelberger" return(HW.mat) } #End LaplacesDemon/R/plot.miss.R0000755000176200001440000000337315144316355015255 0ustar liggesusers########################################################################### # plot.miss # # # # The purpose of the plot.miss function is to plot an object of class # # miss. # ########################################################################### plot.miss <- function(x, PDF=FALSE, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(PDF == TRUE) { pdf("MISS.Plots.pdf") par(mfrow=c(3,3)) } else par(mfrow=c(3,3), ask=TRUE) ### Plot Imputations for (i in 1:nrow(x$Imp)) { plot(1:ncol(x$Imp), x$Imp[i,], type="l", xlab="Iterations", ylab="Value", main=paste("Imp[", i, ",]", sep="")) panel.smooth(1:ncol(x$Imp), x$Imp[i,], pch="") plot(density(x$Imp[i,]), xlab="Value", main=paste("Imp[", i, ",]")) polygon(density(x$Imp[i,]), col="black", border="black") ### Only plot an ACF if there's > 1 unique values if(!is.constant(x$Imp[i,])) { z <- acf(x$Imp[i,], plot=FALSE) se <- 1/sqrt(length(x$Imp[i,])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=paste("Imp[", i, ",]"), xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } else plot(0, 0, main=paste("Imp[", i, ",]"), "is a constant.")} if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/Geweke.Diagnostic.R0000755000176200001440000000564115144316355016617 0ustar liggesusers########################################################################### # Geweke.Diagnostic # # # # The purpose of the Geweke.Diagnostic function is to estimate # # stationarity in samples according to Geweke's diagnostic. Although the # # code is slightly different, it is essentially the same as the # # geweke.diag function in the coda package. # ########################################################################### Geweke.Diagnostic <- function(x) { x <- as.matrix(x) if(nrow(x) < 100) return(rep(NA, ncol(x))) frac1 <- 0.1; frac2 <- 0.5 startx <- 1; endx <- nrow(x) xstart <- c(startx, endx - frac2 * {endx - startx}) xend <- c(startx + frac1 * {endx - startx}, endx) y.variance <- y.mean <- vector("list", 2) for (i in 1:2) { y <- x[xstart[i]:xend[i],] y.mean[[i]] <- colMeans(as.matrix(y)) yy <- as.matrix(y) y <- as.matrix(y) max.freq <- 0.5; order <- 1; max.length <- 200 if(nrow(yy) > max.length) { batch.size <- ceiling(nrow(yy) / max.length) yy <- aggregate(ts(yy, frequency=batch.size), nfreq=1, FUN=mean)} else {batch.size <- 1} yy <- as.matrix(yy) fmla <- switch(order + 1, spec ~ one, spec ~ f1, spec ~ f1 + f2) if(is.null(fmla)) stop("Invalid order.") N <- nrow(yy) Nfreq <- floor(N/2) freq <- seq(from=1/N, by=1/N, length=Nfreq) f1 <- sqrt(3) * {4 * freq - 1} f2 <- sqrt(5) * {24 * freq * freq - 12 * freq + 1} v0 <- numeric(ncol(yy)) for (j in 1:ncol(yy)) { zz <- yy[,j] if(var(zz) == 0) v0[j] <- 0 else { yfft <- fft(zz) spec <- Re(yfft * Conj(yfft)) / N spec.data <- data.frame(one=rep(1, Nfreq), f1=f1, f2=f2, spec=spec[1 + {1:Nfreq}], inset=I(freq <= max.freq)) glm.out <- try(glm(fmla, family=Gamma(link="log"), data=spec.data), silent=TRUE) if(!inherits(glm.out, "try-error")) v0[j] <- predict(glm.out, type="response", newdata=data.frame(spec=0, one=1, f1=-sqrt(3), f2=sqrt(5))) } } spec <- list(spec=v0) spec$spec <- spec$spec * batch.size y.variance[[i]] <- spec$spec / nrow(y) } z <- {y.mean[[1]] - y.mean[[2]]} / sqrt(y.variance[[1]] + y.variance[[2]]) return(z) } #End LaplacesDemon/R/is.model.R0000755000176200001440000000546415144316355015042 0ustar liggesusers########################################################################### # is.model # # # # The purpose of the is.model function is to estimate if a model # # specification function meets some minimum criteria. # ########################################################################### is.model <- function(Model, Initial.Values, Data) { if(missing(Model)) stop("The Model argument is required.") ismodel <- TRUE if(!is.function(Model)) { cat("\nModel must be a function.\n") ismodel <- FALSE} if(missing(Initial.Values)) stop("Initial.Values argument is required.") if(!is.vector(Initial.Values)) stop("Initial.Values must be a vector.") if(missing(Data)) stop("The Data argument is required.") if(!is.data(Data)) stop("The Data argument is not Data.") if(!identical(length(Initial.Values), length(Data[["parm.names"]]))) stop("Lengths of Initial.Values and parm.names differ.") Mo <- try(Model(Initial.Values, Data), silent=TRUE) if(inherits(Mo, "try-error")) stop("Error in executing the Model.") if(!is.list(Mo)) { cat("\nModel must return a list.\n") ismodel <- FALSE} else if(length(Mo) != 5) { cat("\nModel must return 5 list components.\n") ismodel <- FALSE} else if(!identical(Mo[[1]], Mo[["LP"]])) { cat("\nThe first output component must be named LP.\n") ismodel <- FALSE} else if(length(Mo[["LP"]]) != 1) { cat("\nThe length of LP must be 1.\n") ismodel <- FALSE} else if(!identical(Mo[[2]], Mo[["Dev"]])) { cat("\nThe second output component must be named Dev.\n") ismodel <- FALSE} else if(length(Mo[["Dev"]]) != 1) { cat("\nThe length of Dev must be 1.\n") ismodel <- FALSE} else if(!identical(Mo[[3]], Mo[["Monitor"]])) { cat("\nThe third output component must be named Monitor.\n") ismodel <- FALSE} else if(!identical(length(Mo[["Monitor"]]), length(Data[["mon.names"]]))) { cat("\nThe lengths of Monitor values and mon.names differ.\n") ismodel <- FALSE} else if(!identical(Mo[[4]], Mo[["yhat"]])) { cat("\nThe fourth output component must be named yhat.\n") ismodel <- FALSE} else if(!identical(Mo[[5]], Mo[["parm"]])) { cat("\nThe fifth output component must be named parm.\n") ismodel <- FALSE} else if(!identical(length(Mo[["parm"]]), length(Data[["parm.names"]]))) { cat("\nThe lengths of parm and parm.names differ.\n") ismodel <- FALSE} return(ismodel) } #End LaplacesDemon/R/summary.demonoid.ppc.R0000755000176200001440000002501515144316355017375 0ustar liggesusers########################################################################### # summary.demonoid.ppc # # # # The purpose of the summary.demonoid.ppc function is to summarize an # # object of class demonoid.ppc (posterior predictive check). # ########################################################################### summary.demonoid.ppc <- function(object=NULL, Categorical=FALSE, Rows=NULL, Discrep=NULL, d=0, Quiet=FALSE, ...) { if(is.null(object)) stop("The object argument is NULL.") y <- object$y yhat <- object$yhat Deviance <- object$Deviance if(is.null(Rows)) Rows <- 1:length(y) if(any(Rows > length(y)) || any(Rows <= 0)) { warning("Invalid Rows argument; All rows included.") Rows <- 1:length(y)} ### Create Continuous Summary Table if(Categorical == FALSE) { Summ <- matrix(NA, length(y), 8, dimnames=list(1:length(y), c("y","Mean","SD","LB","Median","UB","PQ","Discrep"))) Summ[,1] <- y Summ[,2] <- round(rowMeans(yhat),3) Summ[,3] <- round(sqrt(.rowVars(yhat)),3) for (i in 1:length(y)) { Summ[i,4] <- round(quantile(yhat[i,], probs=0.025, na.rm=TRUE),3) Summ[i,5] <- round(quantile(yhat[i,], probs=0.500, na.rm=TRUE),3) Summ[i,6] <- round(quantile(yhat[i,], probs=0.975, na.rm=TRUE),3) Summ[i,7] <- round(mean(yhat[i,] >= y[i], na.rm=TRUE),3) } ### Discrepancy Statistics Concordance <- 1 - mean({{Summ[,7] < 0.025} | {Summ[,7] > 0.975}}, na.rm=TRUE) if(identical(yhat,y)) Concordance <- 1 Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "Chi-Square"}) { Summ[,8] <- round((y - rowMeans(yhat))^2 / .rowVars(yhat),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Chi-Square2"}) { chisq.obs <- chisq.rep <- yhat E.y <- E.yrep <- rowMeans(yhat, na.rm=TRUE) for (i in 1:nrow(yhat)) { chisq.obs[i,] <- (y[i] - E.y[i])^2 / E.y[i] chisq.rep[i,] <- (yhat[i,] - E.yrep[i])^2 / E.yrep[i] } Summ[,8] <- round(rowMeans(chisq.rep > chisq.obs, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean((Summ[,8] < 0.025) | (Summ[,8] > 0.975), na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "DW"}) { Summ[,8] <- round((rowMeans(y - yhat, na.rm=TRUE) - c(0, diff(rowMeans(y - yhat, na.rm=TRUE))))^2 / rowMeans(y - yhat, na.rm=TRUE)^2, 3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE), 3)} if(!is.null(Discrep) && {Discrep == "Kurtosis"}) { kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} for (i in 1:length(y)) {Summ[i,8] <- round(kurtosis(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "L.criterion"}) { Summ[,8] <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MASE"}) { Summ[,8] <- round(abs(rowMeans(y - yhat, na.rm=TRUE) / mean(abs(diff(y)), na.rm=TRUE)), 3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MSE"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "PPL"}) { Summ[,8] <- round(.rowVars(yhat) + (d/(d+1)) * (rowMeans(yhat) - y)^2,3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Loss"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Utility"}) { Summ[,8] <- round(rowMeans(-1*(y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "RMSE"}) { Summ[,8] <- round(sqrt(rowMeans((y - yhat)^2, na.rm=TRUE)),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Skewness"}) { skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} for (i in 1:length(y)) {Summ[i,8] <- round(skewness(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "max(yhat[i,]) > max(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- max(yhat[i,]) > max(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,]) > mean(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,]) > mean(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > d)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > d)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > mean(y))"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > mean(y))} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "min(yhat[i,]) < min(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- min(yhat[i,]) < min(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "round(yhat[i,]) = d"}) { for (i in 1:length(y)) { Summ[i,8] <- round(mean(round(yhat[i,]) == d, na.rm=TRUE), 3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "sd(yhat[i,]) > sd(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- sd(yhat[i,]) > sd(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE)/2, 3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" L <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2),3) S.L <- round(sd(L, na.rm=TRUE),3); L <- round(sum(L, na.rm=TRUE),3) ### Create Output Summ.out <- list(BPIC=bpic, Concordance=Concordance, Discrepancy.Statistic=round(Discrepancy.Statistic,5), L.criterion=L, S.L=S.L, Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Concordance: ", Concordance, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("L-criterion: ", L, ", S.L: ", S.L, sep="", "\n") cat("Records: \n") print(Summ[Rows,])} } ### Create Categorical Summary Table else { catcounts <- table(y) sumnames <- rep(NA, length(catcounts)+3) sumnames[1] <- "y" for (i in 1:length(catcounts)) { sumnames[i+1] <- paste("p(yhat=",names(catcounts)[i],")",sep="")} sumnames[length(sumnames)-1] <- "Lift" sumnames[length(sumnames)] <- "Discrep" Summ <- matrix(NA, length(y), length(sumnames), dimnames=list(1:length(y), sumnames)) Summ[,1] <- y for (i in 1:length(catcounts)) { Summ[,i+1] <- rowSums(yhat == as.numeric(names(catcounts)[i])) / ncol(yhat)} Summ[,{ncol(Summ)-1}] <- 1 for (i in 1:length(y)) { Summ[i,{ncol(Summ)-1}] <- Summ[i, grep(Summ[i,1],names(catcounts))+1] / {as.vector(catcounts[grep(Summ[i,1],names(catcounts))]) / sum(catcounts)} - 1} ### Discrepancy Statistics Mean.Lift <- round(mean(Summ[,{ncol(Summ)-1}]),3) Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "p(yhat[i,] != y[i])"}) { for (i in 1:length(y)) {Summ[i,ncol(Summ)] <- 1 - Summ[i, grep(Summ[i,1],names(catcounts))+1]} Discrepancy.Statistic <- round(mean(Summ[,ncol(Summ)], na.rm=TRUE),3)} Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE)/2, 3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" ### Create Output Summ.out <- list(BPIC=bpic, Mean.Lift=Mean.Lift, Discrepancy.Statistic=round(Discrepancy.Statistic,5), Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Mean Lift: ", Mean.Lift, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("Records: \n") print(Summ[Rows,])} } return(invisible(Summ.out)) } #End LaplacesDemon/R/plot.demonoid.hpc.R0000755000176200001440000002341015144341655016644 0ustar liggesusers########################################################################### # plot.demonoid.hpc # # # # The purpose of the plot.demonoid.hpc function is to plot an object of # # class demonoid.hpc. # ########################################################################### plot.demonoid.hpc <- function(x, BurnIn=0, Data=NULL, PDF=FALSE, Parms=NULL, FileName = paste0("laplacesDemon-plot_", format(Sys.time(), "%Y-%m-%d_%T"), ".pdf"), ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "demonoid.hpc")) stop("x must be of class demonoid.hpc.") Chains <- length(x) if(is.null(Data)) stop("The Data argument is NULL.") nn <- nrow(x[[1]]$Posterior1) if(BurnIn >= nn) BurnIn <- 0 Stat.at <- BurnIn + 1 ### Selecting Parms if(is.null(Parms)) { Posterior <- list() for (i in 1:Chains) { Posterior[[i]] <- x[[i]][["Posterior1"]]} } else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], colnames(x[[1]]$Posterior1))) == 0) stop("Parameter in Parms does not exist.") keepcols <- grep(Parms[1], colnames(x[[1]]$Posterior1)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], colnames(x[[1]]$Posterior1))) == 0) stop("Parameter in Parms does not exist.") keepcols <- c(keepcols, grep(Parms[i], colnames(x[[1]]$Posterior1)))}} Posterior <- list() for (i in 1:Chains) { Posterior[[i]] <- matrix(x[[i]][["Posterior1"]][,keepcols], nn, length(keepcols))} } if(PDF == TRUE) { pdf(FileName) par(mfrow=c(3,3)) } else {par(mfrow=c(3,3), ask=TRUE)} ### Plot Parameters for (j in 1:ncol(Posterior[[1]])) { plot(Stat.at:nn, Posterior[[1]][Stat.at:nn,j], ylim=c(min(matrix(sapply(Posterior, function(x) { min = min(x[,j])}), nn, Chains)[Stat.at:nn,]), max(matrix(sapply(Posterior, function(x) { max = max(x[,j])}), nn, Chains)[Stat.at:nn,])), col=rgb(0,0,0,50,maxColorValue=255), type="l", xlab="Thinned Samples", ylab="Value", main=colnames(Posterior[[1]])[j]) for (n in 2:Chains) { lines(Stat.at:nn, Posterior[[n]][Stat.at:nn,j], col=rgb(col2rgb(n)[1],col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255))} plot(density(Posterior[[1]][Stat.at:nn,j]), col="white", xlab="Value", main=colnames(Posterior[[1]])[j]) polygon(density(Posterior[[1]][Stat.at:nn,j]), col=rgb(0,0,0,50,maxColorValue=255), border=NA) for (n in 2:Chains) { polygon(density(Posterior[[n]][Stat.at:nn,j]), col=rgb(col2rgb(n)[1],col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255), border=NA)} abline(v=0, col="red", lty=2) ### Only plot an ACF if there's > 1 unique values if(!is.constant(Posterior[[1]][Stat.at:nn,j])) { z <- acf(Posterior[[1]][Stat.at:nn,j], plot=FALSE) se <- 1/sqrt(length(Posterior[[1]][Stat.at:nn,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), col=rgb(0,0,0,50,maxColorValue=255), type="h", main=colnames(Posterior[[1]])[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) for (n in 2:Chains) { z <- acf(Posterior[[n]][Stat.at:nn,j], plot=FALSE) se <- 1/sqrt(length(Posterior[[n]][Stat.at:nn,j])) lines(z$lag, z$acf, col=rgb(col2rgb(n)[1], col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255))} } else {plot(0, 0, main=paste(colnames(Posterior[[1]])[j], "is a constant."))} } rm(Posterior) ### Plot Deviance Deviance <- list() for (i in 1:Chains) {Deviance[[i]] <- x[[i]][["Deviance"]]} plot(Stat.at:nn, Deviance[[1]][Stat.at:nn], ylim=c(min(sapply(Deviance, function(x) {min(x[Stat.at:nn])})), max(sapply(Deviance, function(x) {max(x[Stat.at:nn])}))), col=rgb(0,0,0,50,maxColorValue=255), type="l", xlab="Thinned Samples", ylab="Value", main="Deviance") for (n in 2:Chains) { lines(Stat.at:nn, Deviance[[n]][Stat.at:nn], col=rgb(col2rgb(n)[1], col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255))} plot(density(Deviance[[1]][Stat.at:nn]), col="white", xlab="Value", main="Deviance") polygon(density(Deviance[[1]][Stat.at:nn]), col=rgb(0,0,0,50,maxColorValue=255), border=NA) for (n in 2:Chains) { polygon(density(Deviance[[n]][Stat.at:nn]), col=rgb(col2rgb(n)[1], col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255), border=NA)} abline(v=0, col="red", lty=2) #### Only plot an ACF if there's > 1 unique values if(!is.constant(Deviance[[1]][Stat.at:nn])) { z <- acf(Deviance[[1]][Stat.at:nn], plot=FALSE) se <- 1/sqrt(length(Deviance[[1]][Stat.at:nn])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), col=rgb(0,0,0,50,maxColorValue=255), type="h", main="Deviance", xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) for (n in 2:Chains) { z <- acf(Deviance[[n]][Stat.at:nn], plot=FALSE) se <- 1/sqrt(length(Deviance[[n]][Stat.at:nn])) lines(z$lag, z$acf, col=rgb(col2rgb(n)[1], col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255))} } else {plot(0, 0, main="Deviance is a constant.")} rm(Deviance) #### Plot Monitored Variables J <- length(Data[["mon.names"]]) Monitor <- list() for (i in 1:Chains) { Monitor[[i]] <- matrix(x[[i]][["Monitor"]], nn, J)} for (j in 1:J) { plot(Stat.at:nn, Monitor[[1]][Stat.at:nn,j], ylim=c(min(sapply(Monitor, function(x) {min(x[Stat.at:nn,j])})), max(sapply(Monitor, function(x) {max(x[Stat.at:nn,j])}))), col=rgb(0,0,0,50,maxColorValue=255), type="l", xlab="Thinned Samples", ylab="Value", main=Data[["mon.names"]][j]) for (n in 2:Chains) { lines(Stat.at:nn, Monitor[[n]][Stat.at:nn,j], col=rgb(col2rgb(n)[1],col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255))} plot(density(Monitor[[1]][Stat.at:nn,j]), col="white", xlab="Value", main=Data[["mon.names"]][j]) polygon(density(Monitor[[1]][Stat.at:nn,j]), col=rgb(0,0,0,50,maxColorValue=255), border=NA) for (n in 2:Chains) { polygon(density(Monitor[[n]][Stat.at:nn,j]), col=rgb(col2rgb(n)[1],col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255), border=NA)} abline(v=0, col="red", lty=2) ### Only plot an ACF if there's > 1 unique values if(!is.constant(Monitor[[1]][Stat.at:nn,j])) { z <- acf(Monitor[[1]][Stat.at:nn,j], plot=FALSE) se <- 1/sqrt(length(Monitor[[1]][Stat.at:nn,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), col=rgb(0,0,0,50,maxColorValue=255), type="h", main=Data[["mon.names"]][j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) for (n in 2:Chains) { z <- acf(Monitor[[n]][Stat.at:nn,j], plot=FALSE) se <- 1/sqrt(length(Monitor[[n]][Stat.at:nn,j])) lines(z$lag, z$acf, col=rgb(col2rgb(n)[1], col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255))} } else {plot(0, 0, main=paste(Data[["mon.names"]][j], "is a constant."))} } rm(Monitor) #### Diminishing Adaptation if(nrow(x[[1]]$CovarDHis) > 1) { Diff <- abs(diff(x[[1]]$CovarDHis)) adaptchange <- matrix(NA, nrow(Diff), 3) for (i in 1:nrow(Diff)) { adaptchange[i,1:3] <- as.vector(quantile(Diff[i,], probs=c(0.025, 0.500, 0.975)))} plot(adaptchange[,2], ylim=c(min(adaptchange), max(adaptchange)), type="l", col=rgb(0,0,0,50,maxColorValue=255), xlab="Adaptations", ylab="Absolute Difference", main="Proposal Variance", sub="Median=Red, 95% Bounds=Gray") for (n in 2:Chains) { Diff <- abs(diff(x[[n]]$CovarDHis)) adaptchange <- matrix(NA, nrow(Diff), 3) for (i in 1:nrow(Diff)) { adaptchange[i,1:3] <- as.vector(quantile(Diff[i,], probs=c(0.025, 0.500, 0.975)))} lines(adaptchange[,2], col=rgb(col2rgb(n)[1], col2rgb(n)[2],col2rgb(n)[3],50, maxColorValue=255))} } if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/caterpillar.plot.R0000755000176200001440000004003615144316355016601 0ustar liggesusers########################################################################### # caterpillar.plot # # # # The purpose of the caterpillar.plot function is to provide a # # caterpillar plot of the posterior summaries in an object of class # # demonoid, laplace, or pmc, or also of S x J matrix of S samples and J # # variables. # ########################################################################### caterpillar.plot <- function(x, Parms=NULL, Title=NULL) { ### Initial Checks if(missing(x)) stop("The x argument is required.") par(mfrow=c(1,1)) if(identical(class(x), "demonoid")) { if(any(is.na(x$Summary2))) { x <- x$Summary1 x.lab <- "All Samples"} else { x <- x$Summary2 x.lab <- "Stationary Samples"} if(!is.null(Parms)) { if(is.character(Parms)) { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(x)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(x)))} } } if(is.numeric(Parms)) keeprows <- Parms temp <- x x <- matrix(x[keeprows,], length(keeprows), ncol(temp)) rownames(x) <- rownames(temp)[keeprows] colnames(x) <- colnames(temp) } ### Setup x.rows <- nrow(x) x.lim <- c(min(x[,5]), max(x[,7])) y.lim <- c(0, x.rows+1) ### Basic Plot plot(0, 0, ylim=y.lim, xlim=x.lim, main=Title, sub="", xlab=x.lab, ylab="", type="n", ann=TRUE, yaxt="n") abline(v=0, col="gray") ### Add Medians points(x[,6], x.rows:1, pch=20) ### Add Horizontal Lines for 2.5%-97.5% Quantiles for (i in 1:x.rows) { lines(x[i,c(5,7)], c(x.rows-i+1, x.rows-i+1))} ### Add y-axis labels yy <- x.rows:1 cex.labels <- 1 / {log(x.rows)/5 + 1} axis(2, labels=rownames(x), tick=FALSE, las=1, at=yy, cex.axis=cex.labels) } else if(identical(class(x), "demonoid.hpc")) { Chains <- length(x) x.temp <- list() for (i in 1:Chains) {x.temp[[i]] <- x[[i]][["Summary1"]]} x <- x.temp; remove(x.temp) x.lab <- "All Samples" if(!is.null(Parms)) { if(is.character(Parms)) { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(x[[1]]))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(x[[1]])) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(x[[1]]))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(x[[1]])))} } } if(is.numeric(Parms)) keeprows <- Parms temp <- x for (i in 1:Chains) { x[[i]] <- matrix(x[[i]][keeprows,], length(keeprows), ncol(temp[[1]]))} rownames(x[[1]]) <- rownames(temp[[1]])[keeprows] colnames(x[[1]]) <- colnames(temp[[1]]) } ### Setup x.rows <- nrow(x[[1]]) x.lim <- c(min(x[[1]][,5]), max(x[[1]][,7])) y.lim <- c(0, x.rows+1) ### Basic Plot plot(0, 0, ylim=y.lim, xlim=x.lim, main=Title, sub="", xlab=x.lab, ylab="", type="n", ann=TRUE, yaxt="n") abline(v=0, col="gray") ### Add Medians points(x[[1]][,6], x.rows:1, pch=20) for (i in 2:Chains) {points(x[[i]][,6], (x.rows:1)-(i/10), col=i, pch=20)} ### Add Horizontal Lines for 2.5%-97.5% Quantiles for (i in 1:x.rows) { lines(x[[1]][i,c(5,7)], c(x.rows-i+1, x.rows-i+1))} for (j in 2:Chains) {for (i in 1:x.rows) { lines(x[[j]][i,c(5,7)], c(x.rows-i+1-(j/10), x.rows-i+1-(j/10)), col=j)}} ### Add y-axis labels yy <- x.rows:1 cex.labels <- 1 / {log(x.rows)/5 + 1} axis(2, labels=rownames(x[[1]]), tick=FALSE, las=1, at=yy, cex.axis=cex.labels) } else if(identical(class(x), "iterquad")) { if(any(is.na(x$Posterior))) { x <- x$Summary1 x.lab <- "Point-Estimates"} else { x <- x$Summary2[1:length(x$Initial.Values),] x.lab <- "SIR Samples"} if(is.null(Parms)) { keeprows <- Parms <- 1:length(x$Initial.Values)} else { if(is.numeric(Parms)) keeprows <- Parms if(is.character(Parms)) { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(x)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(x)))} } } } temp <- x x <- matrix(x[keeprows,], length(keeprows), ncol(temp)) rownames(x) <- rownames(temp)[keeprows] colnames(x) <- colnames(temp) if(x.lab != "SIR Samples") Modes <- x[,1] else Modes <- x[,6] if(x.lab != "SIR Samples") LB <- x[,3] else LB <- x[,5] if(x.lab != "SIR Samples") UB <- x[,4] else UB <- x[,7] ### Setup x.rows <- length(Modes) x.lim <- c(min(LB), max(UB)) y.lim <- c(0, x.rows+1) ### Basic Plot plot(0, 0, ylim=y.lim, xlim=x.lim, main=Title, sub="", xlab=x.lab, ylab="", type="n", ann=TRUE, yaxt="n") abline(v=0, col="gray") ### Add Modes points(Modes, x.rows:1, pch=20) ### Add Horizontal Lines for 2.5%-97.5% Quantiles for (i in 1:x.rows) { lines(c(LB[i], UB[i]), c(x.rows-i+1, x.rows-i+1))} ### Add y-axis labels yy <- x.rows:1 cex.labels <- 1/{log(x.rows)/5 + 1} axis(2, labels=rownames(x), tick=FALSE, las=1, at=yy, cex.axis=cex.labels) } else if(identical(class(x), "laplace")) { if(any(is.na(x$Posterior))) { x <- x$Summary1 x.lab <- "Point-Estimates"} else { x <- x$Summary2[1:length(x$Initial.Values),] x.lab <- "SIR Samples"} if(is.null(Parms)) { keeprows <- Parms <- 1:length(x$Initial.Values)} else { if(is.numeric(Parms)) keeprows <- Parms if(is.character(Parms)) { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(x)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(x)))} } } } temp <- x x <- matrix(x[keeprows,], length(keeprows), ncol(temp)) rownames(x) <- rownames(temp)[keeprows] colnames(x) <- colnames(temp) if(x.lab != "SIR Samples") Modes <- x[,1] else Modes <- x[,6] if(x.lab != "SIR Samples") LB <- x[,3] else LB <- x[,5] if(x.lab != "SIR Samples") UB <- x[,4] else UB <- x[,7] ### Setup x.rows <- length(Modes) x.lim <- c(min(LB), max(UB)) y.lim <- c(0, x.rows+1) ### Basic Plot plot(0, 0, ylim=y.lim, xlim=x.lim, main=Title, sub="", xlab=x.lab, ylab="", type="n", ann=TRUE, yaxt="n") abline(v=0, col="gray") ### Add Modes points(Modes, x.rows:1, pch=20) ### Add Horizontal Lines for 2.5%-97.5% Quantiles for (i in 1:x.rows) { lines(c(LB[i], UB[i]), c(x.rows-i+1, x.rows-i+1))} ### Add y-axis labels yy <- x.rows:1 cex.labels <- 1/{log(x.rows)/5 + 1} axis(2, labels=rownames(x), tick=FALSE, las=1, at=yy, cex.axis=cex.labels) } else if(identical(class(x), "pmc")) { x <- x$Summary x.lab <- "All Samples" if(!is.null(Parms)) { if(is.character(Parms)) { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(x)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(x)))} } } if(is.numeric(Parms)) keeprows <- Parms temp <- x x <- matrix(x[keeprows,], length(keeprows), ncol(temp)) rownames(x) <- rownames(temp)[keeprows] colnames(x) <- colnames(temp) } ### Setup x.rows <- nrow(x) x.lim <- c(min(x[,5]), max(x[,7])) y.lim <- c(0, x.rows+1) ### Basic Plot plot(0, 0, ylim=y.lim, xlim=x.lim, main=Title, sub="", xlab=x.lab, ylab="", type="n", ann=TRUE, yaxt="n") abline(v=0, col="gray") ### Add Medians points(x[,6], x.rows:1, pch=20) ### Add Horizontal Lines for 2.5%-97.5% Quantiles for (i in 1:x.rows) { lines(x[i,c(5,7)], c(x.rows-i+1, x.rows-i+1))} ### Add y-axis labels yy <- x.rows:1 cex.labels <- 1 / {log(x.rows)/5 + 1} axis(2, labels=rownames(x), tick=FALSE, las=1, at=yy, cex.axis=cex.labels) } else if(identical(class(x), "vb")) { if(any(is.na(x$Posterior))) { x <- x$Summary1 x.lab <- "Point-Estimates"} else { x <- x$Summary2[1:length(x$Initial.Values),] x.lab <- "SIR Samples"} if(is.null(Parms)) { keeprows <- Parms <- 1:length(x$Initial.Values)} else { if(is.numeric(Parms)) keeprows <- Parms if(is.character(Parms)) { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(x)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(x)))} } } } temp <- x x <- matrix(x[keeprows,], length(keeprows), ncol(temp)) rownames(x) <- rownames(temp)[keeprows] colnames(x) <- colnames(temp) if(x.lab != "SIR Samples") Modes <- x[,1] else Modes <- x[,6] if(x.lab != "SIR Samples") LB <- x[,3] else LB <- x[,5] if(x.lab != "SIR Samples") UB <- x[,4] else UB <- x[,7] ### Setup x.rows <- length(Modes) x.lim <- c(min(LB), max(UB)) y.lim <- c(0, x.rows+1) ### Basic Plot plot(0, 0, ylim=y.lim, xlim=x.lim, main=Title, sub="", xlab=x.lab, ylab="", type="n", ann=TRUE, yaxt="n") abline(v=0, col="gray") ### Add Modes points(Modes, x.rows:1, pch=20) ### Add Horizontal Lines for 2.5%-97.5% Quantiles for (i in 1:x.rows) { lines(c(LB[i], UB[i]), c(x.rows-i+1, x.rows-i+1))} ### Add y-axis labels yy <- x.rows:1 cex.labels <- 1/{log(x.rows)/5 + 1} axis(2, labels=rownames(x), tick=FALSE, las=1, at=yy, cex.axis=cex.labels) } else { x <- as.matrix(x) x.hpd <- p.interval(x, HPD=TRUE, MM=FALSE, prob=0.95) x.median <- apply(x, 2, median) x <- cbind(colMeans(x), sqrt(.colVars(x)), apply(x, 2, MCSE), ESS(x), x.hpd[,1], apply(x, 2, median), x.hpd[,2]) rownames(x) <- rownames(x.hpd) colnames(x) <- c("Mean","SD","MCSE","ESS","LB","Median","UB") x.lab <- "All Samples" ### Setup x.rows <- nrow(x) x.lim <- c(min(x[,5]), max(x[,7])) y.lim <- c(0, x.rows+1) ### Basic Plot plot(0, 0, ylim=y.lim, xlim=x.lim, main=Title, sub="", xlab=x.lab, ylab="", type="n", ann=TRUE, yaxt="n") abline(v=0, col="gray") ### Add Medians points(x[,6], x.rows:1, pch=20) ### Add Horizontal Lines for 2.5%-97.5% Quantiles for (i in 1:x.rows) { lines(x[i,c(5,7)], c(x.rows-i+1, x.rows-i+1))} ### Add y-axis labels yy <- x.rows:1 cex.labels <- 1 / {log(x.rows)/5 + 1} axis(2, labels=rownames(x), tick=FALSE, las=1, at=yy, cex.axis=cex.labels) } } #End LaplacesDemon/R/ESS.R0000755000176200001440000000267315144316355013761 0ustar liggesusers########################################################################### # ESS # # # # The purpose of the ESS function is to estimate the effective sample # # size (ESS) of a target distribution after taking autocorrelation into # # account. Although the code is slightly different, it is essentially the # # same as the effectiveSize function in the coda package. # ########################################################################### ESS <- function(x) { x <- as.matrix(x) v0 <- order <- rep(0, ncol(x)) names(v0) <- names(order) <- colnames(x) N <- nrow(x) z <- 1:N for (i in 1:ncol(x)) { lm.out <- lm(x[, i] ~ z) if(!identical(all.equal(sd(residuals(lm.out)), 0), TRUE)) { ar.out <- try(ar(x[,i], aic=TRUE), silent=TRUE) if(!inherits(ar.out, "try-error")) { v0[i] <- ar.out$var.pred / {1 - sum(ar.out$ar)}^2 order[i] <- ar.out$order}}} spec <- list(spec=v0, order=order) spec <- spec$spec temp <- N * .colVars(x) / spec out <- spec out[which(spec != 0)] <- temp[which(spec != 0)] out[which(out < .Machine$double.eps)] <- .Machine$double.eps out[which(out > N)] <- N return(out) } #End LaplacesDemon/R/plot.pmc.ppc.R0000755000176200001440000010640215144343107015632 0ustar liggesusers########################################################################### # plot.pmc.ppc # # # # The purpose of the plot.pmc.ppc function is to plot an object of class # # pmc.ppc. # ########################################################################### plot.pmc.ppc <- function(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "pmc.ppc")) stop("x is not of class pmc.ppc.") if(is.null(Style)) Style <- "Density" if(is.null(Rows)) Rows <- 1:nrow(x[["yhat"]]) ### Plots if(Style == "Covariates") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) { plot(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75, ylim=c(min(temp[Rows,c(1,4:6)]),max(temp[Rows,c(1,4:6)])), xlab=paste("X[,",i,"]", sep=""), ylab="yhat", sub="Gray lines are yhat at 2.5% and 95%.") panel.smooth(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75)}} if(Style == "Covariates, Categorical DV") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.Cat.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Categorical=TRUE, Quiet=TRUE)$Summary ncat <- length(table(temp[,1])) mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) {for (j in 2:(ncat+1)) { plot(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75, xlab=paste("X[,",i,"]", sep=""), ylab=colnames(temp)[j]) panel.smooth(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75)}}} if(Style == "Density") { if(PDF == TRUE) { pdf("PPC.Plots.Density.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) for (j in 1:length(Rows)) { plot(density(x[["yhat"]][Rows[j],]), main=paste("Post. Pred. Plot of yhat[", Rows[j], ",]", sep=""), xlab="Value", sub="Black=Density, Red=y") polygon(density(x[["yhat"]][Rows[j],]), col="black", border="black") abline(v=x[["y"]][Rows[j]], col="red")}} if(Style == "DW") { if(PDF == TRUE) pdf("PPC.Plots.DW.pdf") par(mfrow=c(1,1)) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[,s]))^2, na.rm=TRUE) / sum(epsilon.obs[,s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[,s]))^2, na.rm=TRUE) / sum(epsilon.rep[,s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")} if(Style == "DW, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.DW.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (j in 1:J) { for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.obs[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.rep[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep=""), sub=paste("Y[,",j,"]",sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")}} if(Style == "ECDF") { if(PDF == TRUE) pdf("PPC.Plots.ECDF.pdf") par(mfrow=c(1,1)) plot(ecdf(x[["y"]][Rows]), verticals=TRUE, do.points=FALSE, main="Cumulative Fit", xlab="y (black) and yhat (red; gray)", ylab="Cumulative Frequency") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.975)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.025)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.500)), verticals=TRUE, do.points=FALSE, col="red")} if(Style == "Fitted") { if(PDF == TRUE) pdf("PPC.Plots.Fitted.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75, ylim=c(min(temp[Rows,4], na.rm=TRUE), max(temp[Rows,6], na.rm=TRUE)), xlab="y", ylab="yhat", main="Fitted") for (i in Rows) { lines(c(temp[Rows[i],1], temp[Rows[i],1]), c(temp[Rows[i],4], temp[Rows[i],6]))} panel.smooth(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75)} if(Style == "Fitted, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:nrow(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Fitted, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:ncol(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Jarque-Bera") { if(PDF == TRUE) pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1)) epsilon.obs <- epsilon.rep <- x[["y"]][Rows] - x[["yhat"]][Rows,] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (s in 1:ncol(epsilon.obs)) { epsilon.rep[,s] <- rnorm(N, mean(epsilon.obs[,s], na.rm=TRUE), sd(epsilon.obs[,s], na.rm=TRUE)) K.obs <- kurtosis(epsilon.obs[,s]) S.obs <- skewness(epsilon.obs[,s]) K.rep <- kurtosis(epsilon.rep[,s]) S.rep <- skewness(epsilon.rep[,s]) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab="JB", ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Jarque-Bera, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Jarque-Bera, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- epsilon.rep <- x[["y"]] - x[["yhat"]] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (j in 1:J) { for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.rep <- rnorm(M, mean(e.obs[,j], na.rm=TRUE), sd(e.obs[,j], na.rm=TRUE)) K.obs <- kurtosis(e.obs[,j]) S.obs <- skewness(e.obs[,j]) K.rep <- kurtosis(e.rep) S.rep <- skewness(e.rep) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab=paste("JB for Y[,",j,"]", sep=""), ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)}} if(Style == "Mardia") { if(PDF == TRUE) pdf("PPC.Plots.Mardia.pdf") par(mfrow=c(2,1)) if(is.null(Data)) stop("Data is required for Style=Mardia, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Mardia, C.") epsilon.obs <- x[["y"]] - x[["yhat"]] M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) K3.obs <- K3.rep <- K4.obs <- K4.rep <- rep(0, ncol(epsilon.obs)) for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.obs.mu <- colMeans(e.obs) e.obs.mu.mat <- matrix(e.obs.mu, M, J, byrow=TRUE) e.obs.stand <- e.obs - e.obs.mu.mat S.obs <- var(e.obs) A.obs <- t(chol(S.obs)) A.inv.obs <- solve(A.obs) Z.obs <- t(A.inv.obs %*% t(e.obs.stand)) Dij.obs <- Z.obs %*% t(Z.obs) D2.obs <- diag(Dij.obs) K3.obs[s] <- mean(as.vector(Dij.obs)^3) K4.obs[s] <- mean(D2.obs^2) e.rep <- rmvn(M, e.obs.mu.mat, S.obs) e.rep.mu <- colMeans(e.rep) e.rep.mu.mat <- matrix(e.rep.mu, M, J, byrow=TRUE) e.rep.stand <- e.rep - e.rep.mu.mat S.rep <- var(e.rep) A.rep <- t(chol(S.rep)) A.inv.rep <- solve(A.rep) Z.rep <- t(A.inv.rep %*% t(e.rep.stand)) Dij.rep <- Z.rep %*% t(Z.rep) D2.rep <- diag(Dij.rep) K3.rep[s] <- mean(as.vector(Dij.rep)^3) K4.rep[s] <- mean(D2.rep^2)} p.K3 <- round(mean(K3.obs > K3.rep), 3) p.K4 <- round(mean(K4.obs > K4.rep), 3) K3.result <- K4.result <- "Non-Normality" if((p.K3 >= 0.025) & (p.K3 <= 0.975)) K3.result <- "Normality" if((p.K4 >= 0.025) & (p.K4 <= 0.975)) K4.result <- "Normality" d.K3.obs <- density(K3.obs) d.K3.rep <- density(K3.rep) d.K4.obs <- density(K4.obs) d.K4.rep <- density(K4.rep) plot(d.K3.obs, xlim=c(min(d.K3.obs$x, d.K3.rep$x), max(d.K3.obs$x, d.K3.rep$x)), ylim=c(0, max(d.K3.obs$y, d.K3.rep$y)), col="white", main="Mardia's Test of MVN Skewness", xlab="Skewness Test Statistic (K3)", ylab="Density", sub=paste("K3.obs=", round(mean(K3.obs, na.rm=TRUE), 2), " (", round(quantile(K3.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K3.obs, probs=0.975, na.rm=TRUE), 2), "), p(K3.obs > K3.rep) = ", p.K3, " = ", K3.result, sep="")) polygon(d.K3.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K3.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) plot(d.K4.obs, xlim=c(min(d.K4.obs$x, d.K4.rep$x), max(d.K4.obs$x, d.K4.rep$x)), ylim=c(0, max(d.K4.obs$y, d.K4.rep$y)), col="white", main="Mardia's Test of MVN Kurtosis", xlab="Kurtosis Test Statistic (K4)", ylab="Density", sub=paste("K4.obs=", round(mean(K4.obs, na.rm=TRUE), 2), " (", round(quantile(K4.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K4.obs, probs=0.975, na.rm=TRUE), 2), "), p(K4.obs > K4.rep) = ", p.K4, " = ", K4.result, sep="")) polygon(d.K4.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K4.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Predictive Quantiles") { if(PDF == TRUE) pdf("PPC.Plots.PQ.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) plot(temp[Rows,1], temp[Rows,7], ylim=c(0,1), col=mycol, pch=16, cex=0.75, xlab="y", ylab="PQ", main="Predictive Quantiles") panel.smooth(temp[Rows,1], temp[Rows,7], col=mycol, pch=16, cex=0.75) abline(h=0.025, col="gray") abline(h=0.975, col="gray")} if(Style == "Residual Density") { if(PDF == TRUE) pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) dens <- density(epsilon.summary[2,Rows], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=expression(epsilon), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")} if(Style == "Residual Density, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { dens <- density(epsilon.500[,i], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[,", i, "]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residual Density, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, R.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { dens <- density(epsilon.500[i,], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[", i, ",]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residuals") { if(PDF == TRUE) pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) plot(epsilon.summary[2,Rows], pch=16, cex=0.75, ylim=c(min(epsilon.summary[,Rows], na.rm=TRUE), max(epsilon.summary[,Rows], na.rm=TRUE)), xlab="y", ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.summary[,Rows])), col="red") for (i in Rows) { lines(c(i,i), c(epsilon.summary[1,Rows[i]], epsilon.summary[3,Rows[i]]), col="black")}} if(Style == "Residuals, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { plot(epsilon.500[,i], pch=16, cex=0.75, ylim=c(min(epsilon.025[,i], na.rm=TRUE), max(epsilon.975[,i], na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab=expression(epsilon)) lines(rep(0, nrow(epsilon.500)), col="red") for (j in 1:nrow(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[j,i], epsilon.975[j,i]), col="black")}}} if(Style == "Residuals, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { plot(epsilon.500[i,], pch=16, cex=0.75, ylim=c(min(epsilon.025[i,], na.rm=TRUE), max(epsilon.975[i,], na.rm=TRUE)), xlab=paste("Y[", i, ",]", sep=""), ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.500)), col="red") for (j in 1:ncol(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[i,j], epsilon.975[i,j]), col="black")}}} if(Style == "Space-Time by Space") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Space.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (s in 1:Data[["S"]]) { plot(matrix(temp[,1], Data[["S"]], Data[["T"]])[s,], ylim=c(min(c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE), max(c(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Space-Time at Space s=",s," of ", Data[["S"]], sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:Data[["T"]],rev(1:Data[["T"]])), c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], rev(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(matrix(temp[,5], Data[["S"]], Data[["T"]])[s,], col="red")}} if(Style == "Space-Time by Time") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Time.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") Heat <- (1-(x[["y"]]-min(x[["y"]], na.rm=TRUE)) / max(x[["y"]]-min(x[["y"]], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 Heat <- matrix(Heat, Data[["S"]], Data[["T"]]) for (t in 1:Data[["T"]]) { plot(Data[["longitude"]], Data[["latitude"]], col=heat.colors(120)[Heat[,t]], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main=paste("Space-Time at t=",t," of ", Data[["T"]], sep=""), sub="Red=High, Yellow=Low")}} if(Style == "Spatial") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- (1-(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE)) / max(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Plot", sub="Red=High, Yellow=Low")} if(Style == "Spatial Uncertainty") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.Unc.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial Uncertainty.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- apply(x[["yhat"]], 1, quantile, probs=c(0.025,0.975)) heat <- heat[2,] - heat[1,] heat <- (1-(heat[Rows]-min(heat[Rows])) / max(heat[Rows]-min(heat[Rows]))) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Uncertainty Plot", sub="Red=High, Yellow=Low")} if(Style == "Time-Series") { if(PDF == TRUE) pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(Rows, temp[Rows,1], ylim=c(min(temp[Rows,c(1,4)], na.rm=TRUE), max(temp[Rows,c(1,6)], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main="Plot of Fitted Time-Series", sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(Rows,rev(Rows)),c(temp[Rows,4],rev(temp[Rows,6])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(Rows, temp[Rows,1]) lines(Rows, temp[Rows,5], col="red")} if(Style == "Time-Series, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][,i], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE), max(Data[["Y"]][,i], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", ncol(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(Style == "Time-Series, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][i,], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE), max(Data[["Y"]][i,], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", nrow(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/Gelfand.Diagnostic.R0000755000176200001440000000474215144316355016751 0ustar liggesusers########################################################################### # Gelfand.Diagnostic # # # # The Gelfand.Diagnostic function is an interpretation of Gelfand's # # ``thick felt-tip pen'' MCMC convergence diagnostic (Gelfand et al., # # 1990). # ########################################################################### Gelfand.Diagnostic <- function(x, k=3, pen=FALSE) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!is.vector(x)) x <- as.vector(x) if(k < 2) k <- 2 if(k > length(x)/2) k <- round(length(x)/2) if({length(x)/k} < 2) stop("k is too large relative to length(x).") ### KDE quantiles <- seq(from=0, to=1, by=1/k) breaks <- round(as.vector(quantiles)*length(x)) breaks <- breaks[-1] d.temp <- density(x) d <- array(c(d.temp$x, d.temp$y), dim=c(length(d.temp$x), 2, length(breaks))) d.temp <- density(x[1:breaks[1]]) d[,,1] <- c(d.temp$x, d.temp$y) for (i in 2:length(breaks)) { d.temp <- density(x[1:breaks[i]]) d[,,i] <- c(d.temp$x, d.temp$y)} ### Plots ymax <- max(d[,2,]) col.list <- c("red", "green", "blue", "yellow", "purple", "orange", "brown", "gray", "burlywood", "aquamarine") col.list <- rep(col.list, len=length(breaks)) rgb.temp <- as.vector(col2rgb(col.list[1])) mycol <- rgb(red=rgb.temp[1], green=rgb.temp[2], blue=rgb.temp[3], alpha=50, maxColorValue=255) plot(d[,1,1], d[,2,1], type="l", col=mycol, xlim=c(range(d[,1,])), ylim=c(0,ymax), main="Gelfand Diagnostic", xlab=deparse(substitute(x)), ylab="Density") polygon(x=d[,1,1], y=d[,2,1], col=mycol, border=NULL) for (i in 2:length(breaks)) { rgb.temp <- as.vector(col2rgb(col.list[i])) mycol <- rgb(red=rgb.temp[1], green=rgb.temp[2], blue=rgb.temp[3], alpha=50, maxColorValue=255) lines(d[,1,i], d[,2,i], col=mycol) polygon(x=d[,1,i], y=d[,2,i], col=mycol, border=mycol) lines(d[,1,i], d[,2,i], lty=i)} if(pen == TRUE) abline(v=mean(range(d[,1,])), col="black", lwd=10) legend(quantile(d[,1,], probs=0.025), round(ymax*0.9,2), legend=paste("1:",breaks,sep=""), lty=1:k, title="Samples") return(invisible(x)) } #End LaplacesDemon/R/SIR.R0000755000176200001440000000612415144316355013757 0ustar liggesusers########################################################################### # Sampling Importance Resampling (SIR) # # # # The purpose of the SIR function is to perform sampling importance # # re-sampling, usually to draw samples from the posterior as output from # # LaplaceApproxmation function. This function is similar to the sir # # function in the LearnBayes package. # ########################################################################### SIR <- function(Model, Data, mu, Sigma, n=1000, CPUs=1, Type="PSOCK") { if(missing(Model)) stop("The Model function is required.") if(missing(Data)) stop("The Data argument is required.") if(missing(mu)) stop("The mu argument is required.") if(!is.vector(mu)) mu <- as.vector(mu) if(missing(Sigma)) stop("The Sigma argument is required.") if(!is.symmetric.matrix(Sigma)) Sigma <- as.symmetric.matrix(Sigma) if(!is.positive.definite(Sigma)) Sigma <- as.positive.definite(Sigma) if(length(mu) != nrow(Sigma)) stop("mu and Sigma are incompatible.") ### Sampling k <- length(mu) theta <- rmvn(n, mu, Sigma) theta[which(!is.finite(theta))] <- 0 colnames(theta) <- Data[["parm.names"]] ### Importance lf <- matrix(0, n, 1) ### Non-Parallel Processing if(CPUs == 1) { for (i in 1:n) { mod <- Model(theta[i,], Data) lf[i] <- mod[["LP"]] theta[i,] <- mod[["parm"]]} } else { ### Parallel Processing detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cl <- makeCluster(CPUs, Type) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) mod <- parLapply(cl, 1:nrow(theta), function(x) Model(theta[x,], Data)) stopCluster(cl) lf <- unlist(lapply(mod, function(x) x[["LP"]]))[1:nrow(theta)] theta <- matrix(unlist(lapply(mod, function(x) x[["parm"]])), nrow(theta), ncol(theta)) rm(mod)} lp <- dmvn(theta, mu, Sigma, log=TRUE) md <- max(lf - lp) lw <- lf - lp - md if(any(!is.finite(lw))) lw[!is.finite(lw)] <- min(lw[is.finite(lw)]) probs <- exp(lw - logadd(lw)) ### Resampling options(warn=-1) indices <- try(sample.int(n, size=n, replace=TRUE, prob=probs), silent=TRUE) options(warn=0) if(inherits(indices, "try-error")) indices <- 1:n if(k > 1) theta <- theta[indices,] else theta <- theta[indices] return(theta) } #End LaplacesDemon/R/Hangartner.Diagnostic.R0000644000176200001440000000107315144316355017471 0ustar liggesusers########################################################################### # Hangartner.Diagnostic # ########################################################################### Hangartner.Diagnostic <- function(x, J=2) { x <- as.vector(x) if(!all(x == round(x))) stop("x is not discrete.") N <- length(x) j <- rep(1:J, each=N/J) if(N %% J != 0) stop("N must be divisible by J.") tab <- table(x, j) out <- chisq.test(x, j) class(out) <- "hangartner" return(out) } #End LaplacesDemon/R/plot.vb.R0000755000176200001440000000743215144343151014703 0ustar liggesusers########################################################################### # plot.vb # # # # The purpose of the plot.vb function is to plot an object of class vb. # ########################################################################### plot.vb <- function(x, Data=NULL, PDF=FALSE, Parms=NULL, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "vb")) stop("x must be of class vb.") if(is.null(Data)) stop("The Data argument is NULL.") if(any(is.na(x$History))) stop("There is no history to plot.") ### Selecting Parms if(is.null(Parms)) { History1 <- x$History[,,1] History2 <- x$History[,,2] Posterior <- x$Posterior} else { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], dimnames(x$History)[[2]])) == 0) stop("Parameter in Parms does not exist.") keepcols <- grep(Parms[1], dimnames(x$History[[2]])) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], dimnames(x$History)[[2]])) == 0) stop("Parameter in Parms does not exist.") keepcols <- c(keepcols, grep(Parms[i], dimnames(x$History)[[2]]))}} History1 <- as.matrix(x$History[,keepcols,1]) History2 <- as.matrix(x$History[,keepcols,2]) colnames(History1) <- dimnames(x$History)[[2]][keepcols] colnames(History2) <- dimnames(x$History)[[2]][keepcols] if(all(!is.na(x$Posterior))) { Posterior <- as.matrix(x$Posterior[,keepcols]) colnames(Posterior) <- colnames(History1)} else Posterior <- x$Posterior } if(PDF == TRUE) { pdf("VariationalBayes.Plots.pdf") par(mfrow=c(3,3)) } else {par(mfrow=c(3,3), ask=TRUE)} ### Plot Parameter for (j in 1:ncol(History1)) { plot(1:nrow(History1), History1[,j], type="l", xlab="Iterations", ylab="Value (Mean)", main=colnames(History1)[j]) plot(1:nrow(History2), History2[,j], type="l", xlab="Iterations", ylab="Value (Variance)", main=colnames(History2)[j]) if({x$Converged == TRUE} & !any(is.na(Posterior))) { plot(density(Posterior[,j]), xlab="Value", main=colnames(Posterior)[j]) polygon(density(Posterior[,j]), col="black", border="black") abline(v=0, col="red", lty=2) } else { draws <- rnorm(1000, x$Summary1[j,1], x$Summary1[j,2]) plot(density(draws), xlab="Value", main=colnames(History1)[j]) polygon(density(draws), col="black", border="black") abline(v=0, col="red", lty=2)} } ### Plot Deviance History plot(1:length(x$Deviance), x$Deviance, type="l", xlab="Iterations", ylab="Value", main="Deviance") ### Plot Monitor if({x$Converged == TRUE} & !any(is.na(x$Monitor))) { for (j in 1:ncol(x$Monitor)) { plot(density(x$Monitor[,j]), xlab="Value", main=Data[["mon.names"]][j]) polygon(density(x$Monitor[,j]), col="black", border="black") abline(v=0, col="red", lty=2)} } if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/summary.laplace.ppc.R0000755000176200001440000002673115144316355017206 0ustar liggesusers########################################################################### # summary.laplace.ppc # # # # The purpose of the summary.laplace.ppc function is to summarize an # # object of class laplace.ppc (posterior predictive check). # ########################################################################### summary.laplace.ppc <- function(object=NULL, Categorical=FALSE, Rows=NULL, Discrep=NULL, d=0, Quiet=FALSE, ...) { if(is.null(object)) stop("The object argument is NULL.") y <- object$y yhat <- object$yhat Deviance <- object$Deviance monitor <- object$monitor if(is.null(Rows)) Rows <- 1:length(y) if(any(Rows > length(y)) || any(Rows <= 0)) { warning("Invalid Rows argument; All rows included.") Rows <- 1:length(y)} ### Create Continuous Summary Table for y and yhat if(Categorical == FALSE) { Summ <- matrix(NA, length(y), 8, dimnames=list(1:length(y), c("y","Mean","SD","LB","Median","UB","PQ","Discrep"))) Summ[,1] <- y Summ[,2] <- round(rowMeans(yhat),3) Summ[,3] <- round(sqrt(.rowVars(yhat)),3) for(i in 1:length(y)) { Summ[i,4] <- round(quantile(yhat[i,], probs=0.025, na.rm=TRUE),3) Summ[i,5] <- round(quantile(yhat[i,], probs=0.500, na.rm=TRUE),3) Summ[i,6] <- round(quantile(yhat[i,], probs=0.975, na.rm=TRUE),3) Summ[i,7] <- round(mean(yhat[i,] >= y[i], na.rm=TRUE),3) } ### Discrepancy Statistics Concordance <- 1 - mean(({Summ[,7] < 0.025} | {Summ[,7] > 0.975}), na.rm=TRUE) Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "Chi-Square"}) { Summ[,8] <- round((y - rowMeans(yhat))^2 / .rowVars(yhat),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Chi-Square2"}) { chisq.obs <- chisq.rep <- yhat E.y <- E.yrep <- rowMeans(yhat, na.rm=TRUE) for (i in 1:nrow(yhat)) { chisq.obs[i,] <- (y[i] - E.y[i])^2 / E.y[i] chisq.rep[i,] <- (yhat[i,] - E.yrep[i])^2 / E.yrep[i] } Summ[,8] <- round(rowMeans(chisq.rep > chisq.obs, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean((Summ[,8] < 0.025) | (Summ[,8] > 0.975), na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Kurtosis"}) { kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} for (i in 1:length(y)) {Summ[i,8] <- round(kurtosis(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "L.criterion"}) { Summ[,8] <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MASE"}) { Summ[,8] <- round(abs(rowMeans(y - yhat, na.rm=TRUE) / mean(abs(diff(y)), na.rm=TRUE)), 3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MSE"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "PPL"}) { Summ[,8] <- round(.rowVars(yhat) + (d/(d+1)) * (rowMeans(yhat) - y)^2,3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Loss"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Utility"}) { Summ[,8] <- round(rowMeans(-1*(y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "RMSE"}) { Summ[,8] <- round(sqrt(rowMeans((y - yhat)^2, na.rm=TRUE)),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Skewness"}) { skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} for (i in 1:length(y)) {Summ[i,8] <- round(skewness(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "max(yhat[i,]) > max(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- max(yhat[i,]) > max(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,]) > mean(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,]) > mean(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > d)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > d)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > mean(y))"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > mean(y))} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "min(yhat[i,]) < min(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- min(yhat[i,]) < min(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "round(yhat[i,]) = d"}) { for (i in 1:length(y)) { Summ[i,8] <- round(mean(round(yhat[i,]) == d, na.rm=TRUE), 3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "sd(yhat[i,]) > sd(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- sd(yhat[i,]) > sd(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} L <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2), 3) S.L <- round(sd(L, na.rm=TRUE),3); L <- round(sum(L, na.rm=TRUE),3) ### Deviance Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE) / 2,3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" ### Create Summary Table for monitored variables Mon <- matrix(NA, nrow(monitor), 5, dimnames=list(c(rownames(monitor)), c("Mean","SD","LB","Median","UB"))) for (i in 1:nrow(monitor)) { Mon[i,1] <- mean(monitor[i,]) Mon[i,2] <- round(sd(monitor[i,]),3) Mon[i,3] <- round(quantile(monitor[i,], probs=0.025),3) Mon[i,4] <- round(quantile(monitor[i,], probs=0.500),3) Mon[i,5] <- round(quantile(monitor[i,], probs=0.975),3) } ### Create Output Summ.out <- list(BPIC=bpic, Concordance=Concordance, Discrepancy.Statistic=round(Discrepancy.Statistic,5), L.criterion=L, S.L=S.L, Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Concordance: ", Concordance, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("L-criterion: ", L, ", S.L: ", S.L, sep="", "\n") cat("Monitors:\n") print(Mon) cat("\n\nRecords:\n") print(Summ[Rows,])} } ### Create Categorical Summary Table else { catcounts <- table(y) sumnames <- rep(NA, length(catcounts)+3) sumnames[1] <- "y" for (i in 1:length(catcounts)) { sumnames[i+1] <- paste("p(yhat=",names(catcounts)[i],")",sep="")} sumnames[length(sumnames)-1] <- "Lift" sumnames[length(sumnames)] <- "Discrep" Summ <- matrix(NA, length(y), length(sumnames), dimnames=list(1:length(y), sumnames)) Summ[,1] <- y for (i in 1:length(catcounts)) { Summ[,i+1] <- rowSums(yhat == as.numeric(names(catcounts)[i])) / ncol(yhat)} Summ[,{ncol(Summ)-1}] <- 1 for (i in 1:length(y)) { Summ[i,{ncol(Summ)-1}] <- Summ[i, grep(Summ[i,1],names(catcounts))+1] / {as.vector(catcounts[grep(Summ[i,1],names(catcounts))]) / sum(catcounts)} - 1} ### Discrepancy Statistics Mean.Lift <- round(mean(Summ[,{ncol(Summ)-1}]),3) Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "p(yhat[i,] != y[i])"}) { for (i in 1:length(y)) { Summ[i,ncol(Summ)] <- 1 - Summ[i, grep(Summ[i,1],names(catcounts))+1]} Discrepancy.Statistic <- round(mean(Summ[,ncol(Summ)], na.rm=TRUE),3)} ### Deviance Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE) / 2,3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" ### Create Summary Table for monitored variables Mon <- matrix(NA, nrow(monitor), 5, dimnames=list(c(rownames(monitor)), c("Mean","SD","LB","Median","UB"))) for (i in 1:nrow(monitor)) { Mon[i,1] <- mean(monitor[i,]) Mon[i,2] <- sd(monitor[i,]) Mon[i,3] <- quantile(monitor[i,], probs=0.025) Mon[i,4] <- quantile(monitor[i,], probs=0.500) Mon[i,5] <- quantile(monitor[i,], probs=0.975) } ### Create Output Summ.out <- list(BPIC=bpic, Mean.Lift=Mean.Lift, Discrepancy.Statistic=round(Discrepancy.Statistic,5), Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Mean Lift: ", Mean.Lift, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("Monitors:\n") print(Mon) cat("\n\nRecords: \n") print(Summ[Rows,])} } return(invisible(Summ.out)) } #End LaplacesDemon/R/Blocks.R0000755000176200001440000001116015144316355014533 0ustar liggesusers########################################################################### # Blocks # # # # The purpose of the Blocks function is to return a list in which each # # component is a block and contains a vector of positions that indicate # # parameter membership. # ########################################################################### Blocks <- function(Initial.Values, N, PostCor=NULL) { ### Initial Checks if(missing(Initial.Values)) stop("The Initial.Values argument is required.") Initial.Values <- as.vector(Initial.Values) LIV <- length(Initial.Values) if(LIV <= 1) stop("More Initial.Values are needed to create blocks.") if(missing(N)) N <- trunc(sqrt(LIV)) if(is.null(PostCor)) { if(length(N != 1)) N <- N[1] N <- max(min(round(N), LIV), 2) } if(!is.null(PostCor)) { if(!is.matrix(PostCor)) stop("PostCor must be a matrix.") if(!identical(nrow(PostCor), ncol(PostCor))) stop("PostCor must be a square matrix.") if(any(diag(PostCor) != 1)) stop("PostCor requires the diagonal to contain 1s.") if(length(N) == 1) N <- max(min(round(N), LIV), 2) else { N <- N[1:2] N[1] <- max(min(round(N[1]), LIV), 2) N[2] <- max(min(round(N[2]), LIV), 2) if(N[1] >= N[2]) stop("N is incorrect.") } } ### Silhouette (from silhouette.default.R in package cluster) silhouette <- function(x, dist, dmatrix, ...) { cll <- match.call() if(is.list(x) && !is.null(cl <- x$clustering)) x <- cl n <- length(x) if(!all(x == round(x))) stop("'x' must only have integer codes") k <- length(clid <- sort(unique(x))) if(k <= 1 || k >= n) return(NA) if(missing(dist)) { if(missing(dmatrix)) stop("Need either a dissimilarity 'dist' or diss.matrix 'dmatrix'") if(is.null(dm <- dim(dmatrix)) || length(dm) != 2 || !all(n == dm)) stop("'dmatrix' is not a dissimilarity matrix compatible to 'x'") } else { dist <- as.dist(dist) if(n != attr(dist, "Size")) stop("clustering 'x' and dissimilarity 'dist' are incompatible") dmatrix <- as.matrix(dist)} wds <- matrix(NA, n,3, dimnames = list(names(x), c("cluster","neighbor","sil_width"))) for (j in 1:k) { Nj <- sum(iC <- x == clid[j]) wds[iC, "cluster"] <- clid[j] diC <- rbind(apply(dmatrix[!iC, iC, drop=FALSE], 2, function(r) tapply(r, x[!iC], mean))) minC <- apply(diC, 2, which.min) wds[iC,"neighbor"] <- clid[-j][minC] s.i <- if(Nj > 1) { a.i <- colSums(dmatrix[iC, iC])/(Nj - 1) b.i <- diC[cbind(minC, seq(along=minC))] ifelse(a.i != b.i, (b.i - a.i) / pmax(b.i, a.i), 0) } else 0 wds[iC,"sil_width"] <- s.i} return(wds) } ### Create Blocks if(missing(PostCor)) { ### Sequential Blocks B <- list() pos <- 0 for (i in 1:N) { if(i != N) { B[[i]] <- pos + c(1:trunc(LIV / N)) pos <- pos + trunc(LIV / N) } else B[[i]] <- c((pos + 1):LIV)} } else { ### Hierarchical Clustering di <- dist(1-abs(PostCor)) hc <- hclust(di, "ave") if(length(N) == 1) clusters <- as.vector(cutree(hc, N)) else { av.width <- rep(0, (N[2]-N[1])+1) names(av.width) <- seq(from=N[1], to=N[2]) count <- 1 for (i in N[1]:N[2]) { av.width[count] <- mean(silhouette(cutree(hc, i), di)[,3]) count <- count + 1} cat("\nMean Silhouette Width per Hierarchical Cluster Solution:\n") print(av.width) N <- N[1] - 1 + which.max(av.width)[1] cat("\n", N, "Blocks will be created.\n") clusters <- as.vector(cutree(hc, N)) } B <- list() for (i in 1:N) B[[i]] <- which(clusters == i) } class(B) <- "blocks" return(B) } #End LaplacesDemon/R/Juxtapose.R0000755000176200001440000001626315144316355015311 0ustar liggesusers########################################################################### # Juxtapose # # # # The purpose of the Juxtapose function is to compare the inefficiency of # # multiple updates of LaplacesDemon, each with a different algorithm, but # # the same model, initial values, and data. The internal ar.act and # # ar.act1 functions are slightly modified versions of those in the # # SamplerCompare package (modified to use the rmvn function), and the # # method of assessing inefficiency differs. # ########################################################################### Juxtapose <- function(x) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!is.list(x)) stop("The x argument must be a list.") ### IAT with probability intervals ar.act1 <- function(y) { stopifnot(NCOL(y) == 1) if(length(unique(y)) < 5) return(list(act=NA, act.025=NA, act.975=NA, se=NA, order=NA)) order.max <- NULL repeat { A <- ar.yw(y, demean=FALSE, order.max=order.max) if(A$order == 0) A <- ar.yw(y, demean=FALSE, order.max=1, aic=FALSE) pi <- A$ar pi.var <- A$asy.var.coef if(kappa(pi.var) < 1 / sqrt(.Machine$double.eps) || isTRUE(order.max == 1)) break order.max <- floor(A$order * 0.7)} acf <- matrix(ARMAacf(ar=pi)[2:(A$order+1)]) act <- (1-sum(pi*acf))/(1-sum(pi))^2 simulation.length <- min(max(40, length(y)), 5000) pi.var2 <- as.symmetric.matrix(pi.var) AX <- rmvn(simulation.length, pi, pi.var2) act.sim <- numeric(simulation.length) for (i in 1:simulation.length) { pi.sim <- AX[i,] acf.sim <- ARMAacf(ar=pi.sim)[2:(A$order+1)] if(any(abs(polyroot(c(-1,pi.sim)))<1)) act.sim[i] <- Inf else act.sim[i] <- (1-sum(pi.sim*acf.sim)) / (1-sum(pi.sim))^2} act.sim[is.na(act.sim)] <- Inf act.025 <- as.numeric(quantile(act.sim, 0.025)) act.975 <- as.numeric(quantile(act.sim, 0.975)) se <- (act.975-act.025)/(2*1.96) return(list(act=act, se=se, act.025=act.025, act.975=act.975, order=A$order)) } ar.act <- function(Y, true.mean=NULL) { Y <- as.matrix(Y) stopifnot(is.null(true.mean) || ncol(Y)==length(true.mean)) if(is.null(true.mean)) mu <- colMeans(Y) else mu <- true.mean acts <- sapply(1:ncol(Y), function(i) ar.act1(Y[,i]-mu[i])) max.i <- which.max(unlist(acts['act',])) if(length(max.i)!=1) { return(list(act=NA, act.025=NA, act.975=NA, se=NA, order=NA))} else return(acts[,max.i]) } ### Back to Juxtapose lenx <- length(x) ### Set up Output out <- matrix(NA, 9, lenx) algs <- rep(NA, lenx) for (i in 1:lenx) { if(!identical(class(x[[i]]), "demonoid")) stop("A component of x was found not be of class demonoid.") ### Use the abbreviated name of the algorithm algs[i] <- switch(x[[i]][["Algorithm"]], "Adaptive Directional Metropolis-within-Gibbs"="ADMG", "Adaptive Griddy-Gibbs"="AGG", "Adaptive Hamiltonian Monte Carlo"="AHMC", "Adaptive Metropolis"="AM", "Adaptive Metropolis-within-Gibbs"="AMWG", "Adaptive-Mixture Metropolis"="AMM", "Affine-Invariant Ensemble Sampler"="AIES", "Automated Factor Slice Sampler"="AFSS", "Componentwise Hit-And-Run Metropolis"="CHARM", "Delayed Rejection Adaptive Metropolis"="DRAM", "Delayed Rejection Metropolis"="DRM", "Differential Evolution Markov Chain"="DEMC", "Elliptical Slice Sampler"="ESS", "Experimental"="Exper", "Gibbs Sampler"="Gibbs", "Griddy-Gibbs"="GG", "Hamiltonian Monte Carlo"="HMC", "Hamiltonian Monte Carlo with Dual-Averaging"="HMCDA", "Hit-And-Run Metropolis"="HARM", "Independence Metropolis"="IM", "Interchain Adaptation"="INCA", "Metropolis-Adjusted Langevin Algorithm"="MALA", "Metropolis-Coupled Markov Chain Monte Carlo"="MCMCMC", "Metropolis-within-Gibbs"="MWG", "Multiple-Try Metropolis"="MTM", "No-U-Turn Sampler"="NUTS", "Oblique Hyperrectangle Slice Sampler"="OHSS", "Preconditioned Crank-Nicolson"="pCN", "Random Dive Metropolis-Hastings"="RDMH", "Random-Walk Metropolis"="RWM", "Reflective Slice Sampler"="RSS", "Refractive Sampler"="Refractive", "Reversible-Jump"="RJ", "Robust Adaptive Metropolis"="RAM", "Sequential Adaptive Metropolis-within-Gibbs"="SAMWG", "Sequential Metropolis-within-Gibbs"="SMWG", "Slice Sampler"="Slice", "Stochastic Gradient Langevin Dynamics"="SGLD", "Tempered Hamiltonian Monte Carlo"="THMC", "t-walk"="t-walk", "Univariate Eigenvector Slice Sampler"="UESS", "Updating Sequential Adaptive Metropolis-within-Gibbs"="USAMWG", "Updating Sequential Metropolis-within-Gibbs"="USMWG") } colnames(out) <- algs rownames(out) <- c("iter.min","t.iter.min","prop.stat","IAT.025", "IAT.500","IAT.975","ISM.025","ISM.500","ISM.975") class(out) <- "juxtapose" ### Juxtapose Algorithms for (i in 1:lenx) { iter.min <- x[[i]][["Iterations"]] / x[[i]][["Minutes"]] t.iter.min <- x[[i]][["Iterations"]] / x[[i]][["Thinning"]] / x[[i]][["Minutes"]] if(x[[i]][["Rec.BurnIn.Thinned"]] >= x[[i]][["Thinned.Samples"]]) prop.stat <- 0 else prop.stat <- 1 - (x[[i]][["Rec.BurnIn.Thinned"]] / x[[i]][["Thinned.Samples"]]) if(all(is.na(x[[i]][["Summary2"]]))) { iat.500 <- iat.025 <- iat.975 <- Inf} else { iat.temp <- ar.act(x[[i]][["Posterior2"]]) iat.500 <- iat.temp$act iat.025 <- iat.temp$act.025 iat.975 <- iat.temp$act.975} ism.025 <- prop.stat * t.iter.min / iat.975 ism.500 <- prop.stat * t.iter.min / iat.500 ism.975 <- prop.stat * t.iter.min / iat.025 out[1,i] <- round(iter.min,2) out[2,i] <- round(t.iter.min,2) out[3,i] <- round(prop.stat,2) out[4,i] <- round(iat.025,2) out[5,i] <- round(iat.500,2) out[6,i] <- round(iat.975,2) out[7,i] <- round(ism.025,2) out[8,i] <- round(ism.500,2) out[9,i] <- round(ism.975,2) } return(out) } #End LaplacesDemon/R/ABB.R0000755000176200001440000000304315144316355013703 0ustar liggesusers########################################################################### # Approximate Bayesian Bootstrap (ABB) # # # # The purpose of the ABB function is to perform Multiple Imputation (MI) # # with the Approximate Bayesian Bootstrap (ABB). # ########################################################################### ABB <- function(X, K=1) { ### Initial Checks if(missing(X)) stop("X is a required argument.") if(!is.matrix(X)) X <- as.matrix(X) J <- ncol(X) N <- nrow(X) ### Missingness Indicator M <- X*0 M[which(is.na(X))] <- 1 if(sum(M) == 0) stop("There are no missing values to impute.") M.sums <- colSums(M) ### Approximate Bayesian Bootstrap MI <- list() for (k in 1:K) { imp <- NULL for (j in 1:J) { if(M.sums[j] > 0) { ### Sample X.star.obs | X.obs X.obs <- X[which(M[,j] == 0),j] X.star.obs <- sample(X.obs, length(X.obs), replace=TRUE) ### Sample X.star.mis | X.star.obs X.star.mis <- sample(X.star.obs, M.sums[j], replace=TRUE) if(length(imp) > 0) imp <- c(imp, X.star.mis) else imp <- X.star.mis} } MI[[k]] <- imp } return(MI) } #End LaplacesDemon/R/BMK.Diagnostic.R0000755000176200001440000000615615144316355016023 0ustar liggesusers########################################################################### # BMK.Diagnostic # # # # The purpose of the BMK.Diagnostic function is to estimate Hellinger # # distances between consecutive batches of posterior samples, so that # # when Hellinger distances are below a given threshold the portion of the # # chain may suggest MCMC convergence. Although the code is slightly # # different, it is similar to the bmkconverge function in the BMK # # package. # ########################################################################### BMK.Diagnostic <- function(X, batches=10) { HD.Batch <- function(batch1, batch2) { n1 <- nrow(as.matrix(batch1)) batches.combined <- c(batch1, batch2) batches.min <- min(batches.combined) batches.max <- max(batches.combined) P1 <- try(density(batch1, from=batches.min, to=batches.max, n=n1), silent=TRUE) Q1 <- try(density(batch2, from=batches.min, to=batches.max, n=n1), silent=TRUE) if(inherits(P1, "try-error")) P1 <- density(rnorm(n1,0,1)) if(inherits(Q1, "try-error")) Q1 <- density(rnorm(n1,1,1)) step1 <- P1$x[2] - P1$x[1] diver1 <- (sqrt(P1$y) - sqrt(Q1$y))^2 * step1 out <- sqrt(sum(diver1) / 2) return(out) } HD.Diag <- function(x, batch.size, batch.list) { x <- as.vector(x) c1 <- 0 for (i in 1:(length(batch.list)-1)) { batch.label1 <- batch.list[i]:(batch.list[i+1]-1) batch.label2 <- batch.list[i+1]:((i+1)*batch.size) HD <- try(HD.Batch(x[batch.label1], x[batch.label2]), silent=TRUE) if(inherits(HD, "try-error")) HD <- 0 c1 <- c(c1, HD)} c1 <- c1[-1] return(c1) } ### Initial Checks if(!is.matrix(X) & !identical(class(X), "demonoid")) stop("X must be a matrix or an object of class demonoid.") if(identical(class(X), "demonoid")) X <- X$Posterior1 n.iter <- nrow(X) n.par <- ncol(X) batch.size <- floor(n.iter / batches) if(n.iter %% batch.size != 0) stop("Batches of even size are required.") batch.list <- seq(from=1, to=n.iter, by=batch.size) size <- floor(n.iter / batch.size) - 1 out <- matrix(0, n.par, size) ### Hellinger Distance for (i in 1:n.par) {out[i,] <- HD.Diag(X[,i], batch.size, batch.list)} ### Constrain to the interval [0,1] d <- dim(out) out <- as.vector(out) out.num <- which(out < 0) out[out.num] <- 0 out.num <- which(out > 1) out[out.num] <- 1 out <- array(out, dim=d) ### Output if(is.null(colnames(X))) rownames(out) <- paste("V", 1:ncol(X), sep="") else rownames(out) <- colnames(X) colnames(out) <- (1:size)*batch.size class(out) <- "bmk" return(out) } #End LaplacesDemon/R/plotSamples.R0000755000176200001440000001070115144316355015621 0ustar liggesusers########################################################################### # plotSamples # # # # The purpose of this function is to provide basic plots that are # # extended to include samples. This takes a N x S matrix X with N records # # and S simulations. # ########################################################################### plotSamples <- function(X, Style="KDE", LB=0.025, UB=0.975, Title=NULL) { ### Initial Checks if(missing(X)) stop("The X argument is required.") if(!is.matrix(X)) stop("X is required to be a matrix.") Xname <- deparse(substitute(X)) N <- nrow(X) S <- ncol(X) if({LB < 0} | {LB >= 0.5}) stop("LB must be in the interval [0, 0.5).") if({UB <= 0.5} | {UB > 1}) stop("UB must be in the interval (0.5, 1].") if(Style == "barplot") { ### Qauntiles qLB <- apply(X, 1, quantile, prob=LB, na.rm=TRUE) qMed <- apply(X, 1, quantile, prob=0.5, na.rm=TRUE) qUB <- apply(X, 1, quantile, prob=UB, na.rm=TRUE) ### Plot barplot(qUB, names.arg=rownames(X), ylim=c(min(qLB), max(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), main=Title, xlab=Xname, ylab="Value") barplot(qMed, add=TRUE, col=rgb(255, 0, 0, 75, maxColorValue=255)) barplot(qLB, add=TRUE, col=rgb(255, 0, 0, 100, maxColorValue=255)) } else if(Style == "dotchart") { ### Qauntiles qLB <- apply(X, 1, quantile, prob=LB, na.rm=TRUE) qMed <- apply(X, 1, quantile, prob=0.5, na.rm=TRUE) qUB <- apply(X, 1, quantile, prob=UB, na.rm=TRUE) ### Plot dotchart(qMed, xlim=range(c(qLB,qUB)), main=Title) for (i in 1:nrow(X)) lines(x=c(qLB[i],qUB[i]), y=c(i,i)) } else if(Style == "hist") { ### Histogram counts by Sample br <- hist(X, plot=FALSE) H <- matrix(0, length(br$counts), S) for (s in 1:S) H[,s] <- hist(X[,s], breaks=br$breaks, plot=FALSE)$counts ### Qauntiles qLB <- apply(H, 1, quantile, prob=LB, na.rm=TRUE) qMed <- apply(H, 1, quantile, prob=0.5, na.rm=TRUE) qUB <- apply(H, 1, quantile, prob=UB, na.rm=TRUE) ### Plot barplot(qUB, names.arg=br$mids, ylim=c(0, max(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), main=Title, xlab=Xname, ylab="Frequency") barplot(qMed, add=TRUE, col=rgb(255, 0, 0, 75, maxColorValue=255)) barplot(qLB, add=TRUE, col=rgb(255, 0, 0, 100, maxColorValue=255)) } else if(Style == "KDE") { ### KDE by Sample D.y <- density(X[,1], na.rm=TRUE) D.x <- D.y$x D.y <- D.y$y D.y <- matrix(D.y, length(D.y), S) for (s in 2:S) D.y[,s] <- density(X[,s])$y ### Quantiles qLB <- apply(D.y, 1, quantile, prob=LB, na.rm=TRUE) qMed <- apply(D.y, 1, quantile, prob=0.5, na.rm=TRUE) qUB <- apply(D.y, 1, quantile, prob=UB, na.rm=TRUE) ### Plot plot(D.x, qUB, col=rgb(255, 0, 0, 50, maxColorValue=255), type="l", ylim=c(0,max(qUB)), main=Title, xlab=Xname, ylab="Density") polygon(x=D.x, y=qUB, col=rgb(255, 0, 0, 50, maxColorValue=255), border=NULL) polygon(x=D.x, y=qMed, col=rgb(255, 0, 0, 75, maxColorValue=255), border=NULL) polygon(x=D.x, y=qLB, col=rgb(255, 0, 0, 100, maxColorValue=255), border=NULL) } else if(Style == "Time-Series") { ### Qauntiles qLB <- apply(X, 1, quantile, prob=LB, na.rm=TRUE) qMed <- apply(X, 1, quantile, prob=0.5, na.rm=TRUE) qUB <- apply(X, 1, quantile, prob=UB, na.rm=TRUE) ### Plot plot(1:nrow(X), qMed, ylim=range(c(qLB,qUB)), col="white", main=Title, xlab="Time", ylab="Value") polygon(c(1:nrow(X),rev(1:nrow(X))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:nrow(X), qMed, col="red") } else stop("Style is unknown.") return(invisible()) } #End LaplacesDemon/R/Importance.R0000755000176200001440000000504215144316355015421 0ustar liggesusers########################################################################### # Importance # # # # The purpose of the Importance function is to compare the impact of # # design matrix X on replicates when each column vector (predictor) is # # sequentially removed. # ########################################################################### Importance <- function(object, Model, Data, Categorical=FALSE, Discrep, d=0, CPUs=1, Type="PSOCK") { if(missing(object)) stop("The object argument is required.") if(missing(Model)) stop("The Model arguement is required.") if(missing(Data)) stop("The Data argument is required.") if(is.null(Data[["X"]])) stop("Data must have X.") if(missing(Discrep)) Discrep <- NULL X.orig <- Data[["X"]] cat("\nX has", ncol(X.orig), "variables") cat("\nEstimating the full model...") Pred <- predict(object, Model, Data) Summ <- summary(Pred, Categorical=Categorical, Discrep=Discrep, d=d, Quiet=TRUE) out <- matrix(0, ncol(X.orig) + 1, 4) out[1,1] <- Summ$BPIC[1,3] if(Categorical == FALSE) out[1,2] <- round(Summ$Concordance, 3) else out[1,2] <- round(Summ$Mean.Lift, 3) out[1,3] <- Summ$Discrepancy.Statistic if(Categorical == FALSE) { out[1,4] <- Summ$L.criterion S.L <- Summ$S.L} else S.L <- NA for (i in 1:ncol(X.orig)) { cat("\nEstimating without X[,", i, "]...", sep="") X.temp <- X.orig X.temp[,i] <- 0 Data[["X"]] <- X.temp Pred <- predict(object, Model, Data, CPUs, Type) Summ <- summary(Pred, Categorical=Categorical, Discrep=Discrep, d=d, Quiet=TRUE) out[i+1,1] <- Summ$BPIC[1,3] if(Categorical == FALSE) out[i+1,2] <- round(Summ$Concordance, 3) else out[i+1,2] <- round(Summ$Mean.Lift, 3) out[i+1,3] <- Summ$Discrepancy.Statistic if(Categorical == FALSE) { out[i+1,4] <- Summ$L.criterion S.L <- c(S.L, Summ$S.L)}} if(Categorical == FALSE) cat("\n\nS.L:", S.L) colnames(out) <- c("BPIC","Concordance", "Discrep", "L-criterion") rownames(out) <- c("Full", paste("X[,-", 1:ncol(X.orig), "]", sep="")) attr(out, "S.L") <- S.L class(out) <- "importance" cat("\n\n") return(out) } #End LaplacesDemon/R/plot.iterquad.ppc.R0000755000176200001440000010644615144342720016701 0ustar liggesusers########################################################################### # plot.iterquad.ppc # # # # The purpose of the plot.iterquad.ppc function is to plot an object of # # class iterquad.ppc. # ########################################################################### plot.iterquad.ppc <- function(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "iterquad.ppc")) stop("x is not of class iterquad.ppc.") if(is.null(Style)) Style <- "Density" if(is.null(Rows)) Rows <- 1:nrow(x[["yhat"]]) ### Plots if(Style == "Covariates") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) { plot(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75, ylim=c(min(temp[Rows,c(1,4:6)]),max(temp[Rows,c(1,4:6)])), xlab=paste("X[,",i,"]", sep=""), ylab="yhat", sub="Gray lines are yhat at 2.5% and 95%.") panel.smooth(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75)}} if(Style == "Covariates, Categorical DV") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.Cat.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Categorical=TRUE, Quiet=TRUE)$Summary ncat <- length(table(temp[,1])) mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) {for (j in 2:(ncat+1)) { plot(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75, xlab=paste("X[,",i,"]", sep=""), ylab=colnames(temp)[j]) panel.smooth(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75)}}} if(Style == "Density") { if(PDF == TRUE) { pdf("PPC.Plots.Density.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) for (j in 1:length(Rows)) { plot(density(x[["yhat"]][Rows[j],]), main=paste("Post. Pred. Plot of yhat[", Rows[j], ",]", sep=""), xlab="Value", sub="Black=Density, Red=y") polygon(density(x[["yhat"]][Rows[j],]), col="black", border="black") abline(v=x[["y"]][Rows[j]], col="red")}} if(Style == "DW") { if(PDF == TRUE) pdf("PPC.Plots.DW.pdf") par(mfrow=c(1,1)) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[,s]))^2, na.rm=TRUE) / sum(epsilon.obs[,s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[,s]))^2, na.rm=TRUE) / sum(epsilon.rep[,s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")} if(Style == "DW, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.DW.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (j in 1:J) { for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.obs[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.rep[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep=""), sub=paste("Y[,",j,"]",sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")}} if(Style == "ECDF") { if(PDF == TRUE) pdf("PPC.Plots.ECDF.pdf") par(mfrow=c(1,1)) plot(ecdf(x[["y"]][Rows]), verticals=TRUE, do.points=FALSE, main="Cumulative Fit", xlab="y (black) and yhat (red; gray)", ylab="Cumulative Frequency") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.975)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.025)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.500)), verticals=TRUE, do.points=FALSE, col="red")} if(Style == "Fitted") { if(PDF == TRUE) pdf("PPC.Plots.Fitted.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75, ylim=c(min(temp[Rows,4], na.rm=TRUE), max(temp[Rows,6], na.rm=TRUE)), xlab="y", ylab="yhat", main="Fitted") for (i in Rows) { lines(c(temp[Rows[i],1], temp[Rows[i],1]), c(temp[Rows[i],4], temp[Rows[i],6]))} panel.smooth(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75)} if(Style == "Fitted, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:nrow(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Fitted, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:ncol(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Jarque-Bera") { if(PDF == TRUE) pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1)) epsilon.obs <- epsilon.rep <- x[["y"]][Rows] - x[["yhat"]][Rows,] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (s in 1:ncol(epsilon.obs)) { epsilon.rep[,s] <- rnorm(N, mean(epsilon.obs[,s], na.rm=TRUE), sd(epsilon.obs[,s], na.rm=TRUE)) K.obs <- kurtosis(epsilon.obs[,s]) S.obs <- skewness(epsilon.obs[,s]) K.rep <- kurtosis(epsilon.rep[,s]) S.rep <- skewness(epsilon.rep[,s]) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab="JB", ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Jarque-Bera, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Jarque-Bera, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- epsilon.rep <- x[["y"]] - x[["yhat"]] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (j in 1:J) { for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.rep <- rnorm(M, mean(e.obs[,j], na.rm=TRUE), sd(e.obs[,j], na.rm=TRUE)) K.obs <- kurtosis(e.obs[,j]) S.obs <- skewness(e.obs[,j]) K.rep <- kurtosis(e.rep) S.rep <- skewness(e.rep) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab=paste("JB for Y[,",j,"]", sep=""), ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)}} if(Style == "Mardia") { if(PDF == TRUE) pdf("PPC.Plots.Mardia.pdf") par(mfrow=c(2,1)) if(is.null(Data)) stop("Data is required for Style=Mardia, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Mardia, C.") epsilon.obs <- x[["y"]] - x[["yhat"]] M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) K3.obs <- K3.rep <- K4.obs <- K4.rep <- rep(0, ncol(epsilon.obs)) for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.obs.mu <- colMeans(e.obs) e.obs.mu.mat <- matrix(e.obs.mu, M, J, byrow=TRUE) e.obs.stand <- e.obs - e.obs.mu.mat S.obs <- var(e.obs) A.obs <- t(chol(S.obs)) A.inv.obs <- solve(A.obs) Z.obs <- t(A.inv.obs %*% t(e.obs.stand)) Dij.obs <- Z.obs %*% t(Z.obs) D2.obs <- diag(Dij.obs) K3.obs[s] <- mean(as.vector(Dij.obs)^3) K4.obs[s] <- mean(D2.obs^2) e.rep <- rmvn(M, e.obs.mu.mat, S.obs) e.rep.mu <- colMeans(e.rep) e.rep.mu.mat <- matrix(e.rep.mu, M, J, byrow=TRUE) e.rep.stand <- e.rep - e.rep.mu.mat S.rep <- var(e.rep) A.rep <- t(chol(S.rep)) A.inv.rep <- solve(A.rep) Z.rep <- t(A.inv.rep %*% t(e.rep.stand)) Dij.rep <- Z.rep %*% t(Z.rep) D2.rep <- diag(Dij.rep) K3.rep[s] <- mean(as.vector(Dij.rep)^3) K4.rep[s] <- mean(D2.rep^2)} p.K3 <- round(mean(K3.obs > K3.rep), 3) p.K4 <- round(mean(K4.obs > K4.rep), 3) K3.result <- K4.result <- "Non-Normality" if((p.K3 >= 0.025) & (p.K3 <= 0.975)) K3.result <- "Normality" if((p.K4 >= 0.025) & (p.K4 <= 0.975)) K4.result <- "Normality" d.K3.obs <- density(K3.obs) d.K3.rep <- density(K3.rep) d.K4.obs <- density(K4.obs) d.K4.rep <- density(K4.rep) plot(d.K3.obs, xlim=c(min(d.K3.obs$x, d.K3.rep$x), max(d.K3.obs$x, d.K3.rep$x)), ylim=c(0, max(d.K3.obs$y, d.K3.rep$y)), col="white", main="Mardia's Test of MVN Skewness", xlab="Skewness Test Statistic (K3)", ylab="Density", sub=paste("K3.obs=", round(mean(K3.obs, na.rm=TRUE), 2), " (", round(quantile(K3.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K3.obs, probs=0.975, na.rm=TRUE), 2), "), p(K3.obs > K3.rep) = ", p.K3, " = ", K3.result, sep="")) polygon(d.K3.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K3.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) plot(d.K4.obs, xlim=c(min(d.K4.obs$x, d.K4.rep$x), max(d.K4.obs$x, d.K4.rep$x)), ylim=c(0, max(d.K4.obs$y, d.K4.rep$y)), col="white", main="Mardia's Test of MVN Kurtosis", xlab="Kurtosis Test Statistic (K4)", ylab="Density", sub=paste("K4.obs=", round(mean(K4.obs, na.rm=TRUE), 2), " (", round(quantile(K4.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K4.obs, probs=0.975, na.rm=TRUE), 2), "), p(K4.obs > K4.rep) = ", p.K4, " = ", K4.result, sep="")) polygon(d.K4.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K4.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Predictive Quantiles") { if(PDF == TRUE) pdf("PPC.Plots.PQ.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) plot(temp[Rows,1], temp[Rows,7], ylim=c(0,1), col=mycol, pch=16, cex=0.75, xlab="y", ylab="PQ", main="Predictive Quantiles") panel.smooth(temp[Rows,1], temp[Rows,7], col=mycol, pch=16, cex=0.75) abline(h=0.025, col="gray") abline(h=0.975, col="gray")} if(Style == "Residual Density") { if(PDF == TRUE) pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) dens <- density(epsilon.summary[2,Rows], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=expression(epsilon), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")} if(Style == "Residual Density, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { dens <- density(epsilon.500[,i], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[,", i, "]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residual Density, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, R.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { dens <- density(epsilon.500[i,], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[", i, ",]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residuals") { if(PDF == TRUE) pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) plot(epsilon.summary[2,Rows], pch=16, cex=0.75, ylim=c(min(epsilon.summary[,Rows], na.rm=TRUE), max(epsilon.summary[,Rows], na.rm=TRUE)), xlab="y", ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.summary[,Rows])), col="red") for (i in Rows) { lines(c(i,i), c(epsilon.summary[1,Rows[i]], epsilon.summary[3,Rows[i]]), col="black")}} if(Style == "Residuals, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { plot(epsilon.500[,i], pch=16, cex=0.75, ylim=c(min(epsilon.025[,i], na.rm=TRUE), max(epsilon.975[,i], na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab=expression(epsilon)) lines(rep(0, nrow(epsilon.500)), col="red") for (j in 1:nrow(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[j,i], epsilon.975[j,i]), col="black")}}} if(Style == "Residuals, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { plot(epsilon.500[i,], pch=16, cex=0.75, ylim=c(min(epsilon.025[i,], na.rm=TRUE), max(epsilon.975[i,], na.rm=TRUE)), xlab=paste("Y[", i, ",]", sep=""), ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.500)), col="red") for (j in 1:ncol(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[i,j], epsilon.975[i,j]), col="black")}}} if(Style == "Space-Time by Space") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Space.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (s in 1:Data[["S"]]) { plot(matrix(temp[,1], Data[["S"]], Data[["T"]])[s,], ylim=c(min(c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE), max(c(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Space-Time at Space s=",s," of ", Data[["S"]], sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:Data[["T"]],rev(1:Data[["T"]])), c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], rev(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(matrix(temp[,5], Data[["S"]], Data[["T"]])[s,], col="red")}} if(Style == "Space-Time by Time") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Time.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") Heat <- (1-(x[["y"]]-min(x[["y"]], na.rm=TRUE)) / max(x[["y"]]-min(x[["y"]], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 Heat <- matrix(Heat, Data[["S"]], Data[["T"]]) for (t in 1:Data[["T"]]) { plot(Data[["longitude"]], Data[["latitude"]], col=heat.colors(120)[Heat[,t]], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main=paste("Space-Time at t=",t," of ", Data[["T"]], sep=""), sub="Red=High, Yellow=Low")}} if(Style == "Spatial") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- (1-(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE)) / max(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Plot", sub="Red=High, Yellow=Low")} if(Style == "Spatial Uncertainty") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.Unc.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial Uncertainty.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- apply(x[["yhat"]], 1, quantile, probs=c(0.025,0.975)) heat <- heat[2,] - heat[1,] heat <- (1-(heat[Rows]-min(heat[Rows])) / max(heat[Rows]-min(heat[Rows]))) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Uncertainty Plot", sub="Red=High, Yellow=Low")} if(Style == "Time-Series") { if(PDF == TRUE) pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(Rows, temp[Rows,1], ylim=c(min(temp[Rows,c(1,4)], na.rm=TRUE), max(temp[Rows,c(1,6)], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main="Plot of Fitted Time-Series", sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(Rows,rev(Rows)),c(temp[Rows,4],rev(temp[Rows,6])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(Rows, temp[Rows,1]) lines(Rows, temp[Rows,5], col="red")} if(Style == "Time-Series, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][,i], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE), max(Data[["Y"]][,i], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", ncol(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(Style == "Time-Series, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][i,], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE), max(Data[["Y"]][i,], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", nrow(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/is.data.R0000755000176200001440000000175215144316355014647 0ustar liggesusers########################################################################### # is.data # # # # The purpose of the is.data function is to estimate if a list of data is # # data as far as IterativeQuadrature, LaplaceApproximation, # # LaplacesDemon, PMC, and VariationalBayes are concerned. # ########################################################################### is.data <- function(Data) { if(missing(Data)) stop("The Data argument is required.") isdata <- TRUE if(!is.list(Data)) { cat("\nData must be a list.\n") isdata <- FALSE} if(is.null(Data[["mon.names"]])) { cat("\nmon.names is NULL.\n") isdata <- FALSE} if(is.null(Data[["parm.names"]])) { cat("\nparm.names is NULL.\n") isdata <- FALSE} return(isdata) } #End LaplacesDemon/R/as.initial.values.R0000755000176200001440000000357415144316355016661 0ustar liggesusers########################################################################### # as.initial.values # # # # The purpose of the as.initial.values function is to retrieve the last # # posterior samples from an object of class demonoid, demonoid.hpc, # # iterquad, laplace, or pmc to serve as initial values for future # # updating. # ########################################################################### as.initial.values <- function(x) { if(!identical(class(x), "demonoid") & !identical(class(x), "demonoid.hpc") & !identical(class(x), "iterquad") & !identical(class(x), "laplace") & !identical(class(x), "pmc") & !identical(class(x), "vb")) stop("The class of x is unknown.") if(identical(class(x), "demonoid")) { initial.values <- as.vector(x$Posterior1[x$Thinned.Samples,]) } else if(identical(class(x), "demonoid.hpc")) { Chains <- length(x) LIV <- x[[1]][["Parameters"]] initial.values <- matrix(0, Chains, LIV) for (i in 1:Chains) { initial.values[i,] <- as.vector(x[[i]][["Posterior1"]][x[[i]][["Thinned.Samples"]],])}} else if(identical(class(x), "iterquad")) initial.values <- as.vector(x$Summary1[,"Mean"]) else if(identical(class(x), "laplace")) initial.values <- as.vector(x$Summary1[,"Mode"]) else if(identical(class(x), "vb")) initial.values <- as.vector(x$Summary1[,"Mean"]) else if(x$M == 1) initial.values <- colMeans(x$Posterior2) else if(x$M > 1) initial.values <- t(x$Mu[dim(x$Mu)[1],,]) return(initial.values) } #End LaplacesDemon/R/BayesTheorem.R0000755000176200001440000000125515144316355015711 0ustar liggesusers########################################################################### # BayesTheorem # ########################################################################### BayesTheorem <- function(PrA, PrBA) { if(missing(PrA)) stop("The PrA argument is required.") if(missing(PrBA)) stop("The PrBA argument is required.") if(any(PrA < 0) | any(PrA > 1)) stop("PrA is not in the interval [0,1].") if(any(PrBA < 0) | any(PrBA > 1)) stop("PrBA is not in the interval [0,1].") PrAB <- (PrBA * PrA) / sum(PrBA * PrA) class(PrAB) <- "bayestheorem" return(PrAB) } #End LaplacesDemon/R/Gelman.Diagnostic.R0000755000176200001440000001031115144316355016601 0ustar liggesusers########################################################################### # Gelman.Diagnostic # # # # The purpose of the Gelman.Diagnostic function is to perform the # # Gelman-Rubin MCMC diagnostic on a set of posterior samples. This # # function is similar to the gelman.diag function in the coda package, # # but has been modified to work with objects of class demonoid. # ########################################################################### Gelman.Diagnostic <- function(x, confidence=0.95, transform=FALSE) { Nchain <- length(x) if(Nchain < 2) stop("More than one chain is required.") if(!all(sapply(x, class) == "demonoid")) stop("At least one item in list x is not of class demonoid.") Burn <- Ntot <- Niter <- Nvar <- rep(0, Nchain) for (i in 1:Nchain) { Burn[i] <- x[[i]]$Rec.BurnIn.Thinned Ntot[i] <- nrow(x[[i]]$Posterior1) if(Burn[i] >= Ntot[i]) Niter[i] <- Ntot[i] if(Burn[i] < Ntot[i]) Niter[i] <- Ntot[i] - Burn[i] Nvar[i] <- x[[i]]$Parameters} if(length(unique(Ntot)) != 1) stop("Total number of iterations differs with demonoid objects.") Ntot <- Ntot[1] Burn <- max(Burn) Niter <- min(Niter) if(length(unique(Nvar)) != 1) stop("Total number of parameters differs with demonoid objects.") else Nvar <- Nvar[1] xnames <- colnames(x[[1]]$Posterior1) if(transform == TRUE) { Gelman.Transform <- function(x, Nvar, Nchain) { for (i in 1:Nchain) { for (j in 1:Nvar) { if(min(x[[i]][,j]) > 0) { if(max(x[[i]][,j]) < 1) { x[[i]][,j] <- log(x[[i]][,j] / (1 - x[[i]][,j]))} else x[[i]][,j] <- log(x[[i]][,j])} } } return(x) } } ## Multivariate (upper case) if(Burn < Ntot) { for (i in 1:Nchain) { x[[i]]$Posterior1 <- x[[i]]$Posterior1[Burn:Ntot,]}} else warning("Non-stationary samples were used.") temp <- unlist(x, recursive=FALSE) x <- temp[names(temp) == "Posterior1"] if(transform == TRUE) x <- Gelman.Transform(x, Nvar, Nchain) S2 <- array(sapply(x, var, simplify=TRUE), dim=c(Nvar,Nvar,Nchain)) W <- apply(S2, c(1,2), mean) if(Nvar > 1){ xbar <- matrix(sapply(x, apply, 2, mean, simplify=TRUE), nrow=Nvar, ncol=Nchain) } else { xbar <- matrix(sapply(x, mean, simplify=TRUE), nrow=Nvar, ncol=Nchain)} B <- Niter * var(t(xbar)) if(Nvar > 1) { CW <- chol(W) emax <- eigen(backsolve(CW, t(backsolve(CW, B, transpose=TRUE)), transpose=TRUE), symmetric=TRUE, only.values=TRUE)$values[1] mpsrf <- sqrt((1 - 1/Niter) + (1 + 1/Nvar) * emax/Niter) } else mpsrf <- NULL ## Univariate (lower case) w <- diag(W) b <- diag(B) s2 <- matrix(apply(S2, 3, diag), nrow=Nvar, ncol=Nchain) muhat <- rowMeans(xbar) var.w <- .rowVars(s2) / Nchain var.b <- (2 * b^2) / (Nchain - 1) cov.wb <- (Niter / Nchain) * diag(var(t(s2), t(xbar^2)) - 2 * muhat * var(t(s2), t(xbar))) V <- (Niter - 1) * w / Niter + (1 + 1/Nchain) * b / Niter var.V <- ((Niter - 1)^2 * var.w + (1 + 1/Nchain)^2 * var.b + 2 * (Niter - 1) * (1 + 1/Nchain) * cov.wb) / Niter^2 df.V <- (2 * V^2) / var.V df.adj <- (df.V + 3) / (df.V + 1) B.df <- Nchain - 1 W.df <- (2 * w^2) / var.w R2.fixed <- (Niter - 1) / Niter R2.random <- (1 + 1/Nchain) * (1/Niter) * (b/w) R2.estimate <- R2.fixed + R2.random R2.upper <- R2.fixed + qf((1 + confidence)/2, B.df, W.df) * R2.random psrf <- cbind(sqrt(df.adj * R2.estimate), sqrt(df.adj * R2.upper)) dimnames(psrf) <- list(xnames, c("Point Est.", "Upper C.I.")) out <- list(PSRF=psrf, MPSRF=mpsrf) return(out) } #End LaplacesDemon/R/plot.vb.ppc.R0000755000176200001440000010637715144343136015477 0ustar liggesusers########################################################################### # plot.vb.ppc # # # # The purpose of the plot.vb.ppc function is to plot an object of class # # vb.ppc. # ########################################################################### plot.vb.ppc <- function(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "vb.ppc")) stop("x is not of class vb.ppc.") if(is.null(Style)) Style <- "Density" if(is.null(Rows)) Rows <- 1:nrow(x[["yhat"]]) ### Plots if(Style == "Covariates") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) { plot(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75, ylim=c(min(temp[Rows,c(1,4:6)]),max(temp[Rows,c(1,4:6)])), xlab=paste("X[,",i,"]", sep=""), ylab="yhat", sub="Gray lines are yhat at 2.5% and 95%.") panel.smooth(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75)}} if(Style == "Covariates, Categorical DV") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.Cat.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Categorical=TRUE, Quiet=TRUE)$Summary ncat <- length(table(temp[,1])) mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) {for (j in 2:(ncat+1)) { plot(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75, xlab=paste("X[,",i,"]", sep=""), ylab=colnames(temp)[j]) panel.smooth(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75)}}} if(Style == "Density") { if(PDF == TRUE) { pdf("PPC.Plots.Density.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) for (j in 1:length(Rows)) { plot(density(x[["yhat"]][Rows[j],]), main=paste("Post. Pred. Plot of yhat[", Rows[j], ",]", sep=""), xlab="Value", sub="Black=Density, Red=y") polygon(density(x[["yhat"]][Rows[j],]), col="black", border="black") abline(v=x[["y"]][Rows[j]], col="red")}} if(Style == "DW") { if(PDF == TRUE) pdf("PPC.Plots.DW.pdf") par(mfrow=c(1,1)) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[,s]))^2, na.rm=TRUE) / sum(epsilon.obs[,s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[,s]))^2, na.rm=TRUE) / sum(epsilon.rep[,s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")} if(Style == "DW, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.DW.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (j in 1:J) { for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.obs[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.rep[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep=""), sub=paste("Y[,",j,"]",sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")}} if(Style == "ECDF") { if(PDF == TRUE) pdf("PPC.Plots.ECDF.pdf") par(mfrow=c(1,1)) plot(ecdf(x[["y"]][Rows]), verticals=TRUE, do.points=FALSE, main="Cumulative Fit", xlab="y (black) and yhat (red; gray)", ylab="Cumulative Frequency") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.975)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.025)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.500)), verticals=TRUE, do.points=FALSE, col="red")} if(Style == "Fitted") { if(PDF == TRUE) pdf("PPC.Plots.Fitted.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75, ylim=c(min(temp[Rows,4], na.rm=TRUE), max(temp[Rows,6], na.rm=TRUE)), xlab="y", ylab="yhat", main="Fitted") for (i in Rows) { lines(c(temp[Rows[i],1], temp[Rows[i],1]), c(temp[Rows[i],4], temp[Rows[i],6]))} panel.smooth(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75)} if(Style == "Fitted, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:nrow(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Fitted, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:ncol(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Jarque-Bera") { if(PDF == TRUE) pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1)) epsilon.obs <- epsilon.rep <- x[["y"]][Rows] - x[["yhat"]][Rows,] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (s in 1:ncol(epsilon.obs)) { epsilon.rep[,s] <- rnorm(N, mean(epsilon.obs[,s], na.rm=TRUE), sd(epsilon.obs[,s], na.rm=TRUE)) K.obs <- kurtosis(epsilon.obs[,s]) S.obs <- skewness(epsilon.obs[,s]) K.rep <- kurtosis(epsilon.rep[,s]) S.rep <- skewness(epsilon.rep[,s]) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab="JB", ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Jarque-Bera, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Jarque-Bera, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- epsilon.rep <- x[["y"]] - x[["yhat"]] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (j in 1:J) { for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.rep <- rnorm(M, mean(e.obs[,j], na.rm=TRUE), sd(e.obs[,j], na.rm=TRUE)) K.obs <- kurtosis(e.obs[,j]) S.obs <- skewness(e.obs[,j]) K.rep <- kurtosis(e.rep) S.rep <- skewness(e.rep) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab=paste("JB for Y[,",j,"]", sep=""), ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)}} if(Style == "Mardia") { if(PDF == TRUE) pdf("PPC.Plots.Mardia.pdf") par(mfrow=c(2,1)) if(is.null(Data)) stop("Data is required for Style=Mardia, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Mardia, C.") epsilon.obs <- x[["y"]] - x[["yhat"]] M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) K3.obs <- K3.rep <- K4.obs <- K4.rep <- rep(0, ncol(epsilon.obs)) for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.obs.mu <- colMeans(e.obs) e.obs.mu.mat <- matrix(e.obs.mu, M, J, byrow=TRUE) e.obs.stand <- e.obs - e.obs.mu.mat S.obs <- var(e.obs) A.obs <- t(chol(S.obs)) A.inv.obs <- solve(A.obs) Z.obs <- t(A.inv.obs %*% t(e.obs.stand)) Dij.obs <- Z.obs %*% t(Z.obs) D2.obs <- diag(Dij.obs) K3.obs[s] <- mean(as.vector(Dij.obs)^3) K4.obs[s] <- mean(D2.obs^2) e.rep <- rmvn(M, e.obs.mu.mat, S.obs) e.rep.mu <- colMeans(e.rep) e.rep.mu.mat <- matrix(e.rep.mu, M, J, byrow=TRUE) e.rep.stand <- e.rep - e.rep.mu.mat S.rep <- var(e.rep) A.rep <- t(chol(S.rep)) A.inv.rep <- solve(A.rep) Z.rep <- t(A.inv.rep %*% t(e.rep.stand)) Dij.rep <- Z.rep %*% t(Z.rep) D2.rep <- diag(Dij.rep) K3.rep[s] <- mean(as.vector(Dij.rep)^3) K4.rep[s] <- mean(D2.rep^2)} p.K3 <- round(mean(K3.obs > K3.rep), 3) p.K4 <- round(mean(K4.obs > K4.rep), 3) K3.result <- K4.result <- "Non-Normality" if((p.K3 >= 0.025) & (p.K3 <= 0.975)) K3.result <- "Normality" if((p.K4 >= 0.025) & (p.K4 <= 0.975)) K4.result <- "Normality" d.K3.obs <- density(K3.obs) d.K3.rep <- density(K3.rep) d.K4.obs <- density(K4.obs) d.K4.rep <- density(K4.rep) plot(d.K3.obs, xlim=c(min(d.K3.obs$x, d.K3.rep$x), max(d.K3.obs$x, d.K3.rep$x)), ylim=c(0, max(d.K3.obs$y, d.K3.rep$y)), col="white", main="Mardia's Test of MVN Skewness", xlab="Skewness Test Statistic (K3)", ylab="Density", sub=paste("K3.obs=", round(mean(K3.obs, na.rm=TRUE), 2), " (", round(quantile(K3.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K3.obs, probs=0.975, na.rm=TRUE), 2), "), p(K3.obs > K3.rep) = ", p.K3, " = ", K3.result, sep="")) polygon(d.K3.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K3.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) plot(d.K4.obs, xlim=c(min(d.K4.obs$x, d.K4.rep$x), max(d.K4.obs$x, d.K4.rep$x)), ylim=c(0, max(d.K4.obs$y, d.K4.rep$y)), col="white", main="Mardia's Test of MVN Kurtosis", xlab="Kurtosis Test Statistic (K4)", ylab="Density", sub=paste("K4.obs=", round(mean(K4.obs, na.rm=TRUE), 2), " (", round(quantile(K4.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K4.obs, probs=0.975, na.rm=TRUE), 2), "), p(K4.obs > K4.rep) = ", p.K4, " = ", K4.result, sep="")) polygon(d.K4.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K4.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Predictive Quantiles") { if(PDF == TRUE) pdf("PPC.Plots.PQ.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) plot(temp[Rows,1], temp[Rows,7], ylim=c(0,1), col=mycol, pch=16, cex=0.75, xlab="y", ylab="PQ", main="Predictive Quantiles") panel.smooth(temp[Rows,1], temp[Rows,7], col=mycol, pch=16, cex=0.75) abline(h=0.025, col="gray") abline(h=0.975, col="gray")} if(Style == "Residual Density") { if(PDF == TRUE) pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) dens <- density(epsilon.summary[2,Rows], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=expression(epsilon), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")} if(Style == "Residual Density, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { dens <- density(epsilon.500[,i], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[,", i, "]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residual Density, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, R.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { dens <- density(epsilon.500[i,], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[", i, ",]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residuals") { if(PDF == TRUE) pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) plot(epsilon.summary[2,Rows], pch=16, cex=0.75, ylim=c(min(epsilon.summary[,Rows], na.rm=TRUE), max(epsilon.summary[,Rows], na.rm=TRUE)), xlab="y", ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.summary[,Rows])), col="red") for (i in Rows) { lines(c(i,i), c(epsilon.summary[1,Rows[i]], epsilon.summary[3,Rows[i]]), col="black")}} if(Style == "Residuals, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { plot(epsilon.500[,i], pch=16, cex=0.75, ylim=c(min(epsilon.025[,i], na.rm=TRUE), max(epsilon.975[,i], na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab=expression(epsilon)) lines(rep(0, nrow(epsilon.500)), col="red") for (j in 1:nrow(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[j,i], epsilon.975[j,i]), col="black")}}} if(Style == "Residuals, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { plot(epsilon.500[i,], pch=16, cex=0.75, ylim=c(min(epsilon.025[i,], na.rm=TRUE), max(epsilon.975[i,], na.rm=TRUE)), xlab=paste("Y[", i, ",]", sep=""), ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.500)), col="red") for (j in 1:ncol(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[i,j], epsilon.975[i,j]), col="black")}}} if(Style == "Space-Time by Space") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Space.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (s in 1:Data[["S"]]) { plot(matrix(temp[,1], Data[["S"]], Data[["T"]])[s,], ylim=c(min(c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE), max(c(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Space-Time at Space s=",s," of ", Data[["S"]], sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:Data[["T"]],rev(1:Data[["T"]])), c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], rev(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(matrix(temp[,5], Data[["S"]], Data[["T"]])[s,], col="red")}} if(Style == "Space-Time by Time") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Time.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") Heat <- (1-(x[["y"]]-min(x[["y"]], na.rm=TRUE)) / max(x[["y"]]-min(x[["y"]], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 Heat <- matrix(Heat, Data[["S"]], Data[["T"]]) for (t in 1:Data[["T"]]) { plot(Data[["longitude"]], Data[["latitude"]], col=heat.colors(120)[Heat[,t]], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main=paste("Space-Time at t=",t," of ", Data[["T"]], sep=""), sub="Red=High, Yellow=Low")}} if(Style == "Spatial") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- (1-(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE)) / max(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Plot", sub="Red=High, Yellow=Low")} if(Style == "Spatial Uncertainty") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.Unc.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial Uncertainty.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- apply(x[["yhat"]], 1, quantile, probs=c(0.025,0.975)) heat <- heat[2,] - heat[1,] heat <- (1-(heat[Rows]-min(heat[Rows])) / max(heat[Rows]-min(heat[Rows]))) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Uncertainty Plot", sub="Red=High, Yellow=Low")} if(Style == "Time-Series") { if(PDF == TRUE) pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(Rows, temp[Rows,1], ylim=c(min(temp[Rows,c(1,4)], na.rm=TRUE), max(temp[Rows,c(1,6)], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main="Plot of Fitted Time-Series", sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(Rows,rev(Rows)),c(temp[Rows,4],rev(temp[Rows,6])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(Rows, temp[Rows,1]) lines(Rows, temp[Rows,5], col="red")} if(Style == "Time-Series, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][,i], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE), max(Data[["Y"]][,i], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", ncol(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(Style == "Time-Series, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][i,], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE), max(Data[["Y"]][i,], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", nrow(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/BigData.R0000755000176200001440000000454115144316355014616 0ustar liggesusers########################################################################### # BigData # # # # The purpose of the BigData function is to enable the use of a data set # # that is larger than the computer memory (RAM). # ########################################################################### BigData <- function(file, nrow, ncol, size=1, Method="add", CPUs=1, Type="PSOCK", FUN, ...) { FUN <- match.fun(FUN) N <- trunc(nrow / size) ### Non-Parallel Processing if(CPUs == 1) { con <- file(file, open="r") on.exit(close(con)) for (i in 1:N) { ### Read in a Batch X <- matrix(scan(file=con, sep=",", #skip=skip.rows[i], nlines=size, quiet=TRUE), size, ncol, byrow=TRUE) ### Perform Function if(Method == "rbind") { if(i == 1) out <- FUN(X, ...) else out <- rbind(out, FUN(X, ...))} else if(Method == "add") { if(i == 1) out <- FUN(X, ...) else out <- out + FUN(X, ...)}} } else { ### Parallel Processing skip.rows <- c(0, size * 1:(N-1)) batch <- function(x) { #seek(con, 0) con <- file(file, open="r") on.exit(close(con)) X <- matrix(scan(file=con, sep=",", skip=skip.rows[x], nlines=size, quiet=TRUE), size, ncol, byrow=TRUE) if(Method == "add") out <- sum(FUN(X, ...)) else out <- FUN(X, ...) return(out) } #library(parallel, quietly=TRUE) detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) if(CPUs > detectedCores) CPUs <- detectedCores cl <- makeCluster(CPUs, Type) clusterSetRNGStream(cl) out <- parLapply(cl, 1:N, function(x) batch(x)) stopCluster(cl) if(Method == "rbind") { out <- unlist(out) out <- matrix(out, length(out), 1) } else if(Method == "add") { out <- sum(unlist(out))} } return(out) } #End LaplacesDemon/R/predict.demonoid.R0000755000176200001440000000662215144316355016554 0ustar liggesusers########################################################################### # predict.demonoid # # # # The purpose of the predict.demonoid function is to predict y[new] or # # y[rep], and later provide posterior predictive checks for objects of # # class demonoid. # ########################################################################### predict.demonoid <- function(object, Model, Data, CPUs=1, Type="PSOCK", ...) { ### Initial Checks if(missing(object)) stop("The object argument is required.") if(missing(Model)) stop("The Model argument is required.") if(missing(Data)) stop("The Data argument is required.") if(is.null(Data[["y"]]) & is.null(Data[["Y"]])) stop("Data must have y or Y.") if(!is.null(Data[["y"]])) y <- as.vector(Data[["y"]]) if(!is.null(Data[["Y"]])) y <- as.vector(Data[["Y"]]) CPUs <- abs(round(CPUs)) ### p(y[rep] | y) post <- as.matrix(object$Posterior1) if(is.matrix(object$Posterior2) == TRUE) { post <- as.matrix(object$Posterior2)} Dev <- rep(NA, nrow(post)) yhat <- matrix(NA, length(y), nrow(post)) lengthcomp <- as.vector(Model(post[1,], Data)[["yhat"]]) if(!identical(length(lengthcomp), length(y))) stop("y and yhat differ in length.") ### Non-Parallel Processing if(CPUs == 1) { for (i in 1:nrow(post)) { mod <- Model(post[i,], Data) Dev[i] <- as.vector(mod[["Dev"]]) yhat[,i] <- as.vector(mod[["yhat"]])} } else { ### Parallel Processing detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cl <- makeCluster(CPUs, Type) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) mod <- parLapply(cl, 1:nrow(post), function(x) Model(post[x,], Data)) stopCluster(cl) Dev <- unlist(lapply(mod, function(x) x[["Dev"]]))[1:nrow(post)] yhat <- matrix(unlist(lapply(mod, function(x) x[["yhat"]])), length(y), nrow(post)) rm(mod)} ### Warnings if(is.matrix(object$Posterior2) == FALSE) { warning("Non-stationary samples were used.")} if(any(is.na(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.na(yhat)), " missing values.\n") if(any(is.nan(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.nan(yhat)), " non-numeric (NaN) values.\n") if(any(is.infinite(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.infinite(yhat)), " infinite values.\n") if(any(!is.finite(Dev))) cat("\nWARNING: Deviance has non-finite values.") ### Create Output predicted <- list(y=y, yhat=yhat, Deviance=Dev) class(predicted) <- "demonoid.ppc" return(predicted) } #End LaplacesDemon/R/AcceptanceRate.R0000755000176200001440000000144115144316355016161 0ustar liggesusers########################################################################### # AcceptanceRate # # # # The purpose of the AcceptanceRate function is to calculate the # # acceptance rate of each chain from its samples. # ########################################################################### AcceptanceRate <- function(x) { if(missing(x)) stop("x is a required argument.") if(!is.matrix(x)) x <- as.matrix(x) out <- colMeans(x[-nrow(x),] != x[-1,]) names(out) <- colnames(x) return(out) } x <- matrix(rnorm(10*10),10,10) colnames(x) <- paste("V", 1:10, sep="") x[2,] <- x[1,] AcceptanceRate(x) #End LaplacesDemon/R/summary.vb.ppc.R0000755000176200001440000002672415144316355016216 0ustar liggesusers########################################################################### # summary.vb.ppc # # # # The purpose of the summary.vb.ppc function is to summarize an object of # # class vb.ppc (posterior predictive check). # ########################################################################### summary.vb.ppc <- function(object=NULL, Categorical=FALSE, Rows=NULL, Discrep=NULL, d=0, Quiet=FALSE, ...) { if(is.null(object)) stop("The object argument is NULL.") y <- object$y yhat <- object$yhat Deviance <- object$Deviance monitor <- object$monitor if(is.null(Rows)) Rows <- 1:length(y) if(any(Rows > length(y)) || any(Rows <= 0)) { warning("Invalid Rows argument; All rows included.") Rows <- 1:length(y)} ### Create Continuous Summary Table for y and yhat if(Categorical == FALSE) { Summ <- matrix(NA, length(y), 8, dimnames=list(1:length(y), c("y","Mean","SD","LB","Median","UB","PQ","Discrep"))) Summ[,1] <- y Summ[,2] <- round(rowMeans(yhat),3) Summ[,3] <- round(sqrt(.rowVars(yhat)),3) for(i in 1:length(y)) { Summ[i,4] <- round(quantile(yhat[i,], probs=0.025, na.rm=TRUE),3) Summ[i,5] <- round(quantile(yhat[i,], probs=0.500, na.rm=TRUE),3) Summ[i,6] <- round(quantile(yhat[i,], probs=0.975, na.rm=TRUE),3) Summ[i,7] <- round(mean(yhat[i,] >= y[i], na.rm=TRUE),3) } ### Discrepancy Statistics Concordance <- 1 - mean(({Summ[,7] < 0.025} | {Summ[,7] > 0.975}), na.rm=TRUE) Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "Chi-Square"}) { Summ[,8] <- round((y - rowMeans(yhat))^2 / .rowVars(yhat),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Chi-Square2"}) { chisq.obs <- chisq.rep <- yhat E.y <- E.yrep <- rowMeans(yhat, na.rm=TRUE) for (i in 1:nrow(yhat)) { chisq.obs[i,] <- (y[i] - E.y[i])^2 / E.y[i] chisq.rep[i,] <- (yhat[i,] - E.yrep[i])^2 / E.yrep[i] } Summ[,8] <- round(rowMeans(chisq.rep > chisq.obs, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean((Summ[,8] < 0.025) | (Summ[,8] > 0.975), na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Kurtosis"}) { kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} for (i in 1:length(y)) {Summ[i,8] <- round(kurtosis(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "L.criterion"}) { Summ[,8] <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MASE"}) { Summ[,8] <- round(abs(rowMeans(y - yhat, na.rm=TRUE) / mean(abs(diff(y)), na.rm=TRUE)), 3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MSE"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "PPL"}) { Summ[,8] <- round(.rowVars(yhat) + (d/(d+1)) * (rowMeans(yhat) - y)^2,3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Loss"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Utility"}) { Summ[,8] <- round(rowMeans(-1*(y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "RMSE"}) { Summ[,8] <- round(sqrt(rowMeans((y - yhat)^2, na.rm=TRUE)),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Skewness"}) { skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} for (i in 1:length(y)) {Summ[i,8] <- round(skewness(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "max(yhat[i,]) > max(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- max(yhat[i,]) > max(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,]) > mean(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,]) > mean(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > d)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > d)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > mean(y))"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > mean(y))} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "min(yhat[i,]) < min(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- min(yhat[i,]) < min(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "round(yhat[i,]) = d"}) { for (i in 1:length(y)) { Summ[i,8] <- round(mean(round(yhat[i,]) == d, na.rm=TRUE), 3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "sd(yhat[i,]) > sd(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- sd(yhat[i,]) > sd(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} L <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2), 3) S.L <- round(sd(L, na.rm=TRUE),3); L <- round(sum(L, na.rm=TRUE),3) ### Deviance Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE) / 2,3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" ### Create Summary Table for monitored variables Mon <- matrix(NA, nrow(monitor), 5, dimnames=list(c(rownames(monitor)), c("Mean","SD","LB","Median","UB"))) for (i in 1:nrow(monitor)) { Mon[i,1] <- mean(monitor[i,]) Mon[i,2] <- round(sd(monitor[i,]),3) Mon[i,3] <- round(quantile(monitor[i,], probs=0.025),3) Mon[i,4] <- round(quantile(monitor[i,], probs=0.500),3) Mon[i,5] <- round(quantile(monitor[i,], probs=0.975),3) } ### Create Output Summ.out <- list(BPIC=bpic, Concordance=Concordance, Discrepancy.Statistic=round(Discrepancy.Statistic,5), L.criterion=L, S.L=S.L, Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Concordance: ", Concordance, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("L-criterion: ", L, ", S.L: ", S.L, sep="", "\n") cat("Monitors:\n") print(Mon) cat("\n\nRecords:\n") print(Summ[Rows,])} } ### Create Categorical Summary Table else { catcounts <- table(y) sumnames <- rep(NA, length(catcounts)+3) sumnames[1] <- "y" for (i in 1:length(catcounts)) { sumnames[i+1] <- paste("p(yhat=",names(catcounts)[i],")",sep="")} sumnames[length(sumnames)-1] <- "Lift" sumnames[length(sumnames)] <- "Discrep" Summ <- matrix(NA, length(y), length(sumnames), dimnames=list(1:length(y), sumnames)) Summ[,1] <- y for (i in 1:length(catcounts)) { Summ[,i+1] <- rowSums(yhat == as.numeric(names(catcounts)[i])) / ncol(yhat)} Summ[,{ncol(Summ)-1}] <- 1 for (i in 1:length(y)) { Summ[i,{ncol(Summ)-1}] <- Summ[i, grep(Summ[i,1],names(catcounts))+1] / {as.vector(catcounts[grep(Summ[i,1],names(catcounts))]) / sum(catcounts)} - 1} ### Discrepancy Statistics Mean.Lift <- round(mean(Summ[,{ncol(Summ)-1}]),3) Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "p(yhat[i,] != y[i])"}) { for (i in 1:length(y)) { Summ[i,ncol(Summ)] <- 1 - Summ[i, grep(Summ[i,1],names(catcounts))+1]} Discrepancy.Statistic <- round(mean(Summ[,ncol(Summ)], na.rm=TRUE),3)} ### Deviance Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE) / 2,3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" ### Create Summary Table for monitored variables Mon <- matrix(NA, nrow(monitor), 5, dimnames=list(c(rownames(monitor)), c("Mean","SD","LB","Median","UB"))) for (i in 1:nrow(monitor)) { Mon[i,1] <- mean(monitor[i,]) Mon[i,2] <- sd(monitor[i,]) Mon[i,3] <- quantile(monitor[i,], probs=0.025) Mon[i,4] <- quantile(monitor[i,], probs=0.500) Mon[i,5] <- quantile(monitor[i,], probs=0.975) } ### Create Output Summ.out <- list(BPIC=bpic, Mean.Lift=Mean.Lift, Discrepancy.Statistic=round(Discrepancy.Statistic,5), Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Mean Lift: ", Mean.Lift, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("Monitors:\n") print(Mon) cat("\n\nRecords: \n") print(Summ[Rows,])} } return(invisible(Summ.out)) } #End LaplacesDemon/R/BayesianBootstrap.R0000755000176200001440000000401315144316355016746 0ustar liggesusers########################################################################### # BayesianBootstrap # # # # The purpose of the BayesianBootstrap is to allow the user to produce # # either bootstrapped weights or statistics. # ########################################################################### BayesianBootstrap <- function(X, n=1000, Method="weights", Status=NULL) { ### Initial Checks if(missing(X)) stop("X is a required argument.") if(!is.matrix(X)) X <- as.matrix(X) if(any(!is.finite(X))) stop("Non-finite values found in X.") S <- round(abs(n)) if(S < 1) S <- 1 if(!(is.numeric(Status) & (length(Status) == 1))) Status <- S + 1 else { Status <- round(abs(Status)) if(Status < 1 | Status > S) Status <- S + 1} N <- nrow(X) J <- ncol(X) if(identical(Method, "weights")) { BB <- replicate(S, diff(c(0, sort(runif(N-1)), 1))) return(BB)} ### Bayesian Bootstrap: Statistics BB <- vector("list", S) for (s in 1:S) { if(s %% Status == 0) cat("\nBootstrapped Samples:", s) u <- c(0, sort(runif(N - 1)), 1) g <- diff(u) BB[[s]] <- Method(X, g)} if(Status < S) cat("\n\nThe Bayesian Bootstrap has finished.\n\n") ### Output BB <- lapply(BB, identity) if(is.vector(BB[[1]])) if(length(BB[[1]]) == 1) BB <- as.matrix(BB) else { B <- matrix(unlist(BB), S, length(BB[[1]]), byrow=TRUE) colnames(B) <- names(BB[[1]]) BB <- B } else { if(is.null(dim(BB[[1]]))) stop("Method must return a vector, matrix or array") B <- array(NA, dim=c(S, dim(BB[[1]]))) for (s in 1:S) {B[s,,] <- BB[[s]]} BB <- B } return(BB) } #End LaplacesDemon/R/print.miss.R0000755000176200001440000000153715144316355015433 0ustar liggesusers########################################################################### # print.miss # # # # The purpose of the print.miss function is to print the contents of an # # object of class miss to the screen. # ########################################################################### print.miss <- function(x, ...) { if(missing(x)) stop("The x argument is required.") cat("\nAlgorithm:", x$Algorithm) cat("\nImp:") cat("\n Missing Values:", nrow(x$Imp)) cat("\n Iterations:", ncol(x$Imp)) cat("\nparm: (NOT SHOWN HERE)") cat("\nPostMode: (NOT SHOWN HERE)") cat("\nType: (NOT SHOWN HERE)\n") invisible(x) } #End LaplacesDemon/R/hpc_server.R0000755000176200001440000000373715144316355015471 0ustar liggesusers########################################################################### # server_Listening # # # # The server_Listening function is not intended to be called directly by # # the user. It is an internal-only function that is intended to prevent # # cluster problems while using the INCA algorithm through the # # LaplacesDemon.hpc function. # ########################################################################### server_Listening <- function(n=2, port=19009) { slist <- vector('list', n) for (i in 1:n) { slist[[i]] <- socketConnection("localhost", port, server=TRUE, open="r+") cat("\nClient", i, "Connected")} tmp <- NULL trow <- 0 stop_server <- FALSE cat("\nStart listening...") repeat { ready <- which(socketSelect(slist, TRUE)) for (i in ready) { #print(paste("Socket", i, "ready to write")) con <- slist[[i]] #print("Write message...") if(is.null(tmp)) serialize(tmp, con) else serialize(tmp[-(((i-1)*trow+1):(i*trow))], con) #print("Read message...") buf <- try(unserialize(con), silent=TRUE) if(is.matrix(buf)) { if(is.null(tmp)) { tmp <- matrix(0, nrow=n*nrow(buf), ncol=ncol(buf)) trow <- nrow(buf) } tmp[((i-1)*trow+1):(i*trow),] <- buf } else { stop_server <- TRUE break } } if(stop_server == TRUE) break } for (i in 1:n) { close(slist[[i]]) cat("\nClose connection", i) } cat("\n") } #End LaplacesDemon/R/SensitivityAnalysis.R0000755000176200001440000000706415144316355017364 0ustar liggesusers########################################################################### # SensitivityAnalysis # # # # The purpose of the SensitivityAnalysis function is to perform a # # sensitivity analysis on the posterior distributions and posterior # # inferences from two models. # ########################################################################### SensitivityAnalysis <- function(Fit1, Fit2, Pred1, Pred2) { ### Initial Checks if(missing(Fit1)) stop("Fit1 is a required argument.") if(missing(Fit2)) stop("Fit2 is a required argument.") if(missing(Pred1)) stop("Pred1 is a required argument.") if(missing(Pred2)) stop("Pred2 is a required argument.") "%!in%" <- function(x,table) match(x, table, nomatch=0) == 0 if(class(Fit1) %!in% c("demonoid","iterquad","laplace","pmc","vb")) stop("Fit1 is not an object of class demonoid, iterquad, laplace, pmc, or vb.") if(class(Fit2) %!in% c("demonoid","iterquad","laplace","pmc","vb")) stop("Fit2 is not an object of class demonoid, iterquad, laplace, pmc, or vb.") if(identical(class(Fit1), "demonoid")) post1 <- Fit1$Posterior2 if(identical(class(Fit2), "demonoid")) post2 <- Fit2$Posterior2 if(identical(class(Fit1), "iterquad")) post1 <- Fit1$Posterior if(identical(class(Fit2), "iterquad")) post2 <- Fit2$Posterior if(identical(class(Fit1), "laplace")) post1 <- Fit1$Posterior if(identical(class(Fit2), "laplace")) post2 <- Fit2$Posterior if(identical(class(Fit1), "pmc")) post1 <- Fit1$Posterior2 if(identical(class(Fit2), "pmc")) post2 <- Fit2$Posterior2 if(identical(class(Fit1), "vb")) post1 <- Fit1$Posterior if(identical(class(Fit2), "vb")) post2 <- Fit2$Posterior if(class(Pred1) %!in% c("demonoid.ppc","iterquad.ppc","laplace.ppc","pmc.ppc","vb.ppc")) stop("Fit1 is not an object of class demonoid.ppc, iterquad.ppc, laplace.ppc, pmc.ppc, or vb.ppc.") if(class(Pred2) %!in% c("demonoid.ppc","iterquad.ppc","laplace.ppc","pmc.ppc","vb.ppc")) stop("Fit2 is not an object of class demonoid.ppc, iterquad.ppc, laplace.ppc, pmc.ppc, or vb.ppc.") if(nrow(post1) != nrow(post2)) stop("The number of posterior samples differ between Fit1 and Fit2.") keep <- which(colnames(post1) %in% colnames(post2)) post1 <- post1[,keep] keep <- which(colnames(post2) %in% colnames(post1)) post2 <- post2[,keep] if(!identical(colnames(post1), colnames(post2))) stop("Posterior names differ between Fit1 and Fit2.") yhat1 <- Pred1$yhat yhat2 <- Pred2$yhat if(!identical(dim(yhat1), dim(yhat2))) stop("Dimensions of yhat differ between Pred1 and Pred2.") ### Sensitivity Analysis Posterior <- matrix(NA, ncol(post1), 2) rownames(Posterior) <- colnames(post1) colnames(Posterior) <- c("p(Fit1 > Fit2)", "var(Fit1) / var(Fit2)") Posterior[,1] <- colMeans(post1 > post2) Posterior[,2] <- .colVars(post1) / .colVars(post2) Post.Pred.Dist <- matrix(NA, nrow(yhat1), 2) rownames(Post.Pred.Dist) <- rownames(yhat1) colnames(Post.Pred.Dist) <- c("p(Pred1 > Pred2)", "var(Pred1) / var(Pred2)") Post.Pred.Dist[,1] <- rowMeans(yhat1 > yhat2) Post.Pred.Dist[,2] <- .rowVars(yhat1) / .rowVars(yhat2) ### Output out <- list(Posterior=Posterior, Post.Pred.Dist=Post.Pred.Dist) class(out) <- "sensitivity" return(out) } #End LaplacesDemon/R/joint.pr.plot.R0000755000176200001440000001226115144316355016041 0ustar liggesusers########################################################################### # joint.pr.plot # # # # The purpose of the joint.pr.plot function is to plot a joint # # probability region. The joint.pr.plot function uses modified forms of # # the ellipse and dataEllipse functions from the car package. # ########################################################################### joint.pr.plot <- function(x, y, quantiles=c(0.25,0.50,0.75,0.95)) { ### Function from car package for ellipses ellipse <- function(center, shape, radius, log="", center.pch=19, center.cex=1.5, segments=51, draw=TRUE, add=draw, xlab="", ylab="", col=palette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, ...) { trans.colors <- function(col, alpha=0.5, names=NULL) { # this function by Michael Friendly nc <- length(col) na <- length(alpha) # make lengths conform, filling out to the longest if(nc != na) { col <- rep(col, length.out=max(nc,na)) alpha <- rep(alpha, length.out=max(nc,na))} clr <-rbind(col2rgb(col)/255, alpha=alpha) col <- rgb(clr[1,], clr[2,], clr[3,], clr[4,], names=names) return(col)} logged <- function(axis=c("x", "y")){ axis <- match.arg(axis) 0 != length(grep(axis, log))} if(!(is.vector(center) && 2==length(center))) stop("center must be a vector of length 2") if(!(is.matrix(shape) && all(2==dim(shape)))) stop("shape must be a 2 by 2 matrix") if(max(abs(shape - t(shape)))/max(abs(shape)) > 1e-10) stop("shape must be a symmetric matrix") angles <- (0:segments)*2*pi/segments unit.circle <- cbind(cos(angles), sin(angles)) Q <- chol(shape, pivot=TRUE) order <- order(attr(Q, "pivot")) ellipse <- t(center + radius*t( unit.circle %*% Q[,order])) colnames(ellipse) <- c("x", "y") if(logged("x")) ellipse[, "x"] <- exp(ellipse[, "x"]) if(logged("y")) ellipse[, "y"] <- exp(ellipse[, "y"]) fill.col <- trans.colors(col, fill.alpha) if(draw) { if(add) { lines(ellipse, col=col, lwd=lwd, ...) if(fill) polygon(ellipse, col=fill.col, border=NA) } else { plot(ellipse, type="n", xlab=xlab, ylab=ylab, ...) lines(ellipse, col=col, lwd=lwd, ... ) if(fill) polygon(ellipse, col=fill.col, border=NA) } if((center.pch != FALSE) && (!is.null(center.pch))) points(center[1], center[2], pch=center.pch, cex=center.cex, col=col)} invisible(ellipse) } ### Function from car package for ellipses dataEllipse <- function(x, y, weights, log="", quantiles=c(0.5, 0.95), center.pch=19, center.cex=1.5, draw=TRUE, plot.points=draw, add=!plot.points, segments=51, xlab=deparse(substitute(x)), ylab=deparse(substitute(y)), col=palette()[1:2], lwd=1, fill=FALSE, fill.alpha=0.3, ...) { if(length(col) == 1) col <- rep(col, 2) if(missing(y)) { if(is.matrix(x) && ncol(x) == 2) { if(missing(xlab)) xlab <- colnames(x)[1] if(missing(ylab)) ylab <- colnames(x)[2] y <- x[,2] x <- x[,1] } else stop("x and y must be vectors, or x must be a 2 column matrix.") } else if(!(is.vector(x) && is.vector(y) && length(x) == length(y))) stop("x and y must be vectors of the same length") if(missing(weights)) weights <- rep(1, length(x)) if(length(weights) != length(x)) stop("weights must be of the same length as x and y") if(draw) { if(!add) { mycol <- rgb(0, 100, 0, 50, maxColorValue=255) plot(x, y, type="n", col=mycol, pch=16, xlab=xlab, ylab=ylab, ...) if(plot.points) points(x, y, col=mycol, pch=16, ...)}} dfn <- 2 dfd <- length(x) - 1 v <- cov.wt(cbind(x, y), wt=weights) shape <- v$cov center <- v$center result <- vector("list", length=length(quantiles)) names(result) <- quantiles for (i in seq(along=quantiles)) { level <- quantiles[i] radius <- sqrt(dfn * qf(level, dfn, dfd)) result[[i]] <- ellipse(center, shape, radius, log=log, center.pch=center.pch, center.cex=center.cex, segments=segments, col=col[1], lwd=lwd, fill=fill, fill.alpha=fill.alpha, draw=draw, ...)} invisible(if(length(quantiles) == 1) result[[1]] else result) } dataEllipse(x, y, quantiles=quantiles) } #End LaplacesDemon/R/cond.plot.R0000755000176200001440000000711415144316355015222 0ustar liggesusers########################################################################### # cond.plot # # # # The purpose of the cond.plot function is to provide several styles of # # conditional plots with base graphics. # ########################################################################### cond.plot <- function(x, y, z, Style="smoothscatter") { ### Initial Checks if(missing(x)) stop("x is a required argument.") if(missing(z)) z <- rep(1, length(x)) if(Style %in% c("boxplot","scatter","smoothscatter")) { if(missing(y)) stop("y is a required argument.") if(length(x) != length(y)) stop("length differs for x and y.")} if(Style == "boxplot") x <- round(x) ### Object Names xname <- deparse(substitute(x)) yname <- deparse(substitute(y)) zname <- deparse(substitute(z)) ### Set Plot Window znum <- length(unique(z)) if(znum == 1) par(mfrow=c(1,1)) else if(znum == 2) par(mfrow=c(2,1)) else if(znum > 2 & znum < 5) par(mfrow=c(2,2)) else if(znum > 4 & znum < 7) par(mfrow=c(2,3)) else par(mfrow=c(3,3)) if(Style == "boxplot") { ### Conditional Boxplot for (i in 1:znum) { boxplot(y[which(z == i)] ~ x[which(z == i)], col="red", varwidth=TRUE, main=paste(zname, " = ", i, sep=""), ylab=yname)} #xlab=xname doesn't work here? } if(Style == "densover") { ### Conditional Density Overlay par(mfrow=c(1,1)) dens <- list() for (i in 1:znum) dens[[i]] <- density(x[which(z == i)]) xmin <- min(sapply(dens, function(x) min(x$x))) xmax <- max(sapply(dens, function(x) max(x$x))) ymax <- max(sapply(dens, function(x) max(x$y))) plot(dens[[1]], xlim=c(xmin, xmax), ylim=c(0,ymax), col=1, main="Density Overlay", xlab=paste("f(", xname, " | ", zname, ")", sep="")) for (i in 2:znum) lines(dens[[i]], col=i) } else if(Style == "hist") { ### Conditional Histogram for (i in 1:znum) { hist(x[which(z == i)], col="red", prob=TRUE, main=paste(zname, " = ", i, sep=""), xlab=xname) lines(density(x[which(z == i)]))} } else if(Style == "scatter") { ### Conditional Scatterplot mycol <- rgb(100, 100, 100, 50, maxColorValue=255) for (i in 1:znum) { plot(x[which(z == i)], y[which(z == i)], xlim=range(x), ylim=range(y), col=mycol, pch=16, xlab=xname, ylab=yname, main=paste(zname, " = ", i, sep="")) panel.smooth(x[which(z == i)], y[which(z == i)], col=mycol, pch=16)} } else if(Style == "smoothscatter") { #Conditional smoothScatter colramp=colorRampPalette(c("black","red")) lowess.na <- function(x, y=NULL, f=2/3, ...) { x1 <- subset(x, is.finite(x) & is.finite(y)) y1 <- subset(y, is.finite(x) & is.finite(y)) lowess.na <- lowess(x1, y1, f, ...)} for (i in 1:znum) { smoothScatter(x[which(z == i)], y[which(z == i)], colramp=colramp, nrpoints=0, xlab=xname, ylab=yname, main=paste(zname, " = ", i, sep="")) lines(lowess.na(x[which(z == i)], y[which(z == i)]), col="white")} } return(invisible()) } #End LaplacesDemon/R/print.pmc.R0000755000176200001440000000400415144316355015227 0ustar liggesusers########################################################################### # print.pmc # # # # The purpose of the print.pmc function is to print the contents of an # # object of class pmc to the screen. # ########################################################################### print.pmc <- function(x, ...) { if(missing(x)) stop("The x argument is required.") cat("Call:\n") print(x$Call) cat("\nalpha:\n", sep="") print(x$alpha) cat("Covariance Matrix: (NOT SHOWN HERE)\n") cat("Deviance: (NOT SHOWN HERE)\n") cat("Deviance Information Criterion (DIC):\n") DIC <- matrix(c(round(x$DIC[1],3), round(x$DIC[2],3), round(x$DIC[3],3)), 3, 1, dimnames=list(c("Dbar","pD","DIC"),c("All"))) print(DIC) cat("ESSN:\n") print(x$ESSN) cat("Initial Values:\n") print(x$Initial.Values) cat("\nIterations: ", x$Iterations, "\n", sep="") cat("Log(Marginal Likelihood): ", x$LML, "\n", sep="") cat("M (Mixture Components): ", x$M, "\n", sep="") cat("Minutes of run-time: ", round(x$Minutes,2), "\n", sep="") cat("Model: (NOT SHOWN HERE)\n") cat("Monitor: (NOT SHOWN HERE)\n") cat("Mu: (NOT SHOWN HERE)\n") cat("Number of Samples: ", x$N, "\n", sep="") cat("nu: ", x$nu, "\n", sep="") cat("Parameters (Number of): ", x$Parameters, "\n", sep="") cat("Perpexity, Normalized:\n") print(x$Perplexity) cat("Posterior1: (NOT SHOWN HERE)\n") cat("Posterior2: (NOT SHOWN HERE)\n") cat("Summary: (SHOWN BELOW)\n") cat("Thinned Samples: ", x$Thinned.Samples, "\n", sep="") cat("Thinning: ", x$Thinning, "\n", sep="") cat("Weights: (NOT SHOWN HERE)\n") cat("\n\nSummary:\n") print(x$Summary) invisible(x) } #End LaplacesDemon/R/plot.demonoid.ppc.R0000755000176200001440000010647015144342657016667 0ustar liggesusers########################################################################### # plot.demonoid.ppc # # # # The purpose of the plot.demonoid.ppc function is to plot an object of # # class demonoid.ppc. # ########################################################################### plot.demonoid.ppc <- function(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, ...) { ### Initial Checks if(missing(x)) stop("The x argument is required.") if(!inherits(x, "demonoid.ppc")) stop("x is not of class demonoid.ppc.") if(is.null(Style)) Style <- "Density" if(is.null(Rows)) Rows <- 1:nrow(x[["yhat"]]) ### Plots if(Style == "Covariates") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) { plot(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75, ylim=c(min(temp[Rows,c(1,4:6)]),max(temp[Rows,c(1,4:6)])), xlab=paste("X[,",i,"]", sep=""), ylab="yhat", sub="Gray lines are yhat at 2.5% and 95%.") panel.smooth(co[Rows,i], temp[Rows,5], col=mycol, pch=16, cex=0.75)}} if(Style == "Covariates, Categorical DV") { if(PDF == TRUE) { pdf("PPC.Plots.Covariates.Cat.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Covariates.") if(is.null(Data[["X"]]) & is.null(Data[["x"]])) stop("X or x is required in Data.") if(is.null(Data[["X"]])) co <- matrix(Data[["x"]], length(Data[["x"]]), 1) else if(is.null(Data[["x"]])) co <- Data[["X"]] temp <- summary(x, Categorical=TRUE, Quiet=TRUE)$Summary ncat <- length(table(temp[,1])) mycol <- rgb(0, 100, 0, 50, maxColorValue=255) for (i in 1:ncol(co)) {for (j in 2:(ncat+1)) { plot(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75, xlab=paste("X[,",i,"]", sep=""), ylab=colnames(temp)[j]) panel.smooth(co[Rows,i], temp[Rows,j], col=mycol, pch=16, cex=0.75)}}} if(Style == "Density") { if(PDF == TRUE) { pdf("PPC.Plots.Density.pdf") par(mfrow=c(3,3))} else par(mfrow=c(3,3), ask=TRUE) for (j in 1:length(Rows)) { plot(density(x[["yhat"]][Rows[j],]), main=paste("Post. Pred. Plot of yhat[", Rows[j], ",]", sep=""), xlab="Value", sub="Black=Density, Red=y") polygon(density(x[["yhat"]][Rows[j],]), col="black", border="black") abline(v=x[["y"]][Rows[j]], col="red")}} if(Style == "DW") { if(PDF == TRUE) pdf("PPC.Plots.DW.pdf") par(mfrow=c(1,1)) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[,s]))^2, na.rm=TRUE) / sum(epsilon.obs[,s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[,s]))^2, na.rm=TRUE) / sum(epsilon.rep[,s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")} if(Style == "DW, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.DW.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- x[["y"]] - x[["yhat"]] N <- nrow(epsilon.obs) S <- ncol(epsilon.obs) epsilon.rep <- matrix(rnorm(N*S), N, S) d.obs <- d.rep <- rep(0, S) for (j in 1:J) { for (s in 1:S) { d.obs[s] <- sum(c(0,diff(epsilon.obs[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.obs[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE) d.rep[s] <- sum(c(0,diff(epsilon.rep[((j-1)*M+1):(j*M),s]))^2, na.rm=TRUE) / sum(epsilon.rep[((j-1)*M+1):(j*M),s]^2, na.rm=TRUE)} result <- "no" if(mean(d.obs > d.rep, na.rm=TRUE) < 0.025) result <- "positive" if(mean(d.obs > d.rep, na.rm=TRUE) > 0.975) result <- "negative" d.d.obs <- density(d.obs, na.rm=TRUE) d.d.rep <- density(d.rep, na.rm=TRUE) plot(d.d.obs, xlim=c(0,4), ylim=c(0, max(d.d.obs$y, d.d.rep$y)), col="white", main="Durbin-Watson test", xlab=paste("d.obs=", round(mean(d.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(d.obs, probs=0.025, na.rm=TRUE)),2), ", ", round(as.vector(quantile(d.obs, probs=0.975, na.rm=TRUE)), 2), "), p(d.obs > d.rep) = ", round(mean(d.obs > d.rep, na.rm=TRUE),3), " = ", result, " autocorrelation", sep=""), sub=paste("Y[,",j,"]",sep="")) polygon(d.d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) abline(v=2, col="red")}} if(Style == "ECDF") { if(PDF == TRUE) pdf("PPC.Plots.ECDF.pdf") par(mfrow=c(1,1)) plot(ecdf(x[["y"]][Rows]), verticals=TRUE, do.points=FALSE, main="Cumulative Fit", xlab="y (black) and yhat (red; gray)", ylab="Cumulative Frequency") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.975)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.025)), verticals=TRUE, do.points=FALSE, col="gray") lines(ecdf(apply(x[["yhat"]][Rows,], 1, quantile, probs=0.500)), verticals=TRUE, do.points=FALSE, col="red")} if(Style == "Fitted") { if(PDF == TRUE) pdf("PPC.Plots.Fitted.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75, ylim=c(min(temp[Rows,4], na.rm=TRUE), max(temp[Rows,6], na.rm=TRUE)), xlab="y", ylab="yhat", main="Fitted") for (i in Rows) { lines(c(temp[Rows[i],1], temp[Rows[i],1]), c(temp[Rows[i],4], temp[Rows[i],6]))} panel.smooth(temp[Rows,1], temp[Rows,5], pch=16, cex=0.75)} if(Style == "Fitted, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:nrow(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Fitted, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Fitted.M.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Fitted, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { temp1 <- as.vector(matrix(temp[,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp2 <- as.vector(matrix(temp[,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp3 <- as.vector(matrix(temp[,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) temp4 <- as.vector(matrix(temp[,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,]) plot(temp1, temp3, pch=16, cex=0.75, ylim=c(min(temp2, na.rm=TRUE), max(temp4, na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab="yhat", main="Fitted") for (j in 1:ncol(Data[["Y"]])) { lines(c(temp1[j], temp1[j]), c(temp2[j], temp4[j]))} panel.smooth(temp1, temp3, pch=16, cex=0.75)}} if(Style == "Jarque-Bera") { if(PDF == TRUE) pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1)) epsilon.obs <- epsilon.rep <- x[["y"]][Rows] - x[["yhat"]][Rows,] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (s in 1:ncol(epsilon.obs)) { epsilon.rep[,s] <- rnorm(N, mean(epsilon.obs[,s], na.rm=TRUE), sd(epsilon.obs[,s], na.rm=TRUE)) K.obs <- kurtosis(epsilon.obs[,s]) S.obs <- skewness(epsilon.obs[,s]) K.rep <- kurtosis(epsilon.rep[,s]) S.rep <- skewness(epsilon.rep[,s]) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab="JB", ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Jarque-Bera, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Jarque.Bera.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Jarque-Bera, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Y is required in Data.") M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) epsilon.obs <- epsilon.rep <- x[["y"]] - x[["yhat"]] kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} JB.obs <- JB.rep <- rep(0, ncol(epsilon.obs)) N <- nrow(epsilon.obs) for (j in 1:J) { for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.rep <- rnorm(M, mean(e.obs[,j], na.rm=TRUE), sd(e.obs[,j], na.rm=TRUE)) K.obs <- kurtosis(e.obs[,j]) S.obs <- skewness(e.obs[,j]) K.rep <- kurtosis(e.rep) S.rep <- skewness(e.rep) JB.obs[s] <- (N/6)*(S.obs^2 + ((K.obs-3)^2)/4) JB.rep[s] <- (N/6)*(S.rep^2 + ((K.rep-3)^2)/4)} p <- round(mean(JB.obs > JB.rep, na.rm=TRUE), 3) result <- "Non-Normality" if((p >= 0.025) & (p <= 0.975)) result <- "Normality" d.obs <- density(JB.obs) d.rep <- density(JB.rep) plot(d.obs, xlim=c(min(d.obs$x,d.rep$x), max(d.obs$x,d.rep$x)), ylim=c(0, max(d.obs$y, d.rep$y)), col="white", main="Jarque-Bera Test", xlab=paste("JB for Y[,",j,"]", sep=""), ylab="Density", sub=paste("JB.obs=", round(mean(JB.obs, na.rm=TRUE),2), " (", round(as.vector(quantile(JB.obs, probs=0.025, na.rm=TRUE)),2), ",", round(as.vector(quantile(JB.obs, probs=0.975, na.rm=TRUE)),2), "), p(JB.obs > JB.rep) = ", p, " = ", result, sep="")) polygon(d.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)}} if(Style == "Mardia") { if(PDF == TRUE) pdf("PPC.Plots.Mardia.pdf") par(mfrow=c(2,1)) if(is.null(Data)) stop("Data is required for Style=Mardia, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Mardia, C.") epsilon.obs <- x[["y"]] - x[["yhat"]] M <- nrow(Data[["Y"]]) J <- ncol(Data[["Y"]]) K3.obs <- K3.rep <- K4.obs <- K4.rep <- rep(0, ncol(epsilon.obs)) for (s in 1:ncol(epsilon.obs)) { e.obs <- matrix(epsilon.obs[,s], M, J) e.obs.mu <- colMeans(e.obs) e.obs.mu.mat <- matrix(e.obs.mu, M, J, byrow=TRUE) e.obs.stand <- e.obs - e.obs.mu.mat S.obs <- var(e.obs) A.obs <- t(chol(S.obs)) A.inv.obs <- solve(A.obs) Z.obs <- t(A.inv.obs %*% t(e.obs.stand)) Dij.obs <- Z.obs %*% t(Z.obs) D2.obs <- diag(Dij.obs) K3.obs[s] <- mean(as.vector(Dij.obs)^3) K4.obs[s] <- mean(D2.obs^2) e.rep <- rmvn(M, e.obs.mu.mat, S.obs) e.rep.mu <- colMeans(e.rep) e.rep.mu.mat <- matrix(e.rep.mu, M, J, byrow=TRUE) e.rep.stand <- e.rep - e.rep.mu.mat S.rep <- var(e.rep) A.rep <- t(chol(S.rep)) A.inv.rep <- solve(A.rep) Z.rep <- t(A.inv.rep %*% t(e.rep.stand)) Dij.rep <- Z.rep %*% t(Z.rep) D2.rep <- diag(Dij.rep) K3.rep[s] <- mean(as.vector(Dij.rep)^3) K4.rep[s] <- mean(D2.rep^2) } p.K3 <- round(mean(K3.obs > K3.rep), 3) p.K4 <- round(mean(K4.obs > K4.rep), 3) K3.result <- K4.result <- "Non-Normality" if((p.K3 >= 0.025) & (p.K3 <= 0.975)) K3.result <- "Normality" if((p.K4 >= 0.025) & (p.K4 <= 0.975)) K4.result <- "Normality" d.K3.obs <- density(K3.obs) d.K3.rep <- density(K3.rep) d.K4.obs <- density(K4.obs) d.K4.rep <- density(K4.rep) plot(d.K3.obs, xlim=c(min(d.K3.obs$x, d.K3.rep$x), max(d.K3.obs$x, d.K3.rep$x)), ylim=c(0, max(d.K3.obs$y, d.K3.rep$y)), col="white", main="Mardia's Test of MVN Skewness", xlab="Skewness Test Statistic (K3)", ylab="Density", sub=paste("K3.obs=", round(mean(K3.obs, na.rm=TRUE), 2), " (", round(quantile(K3.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K3.obs, probs=0.975, na.rm=TRUE), 2), "), p(K3.obs > K3.rep) = ", p.K3, " = ", K3.result, sep="")) polygon(d.K3.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K3.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA) plot(d.K4.obs, xlim=c(min(d.K4.obs$x, d.K4.rep$x), max(d.K4.obs$x, d.K4.rep$x)), ylim=c(0, max(d.K4.obs$y, d.K4.rep$y)), col="white", main="Mardia's Test of MVN Kurtosis", xlab="Kurtosis Test Statistic (K4)", ylab="Density", sub=paste("K4.obs=", round(mean(K4.obs, na.rm=TRUE), 2), " (", round(quantile(K4.obs, probs=0.025, na.rm=TRUE), 2), ", ", round(quantile(K4.obs, probs=0.975, na.rm=TRUE), 2), "), p(K4.obs > K4.rep) = ", p.K4, " = ", K4.result, sep="")) polygon(d.K4.obs, col=rgb(0,0,0,50,maxColorValue=255), border=NA) polygon(d.K4.rep, col=rgb(255,0,0,50,maxColorValue=255), border=NA)} if(Style == "Predictive Quantiles") { if(PDF == TRUE) pdf("PPC.Plots.PQ.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary mycol <- rgb(0, 100, 0, 50, maxColorValue=255) plot(temp[Rows,1], temp[Rows,7], ylim=c(0,1), col=mycol, pch=16, cex=0.75, xlab="y", ylab="PQ", main="Predictive Quantiles") panel.smooth(temp[Rows,1], temp[Rows,7], col=mycol, pch=16, cex=0.75) abline(h=0.025, col="gray") abline(h=0.975, col="gray")} if(Style == "Residual Density") { if(PDF == TRUE) pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) dens <- density(epsilon.summary[2,Rows], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=expression(epsilon), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")} if(Style == "Residual Density, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { dens <- density(epsilon.500[,i], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[,", i, "]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residual Density, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residual.Density.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residual Density, Multivariate, R.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residual Density, Multivariate, R.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { dens <- density(epsilon.500[i,], na.rm=TRUE) plot(dens, col="black", main="Residual Density", xlab=paste("epsilon[", i, ",]", sep=""), ylab="Density") polygon(dens, col="black", border="black") abline(v=0, col="red")}} if(Style == "Residuals") { if(PDF == TRUE) pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1)) epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) plot(epsilon.summary[2,Rows], pch=16, cex=0.75, ylim=c(min(epsilon.summary[,Rows], na.rm=TRUE), max(epsilon.summary[,Rows], na.rm=TRUE)), xlab="y", ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.summary[,Rows])), col="red") for (i in Rows) { lines(c(i,i), c(epsilon.summary[1,Rows[i]], epsilon.summary[3,Rows[i]]), col="black")}} if(Style == "Residuals, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:ncol(Data[["Y"]])) { plot(epsilon.500[,i], pch=16, cex=0.75, ylim=c(min(epsilon.025[,i], na.rm=TRUE), max(epsilon.975[,i], na.rm=TRUE)), xlab=paste("Y[,", i, "]", sep=""), ylab=expression(epsilon)) lines(rep(0, nrow(epsilon.500)), col="red") for (j in 1:nrow(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[j,i], epsilon.975[j,i]), col="black")}}} if(Style == "Residuals, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.Residuals.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Residuals, Multivariate, C.") if(is.null(Data[["Y"]])) stop("Variable Y is required for Style=Residuals, Multivariate, C.") epsilon <- x[["y"]] - x[["yhat"]] epsilon.summary <- apply(epsilon, 1, quantile, probs=c(0.025,0.500,0.975), na.rm=TRUE) epsilon.025 <- matrix(epsilon.summary[1,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.500 <- matrix(epsilon.summary[2,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) epsilon.975 <- matrix(epsilon.summary[3,], nrow(Data[["Y"]]), ncol(Data[["Y"]])) for (i in 1:nrow(Data[["Y"]])) { plot(epsilon.500[i,], pch=16, cex=0.75, ylim=c(min(epsilon.025[i,], na.rm=TRUE), max(epsilon.975[i,], na.rm=TRUE)), xlab=paste("Y[", i, ",]", sep=""), ylab=expression(epsilon)) lines(rep(0, ncol(epsilon.500)), col="red") for (j in 1:ncol(Data[["Y"]])) { lines(c(j,j), c(epsilon.025[i,j], epsilon.975[i,j]), col="black")}}} if(Style == "Space-Time by Space") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Space.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (s in 1:Data[["S"]]) { plot(matrix(temp[,1], Data[["S"]], Data[["T"]])[s,], ylim=c(min(c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE), max(c(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,], matrix(temp[,1], Data[["S"]], Data[["T"]])[s,]), na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Space-Time at Space s=",s," of ", Data[["S"]], sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:Data[["T"]],rev(1:Data[["T"]])), c(matrix(temp[,4], Data[["S"]], Data[["T"]])[s,], rev(matrix(temp[,6], Data[["S"]], Data[["T"]])[s,])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(matrix(temp[,5], Data[["S"]], Data[["T"]])[s,], col="red")}} if(Style == "Space-Time by Time") { if(PDF == TRUE) { pdf("PPC.Plots.SpaceTime.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Space-Time by Time.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") if(is.null(Data[["S"]])) stop("Variable S is required in Data.") if(is.null(Data[["T"]])) stop("Variable T is required in Data.") Heat <- (1-(x[["y"]]-min(x[["y"]], na.rm=TRUE)) / max(x[["y"]]-min(x[["y"]], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 Heat <- matrix(Heat, Data[["S"]], Data[["T"]]) for (t in 1:Data[["T"]]) { plot(Data[["longitude"]], Data[["latitude"]], col=heat.colors(120)[Heat[,t]], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main=paste("Space-Time at t=",t," of ", Data[["T"]], sep=""), sub="Red=High, Yellow=Low")}} if(Style == "Spatial") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- (1-(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE)) / max(x[["y"]][Rows]-min(x[["y"]][Rows], na.rm=TRUE), na.rm=TRUE)) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Plot", sub="Red=High, Yellow=Low")} if(Style == "Spatial Uncertainty") { if(PDF == TRUE) pdf("PPC.Plots.Spatial.Unc.pdf") par(mfrow=c(1,1)) if(is.null(Data)) stop("Data is required for Style=Spatial Uncertainty.") if(is.null(Data[["longitude"]])) stop("Variable longitude is required in Data.") if(is.null(Data[["latitude"]])) stop("Variable latitude is required in Data.") heat <- apply(x[["yhat"]], 1, quantile, probs=c(0.025,0.975)) heat <- heat[2,] - heat[1,] heat <- (1-(heat[Rows]-min(heat[Rows])) / max(heat[Rows]-min(heat[Rows]))) * 99 + 1 plot(Data[["longitude"]][Rows], Data[["latitude"]][Rows], col=heat.colors(120)[heat], pch=16, cex=0.75, xlab="Longitude", ylab="Latitude", main="Spatial Uncertainty Plot", sub="Red=High, Yellow=Low")} if(Style == "Time-Series") { if(PDF == TRUE) pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1)) temp <- summary(x, Quiet=TRUE)$Summary plot(Rows, temp[Rows,1], ylim=c(min(temp[Rows,c(1,4)], na.rm=TRUE), max(temp[Rows,c(1,6)], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main="Plot of Fitted Time-Series", sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(Rows,rev(Rows)),c(temp[Rows,4],rev(temp[Rows,6])), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(Rows, temp[Rows,1]) lines(Rows, temp[Rows,5], col="red")} if(Style == "Time-Series, Multivariate, C") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:ncol(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][,i], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE), max(Data[["Y"]][,i], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[,i], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", ncol(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(Style == "Time-Series, Multivariate, R") { if(PDF == TRUE) { pdf("PPC.Plots.TimeSeries.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(is.null(Data)) stop("Data is required for Style=Time-Series, Multivariate.") if(is.null(Data[["Y"]])) stop("Variable Y is required in Data.") temp <- summary(x, Quiet=TRUE)$Summary for (i in 1:nrow(Data[["Y"]])) { tempy <- matrix(temp[Rows,1], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qLB <- matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qMed <- matrix(temp[Rows,5], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] qUB <- matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,] plot(1:length(tempy), tempy, ylim=c(min(Data[["Y"]][i,], matrix(temp[Rows,4], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE), max(Data[["Y"]][i,], matrix(temp[Rows,6], nrow(Data[["Y"]]), ncol(Data[["Y"]]))[i,], na.rm=TRUE)), type="l", xlab="Time", ylab="y", main=paste("Time-Series ", i, " of ", nrow(Data[["Y"]]), sep=""), sub="Actual=Black, Fit=Red, Interval=Transparent Red") polygon(c(1:length(tempy),rev(1:length(tempy))),c(qLB,rev(qUB)), col=rgb(255, 0, 0, 50, maxColorValue=255), border=FALSE) lines(1:length(tempy), tempy) lines(1:length(tempy), qMed, col="red")}} if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/Elicitation.R0000755000176200001440000000770315144316355015572 0ustar liggesusers########################################################################### # Elicitation # # # # The purpose of these functions is to facilitate prior elicitation and # # its use in model specification. # ########################################################################### delicit <- function(theta, x, a=-Inf, b=Inf, log=FALSE) { ### Initial Checks if(missing(theta)) stop("The theta argument is required.") if(missing(x)) stop("The x argument is required.") if(a >= b) stop("Lower bound a is not less than upper bound b.") if(is.finite(a) & is.infinite(b)) { if(a > 0) {theta <- log(theta); x <- log(x)} else if(a == 0) { theta <- log(theta + 1e-04); x <- log(x + 1e-04) } else { #(a < 0) theta <- log(theta - a + 1e-04) x <- log(x - a + 1e-04) } } if(is.infinite(a) & is.finite(b)) { a <- .Machine$double.xmin theta[which(theta <= a)] <- a + 1e-04 theta[which(theta >= b)] <- b - 1e-04 x[which(x <= a)] <- a + 1e-04 x[which(x >= b)] <- b - 1e-04 theta <- log((theta-a) / (b-theta)) x <- log((x-a) / (b-x)) } if(is.finite(a) & is.finite(b)) { theta[which(theta <= a)] <- a + 1e-04 theta[which(theta >= b)] <- b - 1e-04 x[which(x <= a)] <- a + 1e-04 x[which(x >= b)] <- b - 1e-04 theta <- log((theta-a) / (b-theta)) x <- log((x-a) / (b-x)) } ### Estimate Density kde <- density(x) dens <- approx(kde$x, kde$y, theta)$y if(log == TRUE) dens <- log(dens) return(dens) } elicit <- function(n, cats, cat.names, show.plot=FALSE) { ### Initial Checks if(missing(n)) stop("The n argument is required.") if(missing(cats)) stop("The cats argument is required.") if(missing(cat.names)) stop("The cat.names argument is required.") if(!identical(length(cats),length(cat.names))) stop("Different lengths found for cats and cat.names.") cat.labels <- letters[1:length(cats)] ### Introduction cat("\nYou have", n, "chips.") cat("\nEach chip must be allocated to a category.") cat("\nThe categories are:") cat("\n\n", cat.names) cat("\n\nYou will be asked two questions until all chips are allocated:") cat("\n\n1. How many chips would you like to allocate now?") cat("\n2. To which category do you allocate these chips?\n") cat("\nCategories:", cat.names) cat("\nCategory Entry:", cat.labels, "\n\n") readline("Press Enter or Return when ready to begin: ") ### Elicitation while(n > 0) { cat("\n\nYou have", n ,"chips remaining.\n") N <- 0 while ((N <= 0) | (N > n)) N <- readline("How many chips would you like to allocate now? ") N <- as.numeric(N) cat("\nTo which category do you allocate these chips?\n") cat("\nCategories:", cat.names) cat("\nCategory Entry:", cat.labels, "\n\n") answer <- "LaplacesDemon" while (all(cat.labels != answer)) answer <- readline("Category: ") pos <- which(cat.labels == answer) if(!exists("out")) out <- rep(cats[pos], N) else out <- c(out, rep(cats[pos], N)) n <- n - N ### Barplot if(exists("out")) {if(show.plot == TRUE) { out.table <- table(out) count <- rep(0,length(cats)) count[as.numeric(names(out.table))] <- as.vector(out.table) barplot(count, names.arg=cat.names, xlab="Category", ylab="Chips", col="red")}} } cat("\n\nThank you for participating.\n") #Output return(out) } #End LaplacesDemon/R/LaplaceApproximation.R0000755000176200001440000022376115144341174017443 0ustar liggesusers########################################################################### # LaplaceApproximation # # # # The purpose of the LaplaceApproximation function is to maximize the # # logarithm of the unnormalized joint posterior distribution of a # # Bayesian model with one of many optimization algorithms. # ########################################################################### LaplaceApproximation <- function(Model, parm, Data, Interval=1.0E-6, Iterations=100, Method="SPG", Samples=1000, CovEst="Hessian", sir=TRUE, Stop.Tolerance=1.0E-5, CPUs=1, Type="PSOCK") { ########################## Initial Checks ########################## time1 <- proc.time() LA.call <- match.call() if(missing(Model)) stop("Model is a required argument.") if(!is.function(Model)) stop("Model must be a function.") if(missing(Data)) stop("Data is a required argument.") if(missing(parm)) { cat("Initial values were not supplied, and\n") cat("have been set to zero prior to LaplaceApproximation().\n") parm <- rep(0, length(Data[["parm.names"]]))} if(is.null(Data[["mon.names"]])) stop("In Data, mon.names is NULL.") if(is.null(Data[["parm.names"]])) stop("In Data, parm.names is NULL.") for (i in 1:length(Data)) { if(is.matrix(Data[[i]])) { if(all(is.finite(Data[[i]]))) { mat.rank <- qr(Data[[i]], tol=1e-10)$rank if(mat.rank < ncol(Data[[i]])) { cat("WARNING: Matrix", names(Data)[[i]], "may be rank-deficient.\n")}}}} if({Interval <= 0} | {Interval > 1}) Interval <- 1.0E-6 Iterations <- min(max(round(Iterations), 10), 1000000) "%!in%" <- function(x,table) return(match(x, table, nomatch=0) == 0) if(Method %!in% c("AGA","BFGS","BHHH","CG","DFP","HAR","HJ","LBFGS", "LM","NM","NR","PSO","Rprop","SGD","SOMA","SPG","SR1","TR")) stop("Method is unknown.") if(Stop.Tolerance <= 0) Stop.Tolerance <- 1.0E-5 as.character.function <- function(x, ... ) { fname <- deparse(substitute(x)) f <- match.fun(x) out <- c(sprintf('"%s" <- ', fname), capture.output(f)) if(grepl("^[<]", tail(out,1))) out <- head(out, -1) return(out) } acount <- length(grep("apply", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, " possible instance(s) of apply functions\n") cat( "were found in the Model specification. Iteration speed will\n") cat(" increase if apply functions are vectorized in R or coded\n")} acount <- length(grep("for", as.character.function(Model))) if(acount > 0) { cat("Suggestion:", acount, " possible instance(s) of for loops\n") cat(" were found in the Model specification. Iteration speed will\n") cat(" increase if for loops are vectorized in R or coded in a\n") cat(" faster language such as C++ via the Rcpp package.\n")} ### Sample Size of Data if(!is.null(Data[["n"]])) if(length(Data[["n"]]) == 1) N <- Data[["n"]] if(!is.null(Data[["N"]])) if(length(Data[["N"]]) == 1) N <- Data[["N"]] if(!is.null(Data[["y"]])) N <- nrow(matrix(Data[["y"]])) if(!is.null(Data[["Y"]])) N <- nrow(matrix(Data[["Y"]])) if(Method == "SGD") if(!is.null(Data[["Nr"]])) N <- Data[["Nr"]] if(!is.null(N)) cat("Sample Size: ", N, "\n") else stop("Sample size of Data not found in n, N, y, or Y.") ########################### Preparation ############################ m.old <- Model(parm, Data) if(!is.list(m.old)) stop("Model must return a list.") if(length(m.old) != 5) stop("Model must return five components.") if(any(names(m.old) != c("LP","Dev","Monitor","yhat","parm"))) stop("Name mismatch in returned list of Model function.") if(length(m.old[["LP"]]) > 1) stop("Multiple joint posteriors exist!") if(!identical(length(parm), length(m.old[["parm"]]))) stop("The number of initial values and parameters differs.") if(!is.finite(m.old[["LP"]])) { cat("Generating initial values due to a non-finite posterior.\n") if(!is.null(Data[["PGF"]])) Initial.Values <- GIV(Model, Data, PGF=TRUE) else Initial.Values <- GIV(Model, Data, PGF=FALSE) m.old <- Model(Initial.Values, Data) } if(!is.finite(m.old[["LP"]])) stop("The posterior is non-finite.") if(!is.finite(m.old[["Dev"]])) stop("The deviance is non-finite.") parm <- m.old[["parm"]] if(!identical(Model(m.old[["parm"]], Data)[["LP"]], m.old[["LP"]])) { cat("WARNING: LP differs when initial values are held constant.\n") cat(" Derivatives may be problematic if used.\n")} #################### Begin Laplace Approximation ################### cat("Laplace Approximation begins...\n") if(Method == "AGA") { LA <- .laaga(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) } else if(Method == "BFGS") { LA <- .labfgs(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) } else if(Method == "BHHH") { LA <- .labhhh(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) } else if(Method == "CG") { LA <- .lacg(Model, parm, Data, Iterations, Stop.Tolerance, m.old) } else if(Method == "DFP") { LA <- .ladfp(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) } else if(Method == "HAR") { LA <- .lahar(Model, parm, Data, Iterations, Stop.Tolerance, m.old) } else if(Method == "HJ") { LA <- .lahj(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) } else if(Method == "LBFGS") { LA <- .lalbfgs(Model, parm, Data, Iterations, Stop.Tolerance, m.old) } else if(Method == "LM") { LA <- .lalm(Model, parm, Data, Iterations, Stop.Tolerance, m.old) } else if(Method == "NM") { LA <- .lanm(Model, parm, Data, Iterations, Stop.Tolerance, m.old) } else if(Method == "NR") { LA <- .lanr(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) } else if(Method == "PSO") { LA <- .lapso(Model, parm, Data, Iterations, Stop.Tolerance, m.old) } else if(Method == "Rprop") { LA <- .larprop(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) } else if(Method == "SGD") { LA <- .lasgd(Model, parm, Data, Iterations, Stop.Tolerance, m.old) } else if(Method == "SOMA") { LA <- .lasoma(Model, parm, Data, options=list(maxiter=Iterations, tol=Stop.Tolerance)) } else if(Method == "SPG") { LA <- .laspg(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) } else if(Method == "SR1") { LA <- .lasr1(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) } else if(Method == "TR") { LA <- .latr(Model, parm, Data, Iterations, m.old) } Dev <- as.vector(LA$Dev) if(is.null(LA$H)) H <- FALSE else H <- LA$H iter <- LA$iter parm.len <- LA$parm.len parm.new <- LA$parm.new parm.old <- LA$parm.old post <- LA$post Step.Size <- LA$Step.Size tol.new <- LA$tol.new rm(LA) if(iter == 1) stop("LaplaceApproximation stopped at iteration 1.") if(tol.new <= Stop.Tolerance) converged <- TRUE else converged <- FALSE ### Column names to samples if(ncol(post) == length(Data[["parm.names"]])) colnames(post) <- Data[["parm.names"]] rownames(post) <- 1:nrow(post) ######################## Covariance Matirx ######################### cat("Estimating the Covariance Matrix\n") if(all(H == FALSE)) { VarCov <- CovEstim(Model, parm.new, Data, Method=CovEst) } else { VarCov <- -as.inverse(as.symmetric.matrix(H)) diag(VarCov) <- abs(diag(VarCov)) } ################# Sampling Importance Resampling ################## if({sir == TRUE} & {converged == TRUE}) { cat("Sampling from Posterior with Sampling Importance Resampling\n") posterior <- SIR(Model, Data, mu=parm.new, Sigma=VarCov, n=Samples, CPUs=CPUs, Type=Type) Mon <- matrix(0, nrow(posterior), length(Data[["mon.names"]])) dev <- rep(0, nrow(posterior)) for (i in 1:nrow(posterior)) { mod <- Model(posterior[i,], Data) dev[i] <- mod[["Dev"]] Mon[i,] <- mod[["Monitor"]] } colnames(Mon) <- Data[["mon.names"]]} else { if({sir == TRUE} & {converged == FALSE}) cat("Posterior samples are not drawn due to Converge=FALSE\n") posterior <- NA; Mon <- NA} ##################### Summary, Point-Estimate ###################### cat("Creating Summary from Point-Estimates\n") Summ1 <- matrix(NA, parm.len, 4, dimnames=list(Data[["parm.names"]], c("Mode","SD","LB","UB"))) Summ1[,1] <- parm.new Summ1[,2] <- sqrt(diag(VarCov)) Summ1[,3] <- parm.new - 2*Summ1[,2] Summ1[,4] <- parm.new + 2*Summ1[,2] ################### Summary, Posterior Samples #################### Summ2 <- NA if({sir == TRUE} & {converged == TRUE}) { cat("Creating Summary from Posterior Samples\n") Summ2 <- matrix(NA, ncol(posterior), 7, dimnames=list(Data[["parm.names"]], c("Mode","SD","MCSE","ESS","LB","Median","UB"))) Summ2[,1] <- colMeans(posterior) Summ2[,2] <- sqrt(.colVars(posterior)) Summ2[,3] <- Summ2[,2] / sqrt(nrow(posterior)) Summ2[,4] <- rep(nrow(posterior), ncol(posterior)) Summ2[,5] <- apply(posterior, 2, quantile, c(0.025)) Summ2[,6] <- apply(posterior, 2, quantile, c(0.500)) Summ2[,7] <- apply(posterior, 2, quantile, c(0.975)) Deviance <- rep(0, 7) Deviance[1] <- mean(dev) Deviance[2] <- sd(dev) Deviance[3] <- sd(dev) / sqrt(nrow(posterior)) Deviance[4] <- nrow(posterior) Deviance[5] <- as.numeric(quantile(dev, probs=0.025, na.rm=TRUE)) Deviance[6] <- as.numeric(quantile(dev, probs=0.500, na.rm=TRUE)) Deviance[7] <- as.numeric(quantile(dev, probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Deviance) for (j in 1:ncol(Mon)) { Monitor <- rep(NA,7) Monitor[1] <- mean(Mon[,j]) Monitor[2] <- sd(as.vector(Mon[,j])) Monitor[3] <- sd(as.vector(Mon[,j])) / sqrt(nrow(Mon)) Monitor[4] <- nrow(Mon) Monitor[5] <- as.numeric(quantile(Mon[,j], probs=0.025, na.rm=TRUE)) Monitor[6] <- as.numeric(quantile(Mon[,j], probs=0.500, na.rm=TRUE)) Monitor[7] <- as.numeric(quantile(Mon[,j], probs=0.975, na.rm=TRUE)) Summ2 <- rbind(Summ2, Monitor) rownames(Summ2)[nrow(Summ2)] <- Data[["mon.names"]][j] } } ############### Logarithm of the Marginal Likelihood ############### LML <- list(LML=NA, VarCov=VarCov) if({sir == TRUE} & {converged == TRUE}) { cat("Estimating Log of the Marginal Likelihood\n") lml <- LML(theta=posterior, LL=(dev*(-1/2)), method="NSIS") LML[[1]] <- lml[[1]]} else if({sir == FALSE} & {converged == TRUE}) { cat("Estimating Log of the Marginal Likelihood\n") LML <- LML(Model, Data, Modes=parm.new, Covar=VarCov, method="LME")} colnames(VarCov) <- rownames(VarCov) <- Data[["parm.names"]] time2 <- proc.time() ############################# Output ############################## LA <- list(Call=LA.call, Converged=converged, Covar=VarCov, Deviance=as.vector(Dev), History=post, Initial.Values=parm, Iterations=iter, LML=LML[[1]], LP.Final=as.vector(Model(parm.new, Data)[["LP"]]), LP.Initial=m.old[["LP"]], Minutes=round(as.vector(time2[3] - time1[3]) / 60, 2), Monitor=Mon, Posterior=posterior, Step.Size.Final=Step.Size, Step.Size.Initial=1, Summary1=Summ1, Summary2=Summ2, Tolerance.Final=tol.new, Tolerance.Stop=Stop.Tolerance) class(LA) <- "laplace" cat("Laplace Approximation is finished.\n\n") return(LA) } .laaga <- function(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) { alpha.star <- 0.234 Dev <- matrix(m.old[["Dev"]],1,1) parm.len <- length(as.vector(parm)) parm.new <- parm.old <- m.old[["parm"]] names(parm.new) <- names(parm.old) <- Data[["parm.names"]] tol.new <- 1 Step.Size <- 1 / parm.len post <- matrix(parm.new, 1, parm.len) for (iter in 1:Iterations) { parm.old <- parm.new ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") ### Approximate Truncated Gradient approx.grad <- partial(Model, parm.old, Data, Interval) approx.grad <- interval(approx.grad, -1000, 1000, reflect=FALSE) ### Proposal parm.new <- parm.old + Step.Size * approx.grad if(any(!is.finite(parm.new))) parm.new <- parm.old m.new <- Model(parm.new, Data) tol.new <- max(sqrt(sum(approx.grad^2)), sqrt(sum({parm.new - parm.old}^2))) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) { m.new <- m.old parm.new <- parm.old} ### Accept/Reject and Adapt if(m.new[["LP"]] > m.old[["LP"]]) { m.old <- m.new parm.new <- m.new[["parm"]] Step.Size <- Step.Size + (Step.Size / (alpha.star * (1 - alpha.star))) * (1 - alpha.star) / iter } else { m.new <- m.old parm.new <- parm.old Step.Size <- abs(Step.Size - (Step.Size / (alpha.star * (1 - alpha.star))) * alpha.star / iter) } post <- rbind(post, parm.new) Dev <- rbind(Dev, m.new[["Dev"]]) if(tol.new <= Stop.Tolerance) break } Dev <- Dev[-1,]; post <- post[-1,] ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=parm.new, parm.old=parm.old, post=post, Step.Size=Step.Size, tol.new=tol.new) return(LA) } .labfgs <- function(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) { m.new <- m.old Dev <- matrix(m.old[["Dev"]],1,1) parm.old <- parm parm.len <- length(as.vector(parm)) post <- matrix(m.old[["parm"]], 1, parm.len) tol.new <- 1 keepgoing <- TRUE g.old <- g.new <- rep(0, parm.len) B <- diag(parm.len) #Approximate Hessian options(warn=-1) for (iter in 2:Iterations) { ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") ### Gradient and Direction p g.old <- g.new g.new <- -1*partial(Model, m.old[["parm"]], Data, Interval) p <- as.vector(tcrossprod(g.new, -B)) p[which(!is.finite(p))] <- 0 ### Step-size Line Search Step.Size <- 0.8 changed <- TRUE while(m.new[["LP"]] <= m.old[["LP"]] & changed == TRUE) { Step.Size <- Step.Size * 0.2 s <- Step.Size*p prop <- m.old[["parm"]] + s changed <- !identical(m.old[["parm"]], prop) m.new <- Model(prop, Data) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) m.new <- m.old } ### BFGS Update to Approximate Hessian B if(m.new[["LP"]] > m.old[["LP"]]) { m.old <- m.new g <- g.new - g.old CC <- sum(s*g) #Curvature condition if(CC > 0) { y <- as.vector(crossprod(B, g)) D <- as.double(1 + crossprod(g, y)/CC) B <- B - (tcrossprod(s, y) + tcrossprod(y, s) - D * tcrossprod(s, s))/CC} if(any(!is.finite(B))) B <- diag(parm.len) } ### Storage post <- rbind(post, m.old[["parm"]]) Dev <- rbind(Dev, m.old[["Dev"]]) ### Tolerance tol.new <- sqrt(sum(s*s)) if(keepgoing == FALSE) tol.new <- 0 if(tol.new <= Stop.Tolerance) break } options(warn=0) ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=m.old[["parm"]], parm.old=parm.old, post=post, Step.Size=Step.Size, tol.new=tol.new) return(LA) } .labhhh <- function(Model, parm, Data, Interval, Iterations=100, Stop.Tolerance, m.old) { ### Check data for X and y or Y if(is.null(Data[["X"]])) stop("X is required in the data.") y <- TRUE if(is.null(Data[["y"]])) { y <- FALSE if(is.null(Data[["Y"]])) stop("y or Y is required in the data.")} if(y == TRUE) { if(length(Data[["y"]]) != nrow(Data[["X"]])) stop("length of y differs from rows in X.") } else { if(nrow(Data[["Y"]]) != nrow(Data[["X"]])) stop("The number of rows differs in y and X.")} m.new <- m.old Dev <- matrix(m.old[["Dev"]],1,1) parm.old <- parm parm.len <- length(parm) post <- matrix(parm, 1, parm.len) tol.new <- 1 options(warn=-1) for (iter in 2:Iterations) { ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") ### Gradient p, OPG A from gradient g, and direction delta p <- partial(Model, m.old[["parm"]], Data, Interval) A <- matrix(0, parm.len, parm.len) for (i in 1:nrow(Data[["X"]])) { Data.temp <- Data Data.temp$X <- Data.temp$X[i,,drop=FALSE] if(y == TRUE) Data.temp$y <- Data.temp$y[i] else Data.temp$Y <- Data.temp$Y[i,] g <- partial(Model, m.old[["parm"]], Data.temp, Interval) A <- A + tcrossprod(g,g)} A <- -as.inverse(as.symmetric.matrix(A)) delta <- as.vector(tcrossprod(p, -A)) ### Step-size Line Search Step.Size <- 0.8 changed <- TRUE while(m.new[["LP"]] <= m.old[["LP"]] & changed == TRUE) { Step.Size <- Step.Size * 0.2 s <- Step.Size*delta prop <- m.old[["parm"]] + s changed <- !identical(m.old[["parm"]], prop) m.new <- Model(prop, Data) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) m.new <- m.old } if(m.new[["LP"]] > m.old[["LP"]]) m.old <- m.new ### Storage post <- rbind(post, m.old[["parm"]]) Dev <- rbind(Dev, m.old[["Dev"]]) ### Tolerance tol.new <- sqrt(sum(delta*delta)) if(tol.new < Stop.Tolerance) break } options(warn=0) ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=m.old[["parm"]], parm.old=parm.old, post=post, Step.Size=Step.Size, tol.new=tol.new) return(LA) } .lacg <- function(Model, parm, Data, Iterations, Stop.Tolerance, m.old) { m.best <- m.new <- m.old parm.len <- length(parm) tol <- Stop.Tolerance tol.new <- 1 Dev <- matrix(m.old[["Dev"]],1,1) post <- matrix(parm, 1, parm.len) eps <- 1e-7 bvec <- parm.old <- parm n <- length(bvec) ig <- 0 # count gradient evaluations stepredn <- 0.15 # Step reduction in line search acctol <- 1e-04 # acceptable point tolerance reltest <- 100 # relative equality test accpoint <- as.logical(FALSE) # so far do not have an acceptable point cyclimit <- min(2.5 * n, 10 + sqrt(n)) fmin <- f <- m.old[["LP"]] * -1 bvec <- m.old[["parm"]] keepgoing <- TRUE oldstep <- steplength <- 0.8 fdiff <- NA # initially no decrease cycle <- 0 # !! cycle loop counter options(warn=-1) while (keepgoing == TRUE) { t <- as.vector(rep(0, n)) # zero step vector c <- t # zero 'last' gradient while ({keepgoing == TRUE} && {cycle < cyclimit}) { cycle <- cycle + 1 parm <- bvec ig <- ig + 1 post <- rbind(post, m.best[["parm"]]) Dev <- rbind(Dev, m.best[["Dev"]]) ### Print Status if(ig %% round(Iterations / 10) == 0) cat("Iteration: ", ig, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") if(ig > Iterations) { ig <- Iterations LA <- list(Dev=Dev, iter=ig, parm.len=parm.len, parm.new=parm, parm.old=parm.old, post=post, Step.Size=steplength, tol.new=tol.new) return(LA)} g <- partial(Model, bvec, Data) * -1 g1 <- sum(g * (g - c)) g2 <- sum(t * (g - c)) gradsqr <- sum(g * g) c <- g g3 <- 1 if(gradsqr > tol * (abs(fmin) + reltest)) { if(g2 > 0) { betaDY <- gradsqr / g2 betaHS <- g1 / g2 g3 <- max(0, min(betaHS, betaDY))} } else { keepgoing <- FALSE tol.new <- gradsqr break} if(g3 == 0 || cycle >= cyclimit) { fdiff <- NA cycle <- 0 break } else { t <- t * g3 - g gradproj <- sum(t * g) ### Line search OKpoint <- FALSE steplength <- oldstep * 1.5 f <- fmin changed <- TRUE while ({f >= fmin} && {changed == TRUE}) { bvec <- parm + steplength * t changed <- !identical((bvec + reltest), (parm + reltest)) if(changed == TRUE) { m.old <- m.new m.new <- Model(bvec, Data) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) { f <- fmin + 1 m.new <- m.old } else { if(m.new[["LP"]] > m.best[["LP"]]) m.best <- m.new f <- m.new[["LP"]] * -1 tol.new <- max(sqrt(sum(g*g)), sqrt(sum({m.new[["parm"]] - m.old[["parm"]]}^2))) } bvec <- m.new[["parm"]] if(f < fmin) f1 <- f else { savestep <-steplength steplength <- steplength * stepredn if(steplength >= savestep) changed <-FALSE}}} changed1 <- changed if(changed1 == TRUE) { newstep <- 2 * (f - fmin - gradproj * steplength) if(newstep > 0) newstep <- -(gradproj * steplength * steplength / newstep) bvec <- parm + newstep * t changed <- !identical((bvec + reltest), (parm + reltest)) if(changed == TRUE) { m.old <- m.new m.new <- Model(bvec, Data) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) { f <- fmin + 1 m.new <- m.old } else { if(m.new[["LP"]] > m.best[["LP"]]) m.best <- m.new f <- m.new[["LP"]] * -1 tol.new <- max(sqrt(sum(g*g)), sqrt(sum({m.new[["parm"]] - m.old[["parm"]]}^2))) } bvec <- m.new[["parm"]]} if(f < min(fmin, f1)) { OKpoint <- TRUE accpoint <- (f <= fmin + gradproj * newstep * acctol) fdiff <- (fmin - f) fmin <- f oldstep <- newstep } else { if(f1 < fmin) { bvec <- parm + steplength * t accpoint <- (f1 <= fmin + gradproj * steplength * acctol) OKpoint <- TRUE fdiff <- (fmin - f1) fmin <- f1 oldstep <- steplength } else { fdiff <- NA accpoint <- FALSE} } if(accpoint == FALSE) { keepgoing <- FALSE break} } else { if(cycle == 1) { keekpgoing <- FALSE break}}} } if(oldstep < acctol) oldstep <- acctol if(oldstep > 1) oldstep <- 1 } options(warn=0) Dev <- Dev[-1,]; post <- post[-1,] if({ig < Iterations} & {tol.new > Stop.Tolerance}) tol.new <- Stop.Tolerance ### Output LA <- list(Dev=Dev, iter=ig, parm.len=parm.len, parm.new=m.best[["parm"]], parm.old=parm.old, post=post, Step.Size=steplength, tol.new=tol.new) return(LA) } .ladfp <- function(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) { m.new <- m.old Dev <- matrix(m.old[["Dev"]],1,1) parm.old <- parm parm.len <- length(as.vector(parm)) post <- matrix(m.old[["parm"]], 1, parm.len) tol.new <- 1 keepgoing <- TRUE g.old <- g.new <- -1*partial(Model, m.old[["parm"]], Data, Interval) B <- Iden <- diag(parm.len) #Approximate Hessian options(warn=-1) for (iter in 2:Iterations) { ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") ### Gradient and Direction p g.old <- g.new p <- as.vector(tcrossprod(g.old, -B)) p[which(!is.finite(p))] <- 0 ### Step-size Line Search Step.Size <- 0.8 changed <- TRUE while(m.new[["LP"]] <= m.old[["LP"]] & changed == TRUE) { Step.Size <- Step.Size * 0.2 s <- Step.Size*p prop <- m.old[["parm"]] + s changed <- !identical(m.old[["parm"]], prop) m.new <- Model(prop, Data) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) m.new <- m.old } g.new <- -1*partial(Model, m.new[["parm"]], Data, Interval) ### DFP Update to Approximate Hessian B if(m.new[["LP"]] > m.old[["LP"]]) { m.old <- m.new g <- g.new - g.old if(sum(s*g) > 0) { denom <- as.vector(t(g) %*% s) B <- (Iden - ((g %*% t(s)) / denom)) %*% B %*% (Iden - ((s %*% t(g)) / denom)) + ((g %*% t(g)) / denom) if(any(!is.finite(B))) B <- diag(parm.len)}} ### Storage post <- rbind(post, m.old[["parm"]]) Dev <- rbind(Dev, m.old[["Dev"]]) ### Tolerance tol.new <- sqrt(sum(g.new*g.new)) if(keepgoing == FALSE) tol.new <- 0 if(tol.new <= Stop.Tolerance) break } options(warn=0) ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=m.old[["parm"]], parm.old=parm.old, post=post, Step.Size=Step.Size, tol.new=tol.new) return(LA) } .lahar <- function(Model, parm, Data, Iterations, Stop.Tolerance, m.old) { alpha.star <- 0.234 tau <- 1 Dev <- matrix(m.old[["Dev"]],1,1) parm.len <- length(as.vector(parm)) parm.new <- parm.old <- parm names(parm.new) <- names(parm.old) <- Data[["parm.names"]] tol.new <- 1 post <- matrix(parm.new, 1, parm.len) for (iter in 1:Iterations) { parm.old <- parm.new ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") ### Propose new parameter values theta <- rnorm(parm.len) d <- theta / sqrt(sum(theta*theta)) Step.Size <- runif(1,0,tau) parm.new <- parm.old + Step.Size * d m.new <- Model(parm.new, Data) tol.new <- sqrt(sum({m.new[["parm"]] - parm.old}^2)) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) m.new <- m.old ### Accept/Reject and Adapt if(m.new[["LP"]] > m.old[["LP"]]) { m.old <- m.new parm.new <- m.new[["parm"]] tau <- tau + (tau / (alpha.star * (1 - alpha.star))) * (1 - alpha.star) / iter } else { m.new <- m.old parm.new <- parm.old tau <- abs(tau - (tau / (alpha.star * (1 - alpha.star))) * alpha.star / iter) } post <- rbind(post, parm.new) Dev <- rbind(Dev, m.new[["Dev"]]) if(tol.new <= Stop.Tolerance) break } Dev <- Dev[-1,]; post <- post[-1,] ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=parm.new, parm.old=parm.old, post=post, Step.Size=Step.Size, tol.new=tol.new) return(LA) } .lahj <- function(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) { Dev <- matrix(m.old[["Dev"]],1,1) n <- length(parm) post <- matrix(parm, 1, n) if(n == 1) stop("For univariate functions use some different method.") tol.new <- 1 f <- function(x, Data) { fun <- Model(x, Data) fun[["LP"]] <- fun[["LP"]] * -1 return(fun)} steps <- 2^c(-(0:(Iterations-1))) dir <- diag(1, n, n) x <- parm.old <- parm fx <- f(x, Data) fcount <- 1 ### Search with a single scale .lahjsearch <- function(xb, f, h, dir, fcount, Data) { x <- xb xc <- x sf <- 0 finc <- 0 hje <- .lahjexplore(xb, xc, f, h, dir, Data=Data) x <- hje$x fx <- hje$fx sf <- hje$sf finc <- finc + hje$numf ### Pattern move while (sf == 1) { d <- x - xb xb <- x xc <- x + d fb <- fx hje <- .lahjexplore(xb, xc, f, h, dir, fb, Data) x <- hje$x fx <- hje$fx sf <- hje$sf finc <- finc + hje$numf if(sf == 0) { # pattern move failed hje <- .lahjexplore(xb, xb, f, h, dir, fb, Data) x <- hje$x fx <- hje$fx sf <- hje$sf finc <- finc + hje$numf} } return(list(x=x, fx=fx, sf=sf, finc=finc)) } ### Exploratory move .lahjexplore <- function(xb, xc, f, h, dir, fbold, Data) { n <- length(xb) x <- xb if(missing(fbold)) { fb <- f(x, Data) x <- fb[["parm"]] numf <- 1 } else { fb <- fbold numf <- 0} fx <- fb xt <- xc sf <- 0 # do we find a better point ? dirh <- h * dir fbold <- fx for (k in sample.int(n, n)) { # resample orthogonal directions p <- xt + dirh[, k] ft <- f(p, Data) p <- ft[["parm"]] numf <- numf + 1 if(ft[["LP"]] >= fb[["LP"]]) { p <- xt - dirh[, k] ft <- f(p, Data) p <- ft[["parm"]] numf <- numf + 1 } else { sf <- 1 xt <- p fb <- ft} } if(sf == 1) { x <- xt fx <- fb} return(list(x=x, fx=fx, sf=sf, numf=numf)) } ### Start the main loop for (iter in 1:Iterations) { ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(fx[["LP"]],1), "\n") hjs <- .lahjsearch(x, f, steps[iter], dir, fcount, Data) x <- hjs$x fx <- hjs$fx sf <- hjs$sf fcount <- fcount + hjs$finc post <- rbind(post, x) Dev <- rbind(Dev, fx[["Dev"]]) tol.new <- sqrt(sum({fx[["parm"]] - parm.old}^2)) if(tol.new <= Stop.Tolerance) break parm.old <- x } Dev <- Dev[-1,]; post <- post[-1,] LA <- list(Dev=Dev, iter=iter, parm.len=n, parm.new=x, parm.old=parm, post=post, Step.Size=steps[iter], tol.new=tol.new) return(LA) } .lalbfgs <- function(Model, parm, Data, Iterations, Stop.Tolerance, m.old) { Dev <- matrix(m.old[["Dev"]],1,1) parm.len <- length(as.vector(parm)) parm.new <- parm.old <- m.old[["parm"]] names(parm.new) <- names(parm.old) <- Data[["parm.names"]] tol.new <- 1 post <- matrix(parm.new, 1, parm.len) ModelWrapper <- function(parm.new) { out <- Model(parm.new, Data)[["LP"]] return(out) } for (iter in 1:Iterations) { parm.old <- parm.new ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") ### LBFGS Fit <- optim(par=parm.new, fn=ModelWrapper, method="L-BFGS-B", control=list(fnscale=-1, maxit=1)) m.new <- Model(Fit$par, Data) tol.new <- sqrt(sum({m.new[["parm"]] - parm.old}^2)) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]]))) | {m.new[["LP"]] < m.old[["LP"]]}) m.new <- m.old m.old <- m.new parm.new <- m.new[["parm"]] post <- rbind(post, parm.new) Dev <- rbind(Dev, m.new[["Dev"]]) if(tol.new <= Stop.Tolerance) break } Dev <- Dev[-1,]; post <- post[-1,] ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=parm.new, parm.old=parm.old, post=post, Step.Size=0, tol.new=tol.new) return(LA) } .lalm <- function(Model, parm, Data, Iterations, Stop.Tolerance, m.old) { Norm <- function(x, p=2) { stopifnot(is.numeric(x) || is.complex(x), is.numeric(p), length(p) == 1) if(p > -Inf && p < Inf) return(sum(abs(x)^p)^(1/p)) else if(p == Inf) return(max(abs(x))) else if(p == -Inf) return(min(abs(x))) else return(NULL) } Dev <- matrix(m.old[["Dev"]],1,1) tau <- 1e-3 ### Damping constant tolg <- 1e-8 n <- length(parm) m <- 1 x <- xnew <- parm mod <- modbest <- m.old r <- r.adj <- mod[["LP"]] if(r.adj > 0) r.adj <- r.adj * -1 dold <- dnew <- mod[["Dev"]] x <- parm <- mod[["parm"]] post <- matrix(parm, 1, n) f <- 0.5 * r * r J <- rbind(partial(Model, x, Data)) g <- t(J) %*% r.adj ng <- max(abs(g)) A <- t(J) %*% J mu <- tau * max(diag(A)) ### Damping parameter nu <- 2 nh <- 0 iter <- 1 while (iter < Iterations) { ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(mod[["LP"]],1), "\n") iter <- iter + 1 R <- chol(A + mu*diag(n)) h <- c(-t(g) %*% chol2inv(R)) bad <- !is.finite(h) h[bad] <- 1e-10 * J[1,bad] #Small gradient if ill-conditioned nh <- Norm(h) xnew <- x + h h <- xnew - x dL <- sum(h*(mu*h - g)) / 2 mod <- Model(xnew, Data) if(all(is.finite(c(mod[["LP"]], mod[["Dev"]], mod[["Monitor"]])))) { if(mod[["LP"]] > modbest[["LP"]]) modbest <- mod rn <- mod[["LP"]] xnew <- mod[["parm"]] } else { rn <- r xnew <- x} fn <- 0.5 * rn * rn Jn <- rbind(partial(Model, xnew, Data)) df <- f - fn if(rn > 0) df <- fn - f if(dL > 0 && df > 0) { tol.new <- sqrt(sum({xnew - x}^2)) x <- xnew f <- fn J <- Jn r <- r.adj <- rn if(r.adj > 0) r.adj <- r.adj * -1 A <- t(J) %*% J g <- t(J) %*% r.adj ng <- Norm(g, Inf) mu <- mu * max(1/3, 1 - (2*df/dL - 1)^3) nu <- 2} else {mu <- mu*nu nu <- 2*nu} post <- rbind(post, modbest[["parm"]]) Dev <- rbind(Dev, modbest[["Dev"]]) if(ng <= Stop.Tolerance) { tol.new <- ng break } else if(nh <= Stop.Tolerance) { tol.new <- nh break} } ### Output LA <- list(Dev=Dev, iter=iter, parm.len=n, parm.new=modbest[["parm"]], parm.old=parm, post=post, Step.Size=nh, tol.new=tol.new) return(LA) } .lanm <- function(Model, parm, Data, Iterations, Stop.Tolerance, m.old) { Dev <- matrix(m.old[["Dev"]],1,1) n <- length(as.vector(parm)) parm.old <- m.old[["parm"]] Step.Size <- 1 if(!is.numeric(parm) || length(parm) < 2) stop("Parameters must be a numeric vector of length > 1.") # simplex vertices around parm V <- t(1/(2*n) * cbind(diag(n), rep(-1, n)) + parm) P <- Q <- c() # Function values at vertices Y <- numeric(n+1) for (j in 1:(n+1)) { Mo <- Model(V[j, ], Data) Y[j] <- Mo[["LP"]] * -1 V[j,] <- Mo[["parm"]]} ho <- lo <- which.min(Y) li <- hi <- which.max(Y) for (j in 1:(n+1)) { if(j != lo && j != hi && Y[j] <= Y[li]) li <- j if(j != hi && j != lo && Y[j] >= Y[ho]) ho <- j} iter <- 0 while(Y[hi] > Y[lo] + Stop.Tolerance && iter < Iterations) { S <- numeric(n) for (j in 1:(n+1)) S <- S + V[j,1:n] M <- (S - V[hi,1:n])/n R <- 2*M - V[hi,1:n] Mo <- Model(R, Data) yR <- Mo[["LP"]] * -1 R <- Mo[["parm"]] if(yR < Y[ho]) { if(Y[li] < yR) { V[hi,1:n] <- R Y[hi] <- yR } else { E <- 2*R - M Mo <- Model(E, Data) yE <- Mo[["LP"]] * -1 E <- Mo[["parm"]] if(yE < Y[li]) { V[hi,1:n] <- E Y[hi] <- yE } else { V[hi,1:n] <- R Y[hi] <- yR } } } else { if(yR < Y[hi]) { V[hi,1:n] <- R Y[hi] <- yR} C <- (V[hi,1:n] + M) / 2 Mo <- Model(C, Data) yC <- Mo[["LP"]] * -1 C <- Mo[["parm"]] C2 <- (M + R) / 2 Mo <- Model(C2, Data) yC2 <- Mo[["LP"]] * -1 C2 <- Mo[["parm"]] if(yC2 < yC) { C <- C2 yC <- yC2} if(yC < Y[hi]) { V[hi,1:n] <- C Y[hi] <- yC } else { for (j in 1:(n+1)) { if(j != lo) { V[j,1:n] <- (V[j,1:n] + V[lo,1:n]) / 2 Z <- V[j,1:n] Mo <- Model(Z, Data) Y[j] <- Mo[["LP"]] * -1 Z <- Mo[["parm"]] V[j,1:n] <- Z}}}} ho <- lo <- which.min(Y) li <- hi <- which.max(Y) for (j in 1:(n+1)) { if(j != lo && j != hi && Y[j] <= Y[li]) li <- j if(j != hi && j != lo && Y[j] >= Y[ho]) ho <- j} iter <- iter + 1 if(iter %% round(Iterations / 10) == 0) { cat("Iteration: ", iter, " of ", Iterations, "\n")} P <- rbind(P, V[lo, ]) Q <- c(Q, Y[lo]) Dev <- rbind(Dev, Model(V[lo,], Data)[["Dev"]]) } snorm <- 0 for (j in 1:(n+1)) { s <- abs(V[j] - V[lo]) if(s >= snorm) snorm <- s} V0 <- V[lo, 1:n] y0 <- Y[lo] dV <- snorm dy <- abs(Y[hi] - Y[lo]) Dev <- Dev[-1,] ### Output LA <- list(Dev=Dev, iter=iter, parm.len=n, parm.new=V0, parm.old=parm.old, post=P, Step.Size=Step.Size, tol.new=Y[hi] - Y[lo]) return(LA) } .lanr <- function(Model, parm, Data, Interval, Iterations=100, Stop.Tolerance, m.old) { m.new <- m.old Dev <- matrix(m.old[["Dev"]],1,1) Step.Size <- 1 / length(parm) parm.old <- parm parm.len <- length(parm) converged <- FALSE post <- matrix(parm, 1, parm.len) for (iter in 1:Iterations) { ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") check1 <- TRUE; check2 <- FALSE m.old <- Model(parm, Data) p <- partial(Model, m.old[["parm"]], Data, Interval) H <- Hessian(Model, m.old[["parm"]], Data) if(all(is.finite(H))) { Sigma <- -as.inverse(H) delta <- as.vector(tcrossprod(p, Sigma)) } else check1 <- FALSE if(check1 == TRUE) { if(any(!is.finite(delta))) check1 <- FALSE if(check1 == TRUE) { temp1 <- temp2 <- temp3 <- parm Step.Size1 <- Step.Size / 2 Step.Size3 <- Step.Size * 2 temp1 <- temp1 + Step.Size1 * delta temp2 <- temp2 + Step.Size * delta temp3 <- temp3 + Step.Size3 * delta Mo1 <- Model(temp1, Data) Mo2 <- Model(temp2, Data) Mo3 <- Model(temp3, Data) check2 <- FALSE if({Mo1[["LP"]] == max(Mo1[["LP"]], Mo2[["LP"]], Mo3[["LP"]])} & Mo1[["LP"]] > m.old[["LP"]]) { Step.Size <- Step.Size1 parm <- parm + Step.Size * delta m.old <- m.new <- Mo1 } else if({Mo2[["LP"]] == max(Mo1[["LP"]], Mo2[["LP"]], Mo3[["LP"]])} & Mo2[["LP"]] > m.old[["LP"]]) { parm <- parm + Step.Size * delta m.old <- m.new <- Mo2 } else if({Mo3[["LP"]] == max(Mo1[["LP"]], Mo2[["LP"]], Mo3[["LP"]])} & Mo3[["LP"]] > m.old[["LP"]]) { Step.Size <- Step.Size3 parm <- parm + Step.Size * delta m.old <- m.new <- Mo3 } else check2 <- TRUE}} if({check1 == FALSE} | {check2 == TRUE}) { delta <- p temp1 <- temp2 <- temp3 <- parm Step.Size1 <- Step.Size / 2 Step.Size3 <- Step.Size * 2 temp1 <- temp1 + Step.Size1 * delta temp2 <- temp2 + Step.Size * delta temp3 <- temp3 + Step.Size3 * delta Mo1 <- Model(temp1, Data) Mo2 <- Model(temp2, Data) Mo3 <- Model(temp3, Data) if({Mo1[["LP"]] == max(Mo1[["LP"]], Mo2[["LP"]], Mo3[["LP"]])} & Mo1[["LP"]] > m.old[["LP"]]) { Step.Size <- Step.Size1 parm <- parm + Step.Size * delta m.old <- m.new <- Mo1 } else if({Mo2[["LP"]] == max(Mo1[["LP"]], Mo2[["LP"]], Mo3[["LP"]])} & Mo2[["LP"]] > m.old[["LP"]]) { parm <- parm + Step.Size * delta f <- Mo2 } else if({Mo3[["LP"]] == max(Mo1[["LP"]], Mo2[["LP"]], Mo3[["LP"]])} & Mo3[["LP"]] > m.old[["LP"]]) { Step.Size <- Step.Size3 parm <- parm + Step.Size * delta m.old <- m.new <- Mo3 } else { #Jitter in case of failure Step.Size <- Step.Size / 2 parm <- parm + Step.Size * rnorm(length(parm))}} post <- rbind(post, parm) Dev <- rbind(Dev, m.new[["Dev"]]) Step.Size <- max(Step.Size, .Machine$double.eps) tol.new <- sqrt(sum(delta^2)) if(tol.new < Stop.Tolerance) {converged <- TRUE; break} } Dev <- Dev[-1,]; post <- post[-1,] LA <- list(Dev=Dev, H=H, iter=iter, parm.len=parm.len, parm.new=parm, parm.old=parm.old, post=post, Step.Size=Step.Size, tol.new=tol.new) return(LA) } .lapso <- function(Model, parm, Data, Iterations, Stop.Tolerance, m.old) { Dev <- matrix(m.old[["Dev"]],1,1) LP <- NA parm.len <- length(parm) parm.new <- parm.old <- parm tol.new <- 1 post <- matrix(parm.new, 1, parm.len) p.s <- floor(10 + 2*sqrt(parm.len)) ## Swarm size k <- 3 ### Exponent for calculating number of informants p.p <- 1-(1-1/p.s)^k ### Average % of informants p.w0 <- p.w1 <- 1 / (2*log(2)) ### Exploitation constants p.c.p <- 0.5 + log(2) ### Local exploration constant p.c.g <- 0.5 + log(2) ### Global exploration constant p.randorder <- TRUE ### Randomize Particle Order X <- V <- matrix(parm, parm.len, p.s) if(!is.null(Data[["PGF"]])) { for (i in 2:ncol(X)) X[,i] <- GIV(Model, Data, PGF=TRUE) for (i in 1:ncol(V)) V[,i] <- GIV(Model, Data, PGF=TRUE) } else { for (i in 2:ncol(X)) X[,i] <- GIV(Model, Data, PGF=FALSE) for (i in 1:ncol(V)) V[,i] <- GIV(Model, Data, PGF=FALSE)} V <- (V - X) / 2 ### Velocity mods <- apply(X, 2, function(x) Model(x, Data)) f.x <- sapply(mods, with, LP) * -1 f.d <- sapply(mods, with, Dev) X <- matrix(sapply(mods, with, parm), nrow(X), ncol(X)) P <- X f.p <- f.x P.improved <- rep(FALSE, p.s) i.best <- which.min(f.p) error <- f.p[i.best] init.links <- TRUE iter <- 1 while (iter < Iterations && tol.new > Stop.Tolerance) { iter <- iter + 1 ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(mod[["LP"]],1), "\n") if(p.p != 1 && init.links == TRUE) { links <- matrix(runif(p.s*p.s, 0, 1) <= p.p, p.s, p.s) diag(links) <- TRUE} if(p.randorder == TRUE) index <- sample(p.s) else index <- 1:p.s for (i in index) { if(p.p == 1) j <- i.best else j <- which(links[,i])[which.min(f.p[links[,i]])] temp <- p.w0 + (p.w1 - p.w0)*(iter / Iterations) V[,i] <- temp*V[,i] V[,i] <- V[,i] + runif(parm.len, 0, p.c.p)*(P[,i] - X[,i]) if(i != j) V[,i] <- V[,i] + runif(parm.len, 0, p.c.g)*(P[,j] - X[,i]) X[,i] <- X[,i] + V[,i] mod <- Model(X[,i], Data) f.x[i] <- mod[["LP"]] * -1 f.d[i] <- mod[["Dev"]] X[,i] <- mod[["parm"]] if(f.x[i] < f.p[i]) { ### Improvement P[,i] <- X[,i] f.p[i] <- f.x[i] if(f.p[i] < f.p[i.best]) i.best <- i} } post <- rbind(post, P[,i.best]) Dev <- rbind(Dev, f.d[i.best]) tol.new <- mean(abs(V[,i.best])) init.links <- f.p[i.best] == error error <- f.p[i.best] } ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=P[,i.best], parm.old=parm.old, post=post, Step.Size=mean(abs(V[,i.best])), tol.new=tol.new) return(LA) } .larprop <- function(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) { Dev <- matrix(m.old[["Dev"]],1,1) parm.len <- length(as.vector(parm)) approx.grad.old <- approx.grad.new <- rep(0, parm.len) parm.old <- m.old[["parm"]] parm.new <- parm.old - 0.1 #First step names(parm.new) <- names(parm.old) <- Data[["parm.names"]] tol.new <- 1 post <- matrix(parm.new, 1, parm.len) Step.Size <- rep(0.0125, parm.len) for (iter in 1:Iterations) { approx.grad.old <- approx.grad.new parm.old <- parm.new ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") ### Approximate Truncated Gradient approx.grad.new <- partial(Model, parm.old, Data, Interval) approx.grad.new <- interval(approx.grad.new, -1000, 1000, reflect=FALSE) ### Determine if Gradients Changed Sign change <- (approx.grad.old >= 0) == (approx.grad.new >= 0) ### Adjust weight (step size) based on sign change Step.Size[change == TRUE] <- Step.Size[change == TRUE] * 0.5 Step.Size[change == FALSE] <- Step.Size[change == FALSE] * 1.2 Step.Size <- interval(Step.Size, 0.0001, 50, reflect=FALSE) ### Propose new state based on weighted approximate gradient parm.new <- parm.old + Step.Size * approx.grad.new m.new <- Model(parm.new, Data) tol.new <- max(sqrt(sum(approx.grad.new^2)), sqrt(sum({m.new[["parm"]] - parm.old}^2))) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]]))) | {m.new[["LP"]] < m.old[["LP"]]}) { p.order <- sample(1:length(parm.new)) parm.temp <- parm.old for (i in 1:length(p.order)) { parm.temp[p.order[i]] <- parm.new[p.order[i]] m.new <- Model(parm.temp, Data) if(m.new[["LP"]] < m.old[["LP"]]) parm.temp[p.order[i]] <- parm.old[p.order[i]]} m.new <- Model(parm.temp, Data)} parm.new <- m.new[["parm"]] post <- rbind(post, parm.new) Dev <- rbind(Dev, m.new[["Dev"]]) if(tol.new <= Stop.Tolerance) break } Dev <- Dev[-1,]; post <- post[-1,] ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=parm.new, parm.old=parm.old, post=post, Step.Size=Step.Size, tol.new=tol.new) return(LA) } .lasgd <- function(Model, parm, Data, Iterations, Stop.Tolerance, m.old) { Dev <- matrix(m.old[["Dev"]],1,1) m.new <- m.old parm.len <- length(as.vector(parm)) parm.new <- parm.old <- parm names(parm.new) <- names(parm.old) <- Data[["parm.names"]] tol.new <- 1 post <- matrix(parm.new, 1, parm.len) #Read SGD specifications if(is.null(Data[["file"]])) stop("SGD requires Data$file, which is missing.") if(is.null(Data[["Nr"]])) stop("SGD requires Data$Nr, which is missing.") if(is.null(Data[["Nc"]])) stop("SGD requires Data$Nc, which is missing.") if(is.null(Data[["size"]])) stop("SGD requires Data$size, which is missing.") if(is.null(Data[["epsilon"]])) stop("SGD requires Data$epsilon, which is missing.") con <- file(Data[["file"]], open="r") on.exit(close(con)) for (iter in 1:Iterations) { parm.old <- parm.new ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") ### Sample Data seek(con, 0) skip.rows <- sample.int(Data[["Nr"]] - Data[["size"]], size=1) Data[["X"]] <- matrix(scan(file=con, sep=",", skip=skip.rows, nlines=Data[["size"]], quiet=TRUE), Data[["size"]], Data[["Nc"]], byrow=TRUE) ### Propose new parameter values g <- partial(Model, m.old[["parm"]], Data) parm.new <- m.new[["parm"]] + {Data[["epsilon"]] / 2} * g m.new <- Model(parm.new, Data) tol.new <- max(sqrt(sum(g^2)), sqrt(sum({m.new[["parm"]] - parm.old}^2))) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) m.new <- m.old post <- rbind(post, parm.new) Dev <- rbind(Dev, m.new[["Dev"]]) if(tol.new <= Stop.Tolerance) break } Dev <- Dev[-1,]; post <- post[-1,] ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=parm.new, parm.old=parm.old, post=post, Step.Size=Data[["epsilon"]], tol.new=tol.new) return(LA) } .lasoma <- function(Model, parm, Data, bounds, options=list()) { ### Initial Checks if(missing(bounds)) { bounds <- list(min=rep(-.Machine$double.xmax, length(parm)), max=rep(.Machine$double.xmax, length(parm))) } if(!(all(c("min","max") %in% names(bounds)))) stop("Bounds list must contain \"min\" and \"max\" vector elements") if(length(bounds$min) != length(bounds$max)) stop("Bounds are not of equal length.") ### Option Defaults defaultOptions <- list(pathLength=3, stepLength=0.11, perturbationChance=0.1, tol=1e-3, maxiter=1000, populationSize=10) defaultsNeeded <- setdiff(names(defaultOptions), names(options)) spuriousOptions <- setdiff(names(options), names(defaultOptions)) options[defaultsNeeded] <- defaultOptions[defaultsNeeded] if(length(spuriousOptions) > 0) warning("The following specified options are unused: ", paste(spuriousOptions,collapse=", ")) ### Setup nParams <- length(bounds$min) nParamsTotal <- nParams * options$populationSize steps <- seq(0, options$pathLength, options$stepLength) nSteps <- length(steps) steps <- rep(steps, each=nParamsTotal) post <- matrix(parm, 1, nParams) ### Create Population population <- matrix(parm, nrow=nParams, ncol=options$populationSize) for (i in 2:ncol(population)) { if(!is.null(Data[["PGF"]])) population[,i] <- GIV(Model, Data, PGF=TRUE) else population[,i] <- GIV(Model, Data)} ### Calculate initial LP and Dev per individual in population temp <- apply(population, 2, function(x) Model(x, Data)) population <- sapply(temp, function(l) l$parm) LP <- sapply(temp, function(l) l$LP) Dev <- sapply(temp, function(l) l$Dev) iteration <- 0 DevHistory <- LPHistory <- numeric(0) if((max(LP) - min(LP)) < options$tol) { population <- matrix(runif(nParamsTotal,-10,10), nrow=nParams, ncol=options$populationSize)} if(all(!is.finite(LP))) stop("All individuals have non-finite LPs.") ### Evolution Begins repeat { ### Find the current leader leaderIndex <- which.max(LP) leaderDev <- Dev[leaderIndex] leaderLP <- LP[leaderIndex] ### Check termination criteria if(iteration == options$maxiter) break LPdiff <- max(LP) - min(LP) if(!is.finite(LPdiff)) LPdiff <- 1 if(LPdiff < options$tol) break DevHistory <- c(DevHistory, leaderDev) LPHistory <- c(LPHistory, leaderLP) ### Find the migration direction for each individual directionsFromLeader <- apply(population, 2, "-", population[,leaderIndex]) ### Establish which parameters will be changed toPerturb <- runif(nParamsTotal) < options$perturbationChance # Second line here has a minus, so directions are away from leader populationSteps <- array(rep(population, nSteps), dim=c(nParams, options$populationSize, nSteps)) populationSteps <- populationSteps - steps * rep(directionsFromLeader * toPerturb, nSteps) ### Replace out-of-bounds parameters with random valid values outOfBounds <- which(populationSteps < bounds$min | populationSteps > bounds$max) randomSteps <- array(runif(nParamsTotal*nSteps), dim=c(nParams, options$populationSize, nSteps)) randomSteps <- randomSteps * (bounds$max-bounds$min) + bounds$min populationSteps[outOfBounds] <- randomSteps[outOfBounds] ### Values over potential locations temp <- apply(populationSteps, 2:3, function(x) Model(x, Data)) population <- sapply(temp, function(l) l$parm) LP <- sapply(temp, function(l) l$LP) LP <- matrix(LP, length(LP) / nSteps, nSteps) Dev <- sapply(temp, function(l) l$Dev) Dev <- matrix(Dev, length(Dev) / nSteps, nSteps) individualBestLocs <- apply(LP, 1, which.max) ### Migrate each individual to its best new location, and update LP indexingMatrix <- cbind(seq_len(options$populationSize), individualBestLocs) population <- t(apply(populationSteps, 1, "[", indexingMatrix)) LP <- LP[indexingMatrix] Dev <- Dev[indexingMatrix] post <- rbind(post, population[,leaderIndex]) iteration <- iteration + 1 if(iteration %% round(options$maxiter / 10) == 0) cat("Iteration: ", iteration, " of ", options$maxiter, "\n") } ### Output LA <- list(Dev=DevHistory, iter=iteration, parm.len=nParams, parm.new=population[,leaderIndex], parm.old=parm, post=post[-1,], Step.Size=options$stepLength, tol.new=signif(LPdiff,3)) return(LA) } .laspg <- function(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) { parm.old <- parm parm.len <- length(parm) Dev <- matrix(m.old[["Dev"]],1,1) post <- matrix(parm, 1, parm.len) M <- 10 ftol <- 1e-10 maxfeval <- 10000 quiet <- FALSE feval <- 1 f0 <- fbest <- f <- m.old[["LP"]] * -1 nmls <- function(p, f, d, gtd, lastfv, feval, Model, maxfeval, Data) { # Non-monotone line search of Grippo with safe-guarded quadratic # interpolation gamma <- 1.e-04 fmax <- max(lastfv) alpha <- 1 pnew <- p + alpha*d m.new <- try(Model(pnew, Data), silent=TRUE) feval <- feval + 1 if(inherits(m.new, "try-error") | !is.finite(m.new[["LP"]])) return(list(p=NA, f=NA, feval=NA, lsflag=1)) fnew <- m.new[["LP"]] * -1 pnew <- m.new[["parm"]] while(fnew > fmax + gamma*alpha*gtd) { if(alpha <= 0.1) alpha <- alpha/2 else { atemp <- -(gtd*alpha^2) / (2*(fnew - f - alpha*gtd)) if(atemp < 0.1 | atemp > 0.9*alpha) atemp <- alpha/2 alpha <- atemp } pnew <- p + alpha*d m.new <- try(Model(pnew, Data), silent=TRUE) feval <- feval + 1 if(inherits(m.new, "try-error") | !is.finite(m.new[["LP"]])) return(list(p=NA, f=NA, feval=NA, lsflag=1)) fnew <- m.new[["LP"]] * -1 pnew <- m.new[["parm"]] if(feval > maxfeval) return(list(p=NA, f=NA, feval=NA, lsflag=2)) } return(list(p=pnew, f=fnew, feval=feval, m.new=m.new, lsflag=0)) } ### Initialization lmin <- 1e-30 lmax <- 1e30 iter <- geval <- 0 lastfv <- rep(-1e99, M) fbest <- NA fchg <- Inf if(any(!is.finite(parm))) stop("Failure in initial guess!") pbest <- parm g <- partial(Model, parm, Data, Interval) * -1 geval <- geval + 1 lastfv[1] <- fbest <- f pg <- parm - g if(any(is.nan(pg))) stop("Failure in initial projection!") pg <- pg - parm pg2n <- sqrt(sum(pg*pg)) pginfn <- max(abs(pg)) gbest <- pg2n if(pginfn != 0) lambda <- min(lmax, max(lmin, 1/pginfn)) ### Main iterative loop lsflag <- NULL while ({iter <= Iterations} & ({pginfn > Stop.Tolerance} | {fchg > ftol})) { iter <- iter + 1 d <- parm - lambda * g d <- d - parm gtd <- sum(g * d) if(is.infinite(gtd)) { lsflag <- 4 break} nmls.ans <- nmls(parm, f, d, gtd, lastfv, feval , Model, maxfeval, Data) lsflag <- nmls.ans$lsflag if(lsflag != 0) break fchg <- abs(f - nmls.ans$f) f <- nmls.ans$f pnew <- nmls.ans$p feval <- nmls.ans$feval m.new <- nmls.ans$m.new lastfv[(iter %% M) + 1] <- f gnew <- try(partial(Model, pnew, Data, Interval) * -1, silent=TRUE) geval <- geval + 1 if(inherits(gnew, "try-error") | any(is.nan(gnew))) { lsflag <- 3 break} s <- pnew - parm y <- gnew - g sts <- sum(s*s) yty <- sum(y*y) sty <- sum(s*y) if(sts == 0 | yty == 0) lambda <- lmax else lambda <- min(lmax, max(lmin, sqrt(sts/yty))) if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.new[["LP"]],1), "\n") post <- rbind(post, pnew) Dev <- rbind(Dev, m.new[["Dev"]]) parm <- pnew g <- gnew pg <- parm - g - parm pg2n <- sqrt(sum(pg*pg)) pginfn <- max(abs(pg)) f.rep <- f * -1 if(f < fbest) { fbest <- f pbest <- pnew gbest <- pginfn} } ### Output if(iter < Iterations) pginfn <- max(fchg, pginfn) if(is.null(lsflag)) lsflag <- 0 if(lsflag == 0) parm <- pbest else { parm <- pbest pginfn <- gbest } m.new <- Model(parm, Data) Dev[nrow(Dev),] <- m.new[["Dev"]] post[nrow(post),] <- m.new[["parm"]] Dev <- Dev[-c(1:2),]; post <- post[-c(1:2),] LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=parm, parm.old=parm.old, post=post, Step.Size=1, tol.new=pginfn) return(LA) } .lasr1 <- function(Model, parm, Data, Interval, Iterations, Stop.Tolerance, m.old) { m.new <- m.old Dev <- matrix(m.old[["Dev"]],1,1) parm.old <- parm parm.len <- length(as.vector(parm)) post <- matrix(m.old[["parm"]], 1, parm.len) tol.new <- 1 keepgoing <- TRUE g.old <- g.new <- -1*partial(Model, m.old[["parm"]], Data, Interval) B <- diag(parm.len) #Approximate Hessian options(warn=-1) for (iter in 2:Iterations) { ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(m.old[["LP"]],1), "\n") ### Gradient and Direction p g.old <- g.new p <- as.vector(tcrossprod(g.old, -as.inverse(B))) p[which(!is.finite(p))] <- 0 ### Step-size Line Search Step.Size <- 0.8 changed <- TRUE while(m.new[["LP"]] <= m.old[["LP"]] & changed == TRUE) { Step.Size <- Step.Size * 0.2 s <- Step.Size*p prop <- m.old[["parm"]] + s changed <- !identical(m.old[["parm"]], prop) m.new <- Model(prop, Data) if(any(!is.finite(c(m.new[["LP"]], m.new[["Dev"]], m.new[["Monitor"]])))) m.new <- m.old } g.new <- -1*partial(Model, m.old[["parm"]], Data, Interval) ### SR1 Update to B, the Secant Approximation of the Hessian if(m.new[["LP"]] > m.old[["LP"]]) { m.old <- m.new g <- g.new - g.old if(sum(s*g) > 0) { part1 <- g - B %*% s if(abs(t(s) %*% part1) >= 1e-8*sqrt(sum(s*s))*sqrt(sum(part1*part1))) B <- B + (part1 %*% t(part1)) / as.vector(t(part1) %*% s) if(any(!is.finite(B))) B <- diag(parm.len)} else B <- diag(parm.len)} ### Storage post <- rbind(post, m.old[["parm"]]) Dev <- rbind(Dev, m.old[["Dev"]]) ### Tolerance tol.new <- sqrt(sum(g.new*g.new)) if(keepgoing == FALSE) tol.new <- 0 if(tol.new <= Stop.Tolerance) break } options(warn=0) ### Output LA <- list(Dev=Dev, iter=iter, parm.len=parm.len, parm.new=m.old[["parm"]], parm.old=parm.old, post=post, Step.Size=Step.Size, tol.new=tol.new) return(LA) } .latr <- function(Model, parm, Data, Iterations, m.old) { fterm <- sqrt(.Machine$double.eps) mterm <- sqrt(.Machine$double.eps) Norm <- function(x) return(sqrt(sum(x^2))) parm.len <- length(parm) post <- matrix(parm, 1, parm.len) Dev <- matrix(m.old[["Dev"]],1,1) r <- rinit <- 1 rmax <- 1e10 theta <- parm.old <- parm Mo <- m.old LP <- Mo[["LP"]] theta <- Mo[["parm"]] grad <- partial(Model, theta, Data) H <- Hessian(Model, theta, Data) accept <- TRUE for (iter in 1:Iterations) { ### Print Status if(iter %% round(Iterations / 10) == 0) cat("Iteration: ", iter, " of ", Iterations, ", LP: ", round(Mo[["LP"]],1), "\n") if(accept == TRUE) { B <- H g <- grad f <- LP out.value.save <- f B <- - B g <- - g f <- - f eout <- eigen(B, symmetric=TRUE) gq <- as.numeric(t(eout$vectors) %*% g)} is.newton <- FALSE if(all(eout$values > 0)) { ptry <- as.numeric(- eout$vectors %*% (gq / eout$values)) if(Norm(ptry) <= r) is.newton <- TRUE} if(is.newton == FALSE) { lambda.min <- min(eout$values) beta <- eout$values - lambda.min imin <- beta == 0 C1 <- sum((gq / beta)[!imin]^2) C2 <- sum(gq[imin]^2) C3 <- sum(gq^2) if(C2 > 0 || C1 > r^2) { is.easy <- TRUE is.hard <- (C2 == 0) beta.dn <- sqrt(C2) / r beta.up <- sqrt(C3) / r beta.adj <- function(x) { if(x == 0) { if(C2 > 0) return(- 1 / r) else return(sqrt(1 / C1) - 1 / r)} return(sqrt(1 / sum((gq / {beta + x})^2)) - 1 / r)} if(beta.adj(beta.up) <= 0) uout <- list(root=beta.up) else if(beta.adj(beta.dn) >= 0) uout <- list(root=beta.dn) else uout <- uniroot(beta.adj, c(beta.dn, beta.up)) wtry <- gq / {beta + uout$root} ptry <- as.numeric(-eout$vectors %*% wtry) } else { is.hard <- TRUE is.easy <- FALSE wtry <- gq / beta wtry[imin] <- 0 ptry <- as.numeric(- eout$vectors %*% wtry) utry <- sqrt(r^2 - sum(ptry^2)) if(utry > 0) { vtry <- eout$vectors[ , imin, drop=FALSE] vtry <- vtry[ , 1] ptry <- ptry + utry * vtry} } } preddiff <- sum(ptry * {g + as.numeric(B %*% ptry) / 2}) theta.try <- theta + ptry Mo <- Model(theta.try, Data) LP <- Mo[["LP"]] theta.try <- Mo[["parm"]] grad <- partial(Model, theta.try, Data) H <- Hessian(Model, theta.try, Data) ftry <- LP ftry <- ftry * -1 rho <- {ftry - f} / preddiff if(ftry < Inf) { is.terminate <- {abs(ftry - f) < fterm} || { abs(preddiff) < mterm} } else { is.terminate <- FALSE rho <- -Inf} if(is.terminate == TRUE) { if(ftry < f) { accept <- TRUE theta <- theta.try post <- rbind(post, theta) Dev <- rbind(Dev, Mo[["Dev"]])} } else { if(rho < 1 / 4) { accept <- FALSE r <- r / 4 } else { accept <- TRUE theta <- theta.try post <- rbind(post, theta) Dev <- rbind(Dev, Mo[["Dev"]]) if({rho > 3 / 4} && {is.newton == FALSE}) r <- min(2 * r, rmax)}} if(is.terminate == TRUE) break } Mo <- Model(theta, Data) theta <- Mo[["parm"]] LA <- list(Dev=Dev, H=H, iter=iter, parm.len=parm.len, parm.new=theta, parm.old=parm.old, post=post, Step.Size=abs(ftry-f), tol.new=abs(preddiff)) return(LA) } #End LaplacesDemon/R/KS.Diagnostic.R0000755000176200001440000000132015144316355015713 0ustar liggesusers########################################################################### # KS.Diagnostic # # # # The purpose of the KS.Diagnostic is to assess the stationarity of a # # MCMC chain, given its posterior samples. # ########################################################################### KS.Diagnostic <- function(x) { if(missing(x)) stop("The x argument is required.") if(!is.vector(x)) x <- as.vector(x) n <- length(x) half <- round(n/2) out <- ks.test(x[1:half], x[-c(1:half)])$p.value return(out) } #End LaplacesDemon/R/print.iterquad.R0000755000176200001440000000366615144316355016303 0ustar liggesusers########################################################################### # print.iterquad # # # # The purpose of the print.iterquad function is to print the contents of # # an object of class iterquad to the screen. # ########################################################################### print.iterquad <- function(x, ...) { if(missing(x)) stop("The x argument is required.") cat("\nAlgorithm: ", x$Algorithm, sep="") cat("\nCall:\n") print(x$Call) cat("\nConverged: ", x$Converged, "\n", sep="") cat("Covariance Matrix: (NOT SHOWN HERE; diagonal shown instead)\n") print(diag(x$Covar)) cat("\nDeviance (Final): ", x$Deviance[length(x$Deviance)], "\n") cat("History: (NOT SHOWN HERE)\n") cat("Initial Values:\n") print(x$Initial.Values) cat("\nIterations: ", x$Iterations, "\n", sep="") cat("Log(Marginal Likelihood): ", x$LML, "\n", sep="") cat("Log-Posterior (Final): ", x$LP.Final, "\n", sep="") cat("Log-Posterior (Initial): ", x$LP.Initial, "\n", sep="") cat("Log-Posterior (Weights): (NOT SHOWN HERE)\n") cat("M: (NOT SHOWN HERE)\n") cat("Minutes of run-time: ", x$Minutes, "\n", sep="") cat("Monitor: (NOT SHOWN HERE)\n") cat("Nodes: ", x$N, "\n", sep="") cat("Posterior: (NOT SHOWN HERE)\n") cat("Summary1: (SHOWN BELOW)\n") cat("Summary2: (SHOWN BELOW)\n") cat("Tolerance (Final):\n") print(x$Tolerance.Final) cat("Tolerance (Stop):\n") print(x$Tolerance.Stop) cat("Z: (NOT SHOWN HERE)\n") cat("\nSummary1:\n") print(x$Summary1) if({x$Converged == TRUE} && !any(is.na(x$Posterior))) { cat("\nSummary2:\n") print(x$Summary2)} invisible(x) } #End LaplacesDemon/R/distributions.R0000755000176200001440000031066715144340046016230 0ustar liggesusers########################################################################### # Asymmetric Laplace Distribution # # # # These functions are similar to those in the VGAM package. # ########################################################################### dalaplace <- function(x, location=0, scale=1, kappa=1, log=FALSE) { x <- as.vector(x); location <- as.vector(location) scale <- as.vector(scale); kappa <- as.vector(kappa) if(any(scale <= 0)) stop("The scale parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") NN <- max(length(x), length(location), length(scale), length(kappa)) x <- rep(x, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN); kappa <- rep(kappa, len=NN) logconst <- 0.5 * log(2) - log(scale) + log(kappa) - log1p(kappa^2) temp <- which(x < location); kappa[temp] <- 1/kappa[temp] exponent <- -(sqrt(2) / scale) * abs(x - location) * kappa dens <- logconst + exponent if(log == FALSE) dens <- exp(logconst + exponent) return(dens) } palaplace <- function(q, location=0, scale=1, kappa=1) { q <- as.vector(q); location <- as.vector(location) scale <- as.vector(scale); kappa <- as.vector(kappa) if(any(scale <= 0)) stop("The scale parameter must be positive.") if((kappa <= 0)) stop("The kappa parameter must be positive.") NN <- max(length(q), length(location), length(scale), length(kappa)) q <- rep(q, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN); kappa <- k2 <- rep(kappa, len=NN) temp <- which(q < location); k2[temp] <- 1/kappa[temp] exponent <- -(sqrt(2) / scale) * abs(q - location) * k2 temp <- exp(exponent) / (1 + kappa^2) p <- 1 - temp index1 <- (q < location) p[index1] <- (kappa[index1])^2 * temp[index1] return(p) } qalaplace <- function(p, location=0, scale=1, kappa=1) { p <- as.vector(p); location <- as.vector(location) scale <- as.vector(scale); kappa <- as.vector(kappa) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(scale <= 0)) stop("The scale parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") NN <- max(length(p), length(location), length(scale), length(kappa)) p <- rep(p, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN); kappa <- rep(kappa, len=NN) q <- p temp <- kappa^2 / (1 + kappa^2) index1 <- (p <= temp) exponent <- p[index1] / temp[index1] q[index1] <- location[index1] + (scale[index1] * kappa[index1]) * log(exponent) / sqrt(2) q[!index1] <- location[!index1] - (scale[!index1] / kappa[!index1]) * (log1p((kappa[!index1])^2) + log1p(-p[!index1])) / sqrt(2) q[p == 0] = -Inf q[p == 1] = Inf return(q) } ralaplace <- function(n, location=0, scale=1, kappa=1) { location <- rep(location, len=n) scale <- rep(scale, len=n) kappa <- rep(kappa, len=n) if(any(scale <= 0)) stop("The scale parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") x <- location + scale * log(runif(n)^kappa / runif(n)^(1/kappa)) / sqrt(2) return(x) } ########################################################################### # Asymmetric Log-Laplace Distribution # # # # These functions are similar to those in the VGAM package. # ########################################################################### dallaplace <- function(x, location=0, scale=1, kappa=1, log=FALSE) { x <- as.vector(x); location <- as.vector(location) scale <- as.vector(scale); kappa <- as.vector(kappa) if(any(scale <= 0)) stop("The scale parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") NN <- max(length(x), length(location), length(scale), length(kappa)) x <- rep(x, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN); kappa <- rep(kappa, len=NN) Alpha <- sqrt(2) * kappa / scale Beta <- sqrt(2) / (scale * kappa) Delta <- exp(location) exponent <- -(Alpha + 1) temp <- which(x >= Delta); exponent[temp] <- Beta[temp] - 1 exponent <- exponent * (log(x) - location) dens <- -location + log(Alpha) + log(Beta) - log(Alpha + Beta) + exponent if(log == FALSE) dens <- exp(dens) return(dens) } pallaplace <- function(q, location=0, scale=1, kappa=1) { q <- as.vector(q); location <- as.vector(location) scale <- as.vector(scale); kappa <- as.vector(kappa) if(any(scale <= 0)) stop("The scale parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") NN <- max(length(q), length(location), length(scale), length(kappa)) q <- rep(q, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN); kappa <- rep(kappa, len=NN) Alpha <- sqrt(2) * kappa / scale Beta <- sqrt(2) / (scale * kappa) Delta <- exp(location) temp <- Alpha + Beta p <- (Alpha / temp) * (q / Delta)^(Beta) p[q <= 0] <- 0 index1 <- (q >= Delta) p[index1] <- (1 - (Beta/temp) * (Delta/q)^(Alpha))[index1] return(p) } qallaplace <- function(p, location=0, scale=1, kappa=1) { p <- as.vector(p); location <- as.vector(location) scale <- as.vector(scale); kappa <- as.vector(kappa) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(scale <= 0)) stop("The scale parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") NN <- max(length(p), length(location), length(scale), length(kappa)) p <- rep(p, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN); kappa <- rep(kappa, len=NN) Alpha <- sqrt(2) * kappa / scale Beta <- sqrt(2) / (scale * kappa) Delta <- exp(location) temp <- Alpha + Beta q <- Delta * (p * temp / Alpha)^(1/Beta) index1 <- (p > Alpha / temp) q[index1] <- (Delta * ((1-p) * temp / Beta)^(-1/Alpha))[index1] q[p == 0] <- 0 q[p == 1] <- Inf return(q) } rallaplace <- function(n, location=0, scale=1, kappa=1) { location <- rep(location, len=n); scale <- rep(scale, len=n) kappa <- rep(kappa, len=n) if(any(scale <= 0)) stop("The scale parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") x <- exp(location) * (runif(n)^kappa / runif(n)^(1/kappa))^(scale / sqrt(2)) return(x) } ########################################################################### # Asymmetric Multivariate Laplace Distribution # ########################################################################### daml <- function (x, mu, Sigma, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(Sigma)) Sigma <- diag(ncol(x)) if(!is.matrix(Sigma)) Sigma <- matrix(Sigma) Sigma <- as.symmetric.matrix(Sigma) if(!is.positive.definite(Sigma)) stop("Matrix Sigma is not positive-definite.") k <- nrow(Sigma) Omega <- as.inverse(Sigma) x.Omega.mu <- rowSums(x %*% Omega * mu) x.Omega.x <- rowSums(x %*% Omega * x) mu.Omega.mu <- rowSums(mu %*% Omega * mu) dens <- as.vector(log(2) + x.Omega.mu - (log(2*pi)*(k/2) + logdet(Sigma)*0.5) + (log(x.Omega.x) - (log(2 + mu.Omega.mu)))*((2-k)/4) + log(besselK(sqrt((2 + mu.Omega.mu) * x.Omega.x), (2-k)/2))) if(log == FALSE) dens <- exp(dens) return(dens) } raml <- function(n, mu, Sigma) { mu <- rbind(mu) if(missing(Sigma)) Sigma <- diag(ncol(mu)) if(!is.matrix(Sigma)) Sigma <- matrix(Sigma) if(!is.positive.definite(Sigma)) stop("Matrix Sigma is not positive-definite.") k <- ncol(Sigma) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) e <- matrix(rexp(n, 1), n, k) z <- rmvn(n, rep(0, k), Sigma) x <- mu*e + sqrt(e)*z return(x) } ########################################################################### # Bernoulli Distribution # # # # These functions are similar to those in the Rlab package. # ########################################################################### dbern <- function(x, prob, log=FALSE) {return(dbinom(x, 1, prob, log))} pbern <- function(q, prob, lower.tail=TRUE, log.p=FALSE) {return(pbinom(q, 1, prob, lower.tail, log.p))} qbern <- function(p, prob, lower.tail=TRUE, log.p=FALSE) {return(qbinom(p, 1, prob, lower.tail, log.p))} rbern <- function(n, prob) {return(rbinom(n, 1, prob))} ########################################################################### # Categorical Distribution # ########################################################################### dcat <- function (x, p, log=FALSE) { if(!is.matrix(p)) { if(is.vector(x)) p <- matrix(p, length(x), length(p), byrow=TRUE) else p <- matrix(p, nrow(x), length(p), byrow=TRUE)} if(is.vector(x)) { if(length(x) == 1) { temp <- rbind(rep(0, ncol(p))) temp[1,x] <- 1 x <- temp } else x <- as.indicator.matrix(x)} if(!identical(nrow(x), nrow(p))) stop("The number of rows of x and p differ.") if(!identical(ncol(x), ncol(p))) { x.temp <- matrix(0, nrow(p), ncol(p)) x.temp[, as.numeric(colnames(x))] <- x x <- x.temp} dens <- x * log(p) if(log == FALSE) dens <- x * p dens <- as.vector(rowSums(dens)) return(dens) } qcat <- function(pr, p, lower.tail=TRUE, log.pr=FALSE) { if(!is.vector(pr)) pr <- as.vector(pr) if(!is.vector(p)) p <- as.vector(p) if(log.pr == FALSE) { if(any(pr < 0) | any(pr > 1)) stop("pr must be in [0,1].")} else if(any(!is.finite(pr)) | any(pr > 0)) stop("pr, as a log, must be in (-Inf,0].") if(sum(p) != 1) stop("sum(p) must be 1.") if(lower.tail == FALSE) pr <- 1 - pr breaks <- c(0, cumsum(p)) if(log.pr == TRUE) breaks <- log(breaks) breaks <- matrix(breaks, length(pr), length(breaks), byrow=TRUE) x <- rowSums(pr > breaks) return(x) } rcat <- function(n, p) { if(is.vector(p)) { x <- as.vector(which(rmultinom(n, size=1, prob=p) == 1, arr.ind=TRUE)[, "row"]) } else { d <- dim(p) n <- d[1] k <- d[2] lev <- dimnames(p)[[2]] if(!length(lev)) lev <- 1:k z <- colSums(p) U <- apply(p, 1, cumsum) U[,k] <- 1 un <- rep(runif(n), rep(k,n)) x <- lev[1 + colSums(un > U)]} return(x) } ########################################################################### # Continuous Relaxation of a Markov Random Field Distribution # ########################################################################### dcrmrf <- function(x, alpha, Omega, log=FALSE) { alpha <- as.vector(alpha) if(missing(Omega)) Omega <- diag(length(alpha)) if(!is.matrix(Omega)) Omega <- matrix(Omega) Omega <- as.symmetric.matrix(Omega) if(!is.positive.definite(Omega)) stop("Matrix Omega is not positive-definite.") dens <- as.vector(-0.5*t(x) %*% as.inverse(Omega) %*% x) + log(prod(1 + exp(x + alpha))) if(log == FALSE) dens <- exp(dens) return(dens) } rcrmrf <- function(n=1, alpha, Omega) { alpha <- as.vector(alpha) J <- length(alpha) if(missing(Omega)) Omega <- diag(J) if(!is.matrix(Omega)) Omega <- matrix(Omega) if(!is.positive.definite(Omega)) stop("Matrix Omega is not positive-definite.") dens <- rep(0,J) x <- rep(0,n) for (i in 1:n) { for (j in 1:J) { z <- as.vector(rmvn(1, as.vector(Omega %*% diag(J)[j,]), Omega)) dens[j] <- dcrmrf(z, alpha, Omega, log=FALSE)} x[i] <- sample(1:J, size=1, replace=TRUE, prob=dens)} return(x) } ########################################################################### # Dirichlet Distribution # # # # These functions are similar to those in the MCMCpack package. # ########################################################################### ddirichlet <- function(x, alpha, log=FALSE) { if(missing(x)) stop("x is a required argument.") if(missing(alpha)) stop("alpha is a required argument.") if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(alpha)) alpha <- matrix(alpha, nrow(x), length(alpha), byrow=TRUE) if(any(rowSums(x) != 1)) x / rowSums(x) if(any(x < 0)) stop("x must be non-negative.") if(any(alpha <= 0)) stop("alpha must be positive.") dens <- as.vector(lgamma(rowSums(alpha)) - rowSums(lgamma(alpha)) + rowSums((alpha-1)*log(x))) if(log == FALSE) dens <- exp(dens) return(dens) } rdirichlet <- function (n, alpha) { alpha <- rbind(alpha) alpha.dim <- dim(alpha) if(n > alpha.dim[1]) alpha <- matrix(alpha, n, alpha.dim[2], byrow=TRUE) x <- matrix(rgamma(alpha.dim[2]*n, alpha), ncol=alpha.dim[2]) sm <- x %*% rep(1, alpha.dim[2]) return(x/as.vector(sm)) } ########################################################################### # Generalized Pareto Distribution # ########################################################################### dgpd <- function(x, mu, sigma, xi, log=FALSE) { x <- as.vector(x) mu <- as.vector(mu) sigma <- as.vector(sigma) xi <- as.vector(xi) if(any(sigma <= 0)) stop("The sigma parameter must be positive.") NN <- max(length(x), length(mu), length(sigma), length(xi)) x <- rep(x, len=NN); mu <- rep(mu, len=NN) sigma <- rep(sigma, len=NN); xi <- rep(xi, len=NN) xi.ge.0 <- which(xi >= 0) xi.lt.0 <- which(xi < 0) if(any(mu > x) | any(mu[xi.lt.0] < x[xi.lt.0] + sigma[xi.lt.0] / xi[xi.lt.0])) stop("x is outside of support.") z <- (x - mu) / sigma xi0 <- which(xi == 0) xi1 <- which(xi != 0) dens <- rep(NA, NN) dens[xi0] <- -z[xi0] - log(sigma[xi0]) dens[xi1] <- log(1/sigma[xi1]) + log(1 + xi[xi1] * z[xi1]) * (-1/xi[xi1] - 1) if(log == FALSE) dens <- exp(dens) return(dens) } rgpd <- function(n, mu, sigma, xi) { mu <- as.vector(mu) sigma <- as.vector(sigma) xi <- as.vector(xi) if(any(sigma <= 0)) stop("The sigma parameter must be non-negative.") mu <- rep(mu, len=n); sigma <- rep(sigma, len=n) xi <- rep(xi, len=n) x <- rep(NA,n) u <- runif(n, min=0.001) xi0 <- which(xi == 0) xi1 <- which(xi != 0) x[xi0] <- mu[xi0] - sigma[xi0] * log(u[xi0]) x[xi1] <- mu[xi1] + sigma[xi1] * (u[xi1]^(-xi[xi1]) - 1) / xi[xi1] return(x) } ########################################################################### # Generalized Poisson # ########################################################################### dgpois <- function(x, lambda=0, omega=0, log=FALSE) { x <- as.vector(x); lambda <- as.vector(lambda) omega <- as.vector(omega) lambda.star <- (1 - omega)*lambda + omega*x dens <- log(1 - omega) + log(lambda) + (x - 1)*log(lambda.star) - lgamma(x + 1) - lambda.star if(log == FALSE) dens <- exp(dens) return(dens) } ########################################################################### # Half-Cauchy Distribution # ########################################################################### dhalfcauchy <- function(x, scale=25, log=FALSE) { x <- as.vector(x); scale <- as.vector(scale) if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(x), length(scale)) x <- rep(x, len=NN); scale <- rep(scale, len=NN) dens <- log(2*scale) - log(pi*{x*x + scale*scale}) if(log == FALSE) dens <- exp(dens) return(dens) } phalfcauchy <- function(q, scale=25) { q <- as.vector(q); scale <- as.vector(scale) if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(q), length(scale)) q <- rep(q, len=NN); scale <- rep(scale, len=NN) z <- {2/pi}*atan(q/scale) return(z) } qhalfcauchy <- function(p, scale=25) { p <- as.vector(p); scale <- as.vector(scale) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(p), length(scale)) p <- rep(p, len=NN); scale <- rep(scale, len=NN) q <- scale*tan({pi*p}/2) return(q) } rhalfcauchy <- function(n, scale=25) { scale <- rep(scale, len=n) if(any(scale <= 0)) stop("The scale parameter must be positive.") p <- runif(n, 0, 1) x <- scale*tan({pi*p}/2) return(x) } ########################################################################### # Half-Normal Distribution # # # # This half-normal distribution has mean=0 and is similar to the halfnorm # # functions in package fdrtool. # ########################################################################### dhalfnorm <- function(x, scale=sqrt(pi/2), log=FALSE) { dens <- log(2) + dnorm(x, mean=0, sd=sqrt(pi/2) / scale, log=TRUE) if(log == FALSE) dens <- exp(dens) return(dens) } phalfnorm <- function(q, scale=sqrt(pi/2), lower.tail=TRUE, log.p=FALSE) { q <- as.vector(q); scale <- as.vector(scale) if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(q), length(scale)) q <- rep(q, len=NN); scale <- rep(scale, len=NN) p <- 2*pnorm(q, mean=0, sd=sqrt(pi/2) / scale) - 1 if(lower.tail == FALSE) p <- 1-p if(log.p == TRUE) p <- log.p(p) return(p) } qhalfnorm <- function(p, scale=sqrt(pi/2), lower.tail=TRUE, log.p=FALSE) { p <- as.vector(p); scale <- as.vector(scale) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(p), length(scale)) p <- rep(p, len=NN); scale <- rep(scale, len=NN) if(log.p == TRUE) p <- exp(p) if(lower.tail == FALSE) p <- 1-p q <- qnorm((p+1)/2, mean=0, sd=sqrt(pi/2) / scale) return(q) } rhalfnorm <- function(n, scale=sqrt(pi/2)) { scale <- rep(scale, len=n) if(any(scale <= 0)) stop("The scale parameter must be positive.") x <- abs(rnorm(n, mean=0, sd=sqrt(pi/2) / scale)) return(x) } ########################################################################### # Half-t Distribution # ########################################################################### dhalft <- function(x, scale=25, nu=1, log=FALSE) { x <- as.vector(x); scale <- as.vector(scale); nu <- as.vector(nu) if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(x), length(scale), length(nu)) x <- rep(x, len=NN); scale <- rep(scale, len=NN) nu <- rep(nu, len=NN) dens <- log(2) -log(scale) + lgamma((nu + 1)/2) - lgamma(nu/2) - .5*log(pi*nu) - (nu + 1)/2 * log(1 + (1/nu) * (x/scale) * (x/scale)) if(log == FALSE) dens <- exp(dens) return(dens) } phalft <- function(q, scale=25, nu=1) { q <- as.vector(q); scale <- as.vector(scale); nu <- as.vector(nu) if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(q), length(scale), length(nu)) q <- rep(q, len=NN); scale <- rep(scale, len=NN) p <- ptrunc(q, "st", a=0, b=Inf, mu=0, sigma=scale, nu=nu) return(p) } qhalft <- function(p, scale=25, nu=1) { p <- as.vector(p); scale <- as.vector(scale); nu <- as.vector(nu) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(p), length(scale), length(nu)) p <- rep(p, len=NN); scale <- rep(scale, len=NN) q <- qtrunc(p, "st", a=0, b=Inf, mu=0, sigma=scale, nu=nu) return(q) } rhalft <- function(n, scale=25, nu=1) { scale <- rep(scale, len=n); nu <- rep(nu, len=n) if(any(scale <= 0)) stop("The scale parameter must be positive.") x <- rtrunc(n, "st", a=0, b=Inf, mu=0, sigma=scale, nu=nu) return(x) } ########################################################################### # Horseshoe Distribution # ########################################################################### dhs <- function(x, lambda, tau, log=FALSE) { dens <- dnorm(x, 0, lambda*tau, log=log) return(dens) } rhs <- function(n, lambda, tau) { x <- rnorm(n, 0, lambda*tau) return(x) } ########################################################################### # Huang-Wand Distribution # ########################################################################### dhuangwand <- function(x, nu=2, a, A, log=FALSE) { if(!is.matrix(x)) x <- matrix(x) if(!is.positive.definite(x)) stop("Matrix x is not positive-definite.") a <- as.vector(a) A <- as.vector(A) k <- nrow(x) if(!identical(length(a), length(A), k, ncol(x))) stop("Dimensions of x, a, and A do not agree.") dens <- sum(dinvgamma(a, 0.5, 1/A^2, log=TRUE)) + dinvwishart(x, nu + k - 1, 2*nu*diag(1/a), log=TRUE) if(log == FALSE) dens <- exp(dens) return(dens) } rhuangwand <- function(nu=2, a, A) { if(missing(A)) k <- length(a) else { k <- length(A) a <- rinvgamma(k, 0.5, 1/A^2)} x <- rinvwishart(nu + k - 1, 2*nu*diag(1/a)) return(x) } ########################################################################### # Huang-Wand Distribution (Cholesky Parameterization) # ########################################################################### dhuangwandc <- function(x, nu=2, a, A, log=FALSE) { if(!is.matrix(x)) x <- matrix(x) a <- as.vector(a) A <- as.vector(A) k <- nrow(x) if(!identical(length(a), length(A), k, ncol(x))) stop("Dimensions of x, a, and A do not agree.") dens <- sum(dinvgamma(a, 0.5, 1/A^2, log=TRUE)) + dinvwishartc(x, nu + k - 1, 2*nu*diag(1/a), log=TRUE) if(log == FALSE) dens <- exp(dens) return(dens) } rhuangwandc <- function(nu=2, a, A) { if(missing(A)) k <- length(a) else { k <- length(A) a <- rinvgamma(k, 0.5, 1/A^2)} x <- rinvwishartc(nu + k - 1, 2*nu*diag(1/a)) return(x) } ########################################################################### # Inverse Beta Distribution # ########################################################################### dinvbeta <- function(x, a, b, log=FALSE) { const <- lgamma(a + b) - lgamma(a) - lgamma(b) dens <- const + (a - 1) * log(x) - (a + b) * log(1 + x) if(log == FALSE) dens <- exp(dens) return(dens) } rinvbeta <- function(n, a, b) { x <- rbeta(n, a, b) x <- x / (1-x) return(x) } ########################################################################### # Inverse Chi-Squared Distribution # # # # These functions are similar to those in the GeoR package. # ########################################################################### dinvchisq <- function(x, df, scale=1/df, log=FALSE) { x <- as.vector(x); df <- as.vector(df); scale <- as.vector(scale) if(any(x <= 0)) stop("x must be positive.") if(any(df <= 0)) stop("The df parameter must be positive.") if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(x), length(df), length(scale)) x <- rep(x, len=NN); df <- rep(df, len=NN); scale <- rep(scale, len=NN) nu <- df / 2 dens <- nu*log(nu) - lgamma(nu) + nu*log(scale) - (nu+1)*log(x) - (nu*scale/x) if(log == FALSE) dens <- exp(dens) return(dens) } rinvchisq <- function(n, df, scale=1/df) { df <- rep(df, len=n); scale <- rep(scale, len=n) if(any(df <= 0)) stop("The df parameter must be positive.") if(any(scale <= 0)) stop("The scale parameter must be positive.") z <- rchisq(n, df=df) z[which(z == 0)] <- 1e-100 x <- (df*scale) / z return(x) } ########################################################################### # Inverse Gamma Distribution # # # # These functions are similar to those in the MCMCpack package. # ########################################################################### dinvgamma <- function(x, shape=1, scale=1, log=FALSE) { x <- as.vector(x); shape <- as.vector(shape) scale <- as.vector(scale) if(any(shape <= 0) | any(scale <=0)) stop("The shape and scale parameters must be positive.") NN <- max(length(x), length(shape), length(scale)) x <- rep(x, len=NN); shape <- rep(shape, len=NN) scale <- rep(scale, len=NN) alpha <- shape; beta <- scale dens <- alpha * log(beta) - lgamma(alpha) - {alpha + 1} * log(x) - {beta/x} if(log == FALSE) dens <- exp(dens) return(dens) } rinvgamma <- function(n, shape=1, scale=1) { x <- rgamma(n=n, shape=shape, rate=scale) x[which(x < 1e-300)] <- 1e-300 return(1 / x) } ########################################################################### # Inverse Gaussian Distribution # ########################################################################### dinvgaussian <- function(x, mu, lambda, log=FALSE) { x <- as.vector(x); mu <- as.vector(mu); lambda <- as.vector(lambda) if(any(x <= 0)) stop("x must be positive.") if(any(mu <= 0)) stop("The mu parameter must be positive.") if(any(lambda <= 0)) stop("The lambda parameter must be positive.") NN <- max(length(x), length(mu), length(lambda)) x <- rep(x, len=NN); mu <- rep(mu, len=NN) lambda <- rep(lambda, len=NN) dens <- log(lambda^0.5/(2 * pi * x^3)^0.5) - ((lambda * (x - mu)^2)/(2 * mu^2 * x)) if(log == FALSE) dens <- exp(dens) return(dens) } rinvgaussian <- function(n, mu, lambda) { mu <- rep(mu, len=n); lambda <- rep(lambda, len=n) if(any(mu <= 0)) stop("The mu parameter must be positive.") if(any(lambda <= 0)) stop("The lambda parameter must be positive.") nu <- rnorm(n) y <- nu^2 x <- mu + ((mu^2*y)/(2*lambda)) - (mu/(2*lambda)) * sqrt(4*mu*lambda*y + mu^2*y^2) z <- runif(n) temp <- which(z > {mu / (mu + x)}) x[temp] <- mu[temp] * mu[temp] / x[temp] return(x) } ########################################################################### # Inverse Matrix Gamma Distribution # ########################################################################### dinvmatrixgamma <- function(X, alpha, beta, Psi, log=FALSE) { if(!is.matrix(X)) stop("X is not a matrix.") if(alpha <= 2) stop("The alpha parameter must be greater than 2.") if(beta <= 0) stop("The beta parameter must be positive.") if(missing(Psi)) Psi <- diag(ncol(X)) if(!is.positive.definite(Psi)) stop("Matrix Psi is not positive-definite.") k <- nrow(Psi) gamsum <- 0 for (i in 1:k) gamsum <- gamsum + lgamma(alpha - 0.5*(i-1)) gamsum <- gamsum + log(pi)*(k*(k-1)/4) Omega <- as.inverse(Psi) dens <- logdet(Psi)*alpha - (log(beta)*(k*alpha) + gamsum) + logdet(X)*(-alpha-(k+1)/2) + tr(-(1/beta)*(Psi %*% as.inverse(X))) if(log == FALSE) dens <- exp(dens) return(dens) } rinvmatrixgamma <- function(alpha, beta, Psi){ rinvwishart(2*alpha, 2/beta*Psi) } ########################################################################### # Inverse Wishart Distribution # ########################################################################### dinvwishart <- function(Sigma, nu, S, log=FALSE) { if(!is.matrix(Sigma)) Sigma <- matrix(Sigma) if(!is.positive.definite(Sigma)) stop("Matrix Sigma is not positive-definite.") if(!is.matrix(S)) S <- matrix(S) if(!is.positive.semidefinite(S)) stop("Matrix S is not positive-semidefinite.") if(!identical(dim(S), dim(Sigma))) stop("The dimensions of Sigma and S differ.") if(nu < nrow(S)) stop("The nu parameter is less than the dimension of S.") k <- nrow(Sigma) gamsum <- 0 for (i in 1:k) {gamsum <- gamsum + lgamma((nu + 1 - i)/2)} dens <- -(nu*k/2)*log(2) - ((k*(k - 1))/4)*log(pi) - gamsum + (nu/2)*log(det(S)) - ((nu + k + 1)/2)*logdet(Sigma) - 0.5*tr(S %*% as.inverse(Sigma)) if(log == FALSE) dens <- exp(dens) return(dens) } rinvwishart <- function(nu, S) {return(chol2inv(rwishartc(nu, chol2inv(chol(S)))))} ########################################################################### # Inverse Wishart Distribution (Cholesky Parameterization) # ########################################################################### dinvwishartc <- function(U, nu, S, log=FALSE) { if(missing(U)) stop("Upper triangular U is required.") Sigma <- t(U) %*% U if(!is.matrix(S)) S <- matrix(S) if(!is.positive.semidefinite(S)) stop("Matrix S is not positive-semidefinite.") if(!identical(dim(S), dim(Sigma))) stop("The dimensions of Sigma and S differ.") if(nu < nrow(S)) stop("The nu parameter is less than the dimension of S.") k <- nrow(Sigma) gamsum <- 0 for (i in 1:k) {gamsum <- gamsum + lgamma((nu + 1 - i)/2)} dens <- -(nu*k/2)*log(2) - ((k*(k - 1))/4)*log(pi) - gamsum + (nu/2)*log(det(S)) - ((nu + k + 1)/2)*logdet(Sigma) - 0.5*tr(S %*% as.inverse(Sigma)) if(log == FALSE) dens <- exp(dens) return(dens) } rinvwishartc <- function(nu, S) {return(chol(as.inverse(rwishart(nu, as.inverse(S)))))} ########################################################################### # Laplace Distribution # # # # These functions are similar to those in the VGAM package. # ########################################################################### dlaplace <- function(x, location=0, scale=1, log=FALSE) { x <- as.vector(x); location <- as.vector(location) scale <- as.vector(scale) if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(x), length(location), length(scale)) x <- rep(x, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN) dens <- (-abs(x - location) / scale) - log(2 * scale) if(log == FALSE) dens <- exp(dens) return(dens) } plaplace <- function(q, location=0, scale=1) { q <- as.vector(q); location <- as.vector(location) scale <- as.vector(scale) if(any(scale <= 0)) stop("The scale parameter must be positive.") z <- {q - location} / scale NN <- max(length(q), length(location), length(scale)) q <- rep(q, len=NN); location <- rep(location, len=NN) p <- q temp <- which(q < location); p[temp] <- 0.5 * exp(z[temp]) temp <- which(q >= location); p[temp] <- 1 - 0.5 * exp(-z[temp]) return(p) } qlaplace <- function(p, location=0, scale=1) { p <- as.vector(p); location <- as.vector(location) scale <- as.vector(scale) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(p), length(location), length(scale)) p <- p2 <- rep(p, len=NN); location <- rep(location, len=NN) temp <- which(p > 0.5); p2[temp] <- 1 - p[temp] q <- location - sign(p - 0.5) * scale * log(2 * p2) return(q) } rlaplace <- function(n, location=0, scale=1) { location <- rep(location, len=n); scale <- rep(scale, len=n) if(any(scale <= 0)) stop("The scale parameter must be positive.") r <- r2 <- runif(n) temp <- which(r > 0.5); r2[temp] <- 1 - r[temp] x <- location - sign(r - 0.5) * scale * log(2 * r2) return(x) } ########################################################################### # Laplace Distribution (Precision Parameterization) # ########################################################################### dlaplacep <- function(x, mu=0, tau=1, log=FALSE) { x <- as.vector(x); mu <- as.vector(mu); tau <- as.vector(tau) if(any(tau <= 0)) stop("The tau parameter must be positive.") NN <- max(length(x), length(mu), length(tau)) x <- rep(x, len=NN); mu <- rep(mu, len=NN); tau <- rep(tau, len=NN) dens <- log(tau/2) + (-tau*abs(x-mu)) if(log == FALSE) dens <- exp(dens) return(dens) } plaplacep <- function(q, mu=0, tau=1) { q <- as.vector(q); mu <- as.vector(mu) if(any(tau <= 0)) stop("The tau parameter must be positive.") NN <- max(length(q), length(mu), length(tau)) q <- rep(q, len=NN); mu <- rep(mu, len=NN); tau <- rep(tau, len=NN) p <- plaplace(q, mu, scale=1/tau) return(p) } qlaplacep <- function(p, mu=0, tau=1) { p <- as.vector(p); mu <- as.vector(mu) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(tau <= 0)) stop("The tau parameter must be positive.") NN <- max(length(p), length(mu), length(tau)) p <- rep(p, len=NN); mu <- rep(mu, len=NN); tau <- rep(tau, len=NN) q <- qlaplace(p, mu, scale=1/tau) return(q) } rlaplacep <- function(n, mu=0, tau=1) { mu <- rep(mu, len=n); tau <- rep(tau, len=n) if(any(tau <= 0)) stop("The tau parameter must be positive.") x <- rlaplace(n, mu, scale=1/tau) return(x) } ########################################################################### # Laplace Distribution Mixture # ########################################################################### dlaplacem <- function(x, p, location, scale, log=FALSE) { if(missing(x)) stop("x is a required argument.") x <- as.vector(x) n <- length(x) if(missing(p)) stop("p is a required argument.") p <- as.vector(p) if(any(p <= 0) | any(p > 1)) stop("p must be in (0,1].") if(sum(p) != 1) stop("p must sum to 1 for all components.") m <- length(p) p <- matrix(p, n, m, byrow=TRUE) if(missing(location)) stop("location is a required argument.") location <- as.vector(location) if(!identical(m, length(location))) stop("p and location differ in length.") location <- matrix(location, n, m, byrow=TRUE) if(missing(scale)) stop("scale is a required argument.") scale <- as.vector(scale) if(!identical(m, length(scale))) stop("p and scale differ in length.") scale <- matrix(scale, n, m, byrow=TRUE) dens <- matrix(dlaplace(x, location, scale, log=TRUE), n, m) dens <- dens + log(p) if(log == TRUE) dens <- apply(dens, 1, logadd) else dens <- rowSums(exp(dens)) return(dens) } plaplacem <- function(q, p, location, scale) { n <- length(q) m <- length(p) q <- matrix(q, n, m) p <- matrix(p, n, m, byrow=TRUE) location <- matrix(location, n, m, byrow=TRUE) scale <- matrix(scale, n, m, byrow=TRUE) cdf <- matrix(plaplace(q, location, scale), n, m) cdf <- rowSums(cdf * p) return(cdf) } rlaplacem <- function(n, p, location, scale) { if(missing(p)) stop("p is a required argument.") p <- as.vector(p) if(any(p <= 0) | any(p > 1)) stop("p must be in (0,1].") if(sum(p) != 1) stop("p must sum to 1 for all components.") m <- length(p) p <- matrix(p, n, m, byrow=TRUE) if(missing(location)) stop("location is a required argument.") location <- as.vector(location) if(!identical(m, length(location))) stop("p and location differ in length.") if(missing(scale)) stop("scale is a required argument.") scale <- as.vector(scale) if(!identical(m, length(scale))) stop("p and scale differ in length.") if(any(scale <= 0)) stop("scale must be positive.") z <- rcat(n, p) x <- rlaplace(n, location=location[z], scale=scale[z]) return(x) } ########################################################################### # LASSO Distribution # ########################################################################### dlasso <- function(x, sigma, tau, lambda, a=1, b=1, log=FALSE) { if(any(c(sigma, tau, lambda, a, b) <= 0)) stop("Scale parameters must be positive.") dens <- sum(dmvn(x, 0, sigma^2*diag(tau^2), log=TRUE)) + log(1/sigma^2) + sum(dexp(tau^2, lambda^2/2, log=TRUE)) + dgamma(lambda^2, a, b, log=TRUE) if(log == FALSE) dens <- exp(dens) return(dens) } rlasso <- function(n, sigma, tau, lambda, a=1, b=1) { a <- as.vector(a)[1] b <- as.vector(b)[1] if(missing(sigma)) sigma <- runif(1, 1e-100, 1000) if(missing(lambda)) lambda <- sqrt(rgamma(1, a, b)) if(missing(tau)) stop("The tau parameter is a required argument.") sigma <- as.vector(sigma)[1] lambda <- as.vector(lambda)[1] x <- rnorm(n, 0, sigma^2*diag(tau^2)) return(x) } ########################################################################### # Log-Laplace Distribution # ########################################################################### dllaplace <- function(x, location=0, scale=1, log=FALSE) { x <- as.vector(x); location <- as.vector(location) scale <- as.vector(scale) if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(x), length(location), length(scale)) x <- rep(x, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN) Alpha <- sqrt(2) * scale Beta <- sqrt(2) / scale Delta <- exp(location) exponent <- -(Alpha + 1) temp <- which(x < Delta); exponent[temp] <- Beta[temp] - 1 exponent <- exponent * (log(x) - location) dens <- -location + log(Alpha) + log(Beta) - log(Alpha + Beta) + exponent if(log == FALSE) dens <- exp(dens) return(dens) } pllaplace <- function(q, location=0, scale=1) { q <- as.vector(q); location <- as.vector(location) scale <- as.vector(scale) if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(q), length(location), length(scale)) q <- rep(q, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN) Alpha <- sqrt(2) * scale Beta <- sqrt(2) / scale Delta <- exp(location) temp <- Alpha + Beta p <- (Alpha / temp) * (q / Delta)^(Beta) p[q <= 0] <- 0 index1 <- (q >= Delta) p[index1] <- (1 - (Beta/temp) * (Delta/q)^(Alpha))[index1] return(p) } qllaplace <- function(p, location=0, scale=1) { p <- as.vector(p); location <- as.vector(location) scale <- as.vector(scale) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(scale <= 0)) stop("The scale parameter must be positive.") NN <- max(length(p), length(location), length(scale)) p <- rep(p, len=NN); location <- rep(location, len=NN) scale <- rep(scale, len=NN) Alpha <- sqrt(2) * scale Beta <- sqrt(2) / scale Delta <- exp(location) temp <- Alpha + Beta q <- Delta * (p * temp / Alpha)^(1/Beta) index1 <- (p > Alpha / temp) q[index1] <- (Delta * ((1-p) * temp / Beta)^(-1/Alpha))[index1] q[p == 0] <- 0 q[p == 1] <- Inf return(q) } rllaplace <- function(n, location=0, scale=1) { location <- rep(location, len=n); scale <- rep(scale, len=n) if(any(scale <= 0)) stop("The scale parameter must be positive.") x <- exp(location) * (runif(n) / runif(n))^(scale / sqrt(2)) return(x) } ########################################################################### # Log-Normal Distribution (Precision Parameterization) # ########################################################################### dlnormp <- function(x, mu, tau = NULL, var = NULL, log = FALSE) { if (!is.null(tau) & !is.null(var)) stop("use either tau or var, but not both") x <- as.vector(x); mu <- as.vector(mu); if (!is.null(tau)) { tau <- as.vector(tau) if(any(tau <= 0)) stop("The tau parameter must be positive.") NN <- max(length(x), length(mu), length(tau)) x <- rep(x, len=NN); mu <- rep(mu, len=NN); tau <- rep(tau, len=NN) dens <- 0.5*(log(tau) - log(2*pi)) - log(x) - tau/2*(log(x) - mu)^2 } if (!is.null(var)) { var <- as.vector(var) if(any(var <= 0)) stop("The var parameter must be positive.") NN <- max(length(x), length(mu), length(var)) x <- rep(x, len=NN); mu <- rep(mu, len=NN); var <- rep(var, len=NN) dens <- -0.5*log(2*pi*var) - log(x) - (log(x) - mu)^2/(2*var) } if(log == FALSE) dens <- exp(dens) return(dens) } plnormp <- function(q, mu, tau, lower.tail=TRUE, log.p=FALSE) { q <- as.vector(q); mu <- as.vector(mu); tau <- as.vector(tau) if(any(tau <= 0)) stop("The tau parameter must be positive.") NN <- max(length(q), length(mu), length(tau)) q <- rep(q, len=NN); mu <- rep(mu, len=NN); tau <- rep(tau, len=NN) p <- pnorm(q, mu, sqrt(1/tau), lower.tail, log.p) return(p) } qlnormp <- function(p, mu, tau, lower.tail=TRUE, log.p=FALSE) { p <- as.vector(p); mu <- as.vector(mu); tau <- as.vector(tau) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(tau <= 0)) stop("The tau parameter must be positive.") NN <- max(length(p), length(mu), length(tau)) p <- rep(p, len=NN); mu <- rep(mu, len=NN); tau <- rep(tau, len=NN) q <- qnorm(p, mu, sqrt(1/tau), lower.tail, log.p) return(q) } rlnormp <- function(n, mu, tau = NULL, var = NULL) { if (!is.null(tau) & !is.null(var)) stop("use either tau or var, but not both") mu <- rep(mu, len=n); if (!is.null(tau)) { if(any(tau <= 0)) stop("The tau parameter must be positive.") tau <- rep(tau, len=n) x <- rlnorm(n, log(mu^2 / sqrt(1/tau^2 + mu^2)), sqrt(log(1 + 1/(mu^2*tau^2)))) } if (!is.null(var)) { var = rep(var, len=n) if(any(var <= 0)) stop("The var parameter must be positive.") var <- rep(var, len=n) x <- rlnorm(n, log(mu^2 / sqrt(var^2 + mu^2)), sqrt(log(1 + (var^2/mu^2)))) } return(x) } ########################################################################### # Matrix Gamma Distribution # ########################################################################### dmatrixgamma <- function(X, alpha, beta, Sigma, log=FALSE) { if(!is.matrix(X)) stop("X is not a matrix.") if(alpha <= 2) stop("The alpha parameter must be greater than 2.") if(beta <= 0) stop("The beta parameter must be positive.") if(missing(Sigma)) Sigma <- diag(ncol(X)) if(!is.positive.definite(Sigma)) stop("Matrix Sigma is not positive-definite.") k <- nrow(Sigma) gamsum <- 0 for (i in 1:k) gamsum <- gamsum + lgamma(alpha - 0.5*(i-1)) gamsum <- gamsum + log(pi)*(k*(k-1)/4) Omega <- as.inverse(Sigma) dens <- alpha*logdet(Omega) + logdet(X)*(alpha - 0.5*(k+1)) - (log(beta)*(k*alpha) + gamsum) + (-1/beta)*tr(Omega %*% X) if(log == FALSE) dens <- exp(dens) return(dens) } rmatrixgamma <- function(alpha, beta, Sigma){ rwishart(2*alpha, beta/2*Sigma) } ########################################################################### # Matrix Normal Distribution # ########################################################################### dmatrixnorm <- function(X, M, U, V, log=FALSE) { if(!is.matrix(X)) X <- rbind(X) if(!is.matrix(M)) M <- matrix(M, nrow(X), ncol(X), byrow=TRUE) if(missing(U)) U <- diag(nrow(X)) if(!is.matrix(U)) U <- matrix(U) if(!is.positive.definite(U)) stop("Matrix U is not positive-definite.") if(missing(V)) V <- diag(ncol(X)) if(!is.matrix(V)) V <- matrix(V) if(!is.positive.definite(V)) stop("Matrix V is not positive-definite.") n <- nrow(X) k <- ncol(X) ss <- X - M dens <- -0.5*tr(as.inverse(V) %*% t(ss) %*% as.inverse(U) %*% ss) - (log(2*pi)*(n*k/2) - logdet(V) * (n/2) - logdet(U) * (k/2)) if(log == FALSE) dens <- exp(dens) return(dens) } rmatrixnorm <- function(M, U, V) { if(missing(M)) stop("Matrix M is missing.") if(!is.matrix(M)) M <- matrix(M) if(missing(U)) stop("Matrix U is missing.") if(!is.matrix(U)) U <- matrix(U) if(!is.positive.definite(U)) stop("Matrix U is not positive-definite.") if(missing(V)) stop("Matrix V is missing.") if(!is.matrix(V)) V <- matrix(V) if(!is.positive.definite(V)) stop("Matrix V is not positive-definite.") if(nrow(M) != nrow(U)) stop("Dimensions of M and U are incorrect.") if(ncol(M) != ncol(V)) stop("Dimensions of M and V are incorrect.") n <- nrow(U) k <- ncol(V) Z <- matrix(rnorm(n * k), n, k) X <- M + t(chol(U)) %*% Z %*% chol(V) return(X) } ########################################################################### # Multivariate Cauchy Distribution # ########################################################################### dmvc <- function(x, mu, S, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(S)) S <- diag(ncol(x)) if(!is.matrix(S)) S <- matrix(S) if(!is.positive.definite(S)) stop("Matrix S is not positive-definite.") k <- nrow(S) ss <- x - mu Omega <- as.inverse(S) z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(lgamma((1 + k)/2) - (lgamma(0.5) + (k/2)*log(pi) + 0.5*logdet(S) + ((1+k)/2)*log(1+z))) if(log == FALSE) dens <- exp(dens) return(dens) } rmvc <- function(n=1, mu=rep(0,k), S) { mu <- rbind(mu) if(missing(S)) S <- diag(ncol(mu)) if(!is.matrix(S)) S <- matrix(S) if(!is.positive.definite(S)) stop("Matrix S is not positive-definite.") k <- ncol(S) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) x <- rchisq(n,1) x[which(x == 0)] <- 1e-100 z <- rmvn(n, rep(0,k), S) x <- mu + z/sqrt(x) return(x) } ########################################################################### # Multivariate Cauchy Distribution (Cholesky Parameterization) # ########################################################################### dmvcc <- function(x, mu, U, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(U)) stop("Upper triangular U is required.") k <- nrow(U) S <- t(U) %*% U ss <- x - mu Omega <- as.inverse(S) z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(lgamma(k/2) - (lgamma(0.5) + log(1^(k/2)) + (k/2)*log(pi) + 0.5*logdet(S) + ((1+k)/2)*log(1+z))) if(log == FALSE) dens <- exp(dens) return(dens) } rmvcc <- function(n=1, mu=rep(0,k), U) { mu <- rbind(mu) if(missing(U)) stop("Upper triangular U is required.") k <- ncol(U) S <- t(U) %*% U if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) x <- rchisq(n,1) x[which(x == 0)] <- 1e-100 z <- rmvnc(n, rep(0,k), U) x <- mu + z/sqrt(x) return(x) } ########################################################################### # Multivariate Cauchy Distribution (Precision Parameterization) # ########################################################################### dmvcp <- function(x, mu, Omega, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(Omega)) Omega <- diag(ncol(x)) if(!is.matrix(Omega)) Omega <- matrix(Omega) if(!is.positive.definite(Omega)) stop("Matrix Omega is not positive-definite.") k <- nrow(Omega) logdetOmega <- logdet(Omega) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(lgamma((1+k)/2) - (lgamma(0.5) + log(1^(k/2)) + (k/2)*log(pi)) + 0.5*logdetOmega + (-(1+k)/2)*log(1 + z)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvcp <- function(n=1, mu, Omega) { mu <- rbind(mu) if(missing(Omega)) Omega <- diag(ncol(mu)) if(!is.matrix(Omega)) Omega <- matrix(Omega) if(!is.positive.definite(Omega)) stop("Matrix Omega is not positive-definite.") Sigma <- as.inverse(Omega) k <- ncol(Sigma) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) x <- rchisq(n,1) x[which(x == 0)] <- 1e-100 z <- rmvn(n, rep(0,k), Sigma) x <- mu + z/sqrt(x) return(x) } ########################################################################### # Multivariate Cauchy Distribution (Precision-Cholesky Parameterization) # ########################################################################### dmvcpc <- function(x, mu, U, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(U)) stop("Upper triangular U is required.") k <- nrow(U) Omega <- t(U) %*% U logdetOmega <- logdet(Omega) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(lgamma((1+k)/2) - (lgamma(0.5) + log(1^(k/2)) + (k/2)*log(pi)) + 0.5*logdetOmega + (-(1+k)/2)*log(1 + z)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvcpc <- function(n=1, mu, U) { mu <- rbind(mu) if(missing(U)) stop("Upper triangular U is required.") k <- ncol(U) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) x <- rchisq(n,1) x[which(x == 0)] <- 1e-100 z <- rmvnc(n, rep(0,k), U) x <- mu + z/sqrt(x) return(x) } ########################################################################### # Multivariate Laplace Distribution # ########################################################################### dmvl <- function(x, mu, Sigma, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(Sigma)) Sigma <- diag(ncol(x)) if(!is.matrix(Sigma)) Sigma <- matrix(Sigma) Sigma <- as.symmetric.matrix(Sigma) if(!is.positive.definite(Sigma)) stop("Matrix Sigma is not positive-definite.") k <- nrow(Sigma) Omega <- as.inverse(Sigma) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) z[which(z == 0)] <- 1e-300 dens <- as.vector(log(2) - log(2 * pi) * (k/2) - logdet(Sigma) * 0.5 + (log(pi) - log(2) - log(2 * z) * 0.5) * 0.5 - sqrt(2 * z) - log(z/2) * 0.5 * (k/2 - 1)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvl <- function(n, mu, Sigma) { mu <- rbind(mu) if(missing(Sigma)) Sigma <- diag(ncol(mu)) if(!is.matrix(Sigma)) Sigma <- matrix(Sigma) if(!is.positive.definite(Sigma)) stop("Matrix Sigma is not positive-definite.") k <- ncol(Sigma) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) e <- matrix(rexp(n, 1), n, k) z <- rmvn(n, rep(0, k), Sigma) x <- mu + sqrt(e)*z return(x) } ########################################################################### # Multivariate Laplace Distribution (Cholesky Parameterization) # ########################################################################### dmvlc <- function(x, mu, U, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(U)) stop("Upper triangular U is required.") k <- ncol(U) Sigma <- t(U) %*% U Omega <- as.inverse(Sigma) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) z[which(z == 0)] <- 1e-300 dens <- as.vector(log(2) - log(2*pi)*(k/2) + logdet(Sigma)*0.5 + (log(pi) - log(2) + log(2*z)*0.5)*0.5 - log(2*z)*0.5 - log(z/2)*0.5*(k/2 - 1)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvlc <- function(n, mu, U) { mu <- rbind(mu) if(missing(U)) stop("Upper triangular U is required.") k <- ncol(U) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) e <- matrix(rexp(n, 1), n, k) z <- rmvnc(n, rep(0, k), U) x <- mu + sqrt(e)*z return(x) } ########################################################################### # Multivariate Normal Distribution # ########################################################################### dmvn <- function(x, mu, Sigma, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(Sigma)) Sigma <- diag(ncol(x)) if(!is.matrix(Sigma)) Sigma <- matrix(Sigma) Sigma <- as.symmetric.matrix(Sigma) if(!is.positive.definite(Sigma)) stop("Matrix Sigma is not positive-definite.") k <- nrow(Sigma) Omega <- as.inverse(Sigma) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(-0.5 * (k * log(2 * pi) + logdet(Sigma)) - (0.5 * z)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvn <- function(n=1, mu=rep(0,k), Sigma) { mu <- rbind(mu) if(missing(Sigma)) Sigma <- diag(ncol(mu)) if(!is.matrix(Sigma)) Sigma <- matrix(Sigma) if(!is.positive.definite(Sigma)) stop("Matrix Sigma is not positive-definite.") k <- ncol(Sigma) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) z <- matrix(rnorm(n*k),n,k) %*% chol(Sigma) x <- mu + z return(x) } ########################################################################### # Multivariate Normal Distribution (Cholesky Parameterization) # ########################################################################### dmvnc <- function(x, mu, U, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(U)) stop("Upper triangular U is required.") k <- ncol(U) Sigma <- t(U) %*% U k <- nrow(Sigma) Omega <- as.inverse(Sigma) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(-0.5 * (k * log(2 * pi) + logdet(Sigma)) - (0.5 * z)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvnc <- function(n=1, mu=rep(0,k), U) { mu <- rbind(mu) if(missing(U)) stop("Upper triangular U is required.") k <- ncol(U) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) z <- matrix(rnorm(n*k),n,k) %*% U x <- mu + z return(x) } ########################################################################### # Multivariate Normal Distribution (Precision Parameterization) # ########################################################################### dmvnp <- function(x, mu, Omega, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(Omega)) Omega <- diag(ncol(x)) if(!is.matrix(Omega)) Omega <- matrix(Omega) if(!is.positive.definite(Omega)) stop("Matrix Omega is not positive-definite.") k <- nrow(Omega) logdetOmega <- logdet(Omega) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) dens <- as.vector((-k/2)*log(2*pi) + 0.5*logdetOmega - 0.5*z) if(log == FALSE) dens <- exp(dens) return(dens) } rmvnp <- function(n=1, mu=rep(0, k), Omega) { mu <- rbind(mu) if(missing(Omega)) Omega <- diag(ncol(mu)) if(!is.matrix(Omega)) Omega <- matrix(Omega) if(!is.positive.definite(Omega)) stop("Matrix Omega is not positive-definite.") k <- ncol(Omega) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) z <- matrix(rnorm(n*k),n,k) %*% solve(t(chol(Omega))) x <- mu + z return(x) } ########################################################################### # Multivariate Normal Distribution (Precision-Cholesky Parameterization) # ########################################################################### dmvnpc <- function(x, mu, U, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(U)) stop("Upper triangular U is required.") k <- ncol(U) Omega <- t(U) %*% U logdetOmega <- logdet(Omega) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) dens <- as.vector((-k/2)*log(2*pi) + 0.5*logdetOmega - 0.5*z) if(log == FALSE) dens <- exp(dens) return(dens) } rmvnpc <- function(n=1, mu=rep(0,k), U) { mu <- rbind(mu) if(missing(U)) stop("Upper triangular U is required.") Sigma <- as.inverse(t(U) %*% U) k <- ncol(Sigma) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) z <- matrix(rnorm(n*k),n,k) %*% chol(Sigma) x <- mu + z return(x) } ########################################################################### # Multivariate Polya Distribution # ########################################################################### dmvpolya <- function(x, alpha, log=FALSE) { x <- as.vector(x) alpha <- as.vector(alpha) if(!identical(length(x), length(alpha))) stop("x and alpha differ in length.") dens <- (log(factorial(sum(x))) - sum(log(factorial(x)))) + (log(factorial(sum(alpha)-1)) - log(factorial(sum(x) + sum(alpha)-1))) + (sum(log(factorial(x + alpha - 1)) - log(factorial(alpha - 1)))) if(log == FALSE) dens <- exp(dens) return(dens) } rmvpolya <- function(n=1, alpha) { p <- rdirichlet(n, alpha) x <- rcat(n,p) return(x) } ########################################################################### # Multivariate Power Exponential Distribution # ########################################################################### dmvpe <- function(x=c(0,0), mu=c(0,0), Sigma=diag(2), kappa=1, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(Sigma)) Sigma <- diag(ncol(x)) if(!is.matrix(Sigma)) Sigma <- matrix(Sigma) if(!is.positive.definite(Sigma)) stop("Matrix Sigma is not positive-definite.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") k <- nrow(Sigma) Omega <- as.inverse(Sigma) ss <- x - mu temp <- rowSums({ss %*% Omega} * ss) dens <- as.vector(((log(k)+lgamma(k/2)) - ((k/2)*log(pi) + 0.5*logdet(Sigma) + lgamma(1 + k/(2*kappa)) + (1 + k/(2*kappa))*log(2))) + kappa*(-0.5*temp)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvpe <- function(n, mu=c(0,0), Sigma=diag(2), kappa=1) { mu <- rbind(mu) k <- ncol(mu) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) if(k != nrow(Sigma)) { stop("mu and Sigma have non-conforming size.")} ev <- eigen(Sigma, symmetric=TRUE) if(!all(ev$values >= -sqrt(.Machine$double.eps) * abs(ev$values[1]))) { stop("Sigma must be positive-definite.")} SigmaSqrt <- ev$vectors %*% diag(sqrt(ev$values), length(ev$values)) %*% t(ev$vectors) radius <- (rgamma(n, shape=k/(2*kappa), scale=2))^(1/(2*kappa)) runifsphere <- function(n, k) { p <- as.integer(k) if(!is.integer(k)) stop("k must be an integer in [2,Inf)") if(k < 2) stop("k must be an integer in [2,Inf).") Mnormal <- matrix(rnorm(n*k,0,1), nrow=n) rownorms <- sqrt(rowSums(Mnormal^2)) unifsphere <- sweep(Mnormal,1,rownorms, "/") return(unifsphere) } un <- runifsphere(n=n, k=k) x <- mu + radius * un %*% SigmaSqrt return(x) } ########################################################################### # Multivariate Power Exponential Distribution (Cholesky Parameterization) # ########################################################################### dmvpec <- function(x=c(0,0), mu=c(0,0), U, kappa=1, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(U)) stop("Upper triangular U is required.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") Sigma <- t(U) %*% U k <- nrow(Sigma) Omega <- as.inverse(Sigma) ss <- x - mu temp <- rowSums({ss %*% Omega} * ss) dens <- as.vector(((log(k)+lgamma(k/2)) - ((k/2)*log(pi) + 0.5*logdet(Sigma) + lgamma(1 + k/(2*kappa)) + (1 + k/(2*kappa))*log(2))) + kappa*(-0.5*temp)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvpec <- function(n, mu=c(0,0), U, kappa=1) { mu <- rbind(mu) k <- ncol(mu) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) if(k != nrow(U)) { stop("mu and U have non-conforming size.")} Sigma <- t(U) %*% U ev <- eigen(Sigma, symmetric=TRUE) if(!all(ev$values >= -sqrt(.Machine$double.eps) * abs(ev$values[1]))) { stop("Sigma must be positive-definite.")} SigmaSqrt <- ev$vectors %*% diag(sqrt(ev$values), length(ev$values)) %*% t(ev$vectors) radius <- (rgamma(n, shape=k/(2*kappa), scale=1/2))^(1/(2*kappa)) runifsphere <- function(n, k) { p <- as.integer(k) if(!is.integer(k)) stop("k must be an integer in [2,Inf)") if(k < 2) stop("k must be an integer in [2,Inf).") Mnormal <- matrix(rnorm(n*k,0,1), nrow=n) rownorms <- sqrt(rowSums(Mnormal^2)) unifsphere <- sweep(Mnormal,1,rownorms, "/") return(unifsphere) } un <- runifsphere(n=n, k=k) x <- mu + radius * un %*% SigmaSqrt return(x) } ########################################################################### # Multivariate t Distribution # ########################################################################### dmvt <- function(x, mu, S, df=Inf, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(S)) S <- diag(ncol(x)) if(!is.matrix(S)) S <- matrix(S) if(!is.positive.definite(S)) stop("Matrix S is not positive-definite.") if(any(df <= 0)) stop("The df parameter must be positive.") if(any(df > 10000)) return(dmvn(x, mu, S, log)) k <- nrow(S) ss <- x - mu Omega <- as.inverse(S) z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(lgamma((df+k)/2) - lgamma(df/2) - (k/2)*log(df) - (k/2)*log(pi) - 0.5*logdet(S) - ((df+k)/2)*log(1 + (1/df) * z)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvt <- function(n=1, mu=rep(0,k), S, df=Inf) { mu <- rbind(mu) if(missing(S)) S <- diag(ncol(mu)) if(!is.matrix(S)) S <- matrix(S) if(!is.positive.definite(S)) stop("Matrix S is not positive-definite.") if(any(df <= 0)) stop("The df parameter must be positive.") k <- ncol(S) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) if(df==Inf) x <- 1 else x <- rchisq(n,df) / df x[which(x == 0)] <- 1e-100 z <- rmvn(n, rep(0,k), S) x <- mu + z/sqrt(x) return(x) } ########################################################################### # Multivariate t Distribution (Cholesky Parameterization) # ########################################################################### dmvtc <- function(x, mu, U, df=Inf, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(U)) stop("Upper triangular U is required.") if(any(df <= 0)) stop("The df parameter must be positive.") if(any(df > 10000)) return(dmvnc(x, mu, U, log)) k <- nrow(U) ss <- x - mu S <- t(U) %*% U Omega <- as.inverse(S) z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(lgamma((df+k)/2) - lgamma(df/2) + (k/2)*df + (k/2)*log(pi) + 0.5*logdet(S) + ((df+k)/2)*log(1 + (1/df) * z)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvtc <- function(n=1, mu=rep(0,k), U, df=Inf) { mu <- rbind(mu) if(missing(U)) stop("Upper triangular U is required.") if(any(df <= 0)) stop("The df parameter must be positive.") k <- ncol(U) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) if(df==Inf) x <- 1 else x <- rchisq(n,df) / df x[which(x == 0)] <- 1e-100 z <- rmvnc(n, rep(0,k), U) x <- mu + z/sqrt(x) return(x) } ########################################################################### # Multivariate t Distribution (Precision Parameterization) # ########################################################################### dmvtp <- function(x, mu, Omega, nu=Inf, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(Omega)) Omega <- diag(ncol(x)) if(!is.matrix(Omega)) Omega <- matrix(Omega) if(!is.positive.definite(Omega)) stop("Matrix Omega is not positive-definite.") if(any(nu <= 0)) stop("The nu parameter must be positive.") if(any(nu > 10000)) return(dmvnp(x, mu, Omega, log)) k <- ncol(Omega) logdetOmega <- logdet(Omega) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(lgamma((nu+k)/2) - (lgamma(nu/2) + (k/2)*log(nu) + (k/2)*log(pi)) + 0.5*logdetOmega + (-(nu+k)/2)*log(1 + (1/nu) * z)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvtp <- function(n=1, mu, Omega, nu=Inf) { mu <- rbind(mu) if(missing(Omega)) Omega <- diag(ncol(mu)) if(!is.matrix(Omega)) Omega <- matrix(Omega) if(!is.positive.definite(Omega)) stop("Matrix Omega is not positive-definite.") if(any(nu <= 0)) stop("The nu parameter must be positive.") Sigma <- as.inverse(Omega) k <- ncol(Sigma) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) if(nu == Inf) x <- 1 else x <- rchisq(n,nu) / nu x[which(x == 0)] <- 1e-100 z <- rmvn(n, rep(0,k), Sigma) x <- mu + z/sqrt(x) return(x) } ########################################################################### # Multivariate t Distribution (Precision-Cholesky Parameterization) # ########################################################################### dmvtpc <- function(x, mu, U, nu=Inf, log=FALSE) { if(!is.matrix(x)) x <- rbind(x) if(!is.matrix(mu)) mu <- matrix(mu, nrow(x), ncol(x), byrow=TRUE) if(missing(U)) stop("Upper triangular U is required.") if(any(nu <= 0)) stop("The nu parameter must be positive.") if(any(nu > 10000)) return(dmvnpc(x, mu, U, log)) k <- ncol(U) Omega <- t(U) %*% U logdetOmega <- logdet(Omega) ss <- x - mu z <- rowSums({ss %*% Omega} * ss) dens <- as.vector(lgamma((nu+k)/2) - (lgamma(nu/2) + (k/2)*log(nu) + (k/2)*log(pi)) + 0.5*logdetOmega + (-(nu+k)/2)*log(1 + (1/nu) * z)) if(log == FALSE) dens <- exp(dens) return(dens) } rmvtpc <- function(n=1, mu, U, nu=Inf) { mu <- rbind(mu) if(missing(U)) stop("Upper triangular U is required.") if(any(nu <= 0)) stop("The nu parameter must be positive.") k <- ncol(U) if(n > nrow(mu)) mu <- matrix(mu, n, k, byrow=TRUE) if(nu == Inf) x <- 1 else x <- rchisq(n,nu) / nu x[which(x == 0)] <- 1e-100 z <- rmvnpc(n, rep(0,k), U) x <- mu + z/sqrt(x) return(x) } ########################################################################### # Normal Distribution Mixture # ########################################################################### dnormm <- function(x, p, mu, sigma, log=FALSE) { if(missing(x)) stop("x is a required argument.") x <- as.vector(x) n <- length(x) if(missing(p)) stop("p is a required argument.") p <- as.vector(p) if(any(p <= 0) | any(p > 1)) stop("p must be in (0,1].") if(sum(p) != 1) stop("p must sum to 1 for all components.") m <- length(p) p <- matrix(p, n, m, byrow=TRUE) if(missing(mu)) stop("mu is a required argument.") mu <- as.vector(mu) if(!identical(m, length(mu))) stop("p and mu differ in length.") mu <- matrix(mu, n, m, byrow=TRUE) if(missing(sigma)) stop("sigma is a required argument.") sigma <- as.vector(sigma) if(!identical(m, length(sigma))) stop("p and sigma differ in length.") sigma <- matrix(sigma, n, m, byrow=TRUE) dens <- matrix(dnorm(x, mu, sigma, log=TRUE), n, m) dens <- dens + log(p) if(log == TRUE) dens <- apply(dens, 1, logadd) else dens <- rowSums(exp(dens)) return(dens) } pnormm <- function(q, p, mu, sigma, lower.tail=TRUE, log.p=FALSE) { n <- length(q) m <- length(p) q <- matrix(q, n, m) p <- matrix(p, n, m, byrow=TRUE) mu <- matrix(mu, n, m, byrow=TRUE) sigma <- matrix(sigma, n, m, byrow=TRUE) cdf <- matrix(pnorm(q, mu, sigma, lower.tail=lower.tail, log.p=log.p), n, m) if(log.p == FALSE) cdf <- rowSums(cdf * p) else stop("The log.p argument does not work yet.") return(cdf) } rnormm <- function(n, p, mu, sigma) { if(missing(p)) stop("p is a required argument.") p <- as.vector(p) if(any(p <= 0) | any(p > 1)) stop("p must be in (0,1].") if(sum(p) != 1) stop("p must sum to 1 for all components.") m <- length(p) p <- matrix(p, n, m, byrow=TRUE) if(missing(mu)) stop("mu is a required argument.") mu <- as.vector(mu) if(!identical(m, length(mu))) stop("p and mu differ in length.") if(missing(sigma)) stop("sigma is a required argument.") sigma <- as.vector(sigma) if(!identical(m, length(sigma))) stop("p and sigma differ in length.") if(any(sigma <= 0)) stop("sigma must be positive.") z <- rcat(n, p) x <- rnorm(n, mean=mu[z], sd=sigma[z]) return(x) } ########################################################################### # Normal Distribution (Precision Parameterization) # ########################################################################### dnormp <- function(x, mean=0, prec=1, log=FALSE) { #dens <- sqrt(prec/(2*pi)) * exp(-(prec/2)*(x-mu)^2) dens <- dnorm(x, mean, sqrt(1/prec), log) return(dens) } pnormp <- function(q, mean=0, prec=1, lower.tail=TRUE, log.p=FALSE) {return(pnorm(q, mean=mean, sd=sqrt(1/prec), lower.tail, log.p))} qnormp <- function(p, mean=0, prec=1, lower.tail=TRUE, log.p=FALSE) {return(qnorm(p, mean=mean, sd=sqrt(1/prec), lower.tail, log.p))} rnormp <- function(n, mean=0, prec=1) {return(rnorm(n, mean=mean, sd=sqrt(1/prec)))} ########################################################################### # Normal Distribution (Variance Parameterization) # ########################################################################### dnormv <- function(x, mean=0, var=1, log=FALSE) { #dens <- (1/(sqrt(2*pi*var))) * exp(-((x-mu)^2/(2*var))) dens <- dnorm(x, mean, sqrt(var), log) return(dens) } pnormv <- function(q, mean=0, var=1, lower.tail=TRUE, log.p=FALSE) {return(pnorm(q, mean=mean, sd=sqrt(var), lower.tail, log.p))} qnormv <- function(p, mean=0, var=1, lower.tail=TRUE, log.p=FALSE) {return(qnorm(p, mean=mean, sd=sqrt(var), lower.tail, log.p))} rnormv <- function(n, mean=0, var=1) {return(rnorm(n, mean=mean, sd=sqrt(var)))} ########################################################################### # Normal-Inverse-Wishart Distribution # ########################################################################### dnorminvwishart <- function(mu, mu0, lambda, Sigma, S, nu, log=FALSE) { dens <- dinvwishart(Sigma, nu, S, log=TRUE) + dmvn(mu, mu0, 1/lambda*Sigma, log=TRUE) if(log == FALSE) dens <- exp(dens) return(dens) } rnorminvwishart <- function(n=1, mu0, lambda, S, nu) { Sigma <- rinvwishart(nu, S) mu <- rmvn(n, mu0, 1/lambda*Sigma) return(list(mu=mu, Sigma=Sigma)) } ########################################################################### # Normal-Laplace Distribution # ########################################################################### dnormlaplace <- function(x, mu=0, sigma=1, alpha=1, beta=1, log=FALSE) { x <- as.vector(x) mu <- as.vector(mu) sigma <- as.vector(sigma) alpha <- as.vector(alpha) beta <- as.vector(beta) if(any(sigma <= 0)) stop("The sigma parameter must be positive.") if(any(alpha <= 0)) stop("The alpha parameter must be positive.") if(any(beta <= 0)) stop("The beta parameter must be positive.") NN <- max(length(x), length(mu), length(sigma), length(alpha), length(beta)) x <- rep(x, len=NN) mu <- rep(mu, len=NN) sigma <- rep(sigma, len=NN) alpha <- rep(alpha, len=NN) beta <- rep(beta, len=NN) a <- dnorm((x - mu) / sigma, log=TRUE) z <- alpha*sigma - (x - mu) / sigma b <- pnorm(z, lower.tail=FALSE, log.p=TRUE) - dnorm(z, log=TRUE) z <- beta*sigma + (x - mu) / sigma cc <- pnorm(z, lower.tail=FALSE, log.p=TRUE) - dnorm(z, log=TRUE) z <- log(alpha*beta / (alpha + beta)) d <- pnorm(z, lower.tail=FALSE, log.p=TRUE) - dnorm(z, log=TRUE) if(log == FALSE) dens <- exp(d + a + b) + exp(d + a + cc) else { dens <- rep(NA, NN) e <- d + a + b f <- d + a + cc for (i in 1:NN) dens[i] <- logadd(c(e[i], f[i])) } return(dens) } rnormlaplace <- function(n, mu=0, sigma=1, alpha=1, beta=1) { z <- rnorm(n, 0, sigma^2) w <- rslaplace(n, mu, 1/beta, 1/alpha) return(z + w) } ########################################################################### # Normal-Wishart Distribution # ########################################################################### dnormwishart <- function(mu, mu0, lambda, Omega, S, nu, log=FALSE) { dens <- dwishart(Omega, nu, S, log=TRUE) + dmvnp(mu, mu0, lambda*Omega, log=TRUE) if(log == FALSE) dens <- exp(dens) return(dens) } rnormwishart <- function(n=1, mu0, lambda, S, nu) { Omega <- rwishart(nu, S) mu <- rmvn(n, mu0, as.inverse(lambda*Omega)) return(list(mu=mu, Omega=Omega)) } ########################################################################### # Pareto Distribution # ########################################################################### dpareto <- function(x, alpha, log=FALSE) { x <- as.vector(x); alpha <- as.vector(alpha) if(any(alpha <= 0)) stop("The alpha parameter must be positive.") NN <- max(length(x), length(alpha)) x <- dens <- rep(x, len=NN); alpha <- rep(alpha, len=NN) dens[which(x < 1)] <- -Inf temp <- which(x >= 1) dens[temp] <- log(alpha[temp]) - (alpha[temp] + 1)*log(x[temp]) if(log == FALSE) dens <- exp(dens) return(dens) } ppareto <- function(q, alpha) { q <- as.vector(q); alpha <- as.vector(alpha) if(any(alpha <= 0)) stop("The alpha parameter must be positive.") NN <- max(length(q), length(alpha)) p <- q <- rep(q, len=NN); alpha <- rep(alpha, len=NN) p[which(q < 1)] <- 0 temp <- which(q >= 1) p[temp] <- 1 - 1 / q[temp]^alpha[temp] return(p) } qpareto <- function(p, alpha) { p <- as.vector(p); alpha <- as.vector(alpha) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(alpha <= 0)) stop("The alpha parameter must be positive.") NN <- max(length(p), length(alpha)) p <- rep(p, len=NN); alpha <- rep(alpha, len=NN) q <- (1-p)^(-1/alpha) return(q) } rpareto <- function(n, alpha) { alpha <- rep(alpha, len=n) if(any(alpha <= 0)) stop("The alpha parameter must be positive.") x <- runif(n)^(-1/alpha) return(x) } ########################################################################### # Power Exponential Distribution # # # # These functions are similar to those in the normalp package. # ########################################################################### dpe <- function(x, mu=0, sigma=1, kappa=2, log=FALSE) { x <- as.vector(x); mu <- as.vector(mu); sigma <- as.vector(sigma) kappa <- as.vector(kappa) if(any(sigma <= 0)) stop("The sigma parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") NN <- max(length(x), length(mu), length(sigma), length(kappa)) x <- rep(x, len=NN); mu <- rep(mu, len=NN) sigma <- rep(sigma, len=NN); kappa <- rep(kappa, len=NN) cost <- 2 * kappa^(1/kappa) * gamma(1 + 1/kappa) * sigma expon1 <- (abs(x - mu))^kappa expon2 <- kappa * sigma^kappa dens <- log(1/cost) + (-expon1 / expon2) if(log == FALSE) dens <- exp(dens) return(dens) } ppe <- function(q, mu=0, sigma=1, kappa=2, lower.tail=TRUE, log.p=FALSE) { q <- as.vector(q); mu <- as.vector(mu); sigma <- as.vector(sigma) kappa <- as.vector(kappa) if(any(sigma <= 0)) stop("The sigma parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") NN <- max(length(q), length(mu), length(sigma), length(kappa)) q <- rep(q, len=NN); mu <- rep(mu, len=NN) sigma <- rep(sigma, len=NN); kappa <- rep(kappa, len=NN) z <- (q - mu) / sigma zz <- abs(z)^kappa p <- pgamma(zz, shape=1/kappa, scale=kappa) p <- p / 2 temp <- which(z < 0); p[temp] <- 0.5 - p[temp] temp <- which(z >= 0); p[temp] <- 0.5 + p[temp] if(lower.tail == FALSE) p <- 1 - p if(log.p == TRUE) p <- log(p) return(p) } qpe <- function(p, mu=0, sigma=1, kappa=2, lower.tail=TRUE, log.p=FALSE) { p <- as.vector(p); mu <- as.vector(mu); sigma <- as.vector(sigma) kappa <- as.vector(kappa) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(sigma <= 0)) stop("The sigma parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") NN <- max(length(p), length(mu), length(sigma), length(kappa)) p <- rep(p, len=NN); mu <- rep(mu, len=NN) sigma <- rep(sigma, len=NN); kappa <- rep(kappa, len=NN) if(log.p == TRUE) p <- log(p) if(lower.tail == FALSE) p <- 1 - p zp <- 0.5 - p temp <- which(p >= 0.5); zp[temp] <- p[temp] - 0.5 zp <- 2 * zp qg <- qgamma(zp, shape=1/kappa, scale=kappa) z <- qg^(1/kappa) temp <- which(p < 0.5); z[temp] <- -z[temp] q <- mu + z * sigma return(q) } rpe <- function(n, mu=0, sigma=1, kappa=2) { mu <- rep(mu, len=n); sigma <- rep(sigma, len=n) kappa <- rep(kappa, len=n) if(any(sigma <= 0)) stop("The sigma parameter must be positive.") if(any(kappa <= 0)) stop("The kappa parameter must be positive.") qg <- rgamma(n, shape=1/kappa, scale=kappa) z <- qg^(1/kappa) u <- runif(n) temp <- which(u < 0.5); z[temp] <- -z[temp] x <- mu + z * sigma return(x) } ########################################################################### # Scaled Inverse Wishart Distribution # ########################################################################### dsiw <- function(Q, nu, S, zeta, mu, delta, log=FALSE) { dens <- dinvwishart(Q, nu, S, log=TRUE) + sum(dmvn(log(zeta), mu, diag(delta), log=TRUE)) if(log == FALSE) dens <- exp(dens) return(dens) } rsiw <- function(nu, S, mu, delta) { Q <- rinvwishart(nu, S) Zeta <- diag(as.vector(exp(rmvn(1, mu, diag(delta))))) x <- Zeta %*% Q %*% Zeta return(x) } ########################################################################### # Skew Discrete Laplace Distribution # ########################################################################### dsdlaplace <- function(x, p, q, log=FALSE) { if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(q < 0) || any(q > 1)) stop("q must be in [0,1].") NN <- max(length(x), length(p), length(q)) x <- rep(x, len=NN); p <- rep(p, len=NN); q <- rep(q, len=NN) dens <- log(1-p) + log(1-q) - (log(1-p*q) + x*log(p)) temp <- which(x < 0) dens[temp] <- log(1-p[temp]) + log(1-q[temp]) - (log(1-p[temp]*q[temp]) + abs(x[temp])*log(q[temp])) if(log == FALSE) dens <- exp(dens) return(dens) } psdlaplace <- function(x, p, q) { if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(q < 0) || any(q > 1)) stop("q must be in [0,1].") NN <- max(length(x), length(p), length(q)) x <- rep(x, len=NN); p <- rep(p, len=NN); q <- rep(q, len=NN) pr <- 1-(1-q)*p^(floor(x)+1)/(1-p*q) temp <- which(x < 0) pr[temp] <- (1-p[temp])*q[temp]^(-floor(x[temp]))/(1-p[temp]*q[temp]) return(pr) } qsdlaplace <- function(prob, p, q) { if(any(prob < 0) || any(prob > 1)) stop("prob must be in [0,1].") if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(q < 0) || any(q > 1)) stop("q must be in [0,1].") NN <- max(length(prob), length(p), length(q)) prob <- rep(prob, len=NN); p <- rep(p, len=NN); q <- rep(q, len=NN) x <- numeric(NN) for (i in 1:NN) { k <- 0 if(prob[i] >= psdlaplace(k, p[i], q[i])) { while(prob[i] >= psdlaplace(k, p[i], q[i])) { k <- k + 1}} else if(prob[i] < psdlaplace(k, p[i], q[i])) { while(prob[i] < psdlaplace(k, p[i], q[i])) { k <- k - 1} k <- k + 1} x[i] <- k } return(x) } rsdlaplace <- function(n, p, q) { if(length(p) > 1) stop("p must have a length of 1.") if(length(q) > 1) stop("q must have a length of 1.") if((p < 0) || (p > 1)) stop("p must be in [0,1].") if((q < 0) || (q > 1)) stop("q must be in [0,1].") u <- runif(n) return(qsdlaplace(u,p,q)) } ########################################################################### # Skew-Laplace Distribution # ########################################################################### dslaplace <- function(x, mu, alpha, beta, log=FALSE) { x <- as.vector(x); mu <- as.vector(mu) alpha <- as.vector(alpha); beta <- as.vector(beta) if(any(alpha <= 0)) stop("The alpha parameter must be positive.") if(any(beta <= 0)) stop("The beta parameter must be positive.") NN <- max(length(x), length(mu), length(alpha), length(beta)) x <- rep(x, len=NN); mu <- rep(mu, len=NN) alpha <- rep(alpha, len=NN); beta <- rep(beta, len=NN) ab <- alpha + beta dens <- belowMu <- log(1/ab) + ((x - mu)/alpha) aboveMu <- log(1/ab) + ((mu - x)/beta) temp <- which(x > mu); dens[temp] <- aboveMu[temp] if(log == FALSE) dens <- exp(dens) return(dens) } pslaplace <- function(q, mu, alpha, beta) { q <- as.vector(q); mu <- as.vector(mu) alpha <- as.vector(alpha); beta <- as.vector(beta) if(any(alpha <= 0)) stop("The alpha parameter must be positive.") if(any(beta <= 0)) stop("The beta parameter must be positive.") NN <- max(length(q), length(mu), length(alpha), length(beta)) q <- rep(q, len=NN); mu <- rep(mu, len=NN) alpha <- rep(alpha, len=NN); beta <- rep(beta, len=NN) ab <- alpha + beta p <- belowMu <- (alpha/ab) * exp((q - mu)/alpha) aboveMu <- 1 - (beta/ab) * exp((mu - q)/beta) temp <- which(q >= mu); p[temp] <- aboveMu[temp] return(p) } qslaplace <- function(p, mu, alpha, beta) { p <- as.vector(p); mu <- as.vector(mu) alpha <- as.vector(alpha); beta <- as.vector(beta) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(alpha <= 0)) stop("The alpha parameter must be positive.") if(any(beta <= 0)) stop("The beta parameter must be positive.") NN <- max(length(p), length(mu), length(alpha), length(beta)) p <- rep(p, len=NN); mu <- rep(mu, len=NN) alpha <- rep(alpha, len=NN); beta <- rep(beta, len=NN) ab <- alpha + beta q <- belowMu <- alpha*log(p*ab/alpha) + mu aboveMu <- mu - beta*log(ab*(1 - p)/beta) temp <- which(p >= alpha/ab); q[temp] <- aboveMu[temp] return(q) } rslaplace <- function(n, mu, alpha, beta) { if(any(alpha <= 0)) stop("The alpha parameter must be positive.") if(any(beta <= 0)) stop("The beta parameter must be positive.") mu <- rep(mu, len=n) alpha <- rep(alpha, len=n) beta <- rep(beta, len=n) y <- rexp(n, 1) probs <- alpha / (alpha + beta) signs <- runif(n) temp <- which(signs <= probs) signs[temp] <- -1 signs[-temp] <- 1 mult <- signs * beta temp <- which(signs < 0) mult[temp] <- signs[temp] * alpha[temp] x <- mult * y + mu return(x) } ########################################################################### # Stick-Breaking Prior Distribution # ########################################################################### dStick <- function(theta, gamma, log=FALSE) { if(log == FALSE) dens <- prod(dbeta(theta, 1, gamma, log=FALSE)) else dens <- sum(dbeta(theta, 1, gamma, log=TRUE)) return(dens) } rStick <- function(M, gamma) { betas <- rbeta(M+1, 1, gamma) remaining <- c(1, cumprod(1 - betas))[1:(M+1)] w <- remaining * betas w <- w / sum(w) return(w) #return(Stick(rbeta(M,1,gamma))) #Deprecated } ########################################################################### # Student t Distribution (3-parameter) # # # # The pst and qst functions are similar to the TF functions in the # # gamlss.dist package, but dst and rst have been refined. # ########################################################################### dst <- function(x, mu=0, sigma=1, nu=10, log=FALSE) { x <- as.vector(x); mu <- as.vector(mu) sigma <- as.vector(sigma); nu <- as.vector(nu) if(any(sigma <= 0)) stop("The sigma parameter must be positive.") else if(any(nu <= 0)) stop("The nu parameter must be positive.") NN <- max(length(x), length(mu), length(sigma), length(nu)) x <- rep(x, len=NN); mu <- rep(mu, len=NN) sigma <- rep(sigma, len=NN); nu <- rep(nu, len=NN) const <- lgamma((nu+1)/2) - lgamma(nu/2) - log(sqrt(pi*nu) * sigma) dens <- const + log((1 + (1/nu)*((x-mu)/sigma)^2)^(-(nu+1)/2)) if(log == FALSE) dens <- exp(dens) return(dens) #return({1/sigma} * dt({x-mu}/sigma, df=nu, log)) #Deprecated } pst <- function(q, mu=0, sigma=1, nu=10, lower.tail=TRUE, log.p=FALSE) { q <- as.vector(q); mu <- as.vector(mu) sigma <- as.vector(sigma); nu <- as.vector(nu) if(any(sigma <= 0)) stop("The sigma parameter must be positive.") if(any(nu <= 0)) stop("The nu parameter must be positive.") NN <- max(length(q), length(mu), length(sigma), length(nu)) q <- rep(q, len=NN); mu <- rep(mu, len=NN) sigma <- rep(sigma, len=NN); nu <- rep(nu, len=NN) p <- pt({q-mu}/sigma, df=nu, lower.tail=lower.tail, log.p=log.p) temp <- which(nu > 1e6) p[temp] <- pnorm(q[temp], mu[temp], sigma[temp], lower.tail=lower.tail, log.p=log.p) return(p) } qst <- function(p, mu=0, sigma=1, nu=10, lower.tail=TRUE, log.p=FALSE) { p <- as.vector(p); mu <- as.vector(mu) sigma <- as.vector(sigma); nu <- as.vector(nu) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(sigma <= 0)) stop("The sigma parameter must be positive.") if(any(nu <= 0)) stop("The nu parameter must be positive.") NN <- max(length(p), length(mu), length(sigma), length(nu)) p <- rep(p, len=NN); mu <- rep(mu, len=NN) sigma <- rep(sigma, len=NN); nu <- rep(nu, len=NN) q <- mu + sigma * qt(p, df=nu, lower.tail=lower.tail) temp <- which(nu > 1e6) q[temp] <- qnorm(p[temp], mu[temp], sigma[temp], lower.tail=lower.tail, log.p=log.p) return(q) } rst <- function(n, mu=0, sigma=1, nu=10) { mu <- rep(mu, len=n); sigma <- rep(sigma, len=n); nu <- rep(nu, len=n) if(any(sigma <= 0)) stop("The sigma parameter must be positive.") if(any(nu <= 0)) stop("The nu parameter must be positive.") n <- ceiling(n) y <- rnorm(n) z <- rchisq(n, nu) x <- mu + sigma*y*sqrt(nu/z) return(x) } ########################################################################### # Student t Distribution (Precision Parameterization) # ########################################################################### dstp <- function(x, mu=0, tau=1, nu=10, log=FALSE) { x <- as.vector(x); mu <- as.vector(mu) tau <- as.vector(tau); nu <- as.vector(nu) if(any(tau <= 0)) stop("The tau parameter must be positive.") if(any(nu <= 0)) stop("The nu parameter must be positive.") NN <- max(length(x), length(mu), length(tau), length(nu)) x <- rep(x, len=NN); mu <- rep(mu, len=NN) tau <- rep(tau, len=NN); nu <- rep(nu, len=NN) dens <- (lgamma((nu+1)/2) - lgamma(nu/2)) + 0.5*log(tau/(nu*pi)) + (-(nu+1)/2)*log(1 + (tau/nu)*(x-mu)^2) temp <- which(nu > 1e6) dens[temp] <- dnorm(x[temp], mu[temp], sqrt(1/tau[temp]), log=TRUE) if(log == FALSE) dens <- exp(dens) return(dens) } pstp <- function(q, mu=0, tau=1, nu=10, lower.tail=TRUE, log.p=FALSE) { q <- as.vector(q); mu <- as.vector(mu) tau <- as.vector(tau); nu <- as.vector(nu) if(any(tau <= 0)) stop("The tau parameter must be positive.") if(any(nu <= 0)) stop("The nu parameter must be positive.") NN <- max(length(q), length(mu), length(tau), length(nu)) q <- rep(q, len=NN); mu <- rep(mu, len=NN) tau <- rep(tau, len=NN); nu <- rep(nu, len=NN) p <- pst(q, mu, sqrt(1/tau), nu, lower.tail, log.p) return(p) } qstp <- function(p, mu=0, tau=1, nu=10, lower.tail=TRUE, log.p=FALSE) { p <- as.vector(p); mu <- as.vector(mu) tau <- as.vector(tau); nu <- as.vector(nu) if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(any(tau <= 0)) stop("The tau parameter must be positive.") if(any(nu <= 0)) stop("The nu parameter must be positive.") NN <- max(length(p), length(mu), length(tau), length(nu)) p <- rep(p, len=NN); mu <- rep(mu, len=NN) tau <- rep(tau, len=NN); nu <- rep(nu, len=NN) q <- qst(p, mu, sqrt(1/tau), nu, lower.tail, log.p) return(q) } rstp <- function(n, mu=0, tau=1, nu=10) { mu <- rep(mu, len=n); tau <- rep(tau, len=n); nu <- rep(nu, len=n) if(any(tau <= 0)) stop("The tau parameter must be positive.") if(any(nu <= 0)) stop("The nu parameter must be positive.") x <- rst(n, mu, sqrt(1/tau), nu) n <- ceiling(n) p <- runif(n) x <- qst(p, mu=mu, sqrt(1/tau), nu=nu) return(x) } ########################################################################### # Truncated Distribution # # # # These functions are similar to those from Nadarajah, S. and Kotz, S. # # (2006). ``R Programs for Computing Truncated Distributions''. Journal # # of Statistical Software, 16, Code Snippet 2, 1-8. These functions have # # been corrected to work with log-densities. # ########################################################################### dtrunc <- function(x, spec, a=-Inf, b=Inf, log=FALSE, ...) { if(a >= b) stop("Lower bound a is not less than upper bound b.") if(any(x < a) | any(x > b)) stop("At least one instance of (x < a) or (x > b) found.") dens <- rep(0, length(x)) g <- get(paste("d", spec, sep=""), mode="function") G <- get(paste("p", spec, sep=""), mode="function") if(log == TRUE) { dens <- g(x, log=TRUE, ...) - log(G(b, ...) - G(a, ...)) } else { dens <- g(x, ...) / (G(b, ...) - G(a, ...))} return(dens) } extrunc <- function(spec, a=-Inf, b=Inf, ...) { f <- function(x) x * dtrunc(x, spec, a=a, b=b, log=FALSE, ...) return(integrate(f, lower=a, upper=b)$value) } ptrunc <- function(x, spec, a=-Inf, b=Inf, ...) { if(a >= b) stop("Lower bound a is not less than upper bound b.") if(any(x < a) | any(x > b)) stop("At least one instance of (x < a) or (x > b) found.") p <- x aa <- rep(a, length(x)) bb <- rep(b, length(x)) G <- get(paste("p", spec, sep=""), mode="function") p <- G(apply(cbind(apply(cbind(x, bb), 1, min), aa), 1, max), ...) p <- p - G(aa, ...) p <- p / {G(bb, ...) - G(aa, ...)} return(p) } qtrunc <- function(p, spec, a=-Inf, b=Inf, ...) { if(any(p < 0) || any(p > 1)) stop("p must be in [0,1].") if(a >= b) stop("Lower bound a is not less than upper bound b.") q <- p G <- get(paste("p", spec, sep=""), mode="function") Gin <- get(paste("q", spec, sep=""), mode="function") q <- Gin(G(a, ...) + p*{G(b, ...) - G(a, ...)}, ...) return(q) } rtrunc <- function(n, spec, a=-Inf, b=Inf, ...) { if(a >= b) stop("Lower bound a is not less than upper bound b.") x <- u <- runif(n) x <- qtrunc(u, spec, a=a, b=b,...) return(x) } vartrunc <- function(spec, a=-Inf, b=Inf, ...) { ex <- extrunc(spec, a=a, b=b, ...) f <- function(x) { {x - ex}^2 * dtrunc(x, spec, a=a, b=b, log=FALSE, ...)} sigma2 <- integrate(f, lower=a, upper=b)$value return(sigma2) } ########################################################################### # Wishart Distribution # ########################################################################### dwishart <- function(Omega, nu, S, log=FALSE) { if(!is.matrix(Omega)) Omega <- matrix(Omega) if(!is.positive.definite(Omega)) stop("Matrix Omega is not positive-definite.") if(!is.matrix(S)) S <- matrix(S) if(!is.positive.semidefinite(S)) stop("Matrix S is not positive-semidefinite.") if(!identical(dim(Omega), dim(S))) stop("The dimensions of Omega and S differ.") if(nu < nrow(S)) stop("The nu parameter is less than the dimension of S.") k <- nrow(Omega) gamsum <- 0 for (i in 1:k) {gamsum <- gamsum + lgamma((nu + 1 - i)/2)} dens <- -((nu*k)/2) * log(2) - ((k*(k - 1))/4) * log(pi) - gamsum - (nu/2) * log(det(S)) + ((nu - k - 1)/2) * logdet(Omega) - (tr(as.inverse(S) %*% Omega)/2) if(log == FALSE) dens <- exp(dens) return(dens) } rwishart <- function(nu, S) { if(!is.matrix(S)) S <- matrix(S) if(!is.positive.semidefinite(S)) stop("Matrix S is not positive-semidefinite.") if(nu < nrow(S)) stop("The nu parameter is less than the dimension of S.") k <- nrow(S) Z <- matrix(0, k, k) x <- rchisq(k, nu:{nu - k + 1}) x[which(x == 0)] <- 1e-100 diag(Z) <- sqrt(x) if(k > 1) { kseq <- 1:(k-1) Z[rep(k*kseq, kseq) + unlist(lapply(kseq, seq))] <- rnorm(k*{k - 1}/2)} return(crossprod(Z %*% chol(S))) } ########################################################################### # Wishart Distribution (Cholesky Parameterization) # ########################################################################### dwishartc <- function(U, nu, S, log=FALSE) { if(missing(U)) stop("Upper triangular U is required.") Omega <- t(U) %*% U if(!is.matrix(S)) S <- matrix(S) if(!is.positive.semidefinite(S)) stop("Matrix S is not positive-semidefinite.") if(!identical(dim(Omega), dim(S))) stop("The dimensions of Omega and S differ.") if(nu < nrow(S)) stop("The nu parameter is less than the dimension of S.") k <- nrow(Omega) gamsum <- 0 for (i in 1:k) {gamsum <- gamsum + lgamma((nu + 1 - i)/2)} dens <- -((nu*k)/2) * log(2) - ((k*(k - 1))/4) * log(pi) - gamsum - (nu/2) * log(det(S)) + ((nu - k - 1)/2) * logdet(Omega) - (tr(as.inverse(S) %*% Omega)/2) if(log == FALSE) dens <- exp(dens) return(dens) } rwishartc <- function(nu, S) { if(!is.matrix(S)) S <- matrix(S) if(!is.positive.semidefinite(S)) stop("Matrix S is not positive-semidefinite.") if(nu < nrow(S)) { stop("The nu parameter is less than the dimension of S.")} k <- nrow(S) Z <- matrix(0, k, k) x <- rchisq(k, nu:{nu - k + 1}) x[which(x == 0)] <- 1e-100 diag(Z) <- sqrt(x) if(k > 1) { kseq <- 1:(k-1) Z[rep(k*kseq, kseq) + unlist(lapply(kseq, seq))] <- rnorm(k*{k - 1}/2)} return(Z %*% chol(S)) } ########################################################################### # Yang-Berger Distribution # ########################################################################### dyangberger <- function(x, log=FALSE) { if(missing(x)) stop("Matrix x is a required argument.") if(!is.matrix(x)) x <- as.matrix(x) x <- as.symmetric.matrix(x) if(!is.positive.definite(x)) stop("Matrix x is not positive-definite.") d <- sort(eigen(x)$values) dens <- log(1) - logdet(x) * prod(diff(d)) if(log == FALSE) dens <- exp(dens) return(dens) } dyangbergerc <- function(x, log=FALSE) { if(missing(x)) stop("Upper triangular matrix x is a required argument.") if(!is.matrix(x)) x <- as.matrix(x) x <- t(x) %*% x d <- sort(eigen(x)$values) dens <- log(1) - logdet(x) * prod(diff(d)) if(log == FALSE) dens <- exp(dens) return(dens) } ########################################################################### # Zellner's g-Prior # ########################################################################### dhyperg <- function(g, alpha=3, log=FALSE) { if(g <= 0) stop("The g parameter must be positive.") if(alpha <= 0) stop("The alpha parameter must be positive.") dens <- log((alpha - 2)/2) -(alpha/2)*log(1 + g) if(log == FALSE) dens <- exp(dens) return(dens) } dzellner <- function(beta, g, sigma, X, log=FALSE) { if(g <= 0) stop("The g parameter must be positive.") if(sigma <= 0) stop("The sigma parameter must be positive.") ## HS (01/2020): The original formulation was: ### g*sigma*sigma* as.inverse(t(X) %*% X) ### the latter bit is equivalent to: solve(crossprod(X)) ### which should be equivalent to the more stable and accurate ### chol2inv(qr.R(qr(X))) ## see: strucchange::solveCrossprod dens <- dmvn(beta, rep(0, length(beta)), g*sigma*sigma*chol2inv(qr.R(qr(X))), log=log) return(dens) } rzellner <- function(n, g, sigma, X) { x <- rmvn(n, rep(0, ncol(X)), g*sigma*sigma*chol2inv(qr.R(qr(X)))) return(x) } #End LaplacesDemon/R/predict.pmc.R0000755000176200001440000000615115144316355015532 0ustar liggesusers########################################################################### # predict.pmc # # # # The purpose of the predict.pmc function is to predict y[new] or y[rep], # # and later provide posterior predictive checks for objects of class pmc. # ########################################################################### predict.pmc <- function(object, Model, Data, CPUs=1, Type="PSOCK", ...) { ### Initial Checks if(missing(object)) stop("The object argument is required.") if(missing(Model)) stop("The Model argument is required.") if(missing(Data)) stop("The Data argument is required.") if(is.null(Data[["y"]]) & is.null(Data[["Y"]])) stop("Data must have y or Y.") if(!is.null(Data[["y"]])) y <- as.vector(Data[["y"]]) if(!is.null(Data[["Y"]])) y <- as.vector(Data[["Y"]]) CPUs <- abs(round(CPUs)) ### p(y[rep] | y) post <- as.matrix(object$Posterior2) Dev <- rep(NA, nrow(post)) yhat <- matrix(NA, length(y), nrow(post)) lengthcomp <- as.vector(Model(post[1,], Data)[["yhat"]]) if(!identical(length(lengthcomp), length(y))) stop("y and yhat differ in length.") ### Non-Parallel Processing if(CPUs == 1) { for (i in 1:nrow(post)) { mod <- Model(post[i,], Data) Dev[i] <- as.vector(mod[["Dev"]]) yhat[,i] <- as.vector(mod[["yhat"]])} } else { ### Parallel Processing detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cl <- makeCluster(CPUs, Type) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) mod <- parLapply(cl, 1:nrow(post), function(x) Model(post[x,], Data)) stopCluster(cl) Dev <- unlist(lapply(mod, function(x) x[["Dev"]]))[1:nrow(post)] yhat <- matrix(unlist(lapply(mod, function(x) x[["yhat"]])), length(y), nrow(post)) rm(mod)} ### Warnings if(any(is.na(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.na(yhat)), " missing values.\n") if(any(is.nan(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.nan(yhat)), " non-numeric (NaN) values.\n") if(any(is.infinite(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.infinite(yhat)), " infinite values.\n") if(any(!is.finite(Dev))) cat("\nWARNING: Deviance has non-finite values.") ### Create Output predicted <- list(y=y, yhat=yhat, Deviance=Dev) class(predicted) <- "pmc.ppc" return(predicted) } #End LaplacesDemon/R/predict.vb.R0000755000176200001440000000725015144316355015363 0ustar liggesusers########################################################################### # predict.vb # # # # The purpose of the predict.vb function is to predict y[new] or y[rep], # # and later provide posterior predictive checks for objects of class vb. # ########################################################################### predict.vb <- function(object, Model, Data, CPUs=1, Type="PSOCK", ...) { ### Initial Checks if(missing(object)) stop("The object argument is required.") if(object$Converged == FALSE) stop("VariationalBayes did not converge.") if(missing(Model)) stop("The Model argument is required.") if(missing(Data)) stop("The Data argument is required.") if(is.null(Data[["y"]]) & is.null(Data[["Y"]])) stop("Data must have y or Y.") if(!is.null(Data[["y"]])) y <- as.vector(Data[["y"]]) if(!is.null(Data[["Y"]])) y <- as.vector(Data[["Y"]]) CPUs <- abs(round(CPUs)) ### p(y[rep] | y), Deviance, and Monitors Dev <- rep(NA, nrow(object$Posterior)) monitor <- matrix(NA, length(Data[["mon.names"]]), nrow(object$Posterior)) lengthcomp <- as.vector(Model(object$Posterior[1,], Data)[["yhat"]]) if(!identical(length(lengthcomp), length(y))) stop("y and yhat differ in length.") yhat <- matrix(NA, length(y), nrow(object$Posterior)) ### Non-Parallel Processing if(CPUs == 1) { for (i in 1:nrow(object$Posterior)) { mod <- Model(object$Posterior[i,], Data) Dev[i] <- as.vector(mod[["Dev"]]) monitor[,i] <- as.vector(mod[["Monitor"]]) yhat[,i] <- as.vector(mod[["yhat"]])} } else { ### Parallel Processing detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) cat("\n\nCPUs Detected:", detectedCores, "\n") if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n") CPUs <- detectedCores} cl <- makeCluster(CPUs, Type) varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) mod <- parLapply(cl, 1:nrow(object$Posterior), function(x) Model(object$Posterior[x,], Data)) stopCluster(cl) Dev <- unlist(lapply(mod, function(x) x[["Dev"]]))[1:nrow(object$Posterior)] monitor <- matrix(unlist(lapply(mod, function(x) x[["Monitor"]])), length(Data[["mon.names"]]), nrow(object$Posterior)) yhat <- matrix(unlist(lapply(mod, function(x) x[["yhat"]])), length(y), nrow(object$Posterior)) rm(mod)} rownames(monitor) <- Data[["mon.names"]] ### Warnings if(any(is.na(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.na(yhat)), " missing values.") if(any(is.nan(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.nan(yhat)), " non-numeric (NaN) values.") if(any(is.infinite(yhat))) cat("\nWARNING: Output matrix yhat has ", sum(is.infinite(yhat)), " infinite values.") if(any(!is.finite(Dev))) cat("\nWARNING: Deviance has non-finite values.") ### Create Output predicted <- list(y=y, yhat=yhat, Deviance=Dev, monitor=monitor) class(predicted) <- "vb.ppc" return(predicted) } #End LaplacesDemon/R/Thin.R0000755000176200001440000000141615144316355014223 0ustar liggesusers########################################################################### # Thin # # # # The purpose of the Thin function is to facilitate the thinning of a # # matrix of posterior samples. # ########################################################################### Thin <- function(x, By=1) { ### Initial Checks if(!is.matrix(x)) x <- as.matrix(x) rownum <- nrow(x) By <- abs(round(By)) if(By > rownum) stop("By exceeds number of rows in x.") ### Thin keeprows <- which(rep(1:By, len=rownum) == By) z <- x[keeprows,] return(z) } #End LaplacesDemon/R/as.covar.R0000755000176200001440000000461115144316355015035 0ustar liggesusers########################################################################### # as.covar # # # # The purpose of the as.covar function is to retrieve the covariance # # matrix from an object of class demonoid, demonoid.hpc, iterquad, # # laplace, pmc, or vb, or in the case of an object of class pmc with # # mixture components, to retrieve multiple covariance matrices. # ########################################################################### as.covar <- function(x) { if(!identical(class(x), "demonoid") & !identical(class(x), "demonoid.hpc") & !identical(class(x), "iterquad") & !identical(class(x), "laplace") & !identical(class(x), "pmc") & !identical(class(x), "vb")) stop("The class of x is unknown.") if(identical(class(x), "demonoid")) { if(is.matrix(x$Covar)) { covar <- x$Covar } else if(is.vector(x$Covar)) { covar <- diag(length(x$Covar)) diag(covar) <- x$Covar } else { covar <- x$Covar if(is.list(x$Covar)) cat("\nThe covariance matrix is blocked.\n") } } else if(identical(class(x), "demonoid.hpc")) { Chains <- length(x) Deviance <- list() for (i in 1:Chains) {Deviance[[i]] <- x[[i]][["Deviance"]]} j <- which.min(sapply(Deviance, function(x) {min(x[length(x)])})) cat("\nChain",j,"has the lowest deviance.\n") if(is.matrix(x[[j]]$Covar)) { covar <- x[[j]]$Covar } else if(is.vector(x$Covar)) { covar <- diag(length(x$Covar)) diag(covar) <- x$Covar } else { covar <- x$Covar if(is.list(x$Covar)) cat("\nThe covariance matrix is blocked.\n") } } else if(identical(class(x), "iterquad")) covar <- x$Covar else if(identical(class(x), "laplace")) covar <- x$Covar else if(identical(class(x), "vb")) covar <- x$Covar else covar <- x$Covar[,,x$Iterations,] return(covar) } #End LaplacesDemon/R/plot.bmk.R0000755000176200001440000000516615144316355015055 0ustar liggesusers########################################################################### # plot.bmk # # # # The purpose of the plot.bmk function is to plot an object of class bmk. # ########################################################################### plot.bmk <- function(x, col=colorRampPalette(c("black","red"))(100), title="", PDF=FALSE, Parms=NULL, ...) { ### Initial Checks if(missing(x)) stop("x is a required argument.") if(!identical(class(x), "bmk")) stop("x must be an object of class bmk.") ### Selecting Parms if(!is.null(Parms)) { Parms <- sub("\\[","\\\\[",Parms) Parms <- sub("\\]","\\\\]",Parms) Parms <- sub("\\.","\\\\.",Parms) if(length(grep(Parms[1], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- grep(Parms[1], rownames(x)) if(length(Parms) > 1) { for (i in 2:length(Parms)) { if(length(grep(Parms[i], rownames(x))) == 0) stop("Parameter in Parms does not exist.") keeprows <- c(keeprows, grep(Parms[i], rownames(x)))}} x.temp <- as.matrix(x[keeprows,]) rownames(x.temp) <- rownames(x)[keeprows] x <- x.temp rm(x.temp)} ### Initial Settings min <- 0 max <- 1 if(is.null(rownames(x))) xLabels <- 1:nrow(x) else xLabels <- colnames(x) if(is.null(colnames(x))) yLabels <- 1:ncol(x) else yLabels <- rownames(x) ### plot.bmk if(PDF == TRUE) pdf("plot.bmk.pdf") ### Layout and Colors layout(matrix(data=c(1,2), nrow=1, ncol=2), widths=c(4,1), heights=c(1,1)) ColorRamp <- col ColorLevels <- seq(min, max, length=length(ColorRamp)) ### Reverse y-axis reverse <- nrow(x):1 yLabels <- yLabels[reverse] x <- x[reverse,] ### Data Map par(mar = c(3,5,2.5,2)) image(1:length(xLabels), 1:length(yLabels), t(x), col=ColorRamp, xlab="", ylab="", axes=FALSE, zlim=c(min,max)) if(!is.null(title)) title(main=title) axis(BELOW<-1, at=1:length(xLabels), labels=xLabels, cex.axis=0.7) axis(LEFT <-2, at=1:length(yLabels), labels=yLabels, las=HORIZONTAL<-1, cex.axis=0.7) par(mar=c(3,2.5,2.5,2)) image(1, ColorLevels, matrix(data=ColorLevels, ncol=length(ColorLevels), nrow=1), col=ColorRamp, xlab="", ylab="", xaxt="n") layout(1) if(PDF == TRUE) dev.off() } #End LaplacesDemon/R/is.bayesian.R0000755000176200001440000000160715144316355015530 0ustar liggesusers########################################################################### # is.bayesian # # # # The purpose of the is.bayesian function is to determine whether or not # # a model is Bayesian by comparing the log-posterior (LP) and the LL. # ########################################################################### is.bayesian <- function(Model, Initial.Values, Data) { if(missing(Model)) stop("The Model argument is required.") if(missing(Initial.Values)) stop("The Initial.Values argument is required.") if(missing(Data)) stop("The Data argument is required.") bayesian <- FALSE Mo <- Model(Initial.Values, Data) LL <- Mo[["Dev"]] / -2 if(Mo[["LP"]] != LL) bayesian <- TRUE return(bayesian) } #End LaplacesDemon/R/de.Finetti.Game.R0000755000176200001440000000317215144316355016163 0ustar liggesusers########################################################################### # de.Finetti.Game # # # # The purpose of the de.Finetti.Game function is to elicit the interval # # of a subjective probability about a possible event in the near future. # ########################################################################### de.Finetti.Game <- function(width) { if(missing(width)) stop("The width argument is required.") if((width <= 0) | (width > 1)) stop("The width argument is incoherent.") ques <- paste("\nDescribe a possible event in the near", "future (such as ``rain tomorrow''): ") event <- readline(ques) region <- c(0,1) while((region[2] - region[1]) > width) { x <- round(mean(region) * 100) y <- 100 - x cat("\nYou have two options:") cat("\n\n1.Wait and receive $1 if the event happens.") cat("\n2.Draw a marble from an urn with", x, "black marbles and", y, "white marbles. Drawing a black", "marble results in receiving $1.") ans <- readline("\n\nChoose 1 or 2: ") if(ans == 1) region[1] <- x / 100 else if(ans == 2) region[2] <- x / 100 else region <- c(0,0) } if(sum(region) == 0) cat("\nTry again. Valid answers are 1 or 2.") else {cat("\n\nYour subjective probability is in the interval [", region[1], ",", region[2], "] regarding ", event, ".\n\n", sep="")} return(region) } #End LaplacesDemon/R/is.stationary.R0000755000176200001440000000300015144316355016117 0ustar liggesusers########################################################################### # is.stationary # # # # The purpose of the is.stationary function is to provide a logical test # # regarding whether or not a vector, matrix, or demonoid object is # # stationary. The Geweke.Diagnostic function is used. # ########################################################################### is.stationary <- function(x) { if(missing(x)) stop("The x argument is required.") stationary <- FALSE if(is.vector(x)) { if(is.constant(x)) return(TRUE) options(warn=-1) test <- try(as.vector(Geweke.Diagnostic(x)), silent=TRUE) options(warn=0) if(!inherits(test, "try-error") & is.finite(test)) if((test > -2) & (test < 2)) stationarity <- TRUE } else if(is.matrix(x)) { options(warn=-1) test <- try(as.vector(Geweke.Diagnostic(x)), silent=TRUE) options(warn=0) if(!inherits(test, "try-error") & all(is.finite(test))) if(all(test > -2) & all(test < 2)) stationary <- TRUE } else if(identical(class(x), "demonoid")) { if(x$Rec.BurnIn.Thinned < nrow(x$Posterior1)) stationary <- TRUE} else if(identical(class(x), "laplace")) { warning("x is an object of class laplace.") stationary <- TRUE} else warning("x is an unrecognized object.") return(stationary) } #End LaplacesDemon/R/burnin.R0000755000176200001440000000373215144316355014621 0ustar liggesusers########################################################################### # burnin # # # # The purpose of the burnin function is to estimate the duration of # # burn-in in iterations for one or more MCMC chains. # ########################################################################### burnin <- function(x, method="BMK") { if(missing(x)) stop("The x argument is required.") if(is.vector(x)) x <- matrix(x, length(x), 1) n <- nrow(x) burn <- rep(0,ncol(x)) if(method == "BMK") { if(n %% 10 == 0) x2 <- x if(n %% 10 != 0) x2 <- x[1:(10*trunc(n/10)),] HD <- BMK.Diagnostic(x2, 10) Ind <- 1 * (HD > 0.5) burn <- n batch.list <- seq(from=1, to=nrow(x2), by=floor(nrow(x2)/10)) for (i in 1:9) { if(sum(Ind[,i:9]) == 0) { burn <- batch.list[i] - 1 break } } } else { for (i in 1:ncol(x)) { iter <- 1 stationary <- 0 jump <- round(n/10) while(stationary == 0) { if(method == "KS") { p <- KS.Diagnostic(x[iter:n]) if(p <= 0.05) stationary <- 1} else { #method == Geweke z <- try(Geweke.Diagnostic(x[iter:n]), silent=TRUE) if(inherits(z, "try-error")) z <- 3 if(abs(z < 2)) stationary <- 1} if(stationary == 0) iter <- iter + jump if(iter >= n) stationary <- 1} if(iter > 1) iter <- iter - 1 if(iter > n) iter <- n burn[i] <- iter } } return(burn) } #End LaplacesDemon/R/LaplacesDemon.hpc.R0000755000176200001440000001167615144316355016612 0ustar liggesusers########################################################################### # LaplacesDemon.hpc # # # # The purpose of the LaplacesDemon.hpc function is to extend # # LaplacesDemon to parallel processing on multiple cores. # ########################################################################### #I don't know how to 'shut up' the makeCluster function... #no luck with capture.output, sink, or invisible LaplacesDemon.hpc <- function(Model, Data, Initial.Values, Covar=NULL, Iterations=10000, Status=100, Thinning=10, Algorithm="MWG", Specs=list(B=NULL), Debug=list(DB.chol=FALSE, DB.eigen=FALSE, DB.MCSE=FALSE, DB.Model=TRUE), LogFile="", Chains=2, CPUs=2, Type="PSOCK", Packages=NULL, Dyn.libs=NULL) { detectedCores <- max(detectCores(), as.integer(Sys.getenv("NSLOTS")), na.rm=TRUE) cat("\n\nCPUs Detected:", detectedCores, "\n", file=LogFile, append=TRUE) if(CPUs > detectedCores) { cat("\nOnly", detectedCores, "will be used.\n", file=LogFile, append=TRUE) CPUs <- detectedCores} if(is.vector(Initial.Values)) { Initial.Values <- matrix(Initial.Values, Chains, length(Initial.Values), byrow=TRUE) cat("\nWarning: initial values were a vector, and are now a", file=LogFile, append=TRUE) cat("\n", Chains, "x", length(Initial.Values), "matrix.\n", file=LogFile, append=TRUE)} if(Algorithm == "INCA" && Chains != CPUs) { Chains <- CPUs cat("\nINCA:", Chains, "chains will be used\n")} cat("\nLaplace's Demon is preparing environments for CPUs...", file=LogFile, append=TRUE) cat("\n##################################################\n", file=LogFile, append=TRUE) cl <- makeCluster(CPUs, Type) cat("\n##################################################\n", file=LogFile, append=TRUE) on.exit({stopCluster(cl); cat("\n\nLaplace's Demon has finished.\n", file=LogFile, append=TRUE)}) Packages <- c(Packages, "LaplacesDemon") varlist <- unique(c(ls(), ls(envir=.GlobalEnv), ls(envir=parent.env(environment())))) clusterExport(cl, varlist=varlist, envir=environment()) clusterSetRNGStream(cl) wd <- getwd() clusterExport(cl, varlist=c("Packages", "Dyn.libs", "wd"), envir=environment()) demon.wrapper <- function(x, ...) { if(!is.null(Packages)) { sapply(Packages, function(x) library(x, character.only=TRUE, quietly=TRUE))} if(!is.null(Dyn.libs)) { sapply(Dyn.libs, function(x) dyn.load(paste(wd, x, sep = "/"))) on.exit(sapply(Dyn.libs, function(x) dyn.unload(paste(wd, x, sep = "/"))))} LaplacesDemon(Model, Data, Initial.Values[x,], Covar, Iterations, Status, Thinning, Algorithm, Specs, Debug, LogFile=paste(LogFile, ".", x, sep="")) } cat("\nStatus messages are not displayed for parallel processing.", file=LogFile, append=TRUE) cat("\nLaplace's Demon is beginning parallelization...\n", file=LogFile, append=TRUE) if(Algorithm == "INCA") { ### Start hpc server system(paste("Rscript -e 'library(parallel);library(LaplacesDemon);server_Listening(n=",CPUs,")'", sep=""), wait=FALSE) cat("Start hpc server...\n", file=LogFile, append=TRUE) ### Export chain number clusterExport(cl, varlist="Chains", envir=environment()) ### Connect each process to server_Listening with 0.5s time delay clusterEvalQ(cl, con <- NULL) doCon <- function(i) { Sys.sleep(i/2) con <<- socketConnection("localhost", 19009, blocking=TRUE, open="r+")} clusterExport(cl, varlist="doCon", envir=environment()) expr <- NULL for (i in 1:CPUs) { tmp <- parse(text=paste("doCon(", i,")", sep="")) expr <- c(expr, tmp)} clusterApply(cl, expr, eval, env=.GlobalEnv) cat("\nOpen connections to hpc server...", file=LogFile, append=TRUE)} LaplacesDemon.out <- clusterApply(cl, 1:Chains, demon.wrapper, Model, Data, Initial.Values, Covar, Iterations, Status, Thinning, Algorithm, Specs, Debug) class(LaplacesDemon.out) <- "demonoid.hpc" if(Algorithm == "INCA") { ### Stop server_Listening clusterEvalQ(cl, {close(con)}) cat("\nClose connections to hpc server...", file=LogFile, append=TRUE) } return(LaplacesDemon.out) } #End LaplacesDemon/R/p.interval.R0000755000176200001440000002063115144316355015403 0ustar liggesusers########################################################################### # p.interval # # # # The purpose of the p.interval function is to estimate either a # # quantile-based probability interval, uni-modal highest posterior # # density (HPD) interval, or multi-modal HPD intervals of posterior # # samples. The code for the uni-modal HPD interval is similar to code in # # the coda package, but this is designed to work with matrices or objects # # of class demonoid, iterquad, laplace, or pmc. # ########################################################################### p.interval <- function(obj, HPD=TRUE, MM=TRUE, prob=0.95, plot=FALSE, PDF=FALSE, ...) { ### Initial Checks if(missing(obj)) stop("The obj argument is required.") if(length(prob) > 1) stop("The prob argument must be a scalar.") if((prob <= 0) | (prob >= 1)) stop("The prob argument must be in the interval (0,1).") if(identical(class(obj), "demonoid")) { thin <- obj$Rec.BurnIn.Thinned n <- nrow(obj$Posterior1) if(thin < nrow(obj$Posterior1)) x <- cbind(obj$Posterior1[thin:n,], obj$Monitor[thin:n,]) if(thin >= nrow(obj$Posterior1)) x <- cbind(obj$Posterior1, obj$Monitor) colnames(x) <- c(colnames(obj$Posterior1), colnames(obj$Monitor)) obj <- x } else if(identical(class(obj), "iterquad")) { if(any(is.na(obj$Posterior))) stop("Posterior samples do not exist in obj.") obj <- obj$Posterior } else if(identical(class(obj), "laplace")) { if(any(is.na(obj$Posterior))) stop("Posterior samples do not exist in obj.") obj <- obj$Posterior } else if(identical(class(obj), "pmc")) { x <- cbind(obj$Posterior2, obj$Monitor) colnames(x) <- c(colnames(obj$Posterior2), colnames(obj$Monitor)) obj <- x } else { x <- as.matrix(obj) oname <- deparse(substitute(obj)) colnames(x) <- colnames(obj)#oname obj <- x } if(any(!is.finite(obj))) stop("The obj argument must contain finite values.") if(any(apply(obj, 2, is.constant))) stop("The obj argument has insufficient length.") ### Probability Intervals if(HPD == TRUE) { vals <- apply(obj, 2, sort) if(!is.matrix(vals)) stop("obj must have nsamp > 1.") nsamp <- nrow(vals) npar <- ncol(vals) gap <- max(1, min(nsamp - 1, round(nsamp * prob))) init <- 1:(nsamp - gap) inds <- apply(vals[init + gap, , drop=FALSE] - vals[init, , drop=FALSE], 2, which.min) ans <- cbind(vals[cbind(inds, 1:npar)], vals[cbind(inds + gap, 1:npar)]) dimnames(ans) <- list(colnames(obj), c("Lower", "Upper")) attr(ans, "Probability.Interval") <- gap / nsamp } if(HPD == FALSE) { ans <- apply(obj, 2, quantile, probs=c((1-prob)/2,1-((1-prob)/2))) ans <- as.matrix(t(ans)) colnames(ans) <- c("Lower","Upper") attr(ans, "Probability.Interval") <- prob} if(MM == TRUE) { ansmm <- ans mm <- apply(obj, 2, is.multimodal) if(any(mm)) { cat("\n\nPotentially multimodal column vectors:\n", which(mm),"\n") vals <- apply(obj, 2, sort) if(!is.matrix(vals)) stop("obj must have nsamp > 1.") for (m in which(mm)) { kde <- density(vals[,m]) dens <- approx(kde$x, kde$y, vals[,m])$y dens.ind <- dens >= as.vector(quantile(dens, probs=1-prob)) * 1 ints <- "" count <- 1 for (i in 1:nrow(vals)) { if((i == 1) & (dens.ind[i] == 1)) { ints <- paste("(",round(vals[i,m],3),",",sep="") if(count > ncol(ansmm)) ansmm <- cbind(ansmm,NA) ansmm[m,count] <- vals[i,m] count <- count + 1 } if(i > 1) { if((dens.ind[i] == 0) & (dens.ind[i-1] == 1)) { ints <- paste(ints,round(vals[i-1,m],3),")",sep="") if(count > ncol(ansmm)) ansmm <- cbind(ansmm,NA) ansmm[m,count] <- vals[i-1,m] count <- count + 1 } if((dens.ind[i] == 1) & (dens.ind[i-1] == 0)) { ints <- paste(ints," (",round(vals[i,m],3),",",sep="") if(count > ncol(ansmm)) ansmm <- cbind(ansmm,NA) ansmm[m,count] <- vals[i,m] count <- count + 1 } } } if((dens.ind[i] == 1) & (dens.ind[i-1] == 1)) { ints <- paste(ints,round(vals[i,m],3),")",sep="") if(count > ncol(ansmm)) ansmm <- cbind(ansmm,NA) ansmm[m,count] <- vals[i,m] count <- count + 1 } cat("\nColumn", m, "multimodal intervals:", ints, "\n")} } } if(plot == TRUE) { if(PDF == TRUE) { pdf("P.Interval.Plots.pdf") par(mfrow=c(1,1))} else par(mfrow=c(1,1), ask=TRUE) if(MM == FALSE) { for (i in 1:nrow(ans)) { kde <- kde.low <- kde.high <- density(obj[,i]) kde.low$x <- kde$x[kde$x < ans[i,1]] kde.low$y <- kde$y[which(kde$x < ans[i,1])] kde.high$x <- kde$x[kde$x > ans[i,2]] kde.high$y <- kde$y[which(kde$x > ans[i,2])] plot(kde, xlab="Value", main=colnames(obj)[i]) polygon(kde, col="black", border="black") polygon(c(min(kde.low$x), kde.low$x, max(kde.low$x)), c(min(kde.low$y), kde.low$y, min(kde.low$y)), col="gray", border="gray") polygon(c(min(kde.high$x), kde.high$x, max(kde.high$x)), c(min(kde.high$y), kde.high$y, min(kde.high$y)), col="gray", border="gray") abline(v=0, col="red", lty=2) } } if(MM == TRUE) { for (i in 1:nrow(ansmm)) { ### Mode 1 kde <- density(obj[,i]) x1 <- min(which(kde$x >= ansmm[i,1])) x2 <- max(which(kde$x <= ansmm[i,2])) plot(kde, xlab="Value", main=colnames(obj)[i]) polygon(kde, col="gray", border="gray") with(kde, polygon(x=c(x[c(x1,x1:x2,x2)]), y=c(0,y[x1:x2],0), col="black")) ### Mode 2 if((ncol(ansmm) > 2) && !is.na(ansmm[i,3])) { x1 <- min(which(kde$x >= ansmm[i,3])) x2 <- max(which(kde$x <= ansmm[i,4])) with(kde, polygon(x=c(x[c(x1,x1:x2,x2)]), y=c(0,y[x1:x2],0), col="black")) } if((ncol(ansmm) > 4) && !is.na(ansmm[i,5])) { x1 <- min(which(kde$x >= ansmm[i,5])) x2 <- max(which(kde$x <= ansmm[i,6])) with(kde, polygon(x=c(x[c(x1,x1:x2,x2)]), y=c(0,y[x1:x2],0), col="black")) } abline(v=0, col="red", lty=2) } } if(PDF == TRUE) dev.off() } return(ans) } #End LaplacesDemon/R/summary.pmc.ppc.R0000755000176200001440000002501115144316355016352 0ustar liggesusers########################################################################### # summary.pmc.ppc # # # # The purpose of the summary.pmc.ppc function is to summarize an object # # of class pmc.ppc (posterior predictive check). # ########################################################################### summary.pmc.ppc <- function(object=NULL, Categorical=FALSE, Rows=NULL, Discrep=NULL, d=0, Quiet=FALSE, ...) { if(is.null(object)) stop("The object argument is NULL.") y <- object$y yhat <- object$yhat Deviance <- object$Deviance if(is.null(Rows)) Rows <- 1:length(y) if(any(Rows > length(y)) || any(Rows <= 0)) { warning("Invalid Rows argument; All rows included.") Rows <- 1:length(y)} ### Create Continuous Summary Table if(Categorical == FALSE) { Summ <- matrix(NA, length(y), 8, dimnames=list(1:length(y), c("y","Mean","SD","LB","Median","UB","PQ","Discrep"))) Summ[,1] <- y Summ[,2] <- round(rowMeans(yhat),3) Summ[,3] <- round(sqrt(.rowVars(yhat)),3) for (i in 1:length(y)) { Summ[i,4] <- round(quantile(yhat[i,], probs=0.025, na.rm=TRUE),3) Summ[i,5] <- round(quantile(yhat[i,], probs=0.500, na.rm=TRUE),3) Summ[i,6] <- round(quantile(yhat[i,], probs=0.975, na.rm=TRUE),3) Summ[i,7] <- round(mean(yhat[i,] >= y[i], na.rm=TRUE),3) } ### Discrepancy Statistics Concordance <- 1 - mean({{Summ[,7] < 0.025} | {Summ[,7] > 0.975}}, na.rm=TRUE) if(identical(yhat,y)) Concordance <- 1 Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "Chi-Square"}) { Summ[,8] <- round((y - rowMeans(yhat))^2 / .rowVars(yhat),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Chi-Square2"}) { chisq.obs <- chisq.rep <- yhat E.y <- E.yrep <- rowMeans(yhat, na.rm=TRUE) for (i in 1:nrow(yhat)) { chisq.obs[i,] <- (y[i] - E.y[i])^2 / E.y[i] chisq.rep[i,] <- (yhat[i,] - E.yrep[i])^2 / E.yrep[i] } Summ[,8] <- round(rowMeans(chisq.rep > chisq.obs, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean((Summ[,8] < 0.025) | (Summ[,8] > 0.975), na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "DW"}) { Summ[,8] <- round((rowMeans(y - yhat, na.rm=TRUE) - c(0, diff(rowMeans(y - yhat, na.rm=TRUE))))^2 / rowMeans(y - yhat, na.rm=TRUE)^2, 3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE), 3)} if(!is.null(Discrep) && {Discrep == "Kurtosis"}) { kurtosis <- function(x) { m4 <- mean((x-mean(x, na.rm=TRUE))^4, na.rm=TRUE) kurt <- m4/(sd(x, na.rm=TRUE)^4)-3 return(kurt)} for (i in 1:length(y)) {Summ[i,8] <- round(kurtosis(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "L.criterion"}) { Summ[,8] <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2),3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MASE"}) { Summ[,8] <- round(abs(rowMeans(y - yhat, na.rm=TRUE) / mean(abs(diff(y)), na.rm=TRUE)), 3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "MSE"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "PPL"}) { Summ[,8] <- round(.rowVars(yhat) + (d/(d+1)) * (rowMeans(yhat) - y)^2,3) Discrepancy.Statistic <- round(sum(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Loss"}) { Summ[,8] <- round(rowMeans((y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Quadratic Utility"}) { Summ[,8] <- round(rowMeans(-1*(y - yhat)^2, na.rm=TRUE),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "RMSE"}) { Summ[,8] <- round(sqrt(rowMeans((y - yhat)^2, na.rm=TRUE)),3) Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "Skewness"}) { skewness <- function(x) { m3 <- mean((x-mean(x, na.rm=TRUE))^3, na.rm=TRUE) skew <- m3/(sd(x, na.rm=TRUE)^3) return(skew)} for (i in 1:length(y)) {Summ[i,8] <- round(skewness(yhat[i,]),3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "max(yhat[i,]) > max(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- max(yhat[i,]) > max(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,]) > mean(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,]) > mean(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > d)"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > d)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "mean(yhat[i,] > mean(y))"}) { for (i in 1:length(y)) {Summ[i,8] <- mean(yhat[i,] > mean(y))} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "min(yhat[i,]) < min(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- min(yhat[i,]) < min(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "round(yhat[i,]) = d"}) { for (i in 1:length(y)) { Summ[i,8] <- round(mean(round(yhat[i,]) == d, na.rm=TRUE), 3)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} if(!is.null(Discrep) && {Discrep == "sd(yhat[i,]) > sd(y)"}) { for (i in 1:length(y)) {Summ[i,8] <- sd(yhat[i,]) > sd(y)} Discrepancy.Statistic <- round(mean(Summ[,8], na.rm=TRUE),3)} Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE)/2, 3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" L <- round(sqrt(.rowVars(yhat) + (y - rowMeans(yhat))^2), 3) S.L <- round(sd(L, na.rm=TRUE),3); L <- round(sum(L, na.rm=TRUE),3) ### Create Output Summ.out <- list(BPIC=bpic, Concordance=Concordance, Discrepancy.Statistic=round(Discrepancy.Statistic,5), L.criterion=L, S.L=S.L, Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Concordance: ", Concordance, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("L-criterion: ", L, ", S.L: ", S.L, sep="", "\n") cat("Records: \n") print(Summ[Rows,])} } ### Create Categorical Summary Table else { catcounts <- table(y) sumnames <- rep(NA, length(catcounts)+3) sumnames[1] <- "y" for (i in 1:length(catcounts)) { sumnames[i+1] <- paste("p(yhat=",names(catcounts)[i],")",sep="")} sumnames[length(sumnames)-1] <- "Lift" sumnames[length(sumnames)] <- "Discrep" Summ <- matrix(NA, length(y), length(sumnames), dimnames=list(1:length(y), sumnames)) Summ[,1] <- y for (i in 1:length(catcounts)) { Summ[,i+1] <- rowSums(yhat == as.numeric(names(catcounts)[i])) / ncol(yhat)} Summ[,{ncol(Summ)-1}] <- 1 for (i in 1:length(y)) { Summ[i,{ncol(Summ)-1}] <- Summ[i, grep(Summ[i,1],names(catcounts))+1] / {as.vector(catcounts[grep(Summ[i,1],names(catcounts))]) / sum(catcounts)} - 1} ### Discrepancy Statistics Mean.Lift <- round(mean(Summ[,{ncol(Summ)-1}]),3) Discrepancy.Statistic <- 0 if(!is.null(Discrep) && {Discrep == "p(yhat[i,] != y[i])"}) { for (i in 1:length(y)) {Summ[i,ncol(Summ)] <- 1 - Summ[i, grep(Summ[i,1],names(catcounts))+1]} Discrepancy.Statistic <- round(mean(Summ[,ncol(Summ)], na.rm=TRUE),3)} Dbar <- round(mean(Deviance, na.rm=TRUE),3) pD <- round(var(Deviance, na.rm=TRUE)/2, 3) BPIC <- Dbar + 2*pD bpic <- matrix(c(Dbar, pD, BPIC), 1, 3) colnames(bpic) <- c("Dbar","pD","BPIC"); rownames(bpic) <- "" ### Create Output Summ.out <- list(BPIC=bpic, Mean.Lift=Mean.Lift, Discrepancy.Statistic=round(Discrepancy.Statistic,5), Summary=Summ[Rows,]) if(Quiet == FALSE) { cat("Bayesian Predictive Information Criterion:\n") print(bpic) cat("Mean Lift: ", Mean.Lift, "\n") cat("Discrepancy Statistic: ", round(Discrepancy.Statistic,5), "\n") cat("Records: \n") print(Summ[Rows,])} } return(invisible(Summ.out)) } #End LaplacesDemon/R/joint.density.plot.R0000755000176200001440000000570415144316355017103 0ustar liggesusers########################################################################### # joint.density.plot # # # # The purpose of the joint.density.plot function is to produce a joint # # density plot from samples of two marginal posterior distributions. This # # function is derived from the kde2d and bandwidth.nrd functions from the # # MASS package. # ########################################################################### joint.density.plot <- function(x, y, Title=NULL, contour=TRUE, color=FALSE, Trace=NULL) { ### Initial Checks xname <- deparse(substitute(x)) yname <- deparse(substitute(y)) x <- as.vector(x) y <- as.vector(y) if(!identical(length(y), length(x))) stop("vectors x and y must be the same length.") if(any(!is.finite(x))) stop("x must have finite values.") if(any(!is.finite(y))) stop("y must have finite values.") ### Two-Dimensional Kernel Density Estimates kde2d <- function(x, y, h, n=25, lims=c(range(x), range(y))) { nx <- length(x) if(any(!is.finite(lims))) stop("x and y must have finite values.") n <- rep(n, length.out=2L) gx <- seq.int(lims[1L], lims[2L], length.out=n[1L]) gy <- seq.int(lims[3L], lims[4L], length.out=n[2L]) h <- if(missing(h)) c(bandwidth.nrd(x), bandwidth.nrd(y)) else rep(h, length.out=2L) h <- h / 4 # for S's bandwidth scale ax <- outer(gx, x, "-" ) / h[1L] ay <- outer(gy, y, "-" ) / h[2L] z <- tcrossprod(matrix(dnorm(ax), , nx), matrix(dnorm(ay), , nx)) / (nx * h[1L] * h[2L]) list(x=gx, y=gy, z=z) } bandwidth.nrd <- function(x) { r <- quantile(x, c(0.25, 0.75)) h <- (r[2L] - r[1L]) / 1.34 4 * 1.06 * min(sqrt(var(x)), h) * length(x) ^ (-1/5) } dd <- kde2d(x,y) if(color == FALSE) { plot(x, y, cex=0.1, main=Title, xlab=xname, ylab=yname, col="gray")} else if(color == TRUE) { crp <- colorRampPalette(c("black","red","yellow","white"), space="rgb") image(dd, main=Title, xlab=xname, ylab=yname, col=crp(200)) } if(contour == TRUE) {contour(dd, nlevels=10, add=TRUE)} if(!is.null(Trace)) { if(length(Trace) != 2) stop("Trace requires 2 elements.") if(Trace[1] >= Trace[2]) stop("Trace[1] not smaller than Trace[2].") if(Trace[1] < 1) stop("Trace[1] < 1.") if(Trace[2] > length(x)) stop("Trace[2] > length(x).") lines(x[Trace[1]:Trace[2]], y[Trace[1]:Trace[2]], col="green") points(x[Trace[1]], y[Trace[1]], cex=0.5, col="green") } } #End LaplacesDemon/R/Precision.R0000755000176200001440000000452415144316355015257 0ustar liggesusers########################################################################### # Precision # # # # The purpose of these functions is to facilitate conversions between the # # precision, standard deviation, and variance of scalars, vectors, and # # matrices. # ########################################################################### Cov2Prec <- function(Cov) { if(any(!is.finite(Cov))) stop("Cov must be finite.") if(is.matrix(Cov)) { if(!is.positive.definite(Cov)) stop("Cov is not positive-definite.") Prec <- as.inverse(Cov)} else if(is.vector(Cov)) { k <- as.integer(sqrt(length(Cov))) Cov <- matrix(Cov, k, k) if(!is.positive.definite(Cov)) stop("Cov is not positive-definite.") Prec <- as.inverse(Cov)} return(Prec) } Prec2Cov <- function(Prec) { if(any(!is.finite(Prec))) stop("Prec must be finite.") if(is.matrix(Prec)) { if(!is.positive.definite(Prec)) stop("Prec is not positive-definite.") Cov <- as.inverse(Prec)} else if(is.vector(Prec)) { k <- as.integer(sqrt(length(Prec))) Prec <- matrix(Prec, k, k) if(!is.positive.definite(Prec)) stop("Prec is not positive-definite.") Cov <- as.inverse(Prec)} return(Cov) } prec2sd <- function(prec=1) { prec <- as.vector(prec) if(prec <=0) stop("prec must be positive.") return(sqrt(1/prec)) } prec2var <- function(prec=1) { prec <- as.vector(prec) if(prec <=0) stop("prec must be positive.") return(1/prec) } sd2prec <- function(sd=1) { sd <- as.vector(sd) if(sd <=0) stop("sd must be positive.") return(1/sd^2) } sd2var <- function(sd=1) { sd <- as.vector(sd) if(sd <=0) stop("sd must be positive.") return(sd^2) } var2prec <- function(var=1) { var <- as.vector(var) if(var <=0) stop("var must be positive.") return(1/var) } var2sd <- function(var=1) { var <- as.vector(var) if(var <=0) stop("var must be positive.") return(sqrt(var)) } #End LaplacesDemon/R/IAT.R0000755000176200001440000000351615144316355013741 0ustar liggesusers########################################################################### # IAT # # # # The purpose of the IAT function is to estimate the integrated # # autocorrelation time of a chain, given its samples. Although the code # # is slightly different, it is essentially the same as the IAT function # # in the Rtwalk package, which is currently unavailable on CRAN. # ########################################################################### IAT <- function(x) { if(missing(x)) stop("The x argument is required.") if(!is.vector(x)) x <- as.vector(x) dt <- x n <- length(x) mu <- mean(dt) s2 <- var(dt) ### The maximum lag is half the sample size maxlag <- max(3, floor(n/2)) #### The gammas are sums of two consecutive autocovariances Ga <- rep(0,2) Ga[1] <- s2 lg <- 1 Ga[1] <- Ga[1] + sum((dt[1:(n-lg)]-mu)*(dt[(lg+1):n]-mu)) / n m <- 1 lg <- 2*m Ga[2] <- sum((dt[1:(n-lg)]-mu)*(dt[(lg+1):n]-mu)) / n lg <- 2*m + 1 Ga[2] <- Ga[2] + sum((dt[1:(n-lg)]-mu)*(dt[(lg+1):n]-mu)) / n IAT <- Ga[1]/s2 # Add the autocorrelations ### RULE: while Gamma stays positive and decreasing while ((Ga[2] > 0.0) & (Ga[2] < Ga[1])) { m <- m + 1 if(2*m + 1 > maxlag) { cat("Not enough data, maxlag=", maxlag, "\n") break} Ga[1] <- Ga[2] lg <- 2*m Ga[2] <- sum((dt[1:(n-lg)]-mu)*(dt[(lg+1):n]-mu)) / n lg <- 2*m + 1 Ga[2] <- Ga[2] + sum((dt[1:(n-lg)]-mu)*(dt[(lg+1):n]-mu)) / n IAT <- IAT + Ga[1] / s2 } IAT <- -1 + 2*IAT #Calculates the IAT from the gammas return(IAT) } #End LaplacesDemon/R/deburn.R0000755000176200001440000000653515144316355014607 0ustar liggesusers########################################################################### # deburn # # # # The purpose of deburn() is to remove the user-specified burn-in from an # # object of class demonoid. # ########################################################################### deburn <- function(x, BurnIn=0) { ### Initial Checks if(!identical(class(x), "demonoid")) stop("x is not an object of class demonoid.") S <- nrow(x$Posterior1) if(S < 22) stop("x has too few posterior samples.") BurnIn <- abs(round(BurnIn)) if(BurnIn >= S) BurnIn <- S - 2 LIV <- x$Parameters ### Remove Burn-in x$Posterior1 <- x$Posterior2 <- x$Posterior1[(BurnIn+1):S,] x$Deviance <- x$Deviance[(BurnIn+1):S] x$Monitor <- x$Monitor[(BurnIn+1):S,,drop=FALSE] x$Rec.BurnIn.Thinned <- 0 x$Rec.BurnIn.UnThinned <- 0 x$Thinned.Samples <- x$Thinned.Samples - BurnIn ### Summary1 x$Summary1[1:LIV,1] <- colMeans(x$Posterior1) x$Summary1[1:LIV,2] <- sqrt(.colVars(x$Posterior1)) x$Summary1[1:LIV,4] <- ESS(x$Posterior1) x$Summary1[1:LIV,5] <- apply(x$Posterior1, 2, quantile, c(0.025), na.rm=TRUE) x$Summary1[1:LIV,6] <- apply(x$Posterior1, 2, quantile, c(0.500), na.rm=TRUE) x$Summary1[1:LIV,7] <- apply(x$Posterior1, 2, quantile, c(0.975), na.rm=TRUE) for (i in 1:LIV) { temp <- try(MCSE(x$Posterior1[,i]), silent=TRUE) if(!inherits(temp, "try-error")) x$Summary1[i,3] <- temp else x$Summary1[i,3] <- MCSE(x$Posterior1[,i], method="sample.variance")} ### Deviance x$Summary1[LIV+1,1] <- mean(x$Deviance) x$Summary1[LIV+1,2] <- sd(x$Deviance) temp <- try(MCSE(x$Deviance), silent=TRUE) if(inherits(temp, "try-error")) temp <- MCSE(x$Deviance, method="sample.variance") x$Summary1[LIV+1,3] <- temp x$Summary1[LIV+1,4] <- ESS(x$Deviance) x$Summary1[LIV+1,5] <- as.numeric(quantile(x$Deviance, probs=0.025, na.rm=TRUE)) x$Summary1[LIV+1,6] <- as.numeric(quantile(x$Deviance, probs=0.500, na.rm=TRUE)) x$Summary1[LIV+1,7] <- as.numeric(quantile(x$Deviance, probs=0.975, na.rm=TRUE)) ### Monitor Num.Mon <- ncol(x$Monitor) x$Summary1[LIV+1+1:Num.Mon,1] <- colMeans(x$Monitor) x$Summary1[LIV+1+1:Num.Mon,2] <- sqrt(.colVars(x$Monitor)) x$Summary1[LIV+1+1:Num.Mon,4] <- ESS(x$Monitor) x$Summary1[LIV+1+1:Num.Mon,5] <- apply(x$Monitor, 2, quantile, c(0.025), na.rm=TRUE) x$Summary1[LIV+1+1:Num.Mon,6] <- apply(x$Monitor, 2, quantile, c(0.500), na.rm=TRUE) x$Summary1[LIV+1+1:Num.Mon,7] <- apply(x$Monitor, 2, quantile, c(0.975), na.rm=TRUE) for (i in 1:Num.Mon) { temp <- try(MCSE(x$Monitor[,i]), silent=TRUE) if(!inherits(temp, "try-error")) x$Summary1[LIV+1+i,3] <- temp else x$Summary1[LIV+1+i,3] <- MCSE(x$Monitor[,i], method="sample.variance")} ### Summary2 x$Summary2 <- x$Summary1 ### DIC x$DIC1 <- x$DIC2 <- c(mean(x$Deviance), var(x$Deviance)/2, mean(x$Deviance) + var(x$Deviance)/2) ### Output return(x) } #End LaplacesDemon/R/LossMatrix.R0000755000176200001440000000466515144316355015437 0ustar liggesusers########################################################################### # LossMatrix # # # # The purpose of the LossMatrix function is facilitate Bayesian decision # # theory for discrete actions among discrete states. # ########################################################################### LossMatrix <- function(L, p.theta) { ### Initial Checks if(missing(L)) stop("L is a required argument.") if(missing(p.theta)) stop("p.theta is a required argument.") if(!is.matrix(L) & !is.array(L)) stop("L must be a matrix or array.") if(!is.array(p.theta)) stop("p.theta must be a vector or matrix.") d.L <- dim(L) d.p.theta <- dim(p.theta) if(any(d.L[1:2] != d.p.theta[1:2])) stop("The rows or columns of L and p.theta differ.") if(length(d.L) == 3 & length(d.p.theta) == 3) if(d.L[3] != d.p.theta[3]) stop("The number of samples in L and p.theta differ.") if(length(d.L) > 3 | length(d.p.theta) > 3) stop("L and p.theta may have no more than 3 dimensions.") if(length(d.p.theta) == 2) { if(any(colSums(p.theta) != 1)) stop("Each column in p.theta must sum to one.") } else { for (i in 1:d.p.theta[3]) { if(any(colSums(p.theta[,,i]) != 1)) stop("Each column in p.theta must sum to one.")}} ### Expected Loss if(length(d.L) == 2 & length(d.p.theta) == 2) { E.Loss <- colSums(L * p.theta) } else if(length(d.L) == 3 & length(d.p.theta) == 2) { E.Loss <- rep(0, d.L[3]) for (i in 1:d.L[3]) { E.Loss <- E.Loss + colSums(L[,,i] * p.theta)} E.Loss <- E.Loss / d.L[3] } else if(length(d.L) == 2 & length(d.p.theta) == 3) { E.Loss <- rep(0, d.p.theta[3]) for (i in 1:d.p.theta[3]) { E.Loss <- E.Loss + colSums(L * p.theta[,,i])} E.Loss <- E.Loss / d.p.theta[3] } else { E.Loss <- rep(0, d.L[3]) for (i in 1:d.L[3]) { E.Loss <- E.Loss + colSums(L[,,i] * p.theta[,,i])}} action <- which.min(E.Loss) cat("\nAction", action, "minimizes expected loss.\n") out <- list(BayesAction=action, E.Loss=E.Loss) return(out) } #End LaplacesDemon/R/Model.Spec.Time.R0000755000176200001440000000226015144316355016145 0ustar liggesusers########################################################################### # Model.Spec.Time # # # # The purpose of the Model.Spec.Time function is to return three things: # # the amount of time in minutes that it took to evaluate a model # # specification a number of times, the evaluations per minute, and the # # componentwise iterations per minute. # ########################################################################### Model.Spec.Time <- function(Model, Initial.Values, Data, n=1000) { if(missing(Model)) stop("The Model argument is required.") if(missing(Initial.Values)) stop("The Initial.Values argument is required.") if(missing(Data)) stop("The Data argument is required.") t <- as.vector(system.time(for (i in 1:n) {Model(Initial.Values, Data)})[3]) out <- list(Time=round(t/60,3), Evals.per.Minute=round(n/(t/60),3), Componentwise.Iters.per.Minute=round(n/(t/60)/length(Initial.Values),3)) return(out) } #End LaplacesDemon/vignettes/0000755000176200001440000000000015145054161014773 5ustar liggesusersLaplacesDemon/vignettes/BayesianInference.Stex0000755000176200001440000024062015144316355021226 0ustar liggesusers\documentclass[nojss]{jss} %% need no \usepackage{Sweave.sty} \usepackage{amsmath,mathrsfs} %\VignetteIndexEntry{Bayesian Inference} %\VignettePackage{LaplacesDemon} %\VignetteDepends{LaplacesDemon} \author{Statisticat, LLC} \title{\includegraphics[height=1in,keepaspectratio]{LDlogo} \\ Bayesian Inference} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Statisticat LLC} %% comma-separated \Plaintitle{Bayesian Inference} %% without formatting \Shorttitle{Bayesian Inference} %% a short title (if necessary) \Abstract{The Bayesian interpretation of probability is one of two broad categories of interpretations. Bayesian inference updates knowledge about unknowns, parameters, with information from data. The \pkg{LaplacesDemon} package is a complete environment for Bayesian inference within \proglang{R}, and this vignette provides an introduction to the topic. This article introduces Bayes' theorem, model-based Bayesian inference, components of Bayesian inference, prior distributions, hierarchical Bayes, conjugacy, likelihood, numerical approximation, prediction, Bayes factors, model fit, posterior predictive checks, and ends by comparing advantages and disadvantages of Bayesian inference.} \Keywords{Bayesian, LaplacesDemon, LaplacesDemonCpp, R} \Plainkeywords{bayesian, laplacesdemon, laplacesdemoncpp, r} %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2011} %% \Submitdate{2011-01-18} %% \Acceptdate{2011-01-18} \Address{ Statisticat, LLC\\ Farmington, CT\\ E-mail: is defunct\\ URL: \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index} } %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} \begin{document} This article is an introduction to Bayesian inference for users of the \pkg{LaplacesDemon} package \citep{r:laplacesdemon} in \proglang{R} \citep{rdct:r}, often referred to as LD. \pkg{LaplacesDemonCpp} is an extension package that uses \proglang{C++}. A formal introduction to \pkg{LaplacesDemon} is provided in an accompanying vignette entitled ``\pkg{LaplacesDemon} Tutorial''. Merriam-Webster defines `Bayesian' as follows \begin{quote} \textbf{Bayesian} : being, relating to, or involving statistical methods that assign probabilities or distributions to events (as rain tomorrow) or parameters (as a population mean) based on experience or best guesses before experimentation and data collection and that apply Bayes' theorem to revise the probabilities and distributions after obtaining experimental data. \end{quote} In statistical inference, there are two broad categories of interpretations of probability: Bayesian inference and frequentist inference. These views often differ with each other on the fundamental nature of probability. Frequentist inference loosely defines probability as the limit of an event's relative frequency in a large number of trials, and only in the context of experiments that are random and well-defined. Bayesian inference, on the other hand, is able to assign probabilities to any statement, even when a random process is not involved. In Bayesian inference, probability is a way to represent an individual's degree of belief in a statement, or given evidence. Within Bayesian inference, there are also different interpretations of probability, and different approaches based on those interpretations. The most popular interpretations and approaches are objective Bayesian inference \citep{berger06} and subjective Bayesian inference \citep{anscombe63, goldstein06}. Objective Bayesian inference is often associated with \citet{bayes63}, \citet{laplace14}, and \citet{jeffreys61}. Subjective Bayesian inference is often associated with \citet{ramsey26}, \citet{definetti31}, and \citet{savage54}. The first major event to bring about the rebirth of Bayesian inference was \citet{definetti37}. Differences in the interpretation of probability are best explored outside of this article\footnote{If these terms are new to the reader, then please do not focus too much on the words `objective' and `subjective', since there is a lot of debate over them. For what it's worth, \textit{Statisticat, LLC}, the provider of this \proglang{R} package entitled \pkg{LaplacesDemon}, favors the `subjective' interpretation.}. This article is intended as an approachable introduction to Bayesian inference, or as a handy summary for experienced Bayesians. It is assumed that the reader has at least an elementary understanding of statistics, and this article focuses on applied, rather than theoretical, material. Equations and statistical notation are included, but it is hopefully presented so the reader does not need an intricate understanding of solving integrals, for example, but should understand the basic concept of integration. Please be aware that it is difficult to summarize Bayesian inference in such a short article. In which case, consider \citet{robert07} for a more thorough and formal introduction. \section{Bayes' Theorem} \label{bayestheorem} Bayes' theorem shows the relation between two conditional probabilities that are the reverse of each other. This theorem is named after Reverend Thomas Bayes (1701-1761), and is also referred to as Bayes' law or Bayes' rule \citep{bayes63}\footnote{\citet{stigler83} suggests the earliest discoverer of Bayes' theorem was Nicholas Saunderson (1682-1739), a blind mathematician/optician, who at age 29 became the Lucasian Professor of Mathematics at Cambridge. This position was previously held by Isaac Newton.}. Bayes' theorem expresses the conditional probability, or `posterior probability', of an event $A$ after $B$ is observed in terms of the `prior probability' of $A$, prior probability of $B$, and the conditional probability of $B$ given $A$. Bayes' theorem is valid in all common interpretations of probability. The two (related) examples below should be sufficient to introduce Bayes' theorem. \subsection{Bayes' Theorem, Example 1} \label{bayestheorem1} Bayes' theorem provides an expression for the conditional probability of $A$ given $B$, which is equal to \begin{equation} \label{bayestheorem} \Pr(A | B) = \frac{\Pr(B | A)\Pr(A)}{\Pr(B)} \end{equation} For example, suppose one asks the question: what is the probability of going to Hell, conditional on consorting (or given that a person consorts) with Laplace's Demon\footnote{This example is, of course, intended with humor.}. By replacing $A$ with $Hell$ and $B$ with $Consort$, the question becomes $$\Pr(\mathrm{Hell} | \mathrm{Consort}) = \frac{\Pr(\mathrm{Consort} | \mathrm{Hell}) \Pr(\mathrm{Hell})}{\Pr(\mathrm{Consort})}$$ Note that a common fallacy is to assume that $\Pr(A | B) = \Pr(B | A)$, which is called the conditional probability fallacy. \subsection{Bayes' Theorem, Example 2} \label{bayestheorem2} Another way to state Bayes' theorem is $$\Pr(A_i | B) = \frac{\Pr(B | A_i)\Pr(A_i)}{\Pr(B | A_i)\Pr(A_i) +...+ \Pr(B | A_n)\Pr(A_n)}$$ Let's examine our \textit{burning} question, by replacing $A_i$ with Hell or Heaven, and replacing $B$ with Consort \begin{itemize} \item $\Pr(A_1) = \Pr(\mathrm{Hell})$ \item $\Pr(A_2) = \Pr(\mathrm{Heaven})$ \item $\Pr(B) = \Pr(\mathrm{Consort})$ \item $\Pr(A_1 | B) = \Pr(\mathrm{Hell} | \mathrm{Consort})$ \item $\Pr(A_2 | B) = \Pr(\mathrm{Heaven} | \mathrm{Consort})$ \item $\Pr(B | A_1) = \Pr(\mathrm{Consort} | \mathrm{Hell})$ \item $\Pr(B | A_2) = \Pr(\mathrm{Consort} | \mathrm{Heaven})$ \end{itemize} Laplace's Demon was conjured and asked for some data. He was glad to oblige. \textbf{Data} \begin{itemize} \item 6 people consorted out of 9 who went to Hell. \item 5 people consorted out of 7 who went to Heaven. \item 75\% of the population goes to Hell. \item 25\% of the population goes to Heaven. \end{itemize} Now, Bayes' theorem is applied to the data. Four pieces are worked out as follows \begin{itemize} \item $\Pr(\mathrm{Consort} | \mathrm{Hell}) = 6/9 = 0.666$ \item $\Pr(\mathrm{Consort} | \mathrm{Heaven}) = 5/7 = 0.714$ \item $\Pr(\mathrm{Hell})$ = 0.75 \item $\Pr(\mathrm{Heaven})$ = 0.25 \end{itemize} Finally, the desired conditional probability $\Pr(\mathrm{Hell} | \mathrm{Consort})$ is calculated using Bayes' theorem \begin{itemize} \item $\Pr(\mathrm{Hell} | \mathrm{Consort}) = \frac{0.666(0.75)}{0.666(0.75) + 0.714(0.25)}$ \item $\Pr(\mathrm{Hell} | \mathrm{Consort}) = 0.737$ \end{itemize} The probability of someone consorting with Laplace's Demon and going to Hell is 73.7\%, which is less than the prevalence of 75\% in the population. According to these findings, consorting with Laplace's Demon does not increase the probability of going to Hell. With that in mind, please continue\dots \section{Model-Based Bayesian Inference} \label{modelbasedbayes} The basis for Bayesian inference is derived from Bayes' theorem. Here is Bayes' theorem, equation \ref{bayestheorem}, again $$\Pr(A | B) = \frac{\Pr(B | A)\Pr(A)}{\Pr(B)}$$ Replacing $B$ with observations $\textbf{y}$, $A$ with parameter set $\Theta$, and probabilities $\Pr$ with densities $p$ (or sometimes $\pi$ or function $f$), results in the following $$ p(\Theta | \textbf{y}) = \frac{p(\textbf{y} | \Theta)p(\Theta)}{p(\textbf{y})}$$ where $p(\textbf{y})$ will be discussed below, p($\Theta$) is the set of prior distributions of parameter set $\Theta$ before $\textbf{y}$ is observed, $p(\textbf{y} | \Theta)$ is the likelihood of $\textbf{y}$ under a model, and $p(\Theta | \textbf{y})$ is the joint posterior distribution, sometimes called the full posterior distribution, of parameter set $\Theta$ that expresses uncertainty about parameter set $\Theta$ after taking both the prior and data into account. Since there are usually multiple parameters, $\Theta$ represents a set of $j$ parameters, and may be considered hereafter in this article as $$\Theta = \theta_1,...,\theta_j$$ The denominator $$p(\textbf{y}) = \int p(\textbf{y} | \Theta)p(\Theta) d\Theta$$ defines the ``marginal likelihood'' of $\textbf{y}$, or the ``prior predictive distribution'' of $\textbf{y}$, and may be set to an unknown constant $\textbf{c}$. The prior predictive distribution\footnote{The predictive distribution was introduced by \citet{jeffreys61}.} indicates what $\textbf{y}$ should look like, given the model, before $\textbf{y}$ has been observed. Only the set of prior probabilities and the model's likelihood function are used for the marginal likelihood of $\textbf{y}$. The presence of the marginal likelihood of $\textbf{y}$ normalizes the joint posterior distribution, $p(\Theta | \textbf{y})$, ensuring it is a proper distribution and integrates to one. By replacing $p(\textbf{y})$ with $\textbf{c}$, which is short for a `constant of proportionality', the model-based formulation of Bayes' theorem becomes $$p(\Theta | \textbf{y}) = \frac{p(\textbf{y} | \Theta)p(\Theta)}{\textbf{c}}$$ By removing $\textbf{c}$ from the equation, the relationship changes from 'equals' ($=$) to 'proportional to' ($\propto$)\footnote{For those unfamiliar with $\propto$, this symbol simply means that two quantities are proportional if they vary in such a way that one is a constant multiplier of the other. This is due to the constant of proportionality $\textbf{c}$ in the equation. Here, this can be treated as `equal to'.} \begin{equation} \label{jointposterior} p(\Theta | \textbf{y}) \propto p(\textbf{y} | \Theta)p(\Theta) \end{equation} This form can be stated as the unnormalized joint posterior being proportional to the likelihood times the prior. However, the goal in model-based Bayesian inference is usually not to summarize the unnormalized joint posterior distribution, but to summarize the marginal distributions of the parameters. The full parameter set $\Theta$ can typically be partitioned into $$\Theta = \{\Phi, \Lambda\}$$ where $\Phi$ is the sub-vector of interest, and $\Lambda$ is the complementary sub-vector of $\Theta$, often referred to as a vector of nuisance parameters. In a Bayesian framework, the presence of nuisance parameters does not pose any formal, theoretical problems. A nuisance parameter is a parameter that exists in the joint posterior distribution of a model, though it is not a parameter of interest. The marginal posterior distribution of $\phi$, the parameter of interest, can simply be written as $$p(\phi | \textbf{y}) = \int p(\phi, \Lambda | \textbf{y}) d\Lambda$$ In model-based Bayesian inference, Bayes' theorem is used to estimate the unnormalized joint posterior distribution, and finally the user can assess and make inferences from the marginal posterior distributions. \section{Components of Bayesian Inference} \label{components} The components\footnote{In Bayesian decision theory, an additional component exists \citep[p. 53]{robert07}, the loss function, $\mathrm{L}(\Theta, \Delta)$.} of Bayesian inference are \begin{enumerate} \item $p(\Theta)$ is the set of prior distributions for parameter set $\Theta$, and uses probability as a means of quantifying uncertainty about $\Theta$ before taking the data into account. \item $p(\textbf{y} | \Theta)$ is the likelihood or likelihood function, in which all variables are related in a full probability model. \item $p(\Theta | \textbf{y})$ is the joint posterior distribution that expresses uncertainty about parameter set $\Theta$ after taking both the prior and the data into account. If parameter set $\Theta$ is partitioned into a single parameter of interest $\phi$ and the remaining parameters are considered nuisance parameters, then $p(\phi | \textbf{y})$ is the marginal posterior distribution. \end{enumerate} \section{Prior Distributions} \label{priordistributions} In Bayesian inference, a prior probability distribution, often called simply the prior, of an uncertain parameter $\theta$ or latent variable is a probability distribution that expresses uncertainty about $\theta$ before the data are taken into account\footnote{One so-called version of Bayesian inference is `empirical Bayes', which sounds enticing because anything `empirical' seems desirable. However, empirical Bayes is a term for the use of data-dependent priors, where the prior is first modeled usually with maximum likelihood and then used in the Bayesian model. This is an undesirable double-use of the data and is most problematic with small sample sizes \citep{berger06}. It also seems to violate the elementary concept that a prior probability distribution expresses uncertainty about $\theta$ \textit{before} the data are taken into account. It has been claimed that ``empirical Bayes methods are not Bayesian'' \citep{bernardo08}.}. The parameters of a prior distribution are called hyperparameters, to distinguish them from the parameters ($\Theta$) of the model. When applying Bayes' theorem, the prior is multiplied by the likelihood function and then normalized to estimate the posterior probability distribution, which is the conditional distribution of $\Theta$ given the data. Moreover, the prior distribution affects the posterior distribution. Prior probability distributions have traditionally belonged to one of two categories: informative priors and uninformative priors. Here, four categories of priors are presented according to information\footnote{`Information' is used loosely here to describe either the prior information from personal beliefs or informational-theoretic content.} and the goal in the use of the prior. The four categories are informative, weakly informative, least informative, and uninformative. \subsection{Informative Priors} \label{informativepriors} When prior information is available about $\theta$, it should be included in the prior distribution of $\theta$. For example, if the present model form is similar to a previous model form, and the present model is intended to be an updated version based on more current data, then the posterior distribution of $\theta$ from the previous model may be used as the prior distribution of $\theta$ for the present model. In this way, each version of a model is not starting from scratch, based only on the present data, but the cumulative effects of all data, past and present, can be taken into account. To ensure the current data do not overwhelm the prior, \citet{ibrahim00} introduced the power prior. The power prior is a class of informative prior distribution that takes previous data and results into account. If the present data is very similar to the previous data, then the precision of the posterior distribution increases when including more and more information from previous models. If the present data differs considerably, then the posterior distribution of $\theta$ may be in the tails of the prior distribution for $\theta$, so the prior distribution contributes less density in its tails. Hierarchical Bayes is also a popular way to combine data sets. Sometimes informative prior information is not simply ready to be used, such as when it resides in another person, as in an expert. In this case, their personal beliefs about the probability of the event must be elicited into the form of a proper probability density function. This process is called prior elicitation. \subsection{Weakly Informative Priors} \label{wips} Weakly Informative Prior (WIP) distributions use prior information for regularization\footnote{The definition of regularization is to introduce additional information in order to solve an ill-posed problem or to prevent overfitting.} and stabilization, providing enough prior information to prevent results that contradict our knowledge or problems such as an algorithmic failure to explore the state-space. Another goal is for WIPs to use less prior information than is actually available. A WIP should provide some of the benefit of prior information while avoiding some of the risk from using information that doesn't exist. WIPs are the most common priors in practice, and are favored by subjective Bayesians. Selecting a WIP can be tricky. WIP distributions should change with the sample size, because a model should have enough prior information to learn from the data, but the prior information must also be weak enough to learn from the data. Following is an example of a WIP in practice. It is popular, for good reasons, to center and scale all continuous predictors \citep{gelman08}. Although centering and scaling predictors is not discussed here, it should be obvious that the potential range of the posterior distribution of $\theta$ for a centered and scaled predictor should be small. A popular WIP for a centered and scaled predictor may be $$\theta \sim \mathcal{N}(0, 10000)$$ where $\theta$ is normally-distributed according to a mean of 0 and a variance of 10,000, which is equivalent to a standard deviation of 100, or precision of 1.0E-4. In this case, the density for $\theta$ is nearly flat. Nonetheless, the fact that it is not perfectly flat yields good properties for numerical approximation algorithms. In both Bayesian and frequentist inference, it is possible for numerical approximation algorithms to become stuck in regions of flat density, which become more common as sample size decreases or model complexity increases. Numerical approximation algorithms in frequentist inference function as though a flat prior were used, so numerical approximation algorithms in frequentist inference become stuck more frequently than numerical approximation algorithms in Bayesian inference. Prior distributions that are not completely flat provide enough information for the numerical approximation algorithm to continue to explore the target density, the posterior distribution. After updating a model in which WIPs exist, the user should examine the posterior to see if the posterior contradicts knowledge. If the posterior contradicts knowledge, then the WIP must be revised by including information that will make the posterior consistent with knowledge \citep{gelman08}. A popular objective Bayeisan criticism against WIPs is that there is no precise, mathematical form to derive the optimal WIP for a given model and data. \subsubsection{Vague Priors} \label{vaguepriors} A vague prior, also called a diffuse prior\footnote{Some sources refer to diffuse priors as flat priors.}, is difficult to define, after considering WIPs. The first formal move from vague to weakly informative priors is \citet{lambert05}. After conjugate priors were introduced \citep{raiffa61}, most applied Bayesian modeling has used vague priors, parameterized to approximate the concept of uninformative priors (better considered as least informative priors, see section \ref{lips}). For more information on conjugate priors, see section \ref{conjugacy}. Typically, a vague prior is a conjugate prior with a large scale parameter. However, vague priors can pose problems when the sample size is small. Most problems with vague priors and small sample size are associated with scale, rather than location, parameters. The problem can be particularly acute in random-effects models, and the term random-effects is used rather loosely here to imply exchangeable\footnote{For more information on exchangeability, see \url{https://web.archive.org/web/20150418134644/http://www.bayesian-inference.com/exchangeability}.}, hierarchical, and multilevel structures. A vague prior is defined here as usually being a conjugate prior that is intended to approximate an uninformative prior (or actually, a least informative prior), and without the goals of regularization and stabilization. \subsection{Least Informative Priors} \label{lips} The term `Least Informative Priors', or LIPs, is used here to describe a class of prior in which the goal is to minimize the amount of subjective information content, and to use a prior that is determined solely by the model and observed data. The rationale for using LIPs is often said to be `to let the data speak for themselves'. LIPs are favored by objective Bayesians. \subsubsection{Flat Priors} \label{flatpriors} The flat prior was historically the first attempt at an uninformative prior. The unbounded, uniform distribution, often called a flat prior, is $$\theta \sim \mathcal{U}(-\infty, \infty)$$ where $\theta$ is uniformly-distributed from negative infinity to positive infinity. Although this seems to allow the posterior distribution to be affected soley by the data with no impact from prior information, this should generally be avoided because this probability distribution is improper, meaning it will not integrate to one since the integral of the assumed $p(\theta)$ is infinity (which violates the assumption that the probabilities sum to one). This may cause the posterior to be improper, which invalidates the model. Reverend Thomas Bayes (1701-1761) was the first to use inverse probability \citep{bayes63}, and used a flat prior for his billiard example so that all possible values of $\theta$ are equally likely \textit{a priori} \citep[p. 34-36]{gelman04}. Pierre-Simon Laplace (1749-1827) also used the flat prior to estimate the proportion of female births in a population, and for all estimation problems presented or justified as a reasonable expression of ignorance. Laplace's use of this prior distribution was later referred to as the `principle of indifference' or `principle of insufficient reason', and is now called the flat prior \citep[p. 39]{gelman04}. Laplace was aware that it was not truly uninformative, and used it as a LIP. Another problem with the flat prior is that it is not invariant to transformation. For example, a flat prior on a standard deviation parameter is not also flat for its variance or precision. \subsubsection{Hierarchical Prior} \label{hierarchicalpriors} A hierarchical prior is a prior in which the parameters of the prior distribution are estimated from data via hyperpriors, rather than with subjective information \citep{gelman08}. Parameters of hyperprior distributions are called hyperparameters. Subjective Bayesians prefer the hierarchical prior as the LIP, and the hyperparameters are usually specified as WIPs. Hierarchical priors are presented later in more detail in the section entitled `Hierarchical Bayes'. \subsubsection{Jeffreys Prior} \label{jeffreysprior} Jeffreys prior, also called Jeffreys rule, was introduced in an attempt to establish a least informative prior that is invariant to transformations \citep{jeffreys61}. Jeffreys prior works well for a single parameter, but multi-parameter situations may have inappropriate aspects accumulate across dimensions to detrimental effect. \subsubsection{MAXENT} \label{maxent} A MAXENT prior, proposed by \citet{jaynes68}, is a prior probability distribution that is selected among other candidate distributions as the prior of choice when it has the maximum entropy (MAXENT) in the considered set, given constraints on the candidate set. More entropy is associated with less information, and the least informative prior is preferred as a MAXENT prior. The principle of minimum cross-entropy generalizes MAXENT priors from mere selection to updating the prior given constraints while seeking the maximum, possible entropy. \subsubsection{Reference Priors} \label{referencepriors} Introduced by \citet{bernardo79}, reference priors do not express personal beliefs. Instead, reference priors allow the data to dominate the prior and posterior \citep{berger09}. Reference priors are estimated by maximizing the expected intrinsic discrepancy between the posterior distribution and prior distribution. This maximizes the expected posterior information about $\textbf{y}$ when the prior density is $p(\textbf{y})$. In some sense, $p(\textbf{y})$ is the `least informative' prior about $\textbf{y}$ \citep{bernardo05b}. Reference priors are often the objective prior of choice in multivariate problems, since other rules (e.g., Jeffreys rule) may result in priors with problematic behavior. When reference priors are used, the analysis is called reference analysis, and the posterior is called the reference posterior. Subjective Bayesian criticisms of reference priors are that the concepts of regularization and stabilization are not taken into account, results that contradict knowledge are not prevented, a numerical approximation algorithm may become stuck in low-probability or flat regions, and it may not be desirable to let the data speak fully. \subsection{Uninformative Priors} \label{uninformativepriors} Traditionally, most of the above descriptions of prior distributions were categorized as uninformative priors. However, uninformative priors do not truly exist \citep{irony97}, and all priors are informative in some way. Traditionally, there have been many names associated with uninformative priors, including diffuse, minimal, non-informative, objective, reference, uniform, vague, and perhaps weakly informative. \subsection{Proper and Improper Priors} \label{properpriors} It is important for the prior distribution to be proper. A prior distribution, $p(\theta)$, is improper\footnote{Improper priors were introduced in \citet{jeffreys61}.} when $$\int p(\theta) d\theta = \infty$$ As noted previously, an unbounded uniform prior distribution is an improper prior distribution because $p(\theta) \propto 1$, for $-\infty < \theta < \infty$. An improper prior distribution can cause an improper posterior distribution. When the posterior distribution is improper, inferences are invalid, it is non-integrable, and Bayes factors cannot be used (though there are exceptions). To determine the propriety of a joint posterior distribution, the marginal likelihood must be finite for all $\textbf{y}$. Again, the marginal likelihood is $$p(\textbf{y}) = \int p(\textbf{y} | \Theta) p(\Theta) d\Theta$$ Although improper prior distributions can be used, it is good practice to avoid them. \section{Hierarchical Bayes} \label{hierarchicalbayes} Prior distributions may be estimated within the model via hyperprior distributions, which are usually vague and nearly flat. Parameters of hyperprior distributions are called hyperparameters. Using hyperprior distributions to estimate prior distributions is known as hierarchical Bayes. In theory, this process could continue further, using hyper-hyperprior distributions to estimate the hyperprior distributions. Estimating priors through hyperpriors, and from the data, is a method to elicit the optimal prior distributions. One of many natural uses for hierarchical Bayes is multilevel modeling. Recall that the unnormalized joint posterior distribution (equation \ref{jointposterior}) is proportional to the likelihood times the prior distribution $$p(\Theta | \textbf{y}) \propto p(\textbf{y} | \Theta)p(\Theta)$$ The simplest hierarchical Bayes model takes the form $$p(\Theta, \Phi | \textbf{y}) \propto p(\textbf{y} | \Theta)p(\Theta | \Phi)p(\Phi)$$ where $\Phi$ is a set of hyperprior distributions. By reading the equation from right to left, it begins with hyperpriors $\Phi$, which are used conditionally to estimate priors $p(\Theta | \Phi)$, which in turn is used, as per usual, to estimate the likelihood $p(\textbf{y} | \Theta)$, and finally the posterior is $p(\Theta, \Phi | \textbf{y})$. \section{Conjugacy} \label{conjugacy} When the posterior distribution $p(\Theta | \textbf{y})$ is in the same family as the prior probability distribution $p(\Theta)$, the prior and posterior are then called conjugate distributions, and the prior is called a conjugate prior for the likelihood\footnote{The conjugate prior approach was introduced in \citet{raiffa61}.}. For example, the Gaussian family is conjugate to itself (or self-conjugate) with respect to a Gaussian likelihood function: if the likelihood function is Gaussian, then choosing a Gaussian prior for the mean will ensure that the posterior distribution is also Gaussian. All probability distributions in the exponential family have conjugate priors. See \citet{robert07} for a catalog. Although the gamma distribution is the conjugate prior distribution for the precision of a normal distribution \citep{spiegelhalter03}, $$\tau \sim \mathcal{G}(0.001, 0.001),$$ better properties for scale parameters are yielded with the non-conjugate, proper, half-Cauchy\footnote{The half-t distribution is another option.} distribution, with a general recommendation of scale=25 for a weakly informative scale parameter \citep{gelman06}, $$\sigma \sim \mathcal{HC}(25)$$ $$\tau = \sigma^{-2}$$ When the half-Cauchy is unavailable, a uniform distribution is often placed on $\sigma$ in hierarchical Bayes when the number of groups is, say, at least five, $$\sigma \sim \mathcal{U}(0, 100)$$ $$\tau = \sigma^{-2}$$ Conjugacy is mathematically convenient in that the posterior distribution follows a known parametric form \citep[p. 40]{gelman04}. It is obviously easier to summarize a normal distribution than a complex, multi-modal distribution with no known form. If information is available that contradicts a conjugate parametric family, then it may be necessary to use a more realistic, inconvenient, prior distribution. The basic justification for the use of conjugate prior distributions is similar to that for using standard models (such as the binomial and normal) for the likelihood: it is easy to understand the results, which can often be put in analytic form, they are often a good approximation, and they simplify computations. Also, they are useful as building blocks for more complicated models, including many dimensions, where conjugacy is typically impossible. For these reasons, conjugate models can be good starting points \citep[p. 41]{gelman04}. Nonconjugate prior distributions can make interpretations of posterior inferences less transparent and computation more difficult, though this alternative does not pose any conceptual problems. In practice, for complicated models, conjugate prior distributions may not even be possible \citep[p. 41-42]{gelman04}. When conjugate distributions are used, a summary statistic for a posterior distribution of $\theta$ may be represented as $t(\textbf{y})$ and said to be a sufficient statistic \citep[p. 42]{gelman04}. When nonconjugate distributions are used, a summary statistic for a posterior distribution is usually not a sufficient statistic. A sufficient statistic is a statistic that has the property of sufficiency with respect to a statistical model and the associated unknown parameter. The quantity $t(\textbf{y})$ is said to be a sufficient statistic for $\theta$, because the likelihood for $\theta$ depends on the data $\textbf{y}$ only through the value of $t(\textbf{y})$. Sufficient statistics are useful in algebraic manipulations of likelihoods and posterior distributions. \section{Likelihood} \label{likelihood} In order to complete the definition of a Bayesian model, both the prior distributions and the likelihood\footnote{Ronald A. Fisher, a prominent frequentist, introduced the term likelihood in 1921 \citep{fisher21}, though the concept of likelihood was used by Bayes and Laplace. Fisher's introduction preceded a series of the most influential papers in statistics (mostly in 1922 and 1925), in which Fisher introduced numerous terms that are now common: consistency, efficiency, estimation, information, maximum likelihood estimate, optimality, parameter, statistic, sufficiency, and variance. He was the first to use Greek letters for unknown parameters and Latin letters for the estimates. Later contributions include F statistics, design of experiments, ANOVA, and many more.} must be approximated or fully specified. The likelihood, likelihood function, or $p(\textbf{y} | \Theta)$, contains the available information provided by the sample. The likelihood is $$p(\textbf{y} | \Theta) = \prod^n_{i=1} p(\textbf{y}_i | \Theta)$$ The data $\textbf{y}$ affects the posterior distribution $p(\Theta | \textbf{y})$ only through the likelihood function $p(\textbf{y} | \Theta)$. In this way, Bayesian inference obeys the likelihood principle, which states that for a given sample of data, any two probability models $p(\textbf{y} | \Theta)$ that have the same likelihood function yield the same inference for $\Theta$. For more information on the likelihood principle, see section \ref{lprinciple}. \subsection{Terminology: From Inverse Probability to Bayesian Probability} \label{terminology} A gambler's dispute in 1654 led to the creation of a mathematical theory of probability by two famous French mathematicians, Blaise Pascal and Pierre de Fermat. Reverend Thomas Bayes (1701-1761) discovered Bayes' theorem, published posthumously in 1763, in which he was the first to use inverse probability \citep{bayes63}. `Inverse probability' refers to assigning a probability distribution to an unobserved variable, and is in essence, probability in the opposite direction of the usual sense. For example, the probability of obtaining heads on the next coin flip in a Bayesian context would be the predicted probability, $p(\textbf{y}^{new} | \textbf{y}, \theta)$, but to estimate this predicted probability, the probability distribution of $\theta$ must first be estimated, using coin toss data $\textbf{y}$ to estimate the parameter $\theta$ by the likelihood function $p(\textbf{y} | \theta)$, which contains the likelihood $p(\theta | \textbf{y})$, where $\theta$ is estimated from the data, $\textbf{y}$. Therefore, the data, $\textbf{y}$, is used to estimate the most probable $\theta$ that would lead to a data-generating process for $\textbf{y}$. Unaware of Bayes, Pierre-Simon Laplace (1749-1827) independently developed Bayes' theorem and first published his version in 1774, eleven years after Bayes, in one of Laplace's first major works \citep[p. 366-367]{laplace74}. In 1812, Laplace (1749-1827) introduced a host of new ideas and mathematical techniques in his book, \emph{Theorie Analytique des Probabilites} \citep{laplace12}. Before Laplace, probability theory was solely concerned with developing a mathematical analysis of games of chance. Laplace applied probabilistic ideas to many scientific and practical problems. Then, in 1814, Laplace published his ``Essai philosophique sur les probabilites'', which introduced a mathematical system of inductive reasoning based on probability \citep{laplace14}. In it, the Bayesian interpretation of probability was developed independently by Laplace, much more thoroughly than Bayes, so some ``Bayesians'' refer to Bayesian inference as Laplacian inference. The term ``inverse probability'' appears in an 1837 paper of Augustus De Morgan \citep{demorgan37}, in reference to Laplace's method of probability \citep{laplace74, laplace12}, though the term ``inverse probability'' does not occur in these works. Bayes' theorem has been referred to as ``the principle of inverse probability''. Terminology has changed, so that today, Bayesian probability (rather than inverse probability) refers to assigning a probability distribution to an unobservable variable. The ``distribution'' of an unobserved variable given data is the likelihood function (which is not a distribution), and the distribution of an unobserved variable, given both data and a prior distribution, is the posterior distribution. The term ``Bayesian'', which displaced ``inverse probability'', was in fact introduced by Ronald A. Fisher as a derogatory term. In modern terms, given a probability distribution $p(\textbf{y} | \theta)$ for an observable quantity $\textbf{y}$ conditional on an unobserved variable $\theta$, the ``inverse probability'' is the posterior distribution $p(\theta | \textbf{y})$, which depends both on the likelihood function (the inversion of the probability distribution) and a prior distribution. The distribution $p(\textbf{y} | \theta)$ itself is called the direct probability. However, $p(\textbf{y} | \theta)$ is also called the likelihood function, which can be confusing, seeming to pit the definitions of probability and likelihood against each other. A quick introduction to the likelihood principle follows, and finally all of the information on likelihood comes together in the section entitled ``Likelihood Function of a Parameterized Model''. \subsection{The Likelihood Principle} \label{lprinciple} An informal summary of the likelihood principle may be that inferences from data to hypotheses should depend on how likely the actual data are under competing hypotheses, not on how likely imaginary data would have been under a single ``null'' hypothesis or any other properties of merely possible data. Bayesian inferences depend only on the probabilities assigned due to the observed data, not due to other data that might have been observed. A more precise interpretation may be that inference procedures which make inferences about simple hypotheses should not be justified by appealing to probabilities assigned to observations that have not occurred. The usual interpretation is that any two probability models with the same likelihood function yield the same inference for $\theta$. Some authors mistakenly claim that frequentist inference, such as the use of maximum likelihood estimation (MLE), obeys the likelihood, though it does not. Some authors claim that the largest contention between Bayesians and frequentists regards prior probability distributions. Other authors argue that, although the subject of priors gets more attention, the true contention between frequentist and Bayesian inference is the likelihood principle, which Bayesian inference obeys, and frequentist inference does not. There have been many frequentist attacks on the likelihood principle, and have been shown to be poor arguments. Some Bayesians have argued that Bayesian inference is incompatible with the likelihood principle on the grounds that there is no such thing as an isolated likelihood function \citep{bayarri87}. They argue that in a Bayesian analysis there is no principled distinction between the likelihood function and the prior probability function. The objection is motivated, for Bayesians, by the fact that prior probabilities are needed in order to apply what seems like the likelihood principle. Once it is admitted that there is a universal necessity to use prior probabilities, there is no longer a need to separate the likelihood function from the prior. Thus, the likelihood principle is accepted `conditional' on the assumption that a likelihood function has been specified, but it is denied that specifying a likelihood function is necessary. Nonetheless, the likelihood principle is seen as a useful Bayesian weapon to combat frequentism. Following are some interesting qutoes from prominent statisticians: \begin{quote} ``Using Bayes' rule with a chosen probability model means that the data $\textbf{y}$ affect posterior inference 'only' through the function $p(\textbf{y} | \theta)$, which, when regarded as a function of $\theta$, for fixed $\textbf{y}$, is called the `likelihood function'. In this way Bayesian inference obeys what is sometimes called the `likelihood principle', which states that for a given sample of data, any two probability models $p(\textbf{y} | \theta)$ that have the same likelihood function yield the same inference for $\theta$'' \citep[p. 9]{gelman04}.\\ ``The likelihood principle is reasonable, but only within the framework of the model or family of models adopted for a particular analysis'' \citep[p. 9]{gelman04}.\\ Frequentist ``procedures typically violate the likelihood principle, since long-run behavior under hypothetical repetitions depends on the entire distribution $p(\textbf{y} | \theta)$, $\textbf{y} \in \textbf{Y}$ and not only on the likelihood'' \citep[p. 454]{bernardo00}.\\ There is ``a general fact about the mechanism of parametric Bayesian inference which is trivially obvious; namely `for any specified $p(\theta)$, if the likelihood functions $p_1(\textbf{y}_1 | \theta), p_2(\textbf{y}_2 | \theta)$ are proportional as functions of $\theta$, the resulting posterior densities for $\theta$ are identical'. It turns out...that many non-Bayesian inference procedures do not lead to identical inferences when applied to such proportional likelihoods. The assertion that they `should', the so-called `Likelihood Principle', is therefore a controversial issue among statisticians. In contrast, in the Bayesian inference context...this is a straightforward consequence of Bayes' theorem, rather than an imposed `principle' '' \citep[p. 249]{bernardo00}.\\ ``Although the likelihood principle is implicit in Bayesian statistics, it was developed as a separate principle by Barnard \citep{Barnard49}, and became a focus of interest when Birnbaum (1962) showed that it followed from the widely accepted sufficiency and conditionality principles'' \citep[p. 250]{bernardo00}.\\ ``The likelihood principle, by itself, is not sufficient to build a method of inference but should be regarded as a minimum requirement of any viable form of inference. This is a controversial point of view for anyone familiar with modern econometrics literature. Much of this literature is devoted to methods that do not obey the likelihood principle...'' \citep[p. 15]{rossi05}.\\ ``Adherence to the likelihood principle means that inferences are `conditional' on the observed data as the likelihood function is parameterized by the data. This is worth contrasting to any sampling-based approach to inference. In the sampling literature, inference is conducted by examining the sampling distribution of some estimator of $\theta$, $\hat{\theta} = f(\textbf{y})$. Some sort of sampling experiment results in a distribution of $\textbf{y}$ and therefore, the estimator is viewed as a random variable. The sampling distribution of the estimator summarizes the properties of the estimator `prior' to observing the data. As such, it is irrelevant to making inferences given the data we actually observe. For any finite sample, this dinstinction is extremely important. One must conclude that, given our goal for inference, sampling distributions are simply not useful'' \citep[p. 15]{rossi05}. \end{quote} \subsection{Likelihood Function of a Parameterized Model} \label{likelihoodfunction} In non-technical parlance, ``likelihood'' is usually a synonym for ``probability'', but in statistical usage there is a clear distinction: whereas ``probability'' allows us to predict unknown outcomes based on known parameters, ``likelihood'' allows us to estimate unknown parameters based on known outcomes. In a sense, likelihood can be thought a reversed version of conditional probability. Reasoning forward from a given parameter $\theta$, the conditional probability of $\textbf{y}$ is the density $p(\textbf{y} | \theta)$. With $\theta$ as a parameter, here are relationships in expressions of the likelihood function $$\mathscr{L}(\theta | \textbf{y}) = p(\textbf{y} | \theta) = f(\textbf{y} | \theta)$$ where $\textbf{y}$ is the observed outcome of an experiment, and the likelihood ($\mathscr{L}$) of $\theta$ given $\textbf{y}$ is equal to the density $p(\textbf{y} | \theta)$ or function $f(\textbf{y} | \theta)$. When viewed as a function of $\textbf{y}$ with $\theta$ fixed, it is not a likelihood function $\mathscr{L}(\theta | \textbf{y})$, but merely a probability density function $p(\textbf{y} | \theta)$. When viewed as a function of $\theta$ with $\textbf{y}$ fixed, it is a likelihood function and may be denoted as $\mathscr{L}(\theta | \textbf{y})$, $p(\textbf{y} | \theta)$, or $f(\textbf{y} | \theta)$\footnote{Note that $\mathscr{L}(\theta | \textbf{y})$ is not the same as the probability that those parameters are the right ones, given the observed sample.}. For example, in a Bayesian linear regression with an intercept and two independent variables, the model may be specified as $$\textbf{y}_i \sim \mathcal{N}(\mu_i, \sigma^2)$$ $$\mu_i = \beta_1 + \beta_2\textbf{X}_{i,1} + \beta_3\textbf{X}_{i,2}$$ The dependent variable $\textbf{y}$, indexed by $i=1,...,n$, is stochastic, and normally-distributed according to the expectation vector $\mu$, and variance $\sigma^2$. Expectation vector $\mu$ is an additive, linear function of a vector of regression parameters, $\beta$, and the design matrix \textbf{X}. Since $\textbf{y}$ is normally-distributed, the probability density function (PDF) of a normal distribution will be used, and is usually denoted as $$f(\textbf{y}) = \frac{1}{\sqrt{2\pi}\sigma}\exp[(-\frac{1}{2}\sigma^2)(\textbf{y}_i-\mu_i)^2]; \quad \textbf{y} \in (-\infty, \infty)$$ By considering a conditional distribution, the record-level likelihood in Bayesian notation is $$p(\textbf{y}_i | \Theta) = \frac{1}{\sqrt{2\pi}\sigma}\exp[(-\frac{1}{2}\sigma^2)(\textbf{y}_i-\mu_i)^2]; \quad \textbf{y} \in (-\infty, \infty)$$ In both theory and practice, and in both frequentist and Bayesian inference, the log-likelihood is used instead of the likelihood, on both the record- and model-level. The model-level product of record-level likelihoods can exceed the range of a number that can be stored by a computer, which is usually affected by sample size. By estimating a record-level log-likelihood, rather than likelihood, the model-level log-likelihood is the sum of the record-level log-likelihoods, rather than a product of the record-level likelihoods. $$\log[p(\textbf{y} | \theta)] = \sum^n_{i=1} \log[p(\textbf{y}_i | \theta)]$$ rather than $$p(\textbf{y} | \theta) = \prod^n_{i=1} p(\textbf{y}_i | \theta)$$ As a function of $\theta$, the unnormalized joint posterior distribution is the product of the likelihood function and the prior distributions. To continue with the example of Bayesian linear regression, here is the unnormalized joint posterior distribution $$p(\beta, \sigma^2 | \textbf{y}) = p(\textbf{y} | \beta, \sigma^2)p(\beta_1)p(\beta_2)p(\beta_3)p(\sigma^2)$$ More usually, the logarithm of the unnormalized joint posterior distribution is used, which is the sum of the log-likelihood and prior distributions. Here is the logarithm of the unnormalized joint posterior distribution for this example $$\log[p(\beta, \sigma^2 | \textbf{y})] = \log[p(\textbf{y} | \beta, \sigma^2)] + \log[p(\beta_1)] + \log[p(\beta_2)] + \log[p(\beta_3)] + \log[p(\sigma^2)]$$ The logarithm of the unnormalized joint posterior distribution is maximized with numerical approximation. \section{Numerical Approximation} \label{numericalapproximation} The technical problem of evaluating quantities required for Bayesian inference typically reduces to the calculation of a ratio of two integrals \citep[p. 339]{bernardo00}. In all cases, the technical key to the implementation of the formal solution given by Bayes' theorem is the ability to perform a number of integrations \citep[p. 340]{bernardo00}. Except in certain rather stylized problems, the required integrations will not be feasible analytically and, thus, efficient approximation strategies are required. There are too many different types of numerical approximation algorithms in Bayesian inference to cover in any detail in this article. An incomplete list of broad categories of Bayesian numerical approximation may include Approximate Bayesian Computation (ABC), Importance Sampling, Iterative Quadrature, Laplace Approximation, Markov chain Monte Carlo (MCMC), and Variational Bayes (VB). For more information on algorithms in \pkg{LaplacesDemon}, see the accompanying vignette entitled ``\pkg{LaplacesDemon} Tutorial''. Approximate Bayesian Computation (ABC), also called likelihood-free estimation, is a family of numerical approximation techniques in Bayesian inference. ABC is especially useful when evaluation of the likelihood, $p(\textbf{y} | \Theta)$ is computationally prohibitive, or when suitable likelihoods are unavailable. As such, ABC algorithms estimate likelihood-free approximations. ABC is usually faster than a similar likelihood-based numerical approximation technique, because the likelihood is not evaluated directly, but replaced with an approximation that is usually easier to calculate. The approximation of a likelihood is usually estimated with a measure of distance between the observed sample, $\textbf{y}$, and its replicate given the model, $\textbf{y}^{rep}$, or with summary statistics of the observed and replicated samples. Importance Sampling is a method of estimating a distribution with samples from a different distribution, called the importance distribution. Importance weights are assigned to each sample. The main difficulty with importance sampling is in the selection of the importance distribution. Importance sampling is the basis of a wide variety of algorithms, some of which involve the combination of importance sampling and Markov chain Monte Carlo. There are also many variations of importance sampling, including adaptive importance sampling, and parametric and nonparametric self-normalized importance sampling. Population Monte Carlo (PMC) is based on adaptive importance sampling. Iterative quadrature is a traditional approach to evaluating integrals. Multidimensional quadrature, often called cubature, performs well, but is limited usually to ten or fewer parameters. Componentwise quadrature may be applied to any model regardless of dimension, but estimates only variance, rather than covariance. Bayesian quadrature typically uses adaptive Gauss-Hermite quadrature, which assumes the marginal posterior distributions are normally-distrubted. Under this assumption, the conditional mean and conditional variance of each distribution is adapted each iteration according to the evaluation of samples determined by quadrature rules. Laplace Approximation dates back to \citet{laplace74, laplace14}, and is used to approximate the posterior moments of integrals. Specifically, the posterior mode is estimated for each parameter, assumed to be unimodal and Gaussian. As a Gaussian distribution, the posterior mean is the same as the posterior mode, and the variance is estimated. Laplace Approximation is a family of deterministic algorithms that usually converge faster than MCMC, and just a little slower than Maximum Likelihood Estimation (MLE) \citep{azevedo94}. Laplace Approximation shares many limitations of MLE, including asymptotic estimation with respect to sample size. MCMC algorithms originated in statistical physics and are now used in Bayesian inference to sample from probability distributions by constructing Markov chains. In Bayesian inference, the target distribution of each Markov chain is usually a marginal posterior distribution, such as each parameter $\theta$. Each Markov chain begins with an initial value and the algorithm iterates, attempting to maximize the logarithm of the unnormalized joint posterior distribution and eventually arriving at each target distribution. Each iteration is considered a state. A Markov chain is a random process with a finite state-space and the Markov property, meaning that the next state depends only on the current state, not on the past. The quality of the marginal samples usually improves with the number of iterations. A Monte Carlo method is an algorithm that relies on repeated pseudo-random sampling for computation, and is therefore stochastic (as opposed to deterministic). Monte Carlo methods are often used for simulation. The union of Markov chains and Monte Carlo methods is called MCMC. The revival of Bayesian inference since the 1980s is due to MCMC algorithms and increased computing power. The most prevalent MCMC algorithms may be the simplest: random-walk Metropolis and Gibbs sampling. There are a large number of MCMC algorithms, and further details on MCMC are best explored outside of this article. VB is a family of algorithms within variational inference. VB are deterministic optimization algorithms that approximate the posterior with a distribution. Each marginal posterior distribution is estimated with an approximating distribution. VB usually converges faster than MCMC. VB shares many limitations of MLE, including asymptotic estimation with respect to sample size. \section{Prediction} \label{prediction} The ``posterior predictive distribution'' is either the replication of $\textbf{y}$ given the model (usually represented as $\textbf{y}^{rep}$), or the prediction of a new and unobserved $\textbf{y}$ (usually represented as $\textbf{y}^{new}$ or $\textbf{y}'$), given the model. This is the likelihood of the replicated or predicted data, averaged over the posterior distribution $p(\Theta | \textbf{y})$ $$p(\textbf{y}^{rep} | \textbf{y}) = \int p(\textbf{y}^{rep} | \Theta)p(\Theta | \textbf{y}) d\Theta$$ or $$p(\textbf{y}^{new} | \textbf{y}) = \int p(\textbf{y}^{new} | \Theta)p(\Theta | \textbf{y}) d\Theta$$ If $\textbf{y}$ has missing values, then the missing $\textbf{y}$s can be estimated with the posterior predictive distribution\footnote{The predictive distribution was introduced by \citet{jeffreys61}.} as $\textbf{y}^{new}$ from within the model. For the linear regression example, the integral for prediction is $$p(\textbf{y}^{new} | \textbf{y}) = \int p(\textbf{y}^{new} | \beta,\sigma^2)p(\beta,\sigma^2 | \textbf{y}) d\beta d\sigma^2$$ The posterior predictive distribution is easy to estimate $$\textbf{y}^{new} \sim \mathcal{N}(\mu, \sigma^2)$$ where $\mu$ = \textbf{X}$\beta$, and $\mu$ is the conditional mean, while $\sigma^2$ is the residual variance. \section{Bayes Factors} \label{bayesfactors} Introduced by Harold Jeffreys, a `Bayes factor' is a Bayesian alternative to frequentist hypothesis testing that is most often used for the comparison of multiple models by hypothesis testing, usually to determine which model better fits the data \citep{jeffreys61}. Bayes factors are notoriously difficult to compute, and the Bayes factor is only defined when the marginal density of $\textbf{y}$ under each model is proper. However, Bayes factors are easy to approximate with the Laplace-Metropolis Estimator \citep{kass95, lewis97}\footnote{A Bayes factor may be estimated with the \code{BayesFactor} function in \pkg{LaplacesDemon} to compare multiple models that were fit with the \code{LaplaceApproximation} or \code{LaplacesDemon} functions. See the \code{BayesFactor} function for the interpretation of a Bayes factor regarding strength of evidence.}. Hypothesis testing with Bayes factors is more robust than frequentist hypothesis testing, since the Bayesian form avoids model selection bias, evaluates evidence in favor the null hypothesis, includes model uncertainty, and allows non-nested models to be compared (though of course the model must have the same dependent variable). Also, frequentist significance tests become biased in favor of rejecting the null hypothesis with sufficiently large sample size. The Bayes factor for comparing two models may be approximated as the ratio of the marginal likelihood of the data in model 1 and model 2. Formally, the Bayes factor in this case is $$B = \frac{p(\textbf{y}|\mathcal{M}_1)}{p(\textbf{y}|\mathcal{M}_2)} = \frac{\int p(\textbf{y}|\Theta_1,\mathcal{M}_1)p(\Theta_1|\mathcal{M}_1)d\Theta_1}{\int p(\textbf{y}|\Theta_2,\mathcal{M}_2)p(\Theta_2|\mathcal{M}_2)d\Theta_2}$$ where $p(\textbf{y}|\mathcal{M}_1)$ is the marginal likelihood of the data in model 1. The Bayes factor, $B$, is the posterior odds in favor of the hypothesis divided by the prior odds in favor of the hypothesis, where the hypothesis is usually $\mathcal{M}_1 > \mathcal{M}_2$. Put another way, \begin{center} (Posterior model odds) = (Bayes factor) x (prior model odds) \end{center} For example, when $B=2$, the data favor $\mathcal{M}_1$ over $\mathcal{M}_2$ with 2:1 odds. In a non-hierarchical model, the marginal likelihood may easily be approximated with the Laplace-Metropolis Estimator for model $m$ as $$p(\textbf{y}|m) = (2\pi)^{d_m/2}|\Sigma_m|^{1/2}p(\textbf{y}|\Theta_m,m)p(\Theta_m|m)$$ where $d$ is the number of parameters and $\Sigma$ is the inverse of the negative of the Hessian matrix of second derivatives. \citet{lewis97} introduce the Laplace-Metropolis method of approximating the marginal likelihood in MCMC, though it naturally works with Laplace Approximation as well. For a hierarchical model that involves both fixed and random effects, the Compound Laplace-Metropolis Estimator must be used. Gelman finds Bayes factors generally to be irrelevant, because they compute the relative probabilities of the models conditional on one of them being true. Gelman prefers approaches that measure the distance of the data to each of the approximate models \citep[p. 180]{gelman04}. However, \citet{kass95} explain that ``the logarithm of the marginal probability of the data may also be viewed as a predictive score. This is of interest, because it leads to an interpretation of the Bayes factor that does not depend on viewing one of the models as `true'''. Three of many possible alternatives are to use \begin{enumerate} \item pseudo Bayes factors (PsBF) based on a ratio of pseudo marginal likelihoods (PsMLs) \item Deviance Information Criterion (DIC) \item Widely Applicable Information Criterion (WAIC) \end{enumerate} DIC is the most popular method of assessing model fit and comparing models, though Bayes factors are better, when appropriate, because they take more into account. WAIC is a newer criterion. \section{Model Fit} \label{modelfit} In Bayesian inference, the most common method of assessing the goodness of fit of an estimated statistical model is a generalization of the frequentist Akaike Information Criterion (AIC). The Bayesian method, like AIC, is not a test of the model in the sense of hypothesis testing, though Bayesian inference has Bayes factors for such purposes. Instead, like AIC, Bayesian inference provides a model fit statistic that is to be used as a tool to refine the current model or select the better-fitting model of different methodologies. To begin with, model fit can be summarized with deviance, which is defined as -2 times the log-likelihood \citep[p. 180]{gelman04}, such as $$D(\textbf{y},\Theta) = -2\log[p(\textbf{y} | \Theta)]$$ Just as with the likelihood, $p(\textbf{y} | \Theta)$, or log-likelihood, the deviance exists at both the record- and model-level. Due to the development of \proglang{BUGS} software \citep{gilks94}, deviance is defined differently in Bayesian inference than frequentist inference. In frequentist inference, deviance is -2 times the log-likelihood ratio of a reduced model compared to a full model, whereas in Bayesian inference, deviance is simply -2 times the log-likelihood. In Bayesian inference, the lowest expected deviance has the highest posterior probability \citep[p. 181]{gelman04}. It is possible to have a negative deviance. Deviance is derived from the likelihood, which is derived from probability density functions (PDF). Evaluated at a certain point in parameter space, a PDF can have a density larger than 1 due to a small standard deviation or lack of variation. Likelihoods greater than 1 lead to negative deviance, and are appropriate. On its own, the deviance is an insufficient model fit statistic, because it does not take model complexity into account. The effect of model fitting, pD, is used as the `effective number of parameters' of a Bayesian model. The sum of the differences between the posterior mean of the model-level deviance and the deviance at each draw $i$ of $\theta_i$ is the pD. A related way to measure model complexity is as half the posterior variance of the model-level deviance, known as pV \citep[p. 182]{gelman04} $$\mathrm{pV} = \mathrm{var}(D) / 2$$ The effect of model fitting, pD or pV, can be thought of as the number of `unconstrained' parameters in the model, where a parameter counts as: 1 if it is estimated with no constraints or prior information; 0 if it is fully constrained or if all the information about the parameter comes from the prior distribution; or an intermediate value if both the data and the prior are informative \citep[p. 182]{gelman04}. Therefore, by including prior information, Bayesian inference is more efficient in terms of the effective number of parameters than frequentist inference. Hierarchical, mixed effects, or multilevel models are even more efficient regarding the effective number of parameters. Model complexity, pD or pV, should be positive. Although pV must be positive since it is related to variance, it is possible for pD to be negative, which indicates one or more problems: log-likelihood is non-concave, a conflict between the prior and the data, or that the posterior mean is a poor estimator (such as with a bimodal posterior). The sum of both the mean model-level deviance and the model complexity (pD or pV) is the Deviance Information Criterion (DIC), a model fit statistic that is also an estimate of the expected loss, with deviance as a loss function \citep{spiegelhalter98, spiegelhalter02}. DIC is $$\mathrm{DIC} = \bar{D} + \mathrm{pV}$$ DIC may be compared across different models and even different methods, as long as the dependent variable does not change between models, making DIC the most flexible model fit statistic. DIC is a hierarchical modeling generalization of the Akaike Information Criterion (AIC) and Bayesian Information Criterion (BIC). Like AIC and BIC, it is an asymptotic approximation as the sample size becomes large. DIC is valid only when the joint posterior distribution is approximately multivariate normal. Models should be preferred with smaller DIC. Since DIC increases with model complexity (pD or pV), simpler models are preferred. It is difficult to say what would constitute an important difference in DIC. Very roughly, differences of more than 10 might rule out the model with the higher DIC, differences between 5 and 10 are substantial, but if the difference in DIC is, say, less than 5, and the models make very different inferences, then it could be misleading just to report the model with the lowest DIC. The Widely Applicable Information Criterion (WAIC) is an information criterion that is more fully Bayesian than DIC. WAIC is more difficult to calculate because the record-level log-likelihood is required over numerous samples. However, when available, the result more closely resembles leave-one-out cross-validation (LOO-CV). The Bayesian Predictive Information Criterion (BPIC) was introduced as a criterion of model fit when the goal is to pick a model with the best out-of-sample predictive power \citep{ando07}. BPIC is a variation of DIC where the effective number of parameters is 2pD (or 2pV). BPIC may be compared between $\textbf{y}^{new}$ and $\textbf{y}^{holdout}$, and has many other extensions, such as with Bayesian Model Averaging (BMA). \section{Posterior Predictive Checks} \label{ppc} Comparing the predictive distribution $\textbf{y}^{rep}$ to the observed data $\textbf{y}$ is generally termed a ``posterior predictive check''. This type of check includes the uncertainty associated with the estimated parameters of the model, unlike frequentist statistics. Posterior predictive checks (via the predictive distribution) involve a double-use of the data, which violates the likelihood principle. However, arguments have been made in favor of posterior predictive checks, provided that usage is limited to measures of discrepancy to study model adequacy, not for model comparison and inference \citep{meng94}. Gelman recommends at the most basic level to compare $\textbf{y}^{rep}$ to $\textbf{y}$, looking for any systematic differences, which could indicate potential failings of the model \citep[p. 159]{gelman04}. It is often first recommended to compare graphical plots, such as the distribution of $\textbf{y}$ and $\textbf{y}^{rep}$. There are many posterior predictive checks that are not included in this article, but an introduction to a selection of them appears below. \subsection{Bayesian p-values} \label{bayesianpvalues} A Bayesian form of p-value may be estimated with a variety of test statistics \citep{gelman96a}. Usually the minimum or maximum observed $\textbf{y}$ is compared to the minimum or maximum $\textbf{y}^{rep}$. A Bayesian p-value is one of several ways to report discrepancies between $\textbf{y}$ and $\textbf{y}^{rep}$. Frequentist p-values have many problems, but here it will only be noted that the frequentist p-value estimates $p(\mathrm{data} | \mathrm{hypothesis})$, while in this case the Bayesian form estimates $p(\mathrm{hypothesis} | \mathrm{data})$. The frequentist estimates the wrong probability, because the frequentist is forced to consider the parameters to be fixed and the data random, projecting long-run frequencies of what should happen with future, repeated sampling of similar data, given a fixed parameter, or in this case hypothesis. Even the term hypothesis testing suggests you want to test the hypothesis given the data, not the data given the hypothesis\footnote{Numerous problems with frequentist p-values, confidence intervals, point estimates, and hypothesis testing are worth exploring, but not detailed in this article.}. \subsection{Chi-Square} \label{chisquare} \citet[p. 175]{gelman04} suggest an omnibus test such as the following $\chi^2$ $$\chi^2_i = \frac{(\textbf{y}_i - \frac{\sum^T_{t=1} \textbf{y}^{rep}_{i,t}}{T})^2}{\mathrm{var}(\textbf{y}^{rep}_{i,1:T})},$$ over records $i=1,\dots,N$ and posterior samples $t=1,\dots,T$. The sum of $\chi^2_i$ over records $i=1,\dots,N$ is an overall goodness of fit measure on the data set. Larger values of $\chi^2_i$ indicate a worse fit for each record. An alternative $\chi^2$ test is $$p(\chi^{2rep}_{i,1:T} > \chi^{2obs}_{i,1:T})$$ where a worse fit is indicated as $p$ approaches zero or one, and it is common to consider records with a poor fit to be outside the 95\% probability interval. To continue $$\chi^{2obs}_{i,1:T} = \frac{[\textbf{y}_i - E(\textbf{y}_i)]^2}{E(\textbf{y}_i)}$$ and $$\chi^{2rep}_{i,1:T} = \frac{[\textbf{y}^{rep}_{i,1:T} - E(\textbf{y}^{rep}_i)]^2}{E(\textbf{y}^{rep}_i)}$$ Newer forms of $\chi^2$ tests have been proposed in the literature, and are best explored elsewhere. \subsection{Conditional Predictive Ordinate} \label{cpo} Although the full predictive distribution $p(\textbf{y}^{rep} | \textbf{y})$ is useful for prediction, its use for model-checking is questionable because of the double-use of the data, and causes predictive performance to be overestimated. The leave-one-out cross-validation predictive density has been proposed \citep{geisser79}. This is also known as the Conditional Predictive Ordinate or CPO \citep{gelfand96}. The CPO is $$p(\textbf{y}_i | \textbf{y}_{[i]}) = \int p(\textbf{y}_i |\Theta)p(\Theta | \textbf{y}_{[i]})d\Theta$$ where $\textbf{y}_i$ is each instance of an observed $\textbf{y}$, and $\textbf{y}_{[i]}$ is $\textbf{y}$ without the current observation $i$. The CPO is easy to calculate with MCMC or PMC numerical approximation. By considering the inverse likelihood across $T$ iterations, the CPO for each individual $i$ is $$\mathrm{CPO}_i = \frac{1}{T^{-1} \displaystyle\sum^T_{t=1} p(\textbf{y}_i | \Theta_t)^{-1}}$$ The CPO is a handy posterior predictive check because it may be used to identify outliers, influential observations, and for hypothesis testing across different non-nested models. However, it may be difficult to calculate with latent mixtures. The CPO expresses the posterior probability of observing the value (or set of values) of $\textbf{y}_i$ when the model is fitted to all data except $\textbf{y}_i$, with a larger value implying a better fit of the model to $\textbf{y}_i$, and very low CPO values suggest that $\textbf{y}_i$ is an outlier and an influential observation. A Monte Carlo estimate of the CPO is obtained without actually omitting $\textbf{y}_i$ from the estimation, and is provided by the harmonic mean of the likelihood for $\textbf{y}_i$. Specifically, the $CPO_i$ is the inverse of the posterior mean of the inverse likelihood of $\textbf{y}_i$. The CPO is connected with the frequentist studentized residual test for outlier detection. Data with large studentized residuals have small CPOs and will be detected as outliers. An advantage of the CPO is that observations with high leverage will have small CPOs, independently of whether or not they are outliers. The Bayesian CPO is able to detect both outliers and influential points, whereas the frequentist studentized residual is unable to detect high-leverage outliers. Inverse-CPOs (ICPOs) larger than 40 can be considered as possible outliers, and higher than 70 as extreme values \citep[p. 376]{ntzoufras09}. Congdon recommends scaling CPOs by dividing each by its individual maximum (after the posterior mean) and considering observations with scaled CPOs under 0.01 to be outliers \citep{congdon05}. The range in scaled CPOs is useful as an indicator of a good-fitting model. The sum of the logged CPOs can be an estimator for the logarithm of the marginal likelihood\footnote{Exercise extreme caution when approximating the marginal likelihood from CPOs, or use a method with better repute, such as the Laplace-Metropolis Estimator or importance sampling.}, sometimes called the log pseudo marginal likelihood (LPsML). A ratio of PsMLs is a surrogate for the Bayes factor, sometimes known as the pseudo Bayes factor (PsBF). In this way, non-nested models may be compared with a hypothesis test to determine the better model, if one exists, based on leave-one-out cross-validation. \subsection{Predictive Concordance} \label{predictiveconcordance} \citet{gelfand96} suggests that any $\textbf{y}_i$ that is in either 2.5\% tail area of $\textbf{y}^{rep}_i$ should be considered an outlier. For each $i$, I am calling this the predictive quantile (PQ), which is calculated as $$\mathrm{PQ}_i = p(\textbf{y}^{rep}_i > \textbf{y}_i)$$ and is somewhat similar to the Bayesian p-value. The percentage of $\textbf{y}_i$s that are not outliers is called the `Predictive Concordance'. \citet{gelfand96} suggests the goal is to attempt to achieve 95\% predictive concordance. In the case of, say 80\% predictive concordance, the discrepancy between the model and data is undesirable because the model does not fit the data well and many outliers have resulted. On the other hand, if the predictive concordance is too high, say 100\%, then overfitting may have occurred, and it may be worth considering a more parsimonious model. Kernel density plots of each $\textbf{y}^{rep}_i$ distribution are useful in this case with the actual $\textbf{y}_i$ included as a vertical bar to show its position. \subsection{L-criterion} \label{lcriterion} \citet{laud95} introduced the L-criterion as one of three posterior predictive checks for model, variable, and transformation selection. The L-criterion is a posterior predictive check that is widely applicable and easy to apply. It is a sum of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The L-criterion measures model performance with a combination of how close its predictions are to the observed data and variability of the predictions. Better models have smaller values of L. L is measured in the same units as the response variable, and measures how close the data vector $\textbf{y}$ is to the predictive distribution. In addition to the value of L, there is a value for $S_L$, which is the calibration number of L, and is useful in determining how much of a decrease is necessary between models to be noteworthy. The L-criterion is $$\mathrm{L} = \sum^N_{i=1} \sqrt{\mathrm{var}(\textbf{y}^{rep}_{i,1:T}) + (\textbf{y}_i - \frac{\sum^T_{t=1} \textbf{y}^{rep}_{i,t}}{T})^2},$$ over $t=1,\dots,T$ posterior samples. The calibration number, $S_L$, is the standard deviation of L over records $i=1,\dots,N$. \citet{gelfand98} introduced Posterior Predictive Loss (PPL). This posterior predictive check for model comparison may be viewed as an extension to the L-criterion in which a weight $k$ is applied to the accuracy (fit) component. \section{Advantages Of Bayesian Inference Over Frequentist Inference} \label{advantages} Following is a short list of advantages of Bayesian inference over frequentist inference. \begin{itemize} \item Bayesian inference allows informative priors so that prior knowledge or results of a previous model can be used to inform the current model. \item Bayesian inference can avoid problems with model identification by manipulating prior distributions (usually in complex models). Frequentist inference with any numerical approximation algorithm does not have prior distributions, and can become stuck in regions of flat density, causing problems with model identification. \item Bayesian inference considers the data to be fixed (which it is), and parameters to be random because they are unknowns. Frequentist inference considers the unknown parameters to be fixed, and the data to be random, estimating not based on the data at hand, but the data at hand plus hypothetical repeated sampling in the future with similar data. ``The Bayesian approach delivers the answer to the right question in the sense that Bayesian inference provides answers conditional on the observed data and not based on the distribution of estimators or test statistics over imaginary samples not observed'' \citep[p. 4]{rossi05}. \item Bayesian inference estimates a full probability model. Frequentist inference does not. There is no frequentist probability distribution associated with parameters or hypotheses. \item Bayesian inference estimates $p(\mathrm{hypothesis} | \mathrm{data})$. In contrast, frequentist inference estimates $p(\mathrm{data} | \mathrm{hypothesis})$. Even the term 'hypothesis testing' suggests it should be the hypothesis that is tested, given the data, not the other way around. \item Bayesian inference has an axiomatic foundation \citep{cox46} that is uncontested by frequentists. Therefore, Bayesian inference is coherent to a frequentist, but frequentist inference is incoherent to a Bayesian. \item Bayesian inference has a decision theoretic foundation \citep{bernardo00,robert07}. The purpose of most of statistical inference is to facilitate decision-making \citep[p. 51]{robert07}. The optimal decision is the Bayesian decision. \item Bayesian inference includes uncertainty in the probability model, yielding more realistic predictions. Frequentist inference does not include uncertainty of the parameter estimates, yielding less realistic predictions. \item Bayesian inference is consistent with much of philosophy of science regarding epistemology, where knowledge cannot be built entirely through experimentation, but requires prior knowledge \cite[p. 510]{robert07}. Elsewhere, it has been suggested that the best choice for philosophy of science is through Bayesian inference. \item Bayesian inference may use DIC to compare models with different methods including hierarchical models, where frequentist model fit statistics cannot compare different methods or hierarchical models. \item Bayesian inference obeys the likelihood principle. Frequentist inference, including Maximum Likelihood Estimation (MLE) and the General Method of Moments (GMM) or Generalized Estimating Equations (GEE), violates the likelihood principle. ``The likelihood principle, by itself, is not sufficient to build a method of inference but should be regarded as a minimum requirement of any viable form of inference. This is a controversial point of view for anyone familiar with modern econometrics literature. Much of this literature is devoted to methods that do not obey the likelihood principle...'' \citep[p. 15]{rossi05}. \item Bayesian inference safeguards against overfitting by integrating over model parameters. While Bayesian inference is not immune to overfitting, overfitting is largely a frequentist problem. \item Bayesian inference uses observed data only. Frequentist inference uses both observed data and future data that is unobserved and hypothetical. \item Bayesian inference uses prior distributions, so more information is used and 95\% probability intervals of posterior distributions should be narrower than 95\% confidence intervals of frequentist point-estimates. \item Bayesian inference uses probability intervals (quantile-based, highest posterior density, or preferably lowest posterior loss) to state the probability that $\theta$ is between two points. Frequentist inference uses confidence intervals, which must be interpreted with probability of zero or one that $\theta$ is in the region, and the frequentist never knows whether it is or is not, but can only say that if 100 repeated samples were drawn in the future, that it would be in the region for 95 samples. \item Bayesian inference via MCMC or PMC algorithms allows more complicated models that frequentists are unable to estimate. \item Bayesian inference via MCMC has a theoretic guarantee that the MCMC algorithm will converge if run long enough. Frequentist inference with Maximum Likelihood Estimation (MLE) has no guarantee of convergence. \item Bayesian inference via MCMC or PMC is unbiased with respect to sample size and can accommodate any sample size no matter how small. Frequentist inference becomes more biased as sample size decreases from infinity, and is often wildly biased with small samples, so minimum sample size is an issue. Conversely, frequentist inference with large sample sizes biases p-values to indicate that insignificant effects are significant. \item Bayesian inference via MCMC or PMC uses exact estimation with respect to sample size. Frequentist inference uses approximate estimation that relies on asymptotic theory. \item Bayesian inference with correlated predictors sometimes allows the hyperparameters to be distributed multivariate-normal, therefore including such correlation into the MCMC or PMC algorithm to improve estimation. Frequentist inference does not use prior distributions, so confidence intervals are wider and less certain with correlated predictors. \item Bayesian inference with proper priors is immune to singularities and near-singularities with matrix inversions, unlike frequentist inference. \end{itemize} \section{Advantages Of Frequentist Inference Over Bayesian Inference} \label{disadvantages} Following is a short list of advantages of frequentist inference over Bayesian inference. \begin{itemize} \item Frequentist models are perceived to handle large data sets, while Bayesian models via MCMC have traditionally been restricted to small sample sizes, and Laplace Approximation is similar to the frequentist method in that it is known to be able to handle large data sets. This reputation is no longer true for MCMC. Samplers in \code{LaplacesDemon} do not usually loop through records and can handle large data sets. But most importantly, algorithms now exist (and are available here) that enable fast Bayesian inference with big data. \item Frequentist models are usually much easier to prepare because many things do not need to be specified, such as prior distributions, initial values for numerical approximation, and usually the likelihood function. Most frequentist methods have been standardized to ``procedures'' where less knowledge and programming are required, and in many cases the user can just click on a few things and not really know what they are doing. Garbage in, garbage out. \item Frequentist models optimized with MLE have much shorter run-times than Bayesian models via MCMC or PMC. This is not a difference between frequentist and Bayesian methods, but is due to optimization vs. sampling algorithms. MCMC has a longer run-time, whether it is Bayesian or frequentist. Laplace Approximation uses optimization algorithms, and yields run-times similar to frequentist MLE. If frequentist MLE and Bayesian Laplace Approximation seem to have very different run-times, it is probably due to differences between a method-specific algorithm vs. a general-purpose algorithm. \end{itemize} As they say, it pays to go Bayes. \bibliography{References} \end{document} LaplacesDemon/vignettes/References.bib0000755000176200001440000015141315144347077017554 0ustar liggesusers@article{albert97, author = "Albert, J.", title = "Bayesian Testing and Estimation of Association in a Two-Way Contingency Table", year = "1997", journal = "Journal of the American Statistical Association", volume = "92", number = "438", pages = "685--693" } @article{ando07, author = "Ando, T.", title = "Bayesian Predictive Information Criterion for the Evaluation of Hierarchical Bayesian and Empirical Bayes Models", year = "2007", journal = "Biometrika", volume = "94", number = "2", pages = "443--458" } @article{anscombe63, author = "Anscombe, F.J. and Aumann, R.J.", title = "A Definition of Subjective Probability", year = "1963", journal = "The Annals of Mathematical Statistics", volume = "34", number = "1", pages = "199--205" } @article{atchade06, author = "Atchade, Y.F.", title = "An Adaptive Version for the Metropolis Adjusted Langevin Algorithm with a Truncated Drift", year = "2006", journal = "Methodology and Computing in Applied Probability", volume = "8", pages = "235--254" } @article{atchade11, author = "Atchade, Y.F. and Roberts, G.O. and Rosenthal, J.S.", title = "Towards Optimal Scaling of Metropolis-Coupled Markov Chain Monte Carlo", year = "2011", journal = "Statistics and Computing", volume = "21", number = "4", pages = "555--568" } @inproceedings{azevedo94, author = "Azevedo-Filho, A. and Shachter, R.", title = "Laplace's Method Approximations for Probabilistic Inference in Belief Networks with Continuous Variables", pages = "28--36", booktitle = "Uncertainty in Artificial Intelligence", editor = "Mantaras, R. and Poole, D.", publisher = "Morgan Kauffman, San Francisco, CA", year = "1994" } @misc{bai09, author = "Bai, Y.", title = "An Adaptive Directional Metropolis-within-Gibbs Algorithm", year = "2009", howpublished = "Technical Report in Department of Statistics at the University of Toronto", } @article{barnard00, author = "Barnard, J. and McCulloch, R. and Meng, X.", title = "Modeling Covariance Matrices in Terms of Standard Deviations and Correlations, with Application to Shrinkage", year = "2000", journal = "Statistica Sinica", volume = "10", pages = "1281--1311" } @article{barnard49, author = "Barnard, G.A.", title = "Statistical Inference", year = "1949", journal = "Journal of the Royal Statistical Society", volume = "B 11", pages = "115--149" } @article{bayarri87, author = "Bayarri, M.J. and DeGroot, M.H.", title = "Bayesian Analysis of Selection Models", year = "1987", journal = "The Statistician", volume = "36", pages = "136--146" } @article{bayes63, author = "Bayes, T. and Price, R.", title = "An Essay Towards Solving a Problem in the Doctrine of Chances. By the late Rev. Mr. Bayes, communicated by Mr. Price, in a letter to John Canton, MA. and F.R.S.", year = "1763", journal = "Philosophical Transactions of the Royal Society of London", volume = "53", pages = "370--418" } @article{berger06, author = "Berger, J.", title = "The Case for Objective Bayesian Analysis", year = "2006", journal = "Bayesian Analysis", volume = "1", number = "3", pages = "385--402" } @article{berger09, author = "Berger, J.O. and Bernardo, J.M. and Dongchu, S.", title = "The Formal Definition of Reference Priors", year = "2009", journal = "Annals of Statistics", volume = "37", number = "2", pages = "905--938" } @article{bernardo79, author = "Bernardo, J.M.", title = "Reference Posterior Distributions for Bayesian Inference (with discussion)", year = "1979", journal = "Journal of the Royal Statistical Society", volume = "B 41", pages = "113--147" } @book{bernardo00, author = "Bernardo, J.M. and Smith, A.F.M.", title = "Bayesian Theory", year = "2000", publisher = "John Wiley \& Sons", address = "West Sussex, England" } @article{bernardo02, author = "Bernardo, J.M. and Rueda, R.", title = "Bayesian Hypothesis Testing: A Reference Approach", year = "2002", journal = "International Statistical Review", volume = "70", pages = "351--372" } @article{bernardo05a, author = "Bernardo, J.M.", title = "Intrinsic Credible Regions: An Objective Bayesian Approach to Interval Estimation", year = "2005", journal = "Sociedad de Estadistica e Investigacion Operativa", volume = "14", number = "2", pages = "317--384" } @incollection{bernardo05b, author = "Bernardo, J.M.", title = "Reference Analysis", pages = "17--90", booktitle = "Handbook of Statistics 25", editor = "Dey, D.K. and Rao, C.R.", publisher = "Elsevier, Amsterdam", year = "2005" } @article{bernardo08, author = "Bernardo, J.M.", title = "Comment on Article by Gelman", year = "2008", journal = "Bayesian Analysis", volume = "3", number = "3", pages = "451--454" } @article{berndt74, author = "Berndt, E. and Hall, B. and Hall, R. and Hausman, J.", title = "Estimation and Inference in Nonlinear Structural Models", year = "1974", journal = "Annals of Economic and Social Measurement", volume = "3", pages = "653--665" } @article{besag93, author = "Besag, J. and Green, P.", title = "Spatial Statistics and Bayesian Computation", year = "1993", journal = "Journal of the Royal Statistical Society", volume = "B 55", pages = "25--37" } @article{beskos08, author = "Beskos, A. and Roberts, G.O. and Stuart, A.M. and Voss, J.", title = "MCMC Methods for Diffusion Bridges", year = "2008", journal = "Stoch. Dyn.", volume = "8", pages = "319--350" } @article{birnbaum62, author = "Birnbaum, A.", title = "On the Foundations of Statistical Inference", year = "1962", journal = "Journal of the American Statistical Association", volume = "57", pages = "296--306" } @article{bornkamp11, author = "Bornkamp, B.", title = "Approximating Probability Densities by Iterated Laplace Approximations", year = "2011", journal = "Journal of Computational and Graphical Statistics", volume = "20", number = "3", pages = "656--669" } @misc{bouriga11, author = "Bouriga, M. and Feron, O.", title = "Estimation of Covariance Matrices Based on Hierarchical Inverse-Wishart Priors", year = "2011", howpublished = "\url{http://www.citebase.org/abstract?id=oai:arXiv.org:1106.3203}", } @misc{boyles12, author = "Boyles, L.B. and Welling, M.", title = "Refractive Sampling", year = "2012", howpublished = "\url{http://www.ics.uci.edu/~lboyles/publications.html}", } @article{broyden70, author = "Broyden, C.G.", title = "The Convergence of a Class of Double Rank Minimization Algorithms: 2. The New Algorithm", year = "1970", journal = "Journal of the Institute of Mathematics and its Applications", volume = "6", pages = "76--90" } @misc{burns07, author = "Burns, P.", title = "R Relative to Statistical Packages", year = "2007", howpublished = "\url{http://www.ats.ucla.edu/stat/technicalreports/}", } @article{cappe04, author = "Cappe, O. and Guillin, A. and Marin, J.M. and Robert, C.", title = "Population Monte Carlo", year = "2004", journal = "Journal of Computational and Graphical Statistics", volume = "13", pages = "907--929" } @article{cappe08, author = "Cappe, O. and Douc, R. and Guillin, A. and Marin, J.M. and Robert, C.", title = "Adaptive Importance Sampling in General Mixture Classes", year = "2008", journal = "Statistics and Computing", volume = "18", pages = "587--600" } @article{carlin92, author = "Carlin, B.P. and Polson, N.G. and Stoffer, D.S.", title = "A Monte Carlo Approach to Nonnormal and Nonlinear State-Space Modeling", year = "1992", journal = "Journal of the American Statistical Association", volume = "87", pages = "493--500" } @article{chen92, author = "Chen, M. and Schmeiser, B.", title = "Performance of the Gibbs, Hit-And-Run and Metropolis Samplers", year = "1992", journal = "Journal of Computational and Graphical Statistics", volume = "2", pages = "251--272" } @article{christen10, author = "Christen, J.A. and Fox, C.", title = "A General Purpose Sampling Algorithm for Continuous Distributions (the t-walk)", year = "2010", journal = "Bayesian Analysis", volume = "5(2)", pages = "263--282" } @book{congdon03, author = "Congdon, P.", title = "Applied Bayesian Modelling", year = "2003", publisher = "John Wiley \& Sons", address = "West Sussex, England" } @book{congdon05, author = "Congdon, P.", title = "Bayesian Models for Categorical Data", year = "2005", publisher = "John Wiley \& Sons", address = "West Sussex, England" } @book{congdon06, author = "Congdon, P.", title = "Bayesian Statistical Modelling", edition = "2nd", year = "2006", publisher = "John Wiley \& Sons", address = "West Sussex, England" } @article{cox46, author = "Cox, R.T.", title = "Probability, Frequency and Reasonable Expectation", year = "1946", journal = "American Journal of Physics", volume = "14", number = "1", pages = "1--13" } @article{crainiceanu05, author = "Crainiceanu, C.M. and Ruppert, D. and Wand, M.P.", title = "Bayesian Analysis for Penalized Spline Regression Using WinBUGS", year = "2005", journal = "Journal of Statistical Software", volume = "14", number = "14", pages = "1--24" } @article{craiu09, author = "Craiu, R.V. and Rosenthal, J. and Yang, C.", title = "Learn From Thy Neighbor: Parallel-Chain and Regional Adaptive MCMC", year = "2009", journal = "Journal of the American Statistical Association", volume = "104", number = "488", pages = "1454--1466" } @book{crawley07, author = "Crawley, M.", title = "The R Book", year = "2007", publisher = "John Wiley \& Sons Ltd", address = "West Sussex, England" } @article{daniels99, author = "Daniels, M. and Kass, R.", title = "Nonconjugate Bayesian Estimation of Covariance Matrices and its use in Hierarchical Models", year = "1999", journal = "Journal of the American Statistical Association", volume = "94", number = "448", pages = "1254--1263" } @article{definetti31, author = "De Finetti, B.", title = "Probabilismo", year = "1931", journal = "Erkenntnis", volume = "31", pages = "169--223", note = "English translation as ``Probabilism: A Critical Essay on the Theory of Probability and on the Value of Science''" } @article{definetti37, author = "De Finetti, B.", title = "La Prevision: ses lois logigues, ses sources subjectives", year = "1937", journal = "Annales de l'Institut Henri Poincare", note = "English translation in H.E. Kyburg and H.E. Smokler (eds), (1964), ``Foresight: Its Logical Laws, Its Subjective Sources'', Studies in Subjective Probability, New York: Wiley." } @article{delnegro08, author = "Del Negro, M. and Otrok, C.", title = "Dynamic Factor Models with Time-Varying Parameters: Measuring Changes in International Business Cycles", year = "2008", journal = "Federal Reserve Bank of New York Staff Report", volume = "326", pages = "1--46" } @article{demorgan37, author = "De Morgan, A.", title = "Review of Laplace's Theorie Analytique des Probabilites", year = "1837", journal = "Dublin Review", volume = "2,3", pages = "338--354,237--354" } @article{draper95, author = "Draper, D.", title = "Assessment and Propagation of Model Uncertainty", year = "1995", journal = "Journal of the Royal Statistical Society", volume = "B 57", number = "1", pages = "45--97" } @article{duane87, author = "Duane, S. and Kennedy, A. D. and Pendleton, B. J. and Roweth, D.", title = "Hybrid Monte Carlo", year = "1987", journal = "Physics Letters", volume = "B", number = "195", pages = "216--222" } @article{dutta12, author = "Dutta, S.", title = "Multiplicative Random Walk Metropolis-Hastings on the Real Line", year = "2012", journal = "Sankhya B", volume = "74", number = "2", pages = "315--342" } @article{earl05, author = "Earl, D.J. and Deem, M.W.", title = "Parallel Tempering: Theory, Applications, and New Perspectives", year = "2005", journal = "Journal of Chemistry Chemical Physics", volume = "7", pages = "3910--3916" } @incollection{fearnhead11, author = "Fearnhead, P.", title = "MCMC for State-Space Models", pages = "513--530", booktitle = "Handbook of Markov Chain Monte Carlo", editor = "Brooks, S. and Gelman, A. and Jones, G.L. and Xiao-Li, M.", publisher = "Chapman \& Hall, Boca Raton, FL", year = "2011" } @article{fienberg06, author = "Fienberg, S.E.", title = "When Did Bayesian Inference Become ``Bayesian''", year = "2006", journal = "Bayesian Analysis", volume = "1", number = "1", pages = "1--40" } @article{fisher21, author = "Fisher, R.A.", title = "On the `Probable Error' of a Coefficient of Correlation Deduced From a Small Sample", year = "1921", journal = "Metron", volume = "1", number = "4", pages = "3--32" } @article{flegal08, author = "Flegal, J.M. and Haran, M. and Jones, G.L.", title = "Markov chain Monte Carlo: Can We Trust the Third Significant Digit", year = "2008", journal = "Statistical Science", volume = "23", pages = "250--260" } @article{fletcher70, author = "Fletcher, R.", title = "A New Approach to Variable Metric Algorithms", year = "1970", journal = "Computer Journal", volume = "13", number = "3", pages = "317--322" } @misc{fokoue04, author = "Fokoue, E.", title = "Stochastic Determination of the Intrinsic Structure in Bayesian Factor Analysis", year = "2004", howpublished = "Technical Report 2004-17, Statistical and Mathematical Sciences Institute, Research Triangle Park, NC, \url{www.samsi.info}", } @misc{foreman12, author = "Foreman-Mackey, D. and Hogg, D.W. and Lang, D. and Goodman, J.", title = "emcee: The MCMC Hammer", year = "2012", howpublished = "Upcoming in Publications of the Astronomical Society of the Pacific, \url{http://arxiv.org/abs/1202.3665}", } @article{frantz90, author = "Frantz, D.D. and Freeman, J.D. and Doll, J.L.", title = "Reducing Quasi-Ergodic Behavior in Monte Carlo Simulations by J-Walking: Applications to Atomic Clusters", year = "1990", journal = "Journal of Chemical Physics", volume = "93", pages = "2769--2784" } @article{gallo12, author = "Gallo, Elena and Miller, Brendan and Fender, Rob", title = "Assessing luminosity correlations via cluster analysis: Evidence for dual tracks in the radio/X-ray domain of black hole X-ray binaries", year = "2012", journal = "Monthly Notices of the Royal Astronomical Society", volume = "423", pages = "590--599" } @article{garthwaite10, author = "Garthwaite, P.H. and Fan, Y. and Sisson, S.A.", title = "Adaptive Optimal Scaling of Metropolis-Hastings Algorithms Using the Robbins-Monro Process", year = "2010", howpublished = "\url{http://arxiv.org/abs/1006.3690}", } @article{geisser79, author = "Geisser, S. and Eddy, W.F.", title = "A Predictive Approach to Model Selection", year = "1979", journal = "Journal of the American Statistical Association", volume = "74", pages = "153--160" } @incollection{gelfand96, author = "Gelfand, A.", title = "Model Determination Using Sampling Based Methods", pages = "145--161", booktitle = "Markov Chain Monte Carlo in Practice", editor = "Gilks, W. and Richardson, S. and Spiegelhalter, D.", publisher = "Chapman \& Hall, Boca Raton, FL", year = "1996" } @article{gelfand98, author = "Gelfand, A. and Ghosh, S.", title = "Model Choice: A Minimum Posterior Predictive Loss Approach", year = "1998", journal = "Biometrika", volume = "85", pages = "1--11" } @article{gelman92, author = "Gelman, A. and Rubin, D.", title = "Inference from Iterative Simulation Using Multiple Sequences", year = "1992", journal = "Statistical Science", volume = "7", number = "4", pages = "457--472" } @article{gelman96a, author = "Gelman, A. and Meng, X.L. and Stern, H.", title = "Posterior Predictive Assessment of Model Fitness via Realized Discrepancies", year = "1996", journal = "Statistica Sinica", volume = "6", pages = "773--807" } @article{gelman96b, author = "Gelman, A. and Roberts, G.O. and Gilks, W.R.", title = "Efficient Metropolis Jumping Rules", year = "1996", journal = "Bayesian Statistics", volume = "5", pages = "599--608" } @book{gelman04, author = "Gelman, A. and Carlin, J.B. and Stern, H.S. and Rubin, D.", title = "Bayesian Data Analysis", edition = "2nd", year = "2004", publisher = "Chapman \& Hall", address = "Boca Raton, FL" } @article{gelman06, author = "Gelman, A.", title = "Prior Distributions for Variance Parameters in Hierarchical Models", year = "2006", journal = "Bayesian Analysis", volume = "1", number = "3", pages = "515--533" } @article{gelman08, author = "Gelman, A.", title = "Scaling Regression Inputs by Dividing by Two Standard Deviations", year = "2008", journal = "Statistics in Medicine", volume = "27", pages = "2865--2873" } @book{gelman14, author = "Gelman, A. and Carlin, J.B. and Stern, H.S. and Dunson, D.B. and Vehtari, A. and Rubin, D.B.", title = "Bayesian Data Analysis", edition = "3rd", year = "2014", publisher = "CRC Press", address = "Boca Raton, FL" } @article{geman84, author = "Geman, S. and Geman, D.", title = "Stochastic Relaxation, Gibbs Distributions, and the Bayesian Restoration of Images", year = "1984", journal = "IEEE Transactions on Pattern Analysis and Machine Intelligence", volume = "6", number = "6", pages = "721--741" } @article{geweke92, author = "Geweke, J.", title = "Evaluating the Accuracy of Sampling-Based Approaches to the Calculation of Posterior Moments", year = "1992", journal = "Bayesian Statistics", volume = "4", pages = "1--31" } @article{geweke01, author = "Geweke, J. and Tanizaki, H.", title = "Bayesian Estimation of State-Space Models Using the Metropolis-Hastings Algorithm within Gibbs Sampling", year = "2001", journal = "Computational Statistics and Data Analysis", volume = "37", pages = "151--170" } @incollection{geyer91, author = "Geyer, C.J.", title = "Markov Chain Monte Carlo Maximum Likelihood", pages = "156--163", booktitle = "Computing Science and Statistics: Proceedings of the 23rd Symposium of the Interface", editor = "Keramidas, E.M.", publisher = "Fairfax Station VA: Interface Foundation", year = "1991" } @article{geyer92, author = "Geyer, C.J.", title = "Practical Markov Chain Monte Carlo (with Discussion)", year = "1992", journal = "Statistical Science", volume = "7", number = "4", pages = "473--511" } @incollection{geyer11, author = "Geyer, C.J.", title = "Introduction to Markov Chain Monte Carlo", pages = "3--48", booktitle = "Handbook of Markov Chain Monte Carlo", editor = "Brooks, S. and Gelman, A. and Jones, G.L. and Xiao-Li, M.", publisher = "Chapman \& Hall, Boca Raton, FL", year = "2011" } @article{gilks94, author = "Gilks, W.R. and Thomas, A. and Spiegelhalter, D.J.", title = "A Language and Program for Complex Bayesian Modelling", year = "1994", journal = "The Statistician", volume = "43", number = "1", pages = "169--177" } @incollection{gilks96, author = "Gilks, W.R. and Roberts, G.O.", title = "Strategies for Improving MCMC", pages = "89--114", booktitle = "Markov Chain Monte Carlo in Practice", editor = "Gilks, W. and Richardson, S. and Spiegelhalter, D.", publisher = "Chapman \& Hall, Boca Raton, FL", year = "1996" } @article{goldfarb70, author = "Goldfarb, D.", title = "A Family of Variable Metric Methods Derived by Variational Means", year = "1970", journal = "Mathematics of Computation", volume = "24", number = "109", pages = "23--26" } @article{goldstein06, author = "Goldstein, M.", title = "Subjective Bayesian Analysis: Principles and Practice", year = "2006", journal = "Bayesian Analysis", volume = "1", number = "3", pages = "403--420" } @article{goodman10, author = "Goodman, J. and Weare, J.", title = "Ensemble Samplers with Affine Invariance", year = "2010", journal = "Communications in Applied Mathematics and Computational Science", volume = "5", number = "1", pages = "65--80" } @article{green95, author = "Green, P.J.", title = "Reversible Jump Markov Chain Monte Carlo Computation and Bayesian Model Determination", year = "1995", journal = "Biometrika", volume = "82", pages = "711--732" } @article{haario01, author = "Haario, H. and Saksman, E. and Tamminen, J.", title = "An Adaptive Metropolis Algorithm", year = "2001", journal = "Bernoulli", volume = "7", number = "2", pages = "223--242" } @article{haario05, author = "Haario, H. and Saksman, E. and Tamminen, J.", title = "Componentwise Adaptation for High Dimensional MCMC", year = "2005", journal = "Computational Statistics", volume = "20", number = "2", pages = "265--274" } @article{haario06, author = "Haario, H. and Laine, M. and Mira, A. and Saksman, E.", title = "DRAM: Efficient Adaptive MCMC", year = "2006", journal = "Statistical Computing", volume = "16", pages = "339--354" } @article{halpern99, author = "Halpern, J.Y.", title = "A Counterexample to Theorems of Cox and Fine", year = "1999", journal = "Journal of Artificial Intelligence Research", volume = "10", pages = "67--85" } @incollection{hartmann10, author = "Hartmann, S. and Sprenger, J.", title = "Bayesian Epistemology", pages = "1--19", booktitle = "Routledge Companion to Epistemology", editor = "Bernecker, S. and Pritchard, D.", publisher = "Routledge: London, England", year = "2010" } @article{hastings70, author = "Hastings, W.K.", title = "Monte Carlo Sampling Methods Using Markov Chains and Their Applications", year = "1970", journal = "Biometrika", volume = "57", number = "1", pages = "97--109" } @article{hestenes52, author = "Hestenes, M.R. and Stiefel, E.", title = "Methods of Conjugate Gradients for Solving Linear Systems", year = 1952, journal = "Journal of Research of the National Bureau of Standards", volume = "49", number = "6", pages = "409--436" } @article{higham02, author = "Higham, N.J.", title = "Computing the Nearest Correlation Matrix - a Problem from Finance", year = 2002, journal = "IMA Journal of Numerical Analysis", volume = "22", pages = "329--343" } @article{hoffman12, author = "Hoffman, M.D. and Gelman, A.", title = "The No-U-Turn Sampler: Adaptively Setting Path Lengths in Hamiltonian Monte Carlo", year = 2012, journal = "Journal of Machine Learning Research", pages = "1--30" } @article{hooke61, author = "Hooke, R. and Jeeves, T.A.", title = "'Direct Search' Solution of Numerical and Statistical Problems", year = 1961, journal = "Journal of the Association for Computing Machinery", volume = "8", number = "3", pages = "212--229" } @article{hyndman07, author = "Hyndman, R.J. and Kostenko, A.V.", title = "Minimum Sample Size Requirements for Seasonal Forecasting Models", year = "2007", journal = "Foresight", volume = "6", pages = "12--15" } @article{ibrahim00, author = "Ibrahim, J.G. and Chen, M.H.", title = "Power Prior Distributions for Regression Models", year = "2000", journal = "Statistical Science", volume = "15", pages = "46--60" } @article{irony97, author = "Irony, T.Z. and Singpurwalla, N.D.", title = "Noninformative Priors Do Not Exist: a Discussion with Jose M. Bernardo", year = "1997", journal = "Journal of Statistical Inference and Planning", volume = "65", pages = "159--189" } @article{jaynes68, author = "Jaynes, E.T.", title = "Prior Probabilities", year = "1968", journal = "IEEE Transactions on Systems Science and Cybernetics", volume = "4", number = "3", pages = "227--241" } @book{jeffreys61, author = "Jeffreys, H.", title = "Theory of Probability", edition = "Third", year = "1961", publisher = "Oxford University Press", address = "Oxford, England" } @article{jones06, author = "Jones, G.L. and Haran, M. and Caffo, B.S. and Neath, R.", title = "Fixed-Width Output Analysis for Markov chain Monte Carlo", year = "2006", journal = "Journal of the American Statistical Association", volume = "100", number = "1", pages = "1537--1547" } @article{kass95, author = "Kass, R.E. and Raftery, A.E.", title = "Bayes Factors", year = "1995", journal = "Journal of the American Statistical Association", volume = "90", number = "430", pages = "773--795" } @article{kim02, author = "Kim, J. and Allenby, G.M. and Rossi, P.E.", title = "Modeling Consumer Demand for Variety", year = "2002", journal = "Marketing Science", volume = "21", number = "3", pages = "229--250" } @book{kleine50, author = "Kleine, L.", title = "Economic Fluctuations in the United States 1921-1940", year = "1950", publisher = "John Wiley \& Sons", address = "New York, New York" } @book{kotz01, author = "Kotz, S. and Kozubowski, T.J. and Podgorski, K.", title = "The Laplace Distribution and Generalizations: A Revisit with Applications to Communications, Economics, Engineering, and Finance", year = "2001", publisher = "Birkauser", address = "Boston" } @article{kullback51, author = "Kullback, S. and Leibler, R.A.", title = "On Information and Sufficiency", year = "1951", journal = "The Annals of Mathematical Statistics", volume = "22", number = "1", pages = "79--86" } @article{lambert05, author = "Lambert, P.C. and Sutton, A.J. and Burton, P.R. and Abrams, K.R. and Jones, D.R.", title = "How Vague is Vague? A Simulation Study of the Impact of the Use of Vague Prior Distributions in MCMC using WinBUGS", year = "2005", journal = "Statistics in Medicine", volume = "24", pages = "2401--2428" } @article{laplace74, author = "Laplace, P.S.", title = "Memoire sur la Probabilite des Causes par les Evenements", year = "1774", journal = "l'Academie Royale des Sciences", volume = "6", pages = "621--656", note = "English translation by S.M. Stigler in 1986 as ``Memoir on the Probability of the Causes of Events'' in \textit{Statistical Science}, \textbf{1}(3), 359--378" } @book{laplace12, author = "Laplace, P.S.", title = "Theorie Analytique des Probabilites", year = "1812", publisher = "Courcier", address = "Paris", note = "Reprinted as ``Oeuvres Completes de Laplace'', \textbf{7}, 1878--1912. Paris: Gauthier-Villars" } @misc{laplace14, author = "Laplace, P.S.", title = "Essai Philosophique sur les Probabilites", year = "1814", note = "English translation in Truscott, F.W. and Emory, F.L. (2007) from (1902) as ``A Philosophical Essay on Probabilities''. ISBN 1602063281, translated from the French 6th ed. (1840)" } @article{laud95, author = "Laud, P.W. and Ibrahim, J.G.", title = "Predictive Model Selection", year = "1995", journal = "Journal of the Royal Statistical Society", volume = "B 57", pages = "247--262" } @article{lewis97, author = "Lewis, S.M. and Raftery, A.E.", title = "Estimating Bayes' Factors via Posterior Simulation with the Laplace-Metropolis Estimator", year = "1997", journal = "Journal of the American Statistical Association", volume = "92", pages = "648--655" } @article{liu00, author = "Liu, J. and Liang, F. and Wong, W.", title = "The Multiple-Try Method and Local Optimization in Metropolis Sampling", year = "2000", journal = "Journal of the American Statistical Association", volume = "95", pages = "121--134" } @article{lunn09, author = "Lunn, D. and Spiegelhalter, D. and Thomas, A. and Best, N.", title = "The BUGS Project: Evolution, Critique, and Future Directions", year = "2009", journal = "Statistics in Medicine", volume = "28", pages = "3049--3067" } @article{meng94, author = "Meng, X.L.", title = "Posterior Predictive P-Values", year = "1994", journal = "Annals of Statistics", volume = "22", pages = "1142--1160" } @article{metropolis53, author = "Metropolis, N. and Rosenbluth, A.W. and Rosenbluth M.N. and Teller, E.", title = "Equation of State Calculations by Fast Computing Machines", year = "1953", journal = "Journal of Chemical Physics", volume = "21", pages = "1087--1092" } @article{mira01, author = "Mira, A.", title = "On Metropolis-Hastings Algorithms with Delayed Rejection", year = "2001", journal = "Metron", volume = "LIX", number = "3--4", pages = "231--241" } @article{murray10, author = "Murray, I. and Adams, R.P. and KacKay, D.J.", title = "Elliptical Slice Sampling", year = "2010", journal = "Journal of Machine Learning Research", volume = "9", pages = "541--548" } @article{nadarajah06, author = "Nadarajah, S. and Kotz, S.", title = "R Programs for Computing Truncated Distributions", year = "2006", journal = "Journal of Statistical Software", volume = "16", number = "Code Snippet 2", pages = "1--8" } @article{naylor82, author = "Naylor, J.C. and Smith, A.F.M.", title = "Applications of a Method for the Efficient Computation of Posterior Distributions", year = "1982", journal = "Applied Statistics", volume = "31", number = "3", pages = "214--225" } @misc{neal97, author = "Neal, R.", title = "Markov Chain Monte Carlo Methods Based on Slicing the Density Function", year = "1997", howpublished = "Technical Report, University of Toronto", } @article{neal03, author = "Neal, R.", title = "Slice Sampling (with Discussion)", year = "2003", journal = "Annals of Statistics", volume = "31", number = "3", pages = "705--767" } @incollection{neal11, author = "Neal, R.M.", title = "MCMC for Using Hamiltonian Dynamics", pages = "113--162", booktitle = "Handbook of Markov Chain Monte Carlo", editor = "Brooks, S. and Gelman, A. and Jones, G.L. and Xiao-Li, M.", publisher = "Chapman \& Hall, Boca Raton, FL", year = "2011" } @article{nelder65, author = "Nelder, J.A. and Mead, R.", title = "A Simplex Method for Function Minimization", year = "1965", journal = "The Computer Journal", volume = "7", number = "4", pages = "308--313" } @book{nocedal99, author = "Nocedal, J. and Wright, S.J.", title = "Numerical Optimization", year = "1999", publisher = "Springer-Verlag", address = "New York, New York" } @book{ntzoufras09, author = "Ntzoufras, I.", title = "Bayesian Modeling Using WinBUGS", year = "2009", publisher = "John Wiley \& Sons", address = "West Sussex, England" } @article{ohara09, author = "O'Hara, R.B. and Sillanpaa, M.J.", title = "A Review of Bayesian Variable Selection Methods: What, How and Which", year = "2009", journal = "Journal of Bayesian Analysis", volume = "4", number = "1", pages = "85--118" } @article{ohagan87, author = "O'Hagan, A.", title = "Monte Carlo is Fundamentally Unsound", year = "1987", journal = "The Statistician", volume = "31", number = "3", pages = "214--225" } @article{ohagan91, author = "O'Hagan, A.", title = "Bayes-Hermite Quadrature", year = "1991", journal = "Statistical Planning and Inference", volume = "29", pages = "245--260" } @incollection{ohagan92, author = "O'Hagan, A.", title = "Some Bayesian Numerical Analysis", pages = "356--363", booktitle = "Bayesian Statistics 4", editor = "Bernardo, J.M. and Berger, J.O. and David, A.P. and Smith, A.F.M.", publisher = "Oxford University Press, England", year = "1992" } @book{petris09, author = "Petris, G. and Petrone, S. and Campagnoli, P.", title = "Dynamic Linear Models with R", year = "2009", publisher = "Springer", address = "New York, New York" } @inproceedings{plummer03, author = "Plummer, M.", title = "JAGS: A Program for Analysis of Bayesian Graphical Models Using Gibbs Sampling", booktitle = "Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003)", year = "2003", note = "March 20-22, Vienna, Austria. ISBN 1609--395X" } @book{pole94, author = "Pole, A. and West, M. and Harrison, J.", title = "Applied Bayesian Forecasting and Time Series Analysis", year = "1994", publisher = "Chapman \& Hall", address = "Boca Raton, Florida" } @incollection{rasmussen03, author = "Rasmussen, C.E. and Ghahramani, Z.", title = "Bayesian Monte Carlo", booktitle = "Advances in Neural Information Processing Systems", editor = "Becker, S. and Obermayer, K.", publisher = "MIT Press, Cambridge, MA", year = "2003" } @manual{rdct:r, title = {R: A Language and Environment for Statistical Computing}, author = {{R Core Team}}, organization = {R Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2014}, url = {https://www.R-project.org}, } @manual{r:coda, author = "Plummer, M. and Best, N. and Cowles, K. and Vines, K.", title = {\pkg{coda}: Output Analysis and Diagnostics for MCMC}, year = {2012}, note = {\proglang{R} package version 0.16-1}, url = {http://cran.r-project.org/web/packages/coda/index.html}, } @manual{r:laplacesdemon, author = {{Statisticat LLC.}}, title = {\pkg{LaplacesDemon}: Complete Environment for Bayesian Inference}, year = {2015}, note = {\proglang{R} package version 15.03.19}, url = {https://web.archive.org/web/20150703093901/http://www.bayesian-inference.com/software}, } @manual{r:learnbayes, author = "Albert, J.", title = {\pkg{LearnBayes}: Functions for Learning Bayesian Inference}, year = {2012}, note = {\proglang{R} package version 2.12}, url = {http://cran.r-project.org/web/packages/LearnBayes/index.html}, } @manual{r:mcmc, author = "Geyer, C.J.", title = {\pkg{mcmc}: Markov Chain Monte Carlo}, year = {2013}, note = {\proglang{R} package version 0.9-2}, url = {http://cran.r-project.org/web/packages/mcmc/index.html}, } @manual{r:mcmcpack, author = "Martin, A.D. and Quinn, K.M. and Park, J.H.", title = {\pkg{MCMCpack}: Markov chain Monte Carlo (MCMC) Package}, year = {2013}, note = {\proglang{R} package version 1.3-3}, url = {http://cran.r-project.org/web/packages/MCMCpack/index.html}, } @manual{r:r2winbugs, author = "Gelman, A.", title = {\pkg{R2WinBUGS}: Running WinBUGS and OpenBUGS from R / S-PLUS}, year = {2013}, note = {\proglang{R} package version 2.1-19}, url = {https://CRAN.R-project.org/package=R2WinBUGS}, } @manual{r:umacs, author = "Kerman, J.", title = {\pkg{UMACS}: Universal Markov Chain Sampler}, year = {2007}, note = {\proglang{R} package version 0.924}, url = {https://CRAN.R-project.org/package=UMACS}, } @book{raiffa61, author = "Raiffa, H. and Schlaifer, R.", title = "Applied Statistical Decision Theory", year = "1961", publisher = "Division of Research, Graduate School of Business Administration", address = "Harvard University" } @incollection{ramsey26, author = "Ramsey, F.P.", title = "Truth and Probability", pages = "156--198", booktitle = "The Foundations of Mathematics and other Logical Essays", editor = "Braithwaite, R.", publisher = "Harcourt, Brace and Company, New York", year = "1926" } @article{riedmiller94, author = "Riedmiller, M.", title = "Advanced Supervised Learning in Multi-Layer Perceptrons - From Backpropagation to Adaptive Learning Algorithms", year = "1994", journal = "Computer Standards and Interfaces", volume = "16", pages = "265--278" } @article{ritter92, author = "Ritter, C. and Tanner, M.", title = "Facilitating the Gibbs Sampler: the Gibbs Stopper and the Griddy-Gibbs Sampler", year = "1992", journal = "Journal of the American Statistical Association", volume = "87", pages = "861--868" } @article{robbins51, author = "Robbins, H. and Monro, S.", title = "A Stochastic Approximation Method", year = "1951", journal = "Annals of Mathematical Statistics", volume = "22", pages = "400--407" } @book{robert07, author = "Robert, C.", title = "The Bayesian Choice", edition = "2nd", year = "2007", publisher = "Springer", address = "Paris, France" } @article{roberts96, author = "Roberts, G.O. and Tweedie, R.L.", title = "Exponential Convergence of Langevin Distributions and Their Discrete Approximations", year = "1996", journal = "Bernoulli", volume = "2", number = "4", pages = "341--363" } @article{roberts01, author = "Roberts, G.O. and Rosenthal, J.S.", title = "Optimal Scaling for Various Metropolis-Hastings Algorithms", year = "2001", journal = "Statistical Science", volume = "16", pages = "351--367" } @article{roberts07, author = "Roberts, G.O. and Rosenthal, J.S.", title = "Coupling and Ergodicity of Adaptive Markov Chain Monte Carlo Algorithms", year = "2007", journal = "Journal of Applied Probability", volume = "44", pages = "458--475" } @article{roberts09, author = "Roberts, G.O. and Rosenthal, J.S.", title = "Examples of Adaptive MCMC", year = "2009", journal = "Computational Statistics and Data Analysis", volume = "18", pages = "349--367" } @article{rosenthal07, author = "Rosenthal, J.S.", title = "AMCMC: An R Interface for Adaptive MCMC", year = "2007", journal = "Computational Statistics and Data Analysis", volume = "51", pages = "5467--5470" } @article{rossky78, author = "Rossky, P.J. and Doll, J.D. and Friedman, H.L.", title = "Brownian Dynamics as Smart Monte Carlo Discrete Approximations", year = "1978", journal = "Journal of Chemical Physics", volume = "69", pages = "4628--4633" } @book{rossi05, author = "Rossi, P.E. and Allenby, G.M. and McCulloch, R.", title = "Bayesian Statistics and Marketing", year = "2005", publisher = "John Wiley \& Sons", address = "West Sussex, England" } @article{rubin81, author = "Rubin, D.B.", title = "The Bayesian Bootstrap", year = "1981", journal = "The Annals of Statistics", volume = "9", number = "1", pages = "130--134" } @article{salimans13, author = "Salimans, T. and Knowles, D.A.", title = "Fixed-Form Variational Posterior Approximation through Stochastic Linear Regression", year = "2013", journal = "Bayesian Analysis", volume = "8", number = "4", pages = "837--882" } @manual{sas08, author = {{SAS Institute Inc.}}, title = {SAS/STAT 9.2 User's Guide}, year = {2008}, address = "Cary, NC: SAS Institute Inc.", } @book{savage54, author = "Savage, L.J.", title = "The Foundations of Statistics", year = "1954", publisher = "John Wiley \& Sons", address = "West Sussex, England" } @misc{shaby10, author = "Shaby, B. and Wells, M.T.", title = "Exploring an Adaptive Metropolis Algorithm", year = "2010", howpublished = "Working Paper in Department of Statistical Science, Duke University", } @article{shanno70, author = "Shanno, D.F.", title = "Conditioning of quasi-Newton Methods for Function Minimization", year = "1970", journal = "Mathematics of Computation", volume = "24", pages = "647--650" } @article{smith84, author = "Smith, R.L.", title = "Efficient Monte Carlo Procedures for Generating Points Uniformly Distributed Over Bounded Region", year = "1984", journal = "Operations Research", volume = "32", pages = "1296--1308" } @article{solonen12, author = "Solonen, A. and Ollinaho, P. and Laine, M. and Haario, H. and Tamminen, J. and Jarvinen, H.", title = "Efficient MCMC for Climate Model Parameter Estimation: Parallel Adaptive Chains and Early Rejection", year = "2012", journal = "Bayesian Analysis", volume = "7", number = "2", pages = "1--22" } @article{spiegelhalter98, author = "Spiegelhalter, D.J. and Best, N.G. and Carlin, B.P.", title = "Bayesian Deviance, the Effective Number of Parameters, and the Comparison of Arbitrarily Complex Models", year = "1998", journal = "Research Report", volume = "98-009", notes = "\url{http://www.med.ic.ac.uk/divisions/60/biointro.asp}" } @article{spiegelhalter02, author = "Spiegelhalter, D.J. and Best, N.G. and Carlin, B.P. and van der Linde, A.", title = "Bayesian Measures of Model Complexity and Fit (with Discussion)", year = "2002", journal = "Journal of the Royal Statistical Society", volume = "B 64", pages = "583--639" } @manual{spiegelhalter03, author = "Spiegelhalter, D.J. and Thomas, A. and Best, N.G. and Lunn, D.", title = "WinBUGS User Manual, Version 1.4", year = "2003", organization = "MRC Biostatistics Unit, Institute of Public Health and Department of Epidemiology and Public Health, Imperial College School of Medicine, UK", notes = "\url{http://www.mrc-bsu.cam.ac.uk/bugs}" } @misc{stan12, author = {{Stan Development Team}}, title = {Stan: A C++ Library for Probability and Sampling}, year = {2012}, howpublished = "\url{http://mc-stan.org}", } @article{stigler83, author = "Stigler, S.M.", title = "Who Discovered Bayes's Theorem?", year = "1983", journal = "The American Statistician", volume = "37", number = "4", pages = "290--296" } @article{terbraak06, author = "Ter Braak, C.J.F.", title = "A Markov Chain Monte Carlo Version of the Genetic Algorithm Differential Evolution: Easy Bayesian Computing for Real Parameter Spaces", year = "2006", journal = "Statistics and Computing", volume = "16", pages = "239--249" } @article{terbraak08, author = "Ter Braak, C.J.F. and Vrugt, J.A.", title = "Differential Evolution Markov Chain with Snooker Updater and Fewer Chains", year = "2008", journal = "Statistics and Computing", volume = "18", number = "4", pages = "435--446" } @article{thompson10, author = "Thompson, M.B.", title = "Graphical Comparison of MCMC Performance", year = "2010", journal = "ArXiv e-prints", eprint = "1011.4457", howpublished = "\url{http://adsabs.harvard.edu/abs/2010arXiv1011.4457T}" } @misc{thompson11, author = "Thompson, M.B.", title = "Slice Sampling with Multivariate Steps", year = "2011", howpublished = "\url{http://hdl.handle.net/1807/31955}", } @article{tierney86, author = "Tierney, L. and Kadane, J.B.", title = "Accurate Approximations for Posterior Moments and Marginal Densities", year = "1986", journal = "Journal of the American Statistical Association", volume = "81", number = "393", pages = "82--86" } @article{tierney89, author = "Tierney, L. and Kass, R. and Kadane, J.B.", title = "Fully Exponential Laplace Approximations to Expectations and Variances of Nonpositive Functions", year = "1989", journal = "Journal of the American Statistical Association", volume = "84", number = "407", pages = "710--716" } @article{tierney94, author = "Tierney, L.", title = "Markov Chains for Exploring Posterior Distributions", year = "1994", journal = "The Annals of Statistics", volume = "22", number = "4", pages = "1701--1762", note = "With discussion and a rejoinder by the author" } @book{tolkien54, author = "Tolkien, J.R.R.", title = "The Fellowship of the Ring, The Lord of the Rings", year = "1954", publisher = "Houghton Mifflin", address = "Boston" } @article{turchin71, author = "Turchin, V.F.", title = "On the Computation of Multidimensional Integrals by the Monte Carlo Method", year = "1971", journal = "Theory of Probablility and its Applications", volume = "16", number = "4", pages = "720--724" } @incollection{vihola11, author = "Vihola, M.", title = "Robust Adaptive Metropolis Algorithm with Coerced Acceptance Rate", pages = "1--12", booktitle = "Statistics and Computing", editor = "Forthcoming", publisher = "Springer, Netherlands", year = "2011" } @article{watanabe10, author = "Watanabe, S.", title = "Asymptotic Equivalence of Bayes Cross Validation and Widely Applicable Information Criterion in Singular Learning Theory", year = "2010", journal = "Journal of Machine Learning Research", issue = "11", pages = "3571--3594" } @book{west97, author = "West, M. and Harrison, J.", title = "Bayesian Forecasting and Dynamic Models", year = "1997", publisher = "Springer", address = "New York, New York" } @article{welling11, author = "Welling, M. and Teh, Y.W.", title = "Bayesian Learning via Stochastic Gradient Langevin Dynamics", year = "2011", journal = "Proceedings of the 28th International Conference on Machine Learning (ICML)", pages = "681--688" } @book{williamson99, author = "Williamson, G.K.", title = "Getting Started In Annuities", year = "1999", publisher = "John Wiley \& Sons", address = "New York, New York" } @article{wishart28, author = "Wishart, J.", title = "The Generalised Product Moment Distribution in Samples from a Normal Multivariate Population", year = "1928", journal = "Biometrika", volume = "20A (1-2)", pages = "32--52" } @article{wraith09, author = "Wraith, D. and Kilbinger, M. and Benabed, K. and Capp\'e, O. and Cardoso, J.F. and Fort, G. and Prunet, S. and Robert, C.P.", title = "Estimation of Cosmological Parameters Using Adaptive Importance Sampling", year = "2009", journal = "Physical Review D", volume = "80", number = "2", pages = "023507", howpublished = "\url{http://link.aps.org/doi/10.1103/PhysRevD.80.023507}", } @incollection{zelinka04, author = "Zelinka, I.", title = "SOMA - Self Organizing Migrating Algorithm", booktitle = "New Optimization Techniques in Engineering", editor = "Onwubolu, G.C. and Babu, B.V.", publisher = "Springer, Berlin, Germany", year = "2004" } @article{zellner62, author = "Zellner, A.", title = "An Efficient Method of Estimating Seemingly Unrelated Regression Equations and Tests for Aggregation Bias", year = "1962", journal = "Journal of the American Statistical Association", volume = "57", pages = "348--368" } @article{zhang12, author = "Zhang, Y. and Ghahramani, Z. and Storkey, A.J. and Sutton, C.A.", title = "Continuous Relaxations for Discrete Hamiltonian Monte Carlo", year = "2012", journal = "Advances in Neural Information Processing Systems", volume = "25", pages = "3203--3211" } LaplacesDemon/vignettes/LaplacesDemonTutorial.Stex0000755000176200001440000034562115144316355022116 0ustar liggesusers\documentclass[nojss]{jss} %% need no \usepackage{Sweave.sty} \usepackage{amsmath} %\VignetteIndexEntry{LaplacesDemon Tutorial} %\VignettePackage{LaplacesDemon} %\VignetteDepends{LaplacesDemon} \author{Statisticat, LLC} \title{\includegraphics[height=1in,keepaspectratio]{LDlogo} \\ \pkg{LaplacesDemon}: A Complete Environment for Bayesian Inference within \proglang{R}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Statisticat} %% comma-separated \Plaintitle{LaplacesDemon: A Complete Environment for Bayesian Inference within R} %% without formatting \Shorttitle{LaplacesDemon} %% a short title (if necessary) \Abstract{ \pkg{LaplacesDemon}, also referred to as LD, is a contributed \proglang{R} package for Bayesian inference, and is freely available at \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/indexe}. The user may build any kind of probability model with a user-specified model function. The model may be updated with iterative quadrature, Laplace Approximation, MCMC, PMC, or variational Bayes. After updating, a variety of facilities are available, including MCMC diagnostics, posterior predictive checks, and validation. Hopefully, \pkg{LaplacesDemon} is generalizable and user-friendly for Bayesians, especially Laplacians. } \Keywords{Bayesian, Big Data, High Performance Computing, HPC, Importance Sampling, Iterative Quadrature, Laplace Approximation, LaplacesDemon, LaplacesDemonCpp, Markov chain Monte Carlo, MCMC, Metropolis, Optimization, Parallel, PMC, R, Rejection Sampling, Variational Bayes} \Plainkeywords{bayesian, big data, high performance computing, hpc, importance sampling, iterative quadrature, laplace approximation, laplacesdemon, laplacesdemoncpp, markov chain monte carlo, mcmc, metropolis, optimization, parallel, pmc, r, rejection sampling, variational bayes} %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2011} %% \Submitdate{2011-01-18} %% \Acceptdate{2011-01-18} \Address{ Statisticat, LLC\\ Hot Springs, SD\\ E-mail: defunct\\ URL: \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index} } %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} \begin{document} Bayesian inference is named after Reverend Thomas Bayes (1701-1761) for developing Bayes' theorem, which was published posthumously after his death \citep{bayes63}. This was the first instance of what would be called inverse probability\footnote{`Inverse probability' refers to assigning a probability distribution to an unobserved variable, and is in essence, probability in the opposite direction of the usual sense. Bayes' theorem has been referred to as ``the principle of inverse probability''. Terminology has changed, and the term `Bayesian probability' has displaced `inverse probability'. The adjective ``Bayesian'' was introduced by R. A. Fisher as a derogatory term.}. Unaware of Bayes, Pierre-Simon Laplace (1749-1827) independently developed Bayes' theorem and first published his version in 1774, eleven years after Bayes, in one of Laplace's first major works \citep[p. 366--367]{laplace74}. In 1812, Laplace introduced a host of new ideas and mathematical techniques in his book, \emph{Theorie Analytique des Probabilites} \citep{laplace12}. Before Laplace, probability theory was solely concerned with developing a mathematical analysis of games of chance. Laplace applied probabilistic ideas to many scientific and practical problems. Although Laplace is not the father of probability, Laplace may be considered the father of the field of probability. In 1814, Laplace published his ``Essai Philosophique sur les Probabilites'', which introduced a mathematical system of inductive reasoning based on probability \citep{laplace14}. In it, the Bayesian interpretation of probability was developed independently by Laplace, much more thoroughly than Bayes, so some ``Bayesians'' refer to Bayesian inference as Laplacian inference. This is a translation of a quote in the introduction to this work: \begin{quote} ``We may regard the present state of the universe as the effect of its past and the cause of its future. An intellect which at a certain moment would know all forces that set nature in motion, and all positions of all items of which nature is composed, if this intellect were also vast enough to submit these data to analysis, it would embrace in a single formula the movements of the greatest bodies of the universe and those of the tiniest atom; for such an intellect nothing would be uncertain and the future just like the past would be present before its eyes'' \citep{laplace14}. \end{quote} The `intellect' has been referred to by future biographers as Laplace's Demon. In this quote, Laplace expresses his philosophical belief in hard determinism and his wish for a computational machine that is capable of estimating the universe. This article is an introduction to an \proglang{R} \citep{rdct:r} package called \pkg{LaplacesDemon} \citep{r:laplacesdemon}, which was designed without consideration for hard determinism, but instead with a lofty goal toward facilitating high-dimensional Bayesian (or Laplacian) inference\footnote{Even though the \pkg{LaplacesDemon} package is dedicated to Bayesian inference, frequentist inference may be used instead with the same functions by omitting the prior distributions and maximizing the likelihood.}, posing as its own intellect that is capable of impressive analysis. The \pkg{LaplacesDemon} \proglang{R} package is often referred to as LD. This article guides the user through installation, data, specifying a model, initial values, updating a numerical approximation algorithm, summarizing and plotting output, posterior predictive checks, general suggestions, discusses independence and observability, high performance computing, covers details of the algorithms, and introduces \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index}. Herein, it is assumed that the reader has basic familiarity with Bayesian inference, numerical approximation, and \proglang{R}. If any part of this assumption is violated, then suggested sources include the vignette entitled ``Bayesian Inference'' that comes with the \pkg{LaplacesDemon} package, \citet{robert07}, and \citet{crawley07}. \section{Installation} \label{installation} To obtain the \pkg{LaplacesDemon} package, simply download the source code from \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/softwaredownload}, open \proglang{R}, and install the \pkg{LaplacesDemon} package from source: %%\SweaveOpts{echo=TRUE,results=verbatim,fig=FALSE} \begin{Scode}{eval=FALSE} install.packages(pkgs="path/LaplacesDemon_ver.tar.gz", repos=NULL, type="source") \end{Scode} where \code{path} is a path to the zipped source code, and \code{_ver} is replaced with the latest version found in the name of the downloaded file. A goal in developing the \pkg{LaplacesDemon} package was to minimize reliance on other packages or software. Therefore, the usual \code{dep=TRUE} argument does not need to be used, because the \pkg{LaplacesDemon} package does not depend on anything other than base \proglang{R} and its \pkg{parallel} package. \pkg{LaplacesDemonCpp} is an extension package that uses \proglang{C++}, and imports these packages: \pkg{parallel}, \pkg{Rcpp}, and \pkg{RcppArmadillo}. This tutorial introduces only \pkg{LaplacesDemon}, but the use of \pkg{LaplacesDemonCpp} is identical. Once installed, simply use the \code{library} or \code{require} function in \proglang{R} to activate the \pkg{LaplacesDemon} package and load its functions into memory: \begin{Scode} library(LaplacesDemon) \end{Scode} \section{Data} \label{data} The \pkg{LaplacesDemon} package requires data that is specified in a list\footnote{Though most \proglang{R} functions use data in the form of a data frame, \pkg{LaplacesDemon} uses one or more numeric matrices in a list. It is much faster to process a numeric matrix than a data frame in iterative estimation.}. As an example, there is a data set called \code{demonsnacks} that is provided with the \pkg{LaplacesDemon} package. For no good reason, other than to provide an example, the log of \code{Calories} will be fit as an additive, linear function of the log of some of the remaining variables. Since an intercept will be included, a vector of 1's is inserted into design matrix \textbf{X}. \begin{Scode} data(demonsnacks) N <- nrow(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) J <- ncol(X) for (j in 2:J) {X[,j] <- CenterScale(X[,j])} mon.names <- "LP" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \end{Scode} There are J=\Sexpr{J} independent variables (including the intercept), one for each column in design matrix \textbf{X}. However, there are \Sexpr{J+1} parameters, since the residual variance, $\sigma^2$, must be included as well. Each parameter must have a name specified in the vector \code{parm.names}, and parameter names must be included with the data. This is using a function called \code{as.parm.names}. Also, note that each predictor has been centered and scaled, as per \citet{gelman08}. A \code{CenterScale} function is provided to center and scale predictors\footnote{Centering and scaling a predictor is \code{x.cs <- (x - mean(x)) / (2*sd(x))}.}. \code{PGF} is an optional, but highly recommended, user-specified function. PGF stands for Parameter-Generating Function, and is used by the \code{GIV} function, where GIV stands for Generating Initial Values. Although the \code{PGF} is not technically data, it is most conveniently placed in the list of data. When \code{PGF} is not specified and \code{GIV} is used, initial values are generated randomly without respect to prior distributions. To see why \code{PGF} was specified as it was, consider the following sections on specifying a model and initial values. \section{Specifying a Model} \label{specification} The \pkg{LaplacesDemon} package is capable of estimating any Bayesian model for which the likelihood is specified\footnote{Examples of more than 100 Bayesian models may be found in the ``Examples'' vignette that comes with the \pkg{LaplacesDemon} package. Likelihood-free estimation is also possible by approximating the likelihood, such as in Approximate Bayesian Computation (ABC).}. To use the \pkg{LaplacesDemon} package, the user must specify a model. Let's consider a linear regression model, which is often denoted as: $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ The dependent variable, $\textbf{y}$, is normally distributed according to expectation vector $\mu$ and scalar variance $\sigma^2$, and expectation vector $\mu$ is equal to the inner product of design matrix \textbf{X} and transposed parameter vector $\beta$. For a Bayesian model, the notation for the residual variance, $\sigma^2$, has often been replaced with the inverse of the residual precision, $\tau^{-1}$. Here, $\sigma^2$ will be used. Prior probabilities are specified for $\beta$ and $\sigma$ (the standard deviation, rather than the variance): $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ Each of the $J$ $\beta$ parameters is assigned a vague\footnote{`Traditionally, a vague prior would be considered to be under the class of uninformative or non-informative priors. 'Non-informative' may be more widely used than 'uninformative', but here that is considered poor English, such as saying something is `non-correct' when there's a word for that \dots `incorrect'. In any case, uninformative priors do not actually exist \citep{irony97}, because all priors are informative in some way. These priors are being described here as vague, but not as uninformative.} prior probability distribution that is normally-distributed according to $\mu=0$ and $\sigma^2=1000$. The large variance or small precision indicates a lot of uncertainty about each $\beta$, and is hence a vague distribution. The residual standard deviation $\sigma$ is half-Cauchy-distributed according to its hyperparameter, scale=25. When exploring new prior distributions, the user is encouraged to use the \code{is.proper} function to check for prior propriety. To specify a model, the user must create a function called \code{Model}. Here is an example for a linear regression model written in \proglang{R} code\footnote{A model specification function for the \pkg{LaplacesDemon} or \pkg{LaplacesDemonCpp} packages may be written and compiled in a faster language, such as in \proglang{C++} via the \pkg{Rcpp} package family.}: \begin{Scode} Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- dnormv(beta, 0, 1000, log=TRUE) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(beta, Data$X) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + sum(beta.prior) + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } \end{Scode} A numerical approximation algorithm iteratively maximizes the logarithm of the unnormalized joint posterior density as specified in this \code{Model} function. In Bayesian inference, the logarithm of the unnormalized joint posterior density is proportional to the sum of the log-likelihood and logarithm of the prior densities: $$\log[p(\Theta|\textbf{y})] \propto \log[p(\textbf{y}|\Theta)] + \log[p(\Theta)]$$ where $\Theta$ is a set of parameters, $\textbf{y}$ is the data, $\propto$ means `proportional to'\footnote{For those unfamiliar with $\propto$, this symbol simply means that two quantities are proportional if they vary in such a way that one is a constant multiplier of the other. This is due to an unspecified constant of proportionality in the equation. Here, this can be treated as `equal to'.}, $p(\Theta|\textbf{y})$ is the joint posterior density, $p(\textbf{y}|\Theta)$ is the likelihood, and $p(\Theta)$ is the set of prior densities. During each iteration in which a numerical approximation algorithm is maximizing the logarithm of the unnormalized joint posterior density, two arguments are passed to \code{Model}: \code{parm} and \code{Data}, where \code{parm} is short for the set of parameters, and \code{Data} is a list of data. These arguments are specified in the beginning of the function: \code{Model <- function(parm, Data)} Then, the \code{Model} function is evaluated and the logarithm of the unnormalized joint posterior density is calculated as \code{LP}, and returned in a list called \code{Modelout}, along with the deviance (\code{Dev}), a vector (\code{Monitor}) of any variables desired to be monitored in addition to the parameters, $\textbf{y}^{rep}$ (\code{yhat}) or replicates of $\textbf{y}$, and the parameter vector \code{parm}. All arguments must be returned. Even if there is no desire to observe the deviance and any monitored variable, a scalar must be placed in the second position of the \code{Modelout} list, and at least one element of a vector for a monitored variable. This can be seen in the end of the function: \code{LP <- LL + sum(beta.prior) + sigma.prior} \\ \code{Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP,} \\ \hspace*{0.27 in} \code{yhat=rnorm(length(mu), mu, sigma), parm=parm)} \\ \code{return(Modelout)} The rest of the function specifies the parameters, log of the prior densities, and calculates the log-likelihood. Since design matrix \textbf{X} has J=\Sexpr{J} column vectors (including the intercept), there are \Sexpr{J} \code{beta} parameters and a \code{sigma} parameter for the residual standard deviation. Since a vector of parameters called \code{parm} is passed to \code{Model}, the function needs to know which parameter is associated with which element of \code{parm}. For this, the vector \code{beta} is declared, and then each element of \code{beta} is populated with the value associated in the corresponding element of \code{parm}. Above, the \code{grep} function was used to populate \code{pos.beta} and \code{pos.sigma}, which indicate the positions of $\beta$ and $\sigma$. These positions are stored in the list of data, and used in the \code{Model} function to extract the appropriate parameters from vector \code{parm}: \code{beta <- parm[Data$pos.beta} \\ \code{sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf)} \\ \code{parm[Data$pos.sigma] <- sigma} The $\sigma$ parameter must be positive-only, and so it is constrained to be positive in the \code{interval} function. The algorithm, outside of the \code{Model} function needs to be aware that $\sigma$ has been constrained, so the \code{parm} vector is updated with the constrained value. The user does not have to constrain parameters in this way. For example, an alternative is to reparameterize to real values, such as with a logarithm, in this case. If the user does not constrain or reparameterize a parameter that is not on the real line, then the algorithm will be unaware, and probably attempt a value outside of realistic bounds, such as a negative standard deviation in this example. To work with the log of the prior densities and according to the assigned names of the parameters and hyperparameters, they are specified as follows: \code{beta.prior <- dnormv(beta, 0, 1000, log=TRUE)} \\ \code{sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE)} In the above example, the residual standard deviation \code{sigma} receives a half-Cauchy distributed prior of the form: $$\sigma \sim \mathcal{HC}(25)$$ Finally, everything is put together to calculate \code{LP}, the logarithm of the unnormalized joint posterior density. The expectation vector \code{mu} is the inner product of the design matrix, \code{Data$X}, and the transpose of the vector \code{beta}. Expectation vector \code{mu}, vector \code{Data$y}, and scalar \code{sigma} are used to estimate the sum of the log-likelihoods, where: $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ and as noted before, the logarithm of the unnormalized joint posterior density is: $$\log[p(\Theta|\textbf{y})] \propto \log[p(\textbf{y}|\Theta)] + \log[p(\Theta)]$$ \code{mu <- tcrossprod(Data$X, t(beta))} \\ \code{LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)} \\ \code{LP <- LL + sum(beta.prior) + sigma.prior} In retrospect, the \code{PGF} function was specified so that when the list of data is passed to it, it generates and returns an initial value for each of the \code{beta} parameters, as well as one for the \code{sigma} parameter. Specifying the model in the \code{Model} function is the most involved aspect for the user of the \pkg{LaplacesDemon} package. But this package has been designed so it is also incredibly flexible, allowing a wide variety of Bayesian models to be specified. \section{Initial Values} \label{initialvalues} Each numerical approximation algorithm in the \pkg{LaplacesDemon} package requires a vector of initial values for the parameters. Each initial value is a starting point for the estimation of a parameter. In this example, there are \Sexpr{J+1} parameters. The order of the elements of the vector of initial values must match the order of the parameters associated with each element of \code{parm} passed to the \code{Model} function. With no prior knowledge, it is a good idea to randomize each initial value, such as with the \code{GIV} function (which stands for ``generate initial values''). When all initial values are set to zero for MCMC, the \code{LaplacesDemon} function optimizes initial values using a spectral projected gradient algorithm in the \code{LaplaceApproximation} function. Laplace Approximation is asymptotic with respect to sample size, so it is inappropriate in this example with a sample size of \Sexpr{N} and \Sexpr{J+1} parameters. MCMC will not use Laplace Approximation when the sample size is not at least five times the number of parameters. \begin{Scode} Initial.Values <- c(rep(0,J), 1) \end{Scode} \section{Numerical Approximation} \label{numericalapproximation} Compared to specifying the model in the \code{Model} function, updating a model is easy. Since pseudo-random numbers are involved, it's a good idea to set a `seed' for pseudo-random number generation, so results can be reproduced. Pick any number you like, but there's only one number appropriate for a demon\footnote{Demonic references are used only to add flavor to the software and its use, and in no way endorses beliefs in demons. This specific pseudo-random seed is often referred to, jokingly, as the `demon seed'.}: \begin{Scode} set.seed(666) \end{Scode} The \pkg{LaplacesDemon} package offers a wide variety of numerical approximation algorithms. Details may be found below in section \ref{details}, and also in the appropriate function documentation. If the user is new to Bayesian inference, then the best suggestion may be to consider Laplace Approximation with the \code{LaplaceApproximation} function when sufficient sample size is available, or MCMC with the \code{LaplacesDemon} function otherwise. This guideline is too simple, but serves as a place to start. For this example, the \code{LaplacesDemon} function will be used. As with any \proglang{R} package, the user can learn about a function by using the \code{help} function and including the name of the desired function. To learn the details of the \pkg{LaplacesDemon} function, enter: \begin{Scode}{eval=false} help(LaplacesDemon) \end{Scode} Here is one of many possible ways to begin: \begin{Scode}{eval=false} Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, Covar=NULL, Iterations=1000, Status=100, Thinning=1, Algorithm="AFSS", Specs=list(A=500, B=NULL, m=100, n=0, w=1)) \end{Scode} In this example, an output object called \code{Fit} will be created as a result of using the \pkg{LaplacesDemon} function. \code{Fit} is an object of class \code{demonoid}, which means that since it has been assigned a customized class, other functions have been custom-designed to work with it. The above example specifies the AFSS algorithm for updating. This example tells the \pkg{LaplacesDemon} function to maximize the first component in the list output from the user-specified \code{Model} function, given a data set called \code{Data}, and according to several settings. \begin{itemize} \item The \code{Initial.Values} argument requires a vector of initial values for the parameters. \item The \code{Covar=NULL} argument indicates that a user-specified variance vector or covariance matrix has not been supplied. AFSS requires proposal covariance, and when not specified, will begin with a scaled identity matrix. \item The \code{Iterations=1000} argument indicates that the \code{LaplacesDemon} function will update 1,000 times before completion. \item The \code{Status=100} argument indicates that a status message will be printed to the \proglang{R} console every 100 iterations. \item The \code{Thinning=1} argument indicates that only ever $K$th iteration will be retained in the output, and in this case, every iteration will be retained. See the \code{Thin} function for more information on thinning. \item The \code{Algorithm} argument requires the abbreviated name of the MCMC algorithm in quotes. \item Finally, the \code{Specs} argument contains specifications for each algorithm named in the \code{Algorithm} argument. The \code{AFSS} algorithm has several specifications. The \code{A} specification indicates at which iteration adaptation will stop, and it is arbitrarily set here so that it adapts for the first half, and is non-adaptive in the second half. The \code{B} specification is for blockwise sampling, which is not performed here. The \code{m} specification indicates the maximum number of steps when searching for the slice interval. The \code{n} specification is set to zero and indicates the number of previous adaptive iterations. The \code{w} specification is the step-size, which is adapted in this algorithm. \end{itemize} By running\footnote{This is ``turning the Bayesian crank'', as Dennis Lindley used to say.} the \code{LaplacesDemon} function, the following output was obtained: \begin{Scode} Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, Covar=NULL, Iterations=1000, Status=100, Thinning=1, Algorithm="AFSS", Specs=list(A=500, B=NULL, m=100, n=0, w=1)) \end{Scode} \code{LaplacesDemon} finished quickly, though it had a small data set (N=\Sexpr{NROW(X)}), few parameters (K=\Sexpr{J+1}), and the model was very simple. The output object, \code{Fit}, was created as a list. As with any \proglang{R} object, use \code{str()} to examine its structure: \begin{Scode}{eval=false} str(Fit) \end{Scode} To access any of these values in the output object \code{Fit}, simply append a dollar sign and the name of the component. For example, here is how to access the observed acceptance rate: \begin{Scode} Fit$Acceptance.Rate \end{Scode} \subsection{Warnings} \label{warnings} During updating in \code{LaplacesDemon}, warnings are converted to errors, and the proposal is rejected. Warnings may appear due to checks before updating, or summarizing after updating, but not during updating. If chains appear to have numerous rejections after trying a variety of samplers, then the model specification function may be producing warnings with certain configurations of parameters. If warnings continue to occur, then the priors or parameterization should be considered. An example is when a scale parameter for the posterior predictive distribution is allowed to be too small or large. \section{Summarizing Output} \label{summarizingoutput} The output object, \code{Fit}, has many components. The (copious) contents of \code{Fit} can be printed to the screen with the usual \proglang{R} functions: \begin{Scode}{eval=false} Fit print(Fit) \end{Scode} While a user is welcome to continue this \proglang{R} convention, the \pkg{LaplacesDemon} package adds another feature below the \code{print} function output in the \code{Consort} function. But before describing the additional feature, the results are obtained as: \begin{Scode} Consort(Fit) \end{Scode} Several components are labeled as \code{NOT SHOWN HERE}, due to their size, such as the covariance matrix \code{Covar} or the stationary posterior samples \code{Posterior2}. As usual, these can be printed to the screen by appending a dollar sign, followed by the desired component, such as: \begin{Scode}{eval=false} Fit$Posterior2 \end{Scode} Although a lot can be learned from the above output, notice that it completed \Sexpr{Fit$Iterations} iterations of \Sexpr{J+1} variables in \Sexpr{round(Fit$Minutes,2)} minutes. Of course this was fast, since there were only \Sexpr{NROW(X)} records, and the form of the specified model was simple. In \proglang{R}, there is usually a \code{summary} function associated with each class of output object. The \code{summary} function usually summarizes the output. For example, with frequentist models, the \code{summary} function usually creates a table of parameter estimates, complete with p-values. Since this is not a frequentist package, p-values are not part of any table with the \code{LaplacesDemon} function, and the marginal posterior distributions of the parameters and other variables have already been summarized in \code{Fit}, there is no point to have an associated \code{summary} function. Going one more step toward useability, the \code{Consort} function of \pkg{LaplacesDemon} allows the user to consort with Laplace's Demon about the output object. The additional feature is a second section called \code{Demonic Suggestion}. The \code{Demonic Suggestion} is a very helpful section of output. When the \pkg{LaplacesDemon} package was developed initially in late 2010, there were not to my knowledge any tools of Bayesian inference that make suggestions to the user. Before making its \code{Demonic Suggestion}, Laplace's Demon considers and presents five conditions: the algorithm, acceptance rate, Monte Carlo standard error (MCSE), effective sample size (ESS), and stationarity. In addition to these conditions, there are other suggested values, such as a recommended number of iterations or values for the \code{Periodicity} and \code{Status} arguments. The suggested value for \code{Status} is seeking to print a status message every minute when the expected time is longer than a minute, and is based on the time in minutes it took, the number of iterations, and the recommended number of iterations. In the above output, Laplace's Demon is appeased. However, if any of these five conditions is unsatisfactory, then Laplace's Demon is not appeased, and suggests it should continue updating, and that the user should copy, paste, and execute its suggested \proglang{R} code. Here are the criteria it measures against. The final algorithm must be non-adaptive, so that the Markov property holds (this is covered in section \ref{markovchainproperties}). The acceptance rate of most algorithms is considered satisfactory if it is within the interval [15\%, 50\%]\footnote{While \citet{spiegelhalter03} recommend updating until the acceptance rate is within the interval [20\%, 40\%], and \citet{roberts01} suggest [10\%, 40\%], the interval recommended here is [15\%,50\%]. HMC and Refractive must be in the interval [60\%, 70\%].}. LMC or MALA must be in the interval [40\%, 80\%], and others (AFSS, AGG, ESS, GG, OHSS, SGLD, Slice, and UESS) have an acceptance rate of 100\%. For more information on acceptance rates, see the \code{AcceptanceRate} function. MCSE is considered satisfactory for each target distribution if it is less than 6.27\% of the standard deviation of the target distribution. This allows the true mean to be within 5\% of the area under a Gaussian distribution around the estimated mean. ESS is considered satisfactory for each target distribution if it is at least 100, which is usually enough to describe 95\% probability intervals. And finally, each variable must be estimated as stationary. In this example, notice that all criteria have been met: MCSEs are sufficiently small, ESSs are sufficiently large, and all parameters were estimated to be stationary. Although the algorithm adapted in the first half, it was non-adaptive in the second half of the run, the Markov property holds, so let's look at some plots. \section{Plotting Output} \label{plottingoutput} The \pkg{LaplacesDemon} package has a \code{plot.demonoid} function to enable its own customized plots with \code{demonoid} objects. The variable \code{BurnIn} (below) may be left as it is so it will show only the stationary samples (samples that are no longer trending), or set equal to zero so that all samples can be plotted. In this case, only samples are considered that were generated while the algorithm was non-adaptive, so \code{BurnIn=500}. The \code{plot} function also enables the user to specify whether or not the plots should be saved as a .pdf file, and allows the user to select the parameters to be plotted. For example, \code{Parms=c("beta[1]","beta[2]")} would plot only the first two regression effects, and \code{Parms=NULL} will plot everything. \begin{Scode} \end{Scode} \begin{Scode}{eval=false} plot(Fit, BurnIn=500, MyData, PDF=FALSE, Parms=NULL) \end{Scode} %% Control graphic size, default width=0.8 \setkeys{Gin}{width=0.5\textwidth} \begin{figure} \begin{center} \begin{Scode}{label=fig1,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(3,3)) BurnIn <- 500 for (j in 1:3){ plot((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], type="l", xlab="Thinned Samples", ylab="Value", main=MyData$parm.names[j]) panel.smooth((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], pch="") plot(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), xlab="Value", main=MyData$parm.names[j]) polygon(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], plot=FALSE) se <- 1/sqrt(length(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=MyData$parm.names[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } \end{Scode} \end{center} \caption{Plots of Marginal Posterior Samples} \end{figure} \begin{figure} \begin{center} \begin{Scode}{label=fig2,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(3,3)) for (j in 4:5){ plot((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], type="l", xlab="Thinned Samples", ylab="Value", main=MyData$parm.names[j]) panel.smooth((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], pch="") plot(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), xlab="Value", main=MyData$parm.names[j]) polygon(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], plot=FALSE) se <- 1/sqrt(length(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=MyData$parm.names[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } plot((BurnIn+1):length(Fit$Deviance), Fit$Deviance[(BurnIn+1):length(Fit$Deviance)], type="l", xlab="Thinned Samples", ylab="Value", main="Deviance") panel.smooth((BurnIn+1):length(Fit$Deviance), Fit$Deviance[(BurnIn+1):length(Fit$Deviance)], pch="") plot(density(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)]), xlab="Value", main="Deviance") polygon(density(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)], plot=FALSE) se <- 1/sqrt(length(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main="Deviance", xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) \end{Scode} \end{center} \caption{Plots of Marginal Posterior Samples} \end{figure} \begin{figure} \begin{center} \begin{Scode}{label=fig3,fig=TRUE,echo=FALSE,width=6,height=4} par(mfrow=c(2,3)) JJ <- NCOL(Fit$Monitor); nn <- NROW(Fit$Monitor) for (j in 1:JJ){ plot((BurnIn+1):nn, Fit$Monitor[(BurnIn+1):nn,j], type="l", xlab="Thinned Samples", ylab="Value", main=MyData$mon.names[j]) panel.smooth((BurnIn+1):nn, Fit$Monitor[(BurnIn+1):nn,j], pch="") plot(density(Fit$Monitor[(BurnIn+1):nn,j]), xlab="Value", main=MyData$mon.names[j]) polygon(density(Fit$Monitor[(BurnIn+1):nn,j]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Monitor[(BurnIn+1):nn,j], plot=FALSE) se <- 1/sqrt(length(Fit$Monitor[(BurnIn+1):nn,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=MyData$mon.names[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } \end{Scode} \end{center} \caption{Plots of Marginal Posterior Samples} \end{figure} There are three plots for each parameter, the deviance, and each monitored variable (which in this example are \code{LP} and \code{sigma}). The leftmost plot is a trace-plot, showing the history of the value of the parameter according to the iteration. The middlemost plot is a kernel density plot. The rightmost plot is an ACF or autocorrelation function plot, showing the autocorrelation at different lags. The chains look stationary (do not exhibit a trend), the kernel densities look Gaussian, and the ACF's show low autocorrelation. The Hellinger distances between batches of chains can be plotted with \begin{Scode}{eval=false} plot(BMK.Diagnostic(Fit$Posterior1[501:1000,])) \end{Scode} \begin{figure} \begin{center} \begin{Scode}{label=fig4,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(1,1)) plot(BMK.Diagnostic(Fit$Posterior1[501:1000,])) \end{Scode} \end{center} \caption{Hellinger Distances} \end{figure} These distances occur in the interval $[0,1]$, and lower (darker) is better. The \code{LaplacesDemon} function considers any Hellinger distance greater than 0.5 to indicate non-stationarity and non-convergence. This plot is useful for quickly finding problematic parts of chains. All Hellinger distances here are acceptably small (dark). Another useful plot is called the caterpillar plot, which plots a horizontal representation of three quantiles (2.5\%, 50\%, and 97.5\%) of each selected parameter from the posterior samples summary. The caterpillar plot will attempt to plot the stationary samples first (\code{Fit$Summary2}), but if stationary samples do not exist, then it will plot all samples (\code{Fit$Summary1}). Here, only the first four parameters are selected for a caterpillar plot: \begin{Scode}{eval=false} caterpillar.plot(Fit, Parms="beta") \end{Scode} \begin{figure} \begin{center} \begin{Scode}{label=fig5,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(1,1)) caterpillar.plot(Fit, Parms=1:4) \end{Scode} \end{center} \caption{Caterpillar Plot} \end{figure} If all is well, then the Markov chains should be studied with MCMC diagnostics (such as visual inspections with the \code{CSF} or Cumulative Sample Function), and finally, further assessments of model fit should be estimated with posterior predictive checks, showing how well (or poorly) the model fits the data. When the user is satisfied, the \code{BayesFactor} function may be useful in selecting the best model, and the marginal posterior samples may be used for inference. \section{Posterior Predictive Checks} \label{ppc} A posterior predictive check is a method to assess discrepancies between the model and the data \citep{gelman96a}. To perform posterior predictive checks with the the \pkg{LaplacesDemon} package, simply use the \code{predict} function: \begin{Scode} Pred <- predict(Fit, Model, MyData, CPUs=1) \end{Scode} This creates \code{Pred}, which is an object of class \code{demonoid.ppc} (where ppc is short for posterior predictive check). \code{Pred} is a list that contains three components: \code{y}, \code{yhat}, and \code{Deviance} (though the \code{LaplaceApproximation} output differs a little). If the data set that was used to estimate the model is supplied in \code{predict}, then replicates of \code{y} (also called $\textbf{y}^{rep}$) are estimated. If, instead, a new data set is supplied in \code{predict}, then new, unobserved instances of \code{y} (called $\textbf{y}^{new}$) are estimated. Note that with new data, a \code{y} vector must still be supplied, and if unknown, can be set to something sensible such as the mean of the \code{y} vector in the model. The \code{predict} function calls the \code{Model} function once for each set of stationary samples in \code{Fit\$Posterior2}. When there are few discrepancies between \code{y} and $\textbf{y}^{rep}$, the model is considered to fit well to the data. Parallel processing is enabled when multiple CPUs exist and are specified. Since \code{Pred\$yhat} is a large (39 x 1000) matrix, let's look at the summary of the posterior predictive distribution: \begin{Scode} summary(Pred, Discrep="Chi-Square") \end{Scode} The \code{summary.demonoid.ppc} function returns a list with 5 components when \code{y} is continuous (different output occurs for categorical dependent variables when given the argument \code{Categorical=TRUE}): \begin{itemize} \item \code{BPIC} is the Bayesian Predictive Information Criterion of \citet{ando07}. BPIC is a variation of the Deviance Information Criterion (DIC) that has been modified for predictive distributions. For more information on DIC, see the accompanying vignette entitled ``Bayesian Inference''. \item \code{Concordance} is the predictive concordance of \citet{gelfand96}, that indicates the percentage of times that \code{y} was within the 95\% probability interval of \code{yhat}. A goal is to have 95\% predictive concordance. For more information, see the accompanying vignette entitled ``Bayesian Inference''. In this case, roughly \Sexpr{round(summary(Pred)$Concordance*100,0)}\% of the time, \code{y} is within the 95\% probability interval of \code{yhat}. These results suggest that the model should be attempted again under different conditions, such as using different predictors, or specifying a different form to the model. \item \code{Discrepancy.Statistic} is a summary of a specified discrepancy measure. There are many options for discrepancy measures that may be specified in the \code{Discrep} argument. In this example, the specified discrepancy measure was the $\chi^2$ test in \citet[p. 175]{gelman04}, and higher values indicate a worse fit. \item \code{L-criterion} is a posterior predictive check for model and variable selection that measures the distance between $\textbf{y}$ and $\textbf{y}^{rep}$, providing a criterion to be minimized \citep{laud95}. \item The last part of the summarized output reports \code{y}, information about the distribution of \code{yhat}, and the predictive quantile (\code{PQ}). The mean prediction of \code{y[1]}, or $\textbf{y}^{rep}_1$, given the model and data, is \Sexpr{round(summary(Pred)$Summary[1,2],3)}. Most importantly, \code{PQ[1]} is \Sexpr{round(summary(Pred)$Summary[1,7],3)}, indicating that \Sexpr{round(summary(Pred)$Summary[1,7]*100,1)}\% of the time, \code{yhat[1,]} was greater than \code{y[1]}, or that \code{y[1]} is close to the mean of \code{yhat[1,]}. Contrast this with the 6th record, where \code{y[6]}=\Sexpr{round(summary(Pred)$Summary[6,1],3)} and \code{PQ[6]}=\Sexpr{round(summary(Pred)$Summary[6,7],3)}. Therefore, \code{yhat[6,]} was not a good replication of \code{y[6]}, because the distribution of \code{yhat[6,]} is almost always greater than \code{y[6]}. While \code{y[1]} is within the 95\% probability interval of \code{yhat[1,]}, \code{yhat[6,]} is above \code{y[6]} \Sexpr{round(summary(Pred)$Summary[6,7]*100,1)}\% of the time, indicating a strong discrepancy between the model and data, in this case. \end{itemize} There are also a variety of plots for posterior predictive checks, and the type of plot is controlled with the \code{Style} argument. Many styles exist, such as producing plots of covariates and residuals. The last component of this summary may be viewed graphically as posterior densities. Rather than observing plots for each of \Sexpr{NROW(Pred$yhat)} records or rows, only the first 9 densities will be shown here: \begin{Scode}{eval=false} plot(Pred, Style="Density", Rows=1:9) \end{Scode} \begin{figure} \begin{center} \begin{Scode}{label=fig6,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(3,3)) for (j in 1:9){ plot(density(Pred$yhat[j,]), xlab="Value", main=paste("Post. Pred. Plot of yhat[", j, ",]", sep=""), sub="Black=Density, Red=y") polygon(density(Pred$yhat[j,]), col="black", border="black") abline(v=Pred$y[j], col="red") } \end{Scode} \end{center} \caption{Posterior Predictive Densities} \end{figure} Among many other options, the fit may be observed: \begin{Scode}{eval=false} plot(Pred, Style="Fitted") \end{Scode} \begin{figure} \begin{center} \begin{Scode}{label=fig7,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(1,1)) temp <- summary(Pred, Quiet=TRUE)$Summary plot(temp[,1], temp[,5], pch=16, cex=0.75, ylim=c(min(temp[,c(1,4:6)], na.rm=TRUE), max(temp[,c(1,4:6)], na.rm=TRUE)), xlab="y", ylab="yhat", main="Fitted") for (i in 1:length(y)) { lines(c(temp[i,1], temp[i,1]), c(temp[i,4], temp[i,6]))} panel.smooth(temp[,1], temp[,5], pch=16, cex=0.75) \end{Scode} \end{center} \caption{Posterior Predictive Fit} \end{figure} This plot shows a poor fit between the dependent variable and its expectation, and model revision should be considered. The \code{Importance} function is not presented here in detail, but may be a useful way to assess variable importance, which is defined here as the impact of each variable on $\textbf{y}^{rep}$, when the variable is removed (or set to zero). Variable importance consists of differences in model fit or discrepancy statistics, showing how well the model fits the data with each variable removed. This information may be used for model revision, or presenting the relative importance of variables. These posterior predictive checks indicate that there is plenty of room to improve this model. \section{General Suggestions} \label{generalsuggestions} Following are general suggestions on how best to use the \pkg{LaplacesDemon} package: \begin{itemize} \item As suggested by \citet{gelman08}, continuous predictors should be centered and scaled. Here is an explicit example in \proglang{R} of how to center and scale a single predictor called \code{x}: \code{x.cs <- (x - mean(x)) / (2*sd(x))}. However, it is instead easier to use the \code{CenterScale} function provided in \pkg{LaplacesDemon}. \item Do not forget to reparameterize any bounded parameters in the \code{Model} function to be real-valued in the \code{parm} vector, and this is a good time to check for prior propriety with the \code{is.proper} function. \item If sufficient sample size is available, begin with a deterministic numerical approximation algorithm such as Laplace Approximation or variational Bayes. \item MCMC and PMC are stochastic methods of numerical approximation, and as such, results may differ with each run due to the use of pseudo-random number generation. It is good practice to set a seed so that each update of the model may be reproduced. Here is an example in \proglang{R}: \code{set.seed(666)}. \item Rather than specify the final, intended model in the \code{Model} function, start by specifying the simplest possible form. Rather than beginning with actual data, start by simulating data given specified parameters. Update the simple model on simulated data and verify that the algorithm converges to the correct target distributions. One by one, add components to the model specification, simulate more complicated data, update, verify, and progress toward the intended model. If using MCMC during this phase, then use the \code{Juxtapose} function to compare the inefficiency of several MCMC algorithms (via integrated autocorrelation time or \code{IAT}), and use this information to select the least inefficient algorithm for your particular model. When confident the model is specified correctly and with informed algorithmic selection, finally use actual data, but with few iterations, such as \code{Iterations=20}. \item After studying MCMC updates with few iterations, the first ``actual'' update should be long enough that proposals are accepted (the acceptance rate is not zero), adaptation begins to occur (if used), and that enough iterations occur after the first adaptation to allow the user to study the adaptation (assuming an adaptive algorithm is used). \item Depending on the model specification function, data, and intended iterations, it is a good idea to use the \code{LaplacesDemon.RAM} function to estimate the amount of random-access memory (RAM) that \code{LaplacesDemon} will use. If \code{LaplacesDemon} uses more RAM than the computer has available, then the computer will crash. This can be used to estimate the maximum number of iterations or thinned samples for a particular model and data set on a given computer. \item Once the final, intended model has begun (finally!), the mixing of the chains should be observed after a larger trial run, say, arbitrarily, for 10,000 iterations. If the chains do not mix as expected, then try a different algorithm, either one suggested by the \code{Consort} function (such as when diminishing adaptation is violated), or use the next least inefficient algorithm as indicated previously in the \code{Juxtapose} function. \item When speed is a concern, such as with complex models, there may be things in the \code{Model} function that can be commented out, such as sometimes calculating \code{yhat}. The model can be updated without some features, that can be un-commented and used for posterior predictive checks. By commenting out things that are strictly unnecessary to updating, the model will update more quickly. Other helpful hints for speed are found in the documentation for the \code{Model.Spec.Time} function. \item If the numerical approximation algorithm is exploring areas of the state space that the user knows \textit{a priori} should not be explored, then the parameters may be constrained in the \code{Model} function before being passed back to the numerical approximation function. Simply change the parameter of interest as appropriate and place the constrained value back in the \code{parm} vector. \item For MCMC, \code{Demonic Suggestion} is intended as an aid, not an infallible replacement for critical thinking. As with anything else, its suggestions are based on assumptions, and it is the responsibility of the user to check those assumptions. For example, the \code{BMK.Diagnostic} may indicate stationarity (lack of a trend) when it does not exist. Or, the \code{Demonic Suggestion} may indicate that the next update may need to run for a million iterations in a complex model, requiring weeks to complete. \item If an adaptive MCMC algorithm is used, then use a two-phase approach, where the first phase consists of using an adaptive algorithm to achieve stationary samples that seem to have converged to the target distributions (convergence can never be determined with MCMC, but some instances of non-convergence can be observed). Once it is believed that convergence has occurred, use a non-adaptive algorithm. The final samples should again be checked for signs of non-convergence. If satisfactory, then the non-adaptive algorithm should have estimated the logarithm of the marginal likelihood (LML). This is most easily checked with the \code{is.proper} function, which considers the joint posterior distribution to be proper if it can verify that the LML is finite. \item The desirable number of final, thinned samples for inference depends on the required precision of the inferential goal. A good, general goal is to end up with 1,000 thinned samples \citep[p. 295]{gelman04}, where the ESS is at least 100 (and more is desirable). See the \code{ESS} function for more information. \item Disagreement exists in MCMC literature as to whether to update one, long chain \citep{geyer92, geyer11}, or multiple, long chains with different, randomized initial values \citep{gelman92}. Multiple chains are enabled with an extension function called \code{LaplacesDemon.hpc}, which uses parallel processing. The \code{Gelman.Diagnostic} function may be used to compare multiple chains. Samples from multiple chains may be put together with the \code{Combine} function. \item After a deterministic numerical approximation algorithm has converged, consider following it up with a stochastic numerical approximation algorithm such as MCMC, if practical. When MCMC seems to have converged, consider updating the model again, this time with Population Monte Carlo (PMC). PMC may improve the model fit obtained with MCMC, and should reduce the variance of the marginal posterior distributions, which is desirable for predictive modeling. \item After a model has been updated, consider posterior predictive checks and any necessary model revisions. Afterward, consider updating a model with different prior distributions and compare results with the \code{BayesFactor} and \code{SensitivityAnalysis} functions, as well as comparing posterior predictive checks. Consider applying the model to different data sets and using the \code{Validate} function. Consider beyond the model how decision theory applies to the problem. Finally, make inferences, given the model and data. \end{itemize} \section{Independence and Observability} \label{independence} The \pkg{LaplacesDemon} package was designed with independence and observability in mind. By independence, it is meant that a goal was to minimize dependence on other software. The \pkg{LaplacesDemon} package requires only base \proglang{R}, and the \pkg{parallel} package bundled with it. The variety of packages makes \proglang{R} extremely attractive. However, depending on multiple packages can be problematic when different packages have functions with the same name, or when a change is made in one package, but other packages do not keep pace, and the user is dependent on packages being in sync. By avoiding dependencies on packages that are not in or accompanying base \proglang{R}, the \pkg{LaplacesDemon} package is attempting to be consistent and dependable for the user. For example, common MCMC diagnostics and probability distributions (such as Dirichlet, multivariate normal, Wishart, and many others, as well as truncated forms of distributions) in Bayesian inference have been included in the \pkg{LaplacesDemon} package so the user does not have to load numerous \proglang{R} packages, except of course for exotic distributions that have not been included. \pkg{LaplacesDemonCpp} is an optional extension package that uses \proglang{C++}, and is not an independent package in the sense that it imports \pkg{parallel}, but also \pkg{Rcpp} and \pkg{RcppArmadillo}. Once obtained and activated, its use is seamless to a \pkg{LaplacesDemon} user. \pkg{LaplacesDemonCpp} is a stand-alone replacement of \pkg{LaplacesDemon}, and is currently in development. By observability, it is meant that the base \pkg{LaplacesDemon} package is written entirely in \proglang{R}. Certain functions could be sped up in another language such as \proglang{C++}, but this may prevent some \proglang{R} users from understanding the code. The base \pkg{LaplacesDemon} package is intended to be open and accessible. The optional \pkg{LaplacesDemonCpp} package is available for faster computations via \proglang{C++}. If a user desires speed and is familiar with a faster language, then the user is encouraged to program the model specification function in the faster language. See the documentation for the \code{Model.Spec.Time} function for more information. Observability also enables users to investigate or customize functions in the \pkg{LaplacesDemon} package. To access any function, simply enter the function name and press enter. For example, to print the source code for the \code{LaplacesDemon} function to the \proglang{R} console, simply enter: \begin{Scode}{eval=false} LaplacesDemon \end{Scode} Most undocumented, internal-only functions are exported in the namespace and have an alias in the LaplacesDemon-package.Rd file. \pkg{LaplacesDemon} seeks to provide a complete, Bayesian environment within \proglang{R}. Independence from other software facilitates dependability, and its open code makes it easier for a user to investigate and customize. \section{High Performance Computing} \label{hpc} High performance computing (HPC) is a broad term that can mean many different things. The \pkg{LaplacesDemon} package currently uses the term HPC to refer to two topics: big data and parallel processing. \subsection{Big Data} There are several definitions for big data. Here, big data is defined as data that is too big for the computer memory (RAM). The \code{BigData} function enables updating a Bayesian model with big data by reading in and processing smaller batches or chunks of data and performing a user-specified function on the batch before combining and outputing the result, so the entire data set does not consume RAM. \code{BigData} is also parallelized. The \code{read.matrix} function allows sampling from big data. Finally, the Stochastic Gradient Descent (SGD) algorithm (see \ref{sgd}) in \code{LaplaceApproximation} and the Stochastic Gradient Langevin Dynamics (SGLD) algorithm in \code{LaplacesDemon} are designed specifically for use with big data. \subsection{Parallel Processing} Parallel processing occurs when software is designed to simultaneously use multiple central processing units (CPUs). The motherboard of a computer may contain multiple CPUs, such as a quad-core contains four, and this is called a multicore computer. Several computers may be linked together with network communication, forming what is called a computer cluster. The \pkg{LaplacesDemon} package has several functions that optionally take advantage of multicore computers or may utilize large computer clusters. In the context of MCMC, there are three approaches to parallelization that are avilable in \pkg{LaplacesDemon}: parallel approximation within a chain, parallel sets of independent chains, and parallel sets of interactive chains. There are more parallelized functions in \pkg{LaplacesDemon} in addition to MCMC. \subsection{Iterative Quadrature} \label{paraquad} The \code{IterativeQuadrature} function provides several numerical integration algorithms, and each may be parallelized. At each iteration, the conditional density is evaluated at several nodes, and this processing may take advantage of multiple CPUs. For more information, see \ref{iterativequadrature}. \subsection{Parallel Approximation within a Chain} \label{parapprox} The Griddy-Gibbs (GG) sampler of \citet{ritter92}, Adaptive Griddy-Gibbs (AGG), and Multiple-Try Metropolis (MTM) of \citet{liu00} are examples of algorithms in which an approximation is made within a chain, and the approximation may be parallelized. \subsection{Parallel Sets of Independent Chains} \label{indchains} The \code{LaplacesDemon} function is extended with the \code{LaplacesDemon.hpc} function for the parallel processing of multiple chains on different central processing units (CPUs). This requires a minimum of two additional arguments: \code{Chains} to specify the number of parallel chains, and \code{CPUs} to specify the number of CPUs. The \code{LaplacesDemon.hpc} function allows the parallelization of most MCMC algorithms in the \code{LaplacesDemon} function. An example of using \code{LaplacesDemon.hpc} is to simultaneously update three independent chains as an aid to checking MCMC convergence, as Gelman recommends \citep{gelman92}. Aside from aiding convergence, another benefit of parallelization is that more posterior samples are updated in the same time-frame as a non-parallel implementation. A multicore computer, such as a quad-core, will yield more posterior samples (which is valuable only if it converges, because it does not process more iterations), but a supercomputing environment or large computer cluster will yield many orders more. If multiple CPUs are available, then it only makes sense to use them...all. It is important to note that \code{Status} messages do not print to the console during parallel processing with \code{LaplacesDemon.hpc}, and should alternately be directed by the user to a log file with the \code{LogFile} argument, if desired. The \code{LaplacesDemon.hpc} function sends the information associated with each chain as well as the \code{LaplacesDemon} function to each CPU. The \code{LaplacesDemon} function may very well return status messages, but the \code{LaplacesDemon.hpc} function is unaware. After updating a model with \code{LaplacesDemon.hpc}, the \code{plot} function may be applied so that multiple chains may be viewed simultaneously, and this is helpful when comparing samplers for a specific model. If this looks good, then the \code{Gelman.Diagnostic} function may be applied to assess convergence. Otherwise, the \code{as.initial.values} function may be used to extract the latest values from the chains and use these to begin the next update. Once results seem acceptable, the \code{Combine} function may be used to combine the posterior samples of multiple chains into one \code{demonoid} object, from which the remaining facilities of the \pkg{LaplacesDemon} package are available. The Metropolis-Coupled Markov Chain Monte Carlo (MCMCMC) algorithm of \citet{geyer91} is an example of an MCMC algorithm in which multiple chains are updated in parallel, but in \code{LaplacesDemon}, not \code{LaplacesDemon.hpc}. \subsection{Parallel Sets of Interactive Chains} \label{intchains} Parallel sets of independent chains should each run as efficiently as a traditional single set of chains. However, independent chains cannot benefit from the fact that there are other chains, while each chain is running. They are independent of each other. In contrast, parallel sets of interactive chains are able to learn from each other through interaction. In the \pkg{LaplacesDemon} package, some of these algorithms are called with the \code{LaplacesDemon} function, and some with the \code{LaplacesDemon.hpc} function. The Interchain Adaptation (INCA) algorithm \citep{craiu09, solonen12} performs Adaptive Metropolis (AM) with parallel chains that share the adaptive component, and this sharing speeds convergence. Whenever the chains are specified to adapt, adaptation is performed by pooling the historical covariance matrix across all parallel chains, and then returns the combined result to all chains. Network communication time slows the adaptation, but once returned to each CPU, chains iterate at their usual speed. This algorithm must be used with the \code{LaplacesDemon.hpc} function, and there is not an un-parallelized form of it. The Affine-Invariant Ensemble Sampler (AIES) of \citep{goodman10} must be used with the \code{LaplacesDemon} function, and is available in either a parallelized or un-parallelized form. A large, even number of parallel chains (or walkers) are grouped into two batches, and each iteration, each chain moves in relation to a randomly selected chain (walker) in the other batch. Since these interactive chains interact each iteration, computer network communication is frequent, and this communication may be much slower than processing with one CPU. However, in a large-scale computing environment and when a \code{Model} function is not trivial to evaluate, this form of parallelization can result in very early convergence. \subsection{Population Monte Carlo} The \code{PMC} function has been parallelized at each iteration to speed up the evaluation of the model specification function over numerous importance samples. \subsection{Predict Functions} The predict functions (\code{predict.demonoid}, \code{predict.laplace}, \code{predict.pmc}) have been parallelized to speed up the prediction, or scoring, of larger data sets or when models have many posterior samples. The \code{Importance} function, which extensively uses predict functions, has also been parallelized. \subsection{Model Specification Function} A user may have a model with a model specification function that is computationally expensive, and may write their own parallelization code to speed up its processing by breaking down challenging computations and sending them to separate CPUs. \subsection{Parallelization Details} Parallelization is enabled by the \pkg{parallel} package that comes with base \proglang{R}. Parallelization is accomplished by default with socket-transport functions derived from the \pkg{snow} package, which is an acronym for a Simple Network of Workstations. Alternatively, Message Passing Interface (MPI) may be used. SNOW is more general, being cross-platform, and works on multicore computers, computer clusters, and supercomputers. More performance may be found with MPI, but it is more specialized. \code{LaplacesDemon.hpc} was reported to have been used successfully on a cluster with over 200 nodes. \section{Details} \label{details} The \pkg{LaplacesDemon} package uses five broad types of numerical approximation algorithms: Importance Sampling (IS), Iterative Quadrature, Laplace Approximation, Markov chain Monte Carlo (MCMC), and Variational Bayes (VB). Approximate Bayesian Computation (ABC) may be estimated within each. These numerical approximation algorithms are introduced below. \subsection{Approximate Bayesian Computation} \label{abc} Approximate Bayesian Computation (ABC), also called likelihood-free estimation, is a family of numerical approximation techniques in Bayesian inference. ABC is especially useful when evaluation of the likelihood, $p(\textbf{y} | \Theta)$ is computationally prohibitive, or when suitable likelihoods are unavailable. As such, ABC algorithms estimate likelihood-free approximations. ABC is usually faster than a similar likelihood-based numerical approximation technique, because the likelihood is not evaluated directly, but replaced with an approximation that is usually easier to calculate. The approximation of a likelihood is usually estimated with a measure of distance between the observed sample, $\textbf{y}$, and its replicate given the model, $\textbf{y}^{rep}$, or with summary statistics of the observed and replicated samples. See the accompanying vignette entitled ``Examples'' for an example. \subsection{Importance Sampling} \label{importancesampling} Importance Sampling (IS) is a method of estimating a distribution with samples from a different distribution, called the importance distribution. Importance weights are assigned to each sample. The main difficulty with IS is in the selection of the importance distribution. IS dates back at least to the 1950s, including iterative IS. IS is the basis of a wide variety of algorithms, some of which involve the combination of IS and Markov chain Monte Carlo (MCMC). There are also many variations of IS, including adaptive IS, and parametric and nonparametric self-normalized IS (SNIS). Some popular algorithms, or families of algorithms, that include IS are Particle Filtering, Population Monte Carlo (PMC), and Sequential Monte Carlo (SMC). \subsubsection{Population Monte Carlo} \label{pmc} Population Monte Carlo (PMC) uses adaptive IS, and the proposal or importance distribution is a multivariate Gaussian \citep{cappe04}, or a mixture of multivariate Gaussian distributions \citep{cappe08, wraith09}. \pkg{LaplacesDemon} uses the version presented in the appendix of \citet{wraith09}. At each iteration, the importance distribution of $N$ samples and $M$ mixture components is adapted. Parallel processing is available. Compared with Markov chain Monte Carlo (MCMC), very few iterations are required, convergence and ergodicity are not problems, posterior samples are independent, and PMC lends itself well to parallelization. However, PMC requires much more prior information about the model (better initial values and proposal covariance matrix) than MCMC, and becomes harder to apply as the number of variables increases. Amazingly, PMC may improve the model fit obtained with MCMC, and should reduce the variance of the marginal posterior distributions. This reduction in variance is desirable for predictive modeling. Therefore, it is recommended that a model is attempted to be updated with PMC after the model seems to have converged with MCMC. \subsection{Iterative Quadrature} \label{iterativequadrature} Quadrature is a historical term in mathematics that means determining area. Mathematicians of ancient Greece, according to the Pythagorean doctrine, understood determination of area of a figure as the process of geometrically constructing a square having the same area (squaring). Thus the name quadrature for this process. In medieval Europe, quadrature meant the calculation of area by any method. With the invention of integral calculus, quadrature has been applied to the computation of a univariate definite integral. Numerical integration is a broad family of algorithms for calculating the numerical value of a definite integral. Numerical quadrature is a synonym for quadrature applied to one-dimensional integrals. Multivariate quadrature, also called cubature, is the application of quadrature to multidimensional integrals. A quadrature rule is an approximation of the definite integral of a function, usually stated as a weighted sum of function values at specified points within the domain of integration. The specified points are referred to as abscissae, abscissas, integration points, or nodes, and have associated weights. The calculation of the nodes and weights of the quadrature rule differs by the type of quadrature. There are numerous types of quadrature algorithms. Bayesian forms of quadrature usually use Gauss-Hermite quadrature \citep{naylor82}, and placing a Gaussian Process on the function is a common extension \citep{ohagan91,rasmussen03} that is called `Bayesian Quadrature'. Often, these and other forms of quadrature are also referred to as model-based integration. Gauss-Hermite quadrature uses Hermite polynomials to calculate the rule. However, there are two versions of Hermite polynomials, which result in different kernels in different fields. In physics, the kernel is $\exp(-x^2)$, while in probability the kernel is $\exp(-x^2/2)$. The weights are a normal density. If the parameters of the normal distribution, $\mu$ and $\sigma^2$, are estimated from data, then it is referred to as adaptive Gauss-Hermite quadrature, and the parameters are the conditional mean and conditional variance. Outside of Gauss-Hermite quadrature, adaptive quadrature implies that a difficult range in the integrand is subdivided with more points until it is well-approximated. Gauss-Hermite quadrature performs well when the integrand is smooth, and assumes normality or multivariate normality. Adaptive Gauss-Hermite quadrature has been demonstrated to outperform Gauss-Hermite quadrature in speed and accuracy. A goal in quadrature is to minimize integration error, which is the error between the evaluations and the weights of the rule. Therefore, a goal in Bayesian Gauss-Hermite quadrature is to minimize integration error while approximating a marginal posterior distribution that is assumed to be smooth and normally-distributed. This minimization often occurs by increasing the number of nodes until a change in mean integration error is below a tolerance, rather than minimizing integration error itself, since the target may be only approximately normally distributed, or minimizing the sum of integration error, which would change with the number of nodes. To approximate integrals in multiple dimensions, one approach applies $N$ nodes of a univariate quadrature rule to multiple dimensions (using the \code{GaussHermiteCubeRule} function for example) via the product rule, which results in many more multivariate nodes. This requires the number of function evaluations to grow exponentially as dimension increases. Multidimensional quadrature is usually limited to less than ten dimensions, both due to the number of nodes required, and because the accuracy of multidimensional quadrature algorithms decreases as the dimension increases. Three methods may overcome this curse of dimensionality in varying degrees: componentwise quadrature, sparse grids, and Monte Carlo. Componentwise quadrature is the iterative application of univariate quadrature to each parameter. It is applicable with high-dimensional models, but sacrifices the ability to calculate the conditional covariance matrix, and calculates only the variance of each parameter. Sparse grids were originally developed by Smolyak for multidimensional quadrature. A sparse grid is based on a one-dimensional quadrature rule. Only a subset of the nodes from the product rule is included, and the weights are appropriately rescaled. Although a sparse grid is more efficient because it reduces the number of nodes to achieve the same accuracy, the user must contend with increasing the accuracy of the grid, and it remains inapplicable to high-dimensional integrals. Monte Carlo is a large family of sampling-based algorithms. \citet{ohagan87} asserts that Monte Carlo is frequentist, inefficient, regards irrelevant information, and disregards relevant information. Quadrature, he maintains \citep{ohagan92}, is the most Bayesian approach, and also the most efficient. In high dimensions, he concedes, a popular subset of Monte Carlo algorithms is currently the best for cheap model function evaluations. These algorithms are called Markov chain Monte Carlo (MCMC). High-dimensional models with expensive model evaluation functions, however, are not well-suited to MCMC. A large number of MCMC algorithms is available in the \code{LaplacesDemon} function. Following are some reasons to consider iterative quadrature rather than MCMC. Once an MCMC sampler finds equilibrium, it must then draw enough samples to represent all targets. Iterative quadrature does not need to continue drawing samples. Multivariate quadrature is consistently reported as more efficient than MCMC when its assumptions hold, though multivariate quadrature is limited to small dimensions. High-dimensional models therefore default to MCMC, between the two. Componentwise quadrature algorithms like CAGH, however, may also be more efficient with clock-time than MCMC in high dimensions, especially against componentwise MCMC algorithms. Another reason to consider iterative quadrature are that assessing convergence in MCMC is a difficult topic, but not for iterative quadrature. A user of iterative quadrature does not have to contend with effective sample size and autocorrelation, assessing stationarity, acceptance rates, diminishing adaptation, etc. Stochastic sampling in MCMC is less efficient when samples occur in close proximity (such as when highly autocorrelated), whereas in quadrature the nodes are spread out by design. In general, the conditional means and conditional variances progress smoothly to the target in multidimensional quadrature. For componentwise quadrature, movement to the target is not smooth, and often resembles a Markov chain or optimization algorithm. Iterative quadrature is often applied after \code{LaplaceApproximation} to obtain a more reliable estimate of parameter variance or covariance than the negative inverse of the \code{Hessian} matrix of second derivatives, which is suitable only when the contours of the logarithm of the unnormalized joint posterior density are approximately ellipsoidal \citep{naylor82}. \subsubsection{Adaptive Gauss-Hermite} \label{agh} The Adaptive Gauss-Hermite (AGH) algorithm is the \citet{naylor82} algorithm. The AGH algorithm uses multivariate quadrature with the physicist's (not the probabilist's) kernel. There are four algorithm specifications: \code{N} is the number of univariate nodes, \code{Nmax} is the maximum number of univariate nodes, \code{Packages} accepts any package required for the model function when parallelized, and \code{Dyn.libs} accepts dynamic libraries for parallelization, if required. The number of univariate nodes begins at $N$ and increases by one each iteration. The number of multivariate nodes grows quickly with $N$. \citet{naylor82} recommend beginning with as few nodes as $N=3$. Any of the following events will cause $N$ to increase by 1 when $N$ is less than \code{Nmax}: \begin{itemize} \item All LP weights are zero (and non-finite weights are set to zero) \item $\mu$ does not result in an increase in LP \item All elements in $\Sigma$ are not finite \item The square root of the sum of the squared changes in $\mu$ is less than or equal to the \code{Stop.Tolerance} \end{itemize} Tolerance includes two metrics: change in mean integration error and change in parameters. Including the change in parameters for tolerance was not mentioned in \citet{naylor82}. \citet{naylor82} consider a transformation due to correlation. This is not included here. The AGH algorithm does not currently handle constrained parameters, such as with the \code{interval} function. If a parameter is constrained and changes during a model evaluation, this changes the node and the multivariate weight. This is currently not corrected. An advantage of AGH over componentwise adaptive quadrature is that AGH estimates covariance, where a componentwise algorithm ignores it. A disadvantage of AGH over a componentwise algorithm is that the number of nodes increases so quickly with dimension, that AGH is limited to small-dimensional models. \subsubsection{Adaptive Gauss-Hermite Sparse Grid} \label{aghsg} The Adaptive Gauss-Hermite Sparse Grid (AGHSG) algorithm is the \citet{naylor82} algorithm applied to a sparse grid, rather than a traditional multivariate quadrature rule. This is identical to the AGH algorithm above, except that a sparse grid replaces the multivariate quadrature rule. The sparse grid reduces the number of nodes. The cost of reducing the number of nodes is that the user must consider the accuracy, $K$. There are four algorithm specifications: \code{K} is the accuracy (as a positive integer), \code{Kmax} is the maximum accuracy, \code{Packages} accepts any package required for the model function when parallelized, and \code{Dyn.libs} accepts dynamic libraries for parallelization, if required. These arguments represent accuracy rather than the number of univariate nodes, but otherwise are similar to the AGH algorithm. \subsubsection{Componentwise Adaptive Gauss-Hermite} \label{cagh} The Componentwise Adaptive Gauss-Hermite (CAGH) algorithm is a componentwise version of the adaptive Gauss-Hermite quadrature of \citet{naylor82}. Each iteration, each marginal posterior distribution is approximated sequentially, in a random order, with univariate quadrature. The conditional mean and conditional variance are also approximated each iteration, making it an adaptive algorithm. There are four algorithm specifications: \code{N} is the number of nodes, \code{Nmax} is the maximum number of nodes, \code{Packages} accepts any package required for the model function when parallelized, and \code{Dyn.libs} accepts dynamic libraries for parallelization, if required. The number of nodes begins at $N$. All parameters have the same number of nodes. Any of the following events will cause $N$ to increase by 1 when $N$ is less than \code{Nmax}, and these conditions refer to all parameters (not individually): \begin{itemize} \item Any LP weights are not finite \item All LP weights are zero \item $\mu$ does not result in an increase in LP \item The square root of the sum of the squared changes in $\mu$ is less than or equal to the \code{Stop.Tolerance} \end{itemize} It is recommended to begin with \code{N=3} and set \code{Nmax} between 10 and 100. As long as CAGH does not experience problematic weights, and as long as CAGH is improving LP with $\mu$, the number of nodes does not increase. When CAGH becomes either universally problematic or universally stable, then $N$ slowly increases until the sum of both the mean integration error and the sum of the squared changes in $\mu$ is less than the \code{Stop.Tolerance} for two consecutive iterations. If the highest LP occurs at the lowest or highest node, then the value at that node becomes the conditional mean, rather than calculating it from all weighted samples; this facilitates movement when the current integral is poorly centered toward a well-centered integral. If all weights are zero, then a random proposal is generated with a small variance. Tolerance includes two metrics: change in mean integration error and change in parameters, as the square root of the sum of the squared differences. When a parameter constraint is encountered, the node and weight of the quadrature rule is recalculated. An advantage of CAGH over multidimensional adaptive quadrature is that CAGH may be applied in large dimensions. Disadvantages of CAGH are that only variance, not covariance, is estimated, and ignoring covariance may be problematic. \subsection{Laplace Approximation} \label{laplaceapproximation} The Laplace Approximation or Laplace Method is a family of asymptotic techniques used to approximate integrals. Laplace's method seems to accurately approximate unimodal posterior moments and marginal posterior distributions in many cases. Since it is not applicable in all cases, it is recommended here that Laplace Approximation is used cautiously in its own right, or preferably, it is used before MCMC. After introducing the Laplace Approximation \citep[p. 366--367]{laplace74}, a proof was published later \citep{laplace14} as part of a mathematical system of inductive reasoning based on probability. Laplace used this method to approximate posterior moments. Since its introduction, the Laplace Approximation has been applied successfully in many disciplines. In the 1980s, the Laplace Approximation experienced renewed interest, especially in statistics, and some improvements in its implementation were introduced \citep{tierney86, tierney89}. Only since the 1980s has the Laplace Approximation been seriously considered by statisticians in practical applications. There are many variations of Laplace Approximation, with an effort toward replacing Markov chain Monte Carlo (MCMC) algorithms as the dominant form of numerical approximation in Bayesian inference. The run-time of Laplace Approximation is a little longer than Maximum Likelihood Estimation (MLE), usually shorter than variational Bayes, and much shorter than MCMC \citep{azevedo94}. The speed of Laplace Approximation depends on the optimization algorithm selected, and typically involves many evaluations of the objective function per iteration (where an MCMC algorithm with a multivariate proposal usually evaluates once per iteration), making many MCMC algorithms faster per iteration. The attractiveness of Laplace Approximation is that it typically improves the objective function better than iterative quadrature, MCMC, and PMC when the parameters are in low-probability regions. Laplace Approximation is also typically faster than MCMC and PMC because it is seeking point-estimates, rather than attempting to represent the target distribution with enough simulation draws. Laplace Approximation extends MLE, but shares similar limitations, such as its asymptotic nature with respect to sample size and that marginal posterior distributions are Gaussian. \citet{bernardo00} note that Laplace Approximation is an attractive family of numerical approximation algorithms, and will continue to develop. \code{LaplaceApproximation} seeks a global maximum of the logarithm of the unnormalized joint posterior density. The approach differs by \code{Method}. The \code{LaplacesDemon} function uses the \code{LaplaceApproximation} algorithm to optimize initial values and save time for the user. Most optimization algorithms assume that the logarithm of the unnormalized joint posterior density is defined and differentiable\footnote{When the joint posterior is not differentiable, and should be, it has probably encountered an area of flat density. It is recommended that WIPs are used for regularization. For more information on WIPs, see the accompanying vignette entitled ``Bayesian Inference''.}. Some methods calculate an approximate gradient for each initial value as the difference in the logarithm of the unnormalized joint posterior density due to a slight increase in the parameter. The user may select from numerous optimization algorithms: \subsubsection{Adaptive Gradient Ascent} \label{aga} With adaptive gradient ascent, the direction and distance for each parameter is proposed based on an approximate truncated graident and an adaptive step size. The step size parameter, which is often plural and called rate parameters in other literature, is adapted each iteration with the univariate version of the Robbins-Monro stochastic approximation in \citet{garthwaite10}. The step size shrinks when a proposal is rejected and expands when a proposal is accepted. Gradient ascent is criticized for sometimes being relatively slow when close to the maximum, and its asymptotic rate of convergence is inferior to other methods. However, compared to other popular optimization algorithms such as Newton-Raphson, an advantage of the gradient ascent is that it works in infinite dimensions, requiring only sufficient computer memory. Although Newton-Raphson converges in fewer iterations, calculating the inverse of the negative Hessian matrix of second-derivatives is more computationally expensive and subject to singularities. Therefore, gradient ascent takes longer to converge, but is more generalizable. \subsubsection{BFGS} \label{bfgs} The Broyden-Fletcher-Goldfarb-Shanno (BFGS) algorithm was proposed independently by \citet{broyden70}, \citet{fletcher70}, \citet{goldfarb70}, and \citet{shanno70}. BFGS may be the most efficient and popular quasi-Newton optimiziation algorithm. As a quasi-Newton algorithm, the Hessian matrix is approximated using rank-one updates specified by (approximate) gradient evaluations. Since BFGS is very popular, there are many variations of it. This is a version by Nash that has been adapted from the Rvmmin package, and is used in the \code{optim} function of base R. The approximate Hessian is not guaranteed to converge to the Hessian. When BFGS is used, the approximate Hessian is not used to calculate the final covariance matrix. \subsubsection{BHHH} \label{bhhh} The BHHH algorithm of \citet{berndt74} is a quasi-Newton method that includes a step-size parameter, partial derivatives, and an approximation of a covariance matrix that is calculated as the inverse of the sum of the outer product of the gradient (OPG), calculated from each record. The OPG method becomes more costly with data sets with more records. Since partial derivatives must be calculated per record of data, the list of data has special requirements with this method, and must include design matrix \textbf{X}, and dependent variable \textbf{y} or \textbf{Y}. Records must be row-wise. An advantage of BHHH over NR (see below) is that the covariance matrix is necessarily positive definite, and gauranteed to provide an increase in LP each iteration (given a small enough step-size), even in convex areas. The covariance matrix is better approximated with larger data sample sizes, and when closer to the maximum of LP. Disadvantages of BHHH include that it can give small increases in LP, especially when far from the maximum or when LP is highly non-quadratic. \subsubsection{Conjugate Gradient} \label{cg} Conjugate gradient (CG) is a family of algorithms that uses partial derivatives, but does not use the Hessian matrix or any approximation of it. CG usually requires more iterations to reach convergence than other algorithms that use the Hessian or an approximation. However, since the Hessian becomes computationally expensive as the dimension of the model grows, CG is applicable to large dimensional models. CG was originally developed by \citet{hestenes52}. The version here is a nonlinear CG method. \subsubsection{Davidon-Fletcher-Powell} \label{dfp} The Davidon-Fletcher-Powell (DFP) algorithm was the first popular, multidimensional, quasi-Newton optimization algorithm. The DFP update of an approximate Hessian matrix maintains symmetry and positive-definiteness. The approximate Hessian is not guaranteed to converge to the Hessian. When DFP is used, the approximate Hessian is not used to calculate the final covariance matrix. Although DFP is very effective, it was superseded by the BFGS algorithm. \subsubsection{Hit-And-Run} \label{har} This version of the Hit-And-Run (HAR) algorithm makes multivariate proposals and uses an adpative length parameter. The length parameter is adapted each iteration with the univariate version of the Robbins-Monro stochastic approximation in \citet{garthwaite10}. The length shrinks when a proposal is rejected and expands when a proposal is accepted. This is the same algorithm as the HARM or Hit-And-Run Metropolis MCMC algorithm with adaptive length, except that a Metropolis step is not used. \subsubsection{Hooke-Jeeves} \label{hj} The Hooke-Jeeves algorithm \citep{hooke61} is a derivative-free, direct search method. Each iteration involves two steps: an exploratory move and a pattern move. The exploratory move explores local behavior, and the pattern move takes advantage of pattern direction. It is sometimes described as a hill-climbing algorithm. If the solution improves, it accepts the move, and otherwise rejects it. Step size decreases with each iteration. The decreasing step size can trap it in local maxima, where it gets stuck and convergences erroneously. Users are encouraged to attempt again after what seems to be convergence, starting from the latest point. Although getting stuck at local maxima can be problematic, the Hooke-Jeeves algorithm is also attractive because it is simple, fast, does not depend on derivatives, and is otherwise relatively robust. \subsubsection{Levenberg-Marquardt} \label{levenberg} Also known as the Levenberg-Marquardt Algorithm (LMA) or the Damped Least-Squares (DLS) method, Levenberg-Marquardt (LM) is a trust region (not to be confused with TR below) optimization algorithm that minimizes nonlinear least squares, and has been adapted here to maximize LP. LM uses partial derivatives and approximates the Hessian with outer-products. It is suitable for nonlinear optimization up to a few hundred parameters, but loses its efficiency in larger problems due to matrix inversion. LM is considered between the Gauss-Newton algorithm and gradient descent. When far from the solution, LM moves slowly like gradient descent, but is guaranteed to converge. When LM is close to the solution, LM becomes a damped Gauss-Newton method. \subsubsection{Limited-Memory BFGS} \label{lmbfgs} The limited-memory BFGS (Broyden-Fletcher-Goldfarb-Shanno) algorithm is a quasi-Newton optimization algorithm that compactly approximates the Hessian matrix. Rather than storing the dense Hessian matrix, L-BFGS stores only a few vectors that represent the approximation. This algorithm is better suited for large-scale models than the BFGS algorithm. When (\code{method="LBFGS"}) for \code{LaplaceApproximation}, \code{method="L-BFGS-B"} is called in the \code{optim} function of base \proglang{R}. \subsubsection{Nelder-Mead} \label{nm} The Nelder-Mead algorithm \citep{nelder65} is a derivative-free, direct search method that is known to become inefficient in large-dimensional problems. As the dimension increases, the search direction becomes increasingly orthogonal to the steepest ascent (usually descent) direction. However, in smaller dimensions it is a popular algorithm. At each iteration, three steps are taken to improve a simplex: reflection, extension, and contraction. \subsubsection{Newton-Raphson} \label{nr} The Newton-Raphson optimization algorithm, also known as Newton's Method, uses derivatives and a Hessian matrix. The algorithm is included for its historical significance, but is known to be problematic when starting values are far from the targets, and calculating and inverting the Hessian matrix can be computationally expensive. As programmed here, when the Hessian is problematic, it tries to use only the derivatives, and when that fails, a jitter is applied. Newton-Raphson should not be the first choice of the user, and BFGS should always be preferred. \subsubsection{Particle Swarm Optimization} \label{pso} Of numerous Particle Swarm Optimization (PSO) algorithms, the Standard Particle Swarm Optimization 2007 (SPSO 07) algorithm is used here. A swarm of particles is moved according to velocity, neighborhood, and the best previous solution. The neighborhood for each particle is a set of informing particles. PSO is derivative-free. \subsubsection{Resilient Backpropagation} \label{resilientbackprop} ``Rprop'' stands for resilient backpropagation. In Rprop, the approximate gradient is taken for each parameter in each iteration, and its sign is compared to the approximate gradient in the previous iteration. A weight element in a weight vector is associated with each approximate gradient. A weight element is multiplied by 1.2 when the sign does not change, or by 0.5 if the sign changes. The weight vector is the step size, and is constrained to the interval [0.001, 50], and initial weights are 0.0125. This is the resilient backpropagation algorithm, which is often denoted as the ``Rprop-'' algorithm of \citet{riedmiller94}. \subsubsection{Self-Organizing Migration Algorithm} \label{soma} The Self-Organizing Migration Algorithm (SOMA) of \citet{zelinka04}, as used here, moves a population of ten particles or individuals in the direction of the best particle, the leader. The leader does not move in each iteration, and a line-search is used for each non-leader, up to three times the difference in parameter values between each non-leader and leader. This algorithm is derivative-free and often considered in the family of evolution algorithms. Numerous model evaluations are performed per non-leader per iteration. \subsubsection{Spectral Projected Gradient} \label{spg} The Spectral Projected Gradient (SPG) algorithm is a non-monotone algorithm that is suitable for high-dimensional models. The approximate gradient is used, but the Hessian matrix is not. SPG is the default algorithm for the \code{LaplaceApproximation} function. \subsubsection{Stochastic Gradient Descent} \label{sgd} The stochastic gradient descent (SGD) algorithm, here, is designed only for big data. Traditional optimization algorithms require the entire data set to be included in the model evaluation each iteration. In contrast, SGD reads and processes only a small, randomly selected batch of records each iteration. In addition to saving computation time, the entire data set does not need to be loaded into memory at once. In this version of SGD, a multivariate proposal is used, and it is merely the vector of current values plus a step size times the gradient. SGD requires five objects in the \code{Data} list: \code{epsilon} or $\epsilon$ is the step size as a scalar, \code{file} is a quoted name of a .csv file that is the big data set, \code{Nr} is the number of rows in the big data set, \code{Nc} is the number of columns in the big data set, and \code{size} is the number of rows to be read and processed each iteration. Since SGD, as implemented here, is designed for big data, the entire data set is not included in the \code{Data} list, but one small batch must be included and named \code{X}. All data must be included. For example, both the dependent variable \textbf{y} and design matrix \textbf{X} in linear regression are included. The requirement for the small batch to be in \code{Data} is so that numerous checks may be passed after \code{LaplaceApproximation} is called and before the SGD algorithm begins. Each iteration, SGD uses the \code{scan} function, without headers, to read a random block of rows from, say, \code{X.csv}, stores it in \code{Data$X}, and passes it to the \code{Model} specification function. The \code{Model} function must differ from the other examples found in this package in that multiple objects, such as \code{X} and \code{y} must be read from \code{Data$X}, where usually there is both \code{Data$X} and \code{Data$y}. The user tunes SGD with step size $\epsilon$ via \code{Data$epsilon}. The step size must be scalar and remain in the interval (0,1). When $\epsilon = 0$, SGD is reduced to zero, the algorithm will not move, and false convergence occurs. When $\epsilon$ is too large, degenerate results occur. A good recommendation seems to be to begin with $\epsilon$ set to \code{1/Nr}. The user may perform several short runs, and experimenting with adjusting \code{Data$epsilon}. At least \code{Nr / size} iterations are suggested. \subsubsection{Symmetric Rank-One} \label{srone} The Symmetric Rank-One (SR1) algorithm is a quasi-Newton optimization algorithm, and the Hessian matrix is approximated, often without being positive-definite. At the posterior modes, the true Hessian is usually positive-definite, but this is often not the case during optimization when the parameters have not yet reached the posterior modes. Other restrictions, including constraints, often result in the true Hessian being indefinite at the solution. For these reasons, SR1 often outperforms BFGS. The approximate Hessian is not guaranteed to converge to the Hessian. When SR1 is used, the approximate Hessian is not used to calculate the final covariance matrix. \subsubsection{Trust Region} \label{trust} The Trust Region (TR) algorithm of \citet{nocedal99} attempts to reach its objective in the fewest number of iterations, is therefore very efficient, as well as safe. The efficiency of TR is attractive when model evaluations are expensive.The Hessian is approximated each iteration, making TR best suited to models with small to medium dimensions, say up to a few hundred parameters. \subsubsection{Afterward} \label{afterward1} After \code{LaplaceApproximation} finishes, due either to early convergence or completing the number of specified iterations, it approximates the Hessian matrix of second derivatives (by default, but the user has other options), and attempts to calculate the covariance matrix by taking the inverse of the negative of this matrix. If successful, then this covariance matrix may be passed to \code{IterativeQuadrature}, \code{LaplacesDemon}, or \code{PMC}, and the diagonal of this matrix is the variance of the parameters. If unsuccessful, then a scaled identity matrix is returned, and each parameter's variance will be 1. \subsection{Markov Chain Monte Carlo} \label{mcmc} Markov chain Monte Carlo (MCMC) algorithms are also called samplers. There are a large number of MCMC algorithms, too many to review here. Popular families (which are often non-distinct) include Gibbs sampling, Metropolis-Hastings, slice sampling, Hamiltonian Monte Carlo, and many others. Though the name is misleading, Metropolis-within-Gibbs (MWG) was developed first \citep{metropolis53}, and Metropolis-Hastings was a generalization of MWG \citep{hastings70}. All MCMC algorithms are known as special cases of the Metropolis-Hastings algorithm. Regardless of the algorithm, the goal in Bayesian inference is to maximize the unnormalized joint posterior distribution and collect samples of the target distributions, which are marginal posterior distributions, later to be used for inference. The most generalizable MCMC algorithm is the Metropolis-Hastings (MH) generalization of the MWG algorithm. The MH algorithm extended MWG to include asymmetric proposal distributions. For years, the main disadvantage of the MWG algorithms was that the proposal variance (see below) had to be tuned manually, and therefore other MCMC algorithms have become popular because they do not need to be tuned. Gibbs sampling became popular for Bayesian inference, though it requires conditional sampling of conjugate distributions, so it is precluded from non-conjugate sampling in its purest form. Gibbs sampling also suffers under high correlations \citep{gilks96}. Due to these limitations, Gibbs sampling is less generalizable than RWM, though RWM and other algorithms are not immune to problems with correlation. The Griddy-Gibbs sampler evaluates a grid of proposals and approximates the conditional distribution, which enables non-conjugate sampling. Componentwise slice sampling is a special case of Gibbs sampling that samples a distribution by sampling uniformly from the region under the plot of its density function, and is more appropriate with bounded distributions that cannot approach infinity, though the improved slice sampler of \citet{neal03} is available here. \subsubsection{Blockwise Sampling} \label{block} Usually, there is more than one target distribution, in which case it must be determined whether it is best to sample from target distributions individually, in groups, or all at once. Block updating refers to splitting a multivariate vector into groups called blocks, and each block is sampled separately. A block may contain one or more parameters. Parameters are usually grouped into blocks such that parameters within a block are as correlated as possible, and parameters between blocks are as independent as possible. This strategy retains as much of the parameter correlation as possible for blockwise sampling, as opposed to componentwise sampling where parameter correlation is ignored. The \code{PosteriorChecks} function can be used on the output of previous runs to find highly correlated parameters, and the \code{Blocks} function may be used to create blocks based on posterior correlation. Advantages of blockwise sampling are that a different MCMC algorithm may be used for each block (or parameter, for that matter), creating a more specialized approach (though different algorithms by block are not supported here), the acceptance of a newly proposed state is likely to be higher than sampling from all target distributions at once in high dimensions, and large proposal covariance matrices can be reduced in size, which is most helpful again in high dimensions. Disadvantages of blockwise sampling are that correlations probably exist between parameters between blocks, and each block is updated while holding the other blocks constant, ignoring these correlations of parameters between blocks. Without simultaneously taking everything into account, the algorithm may converge slowly or never arrive at the proper solution. However, there are instances when it may be best when everything is not taken into account at once, such as in state-space models. Also, as the number of blocks increases, more computation is required, which slows the algorithm. In general, blockwise sampling allows a more specialized approach at the expense of accuracy, generalization, and speed. Blockwise sampling is offered in the following algorithms: Adaptive Metropolis-within-Gibbs (AMWG), Adaptive-Mixture Metropolis (AMM), Automated Factor Slice Sampler (AFSS), Elliptical Slice Sampler (ESS), Hit-And-Run Metropolis (HARM), Metropolis-within-Gibbs (MWG), Random-Walk Metropolis (RWM), Robust Adaptive Metropolis (RAM), and the Univariate Eigenvector Slice Sampler (UESS). \subsubsection{Markov Chain Properties} \label{markovchainproperties} This tutorial introduces only briefly the basics of Markov chain properties. A Markov chain is Markovian when the current iteration depends only on the previous iteration. Many (but not all) adaptive algorithms are merely chains but not Markov chains when the adaptation is based on the history of the chains, not just the previous iteration. A Markov chain is said to be aperiodic when it is not repeating a cycle. A Markov chain is considered irreducible when it is possible to go from any state to any other state, though not necessarily in one iteration. A Markov chain is said to be recurrent if it will eventually return to a given state with probability 1, and it is positive recurrent if the expected return time is finite, and null recurrent otherwise. The ergodic theorem states that a Markov chain is ergodic when it is aperiodic, irreducible, and positive recurrent. The non-Markovian chains of an adaptive algorithm that adapt based on the history of the chains should have two conditions: containment and diminishing adaptation. Containment is difficult to implement and is not currently programmed into \pkg{LaplacesDemon}. The condition of diminishing adaptation is fulfilled when the amount of adaptation diminishes with the length of the chain. Diminishing adaptation can be achieved when the proposal variances become smaller or by decreasing the probability of performing adaptations with more iterations \citep{roberts07}. Trace-plots of the output of the \code{LaplacesDemon} function automatically include plots of the absolute differences in proposal variance with each adaptation for adaptive algorithms, and the \code{Consort} function will try to suggest a different adaptive algorithm when these absolute differences are not trending downward. Descriptions of the MCMC algorithms in the \pkg{LaplacesDemon} package are available online at \url{https://web.archive.org/web/20150227012508/http://www.bayesian-inference.com/mcmc}. \subsubsection{Sampler Selection} \label{samplerselection} The optimal sampler differs for each problem, and it is recommended that the \code{Juxtapose} function is used to help select the least inefficient MCMC algorithm. Nonetheless, some general observations here may be helpful to a user attempting to select the most appropriate sampler for a given model. Suggestions in this section have been reached by attempting to compare all samplers on most models in the accompanying ``Examples'' vignette. Comparisons consisted of \begin{itemize} \item diminishing adaptation, if applicable \item how many iterations it took the sampler to seem to converge \item how many minutes it took the sampler to seem to converge \item how quickly the sampler improved in the beginning \item \code{Juxtapose} results based on integrated autocorrelation time (\code{IAT}) \item mixing of the chains \item whether or not the sampler arrived at the correct solution \end{itemize} When the user is ready to select a general-purpose sampler, the best place to begin is with the AFSS algorithm. This is not to say that AFSS is the best sampler and everything else pales by comparison. Instead, AFSS is a great sampler with which to start in the general case, and for beginners. Although AFSS has several algorithm specifications, the default specifications are suitable for many cases. A new user should not begin to learn AFSS and this package with a complicated and high-dimensional model. When this is necessary, the user of AFSS will need to learn how to create blocks of parameters and a list of proposal covariance matrices. In smaller cases, more suitable to learning, the user should not generally have to adjust the \code{m} or \code{w} specifications, and need only learn \code{A} and \code{n}. A new user should begin with \code{A=Inf} and \code{n=0}, and use code provided by the \code{Consort} function for the next run. When the user is satified that equilibrium is reached, then another run should be made without adaptation: \code{A=0}. Models with multimodal marginal posterior distributions are potentially troublesome for any numerical approximation algorithm, though MCMC may be better suited in general. It is best to begin either with MCMCMC or RDMH. Alternatives include AFSS, AGG, CHARM, GG, HARM, RAM, Slice, THMC, or t-walk. The MCMCMC and RDMH algorithms have demonstrated remarkable performance with multimodal distributions. The use of parallel chains in MCMCMC increases the chances that different chains may settle on different modes. Parallel chains from other parallelized algorithms may be helpful in finding multiple modes, but when the chains are combined with the \code{Combine} function for inference, each mode probably is not represented in a proportion correct for the distribution. Consider updating the model with PMC, with multiple mixture components, after MCMC is finished. Unlike MCMC with parallel chains, the proportion of each mode will be correctly represented with PMC. Models with discrete parameters currently require either the AGG, GG, or Slice algorithms, or converting the discrete parameters to continuous parameters so that any MCMC algorithm may be used. This is performed via the continuous relaxation of a Markov random field (MRF), as in \citet{zhang12}. For more information, see the \code{dcrmrf} and \code{rcrmrf} functions. Models with big data sets, too big for memory, may use the SGLD algorithm, the \code{BigData} function, or opt for alternative methods suggested in the details of the documentation for the \code{BigData} function. Regardless of the model or algorithm, parallel chains are recommended in general, provided the user has multiple CPUs and enough random-access memory (RAM). However, it is best to begin with a single chain, until the user is confident in the model specification. Parallel chains produce more posterior samples upon convergence than single chains in roughly the same amount of time, and may facilitate the discovery of multimodal marginal posterior distributions that would otherwise have been overlooked. Although algorithms may update independently in parallel, there are several that learn from other parallel updates, such as AIES and INCA. The \code{Demonic Suggestion} section of output from the \code{Consort} function also attempts to help the user to select a sampler. There are exceptions to each of these suggestions above. In some cases, a particular algorithm will fail to update for a given example. Hopefully this section assists the user in selecting a sampler. \subsubsection{Afterward} \label{afterward} Once the model is updated with the \code{LaplacesDemon} function, the \code{BMK.Diagnostic} function is applied to 10 batches of the thinned samples to assess stationarity (or lack of trend). When all parameters are estimated as stationary beyond a given iteration, the previous iterations are suggested to be considered as burn-in and discarded. The importance of Monte Carlo Standard Error (MCSE) is debated \citep{gelman04,jones06}. It is included in posterior summaries of \code{LaplacesDemon}, and is one of five main criteria as a stopping rule to appease Laplace's Demon. MCSE has been shown to be a better stopping rule than MCMC diagnostics \citep{jones06}. \pkg{LaplacesDemon} provides a \code{MCSE} function that allows three methods of estimation: sample variance, batch means \citep{jones06}, and Geyer's method \citep{geyer92}. The user is encouraged to explore MCMC diagnostics (also called convergence diagnostics). The \pkg{LaplacesDemon} package offers \code{AcceptanceRate}, the \code{BMK.Diagnostic}, a Cumulative Sample Function (\code{CSF}), Effective Sample Size (\code{ESS}), \code{Gelfand.Diagnostic}, \code{Gelman.Diagnostic}, \code{Geweke.Diagnostic}, \code{Heidelberger.Diagnostic}, Integrated Autocorrelation Time (\code{IAT}), the Kolmogorov-Smirnov test (\code{KS.Diagnostic}), Monte Carlo Standard Error (\code{MCSE}), \code{Raftery.Diagnostic}, and both the \code{plot} and \code{PosteriorChecks} functions include multiple diagnostics. \subsection{Variational Bayes} \label{variationalbayes} Variational Bayes (VB) is a family of numerical approximation algorithms that is a subset of variational inference algorithms, or variational methods. Some examples of variational methods include the mean-field approximation, loopy belief propagation, tree-reweighted belief propagation, and expectation propagation (EP). Variational inference for probabilistic models was introduced in the field of machine learning, influenced by statistical physics literature. A VB algorithm deterministically estimates the marginal posterior distributions (target distributions) in a Bayesian model with approximated distributions by minimizing the Kullback-Leibler Divergence (\code{KLD}) between the target and its approximation. The complicated posterior distribution is approximated with a simpler distribution. The simpler, approximated distribution is called the variational approximation, or approximation distribution, of the posterior. The term variational is derived from the calculus of variations, and regards optimization algorithms that select the best function (which is a distribution in VB), rather than merely selecting the best parameters. VB algorithms often use Gaussian distributions as approximating distributions. In this case, both the mean and variance of the parameters are estimated. Usually, a VB algorithm is slower to convergence than a Laplace Approximation algorithm, and faster to convergence than a Monte Carlo algorithm such as Markov chain Monte Carlo (MCMC). VB often provides solutions with comparable accuracy to MCMC in less time. Though Monte Carlo algorithms provide a numerical approximation to the exact posterior using a set of samples, VB provides a locally-optimal, exact analytical solution to an approximation of the posterior. VB is often more applicable than MCMC to big data or large-dimensional models. Since VB is deterministic, it is asymptotic and subject to the same limitations with respect to sample size as Laplace Approximation. However, VB estimates more parameters than Laplace Approximation, such as when Laplace Approximation optimizes the posterior mode of a Gaussian distribution, while VB optimizes both the Gaussian mean and variance. Traditionally, VB algorithms required customized equations. The \code{VariationalBayes} function uses general-purpose algorithms. A general-purpose VB algorithm is less efficient than an algorithm custom designed for the model form. However, a general-purpose algorithm is applied consistently and easily to numerous model forms. \subsubsection{Salimans2} The \code{Salimans2} algorithm is the second algorithm of \citet{salimans13} is used. This requires the gradient and Hessian, which is more efficient with a small number of parameters as long as the posterior is twice differentiable. The step size is constant. This algorithm is suitable for marginal posterior distributions that are Gaussian and unimodal. A stochastic approximation algorithm is used in the context of fixed-form VB, inspired by considering fixed-form VB to be equivalent to performing a linear regression with the sufficient statistics of the approximation as independent variables and the unnormalized logarithm of the joint posterior density as the dependent variable. The number of requested iterations should be large, since the step-size decreases for larger requested iterations, and a small step-size will eventually converge. A large number of requested iterations results in a smaller step-size and better convergence properties, so hope for early convergence. However convergence is checked only in the last half of the iterations after the algorithm begins to average the mean and variance from the samples of the stochastic approximation. The history of stochastic samples is returned. \section{Bayesian-Inference.com} \label{bayesianinferencecom} Many additional resources may be found at \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index}, as well as other places online: \begin{itemize} %\item A Bayesian forum is available at \url{http://www.bayesian-inference.com/forum} to discuss all things Bayesian, including \pkg{LaplacesDemon}. \item Bayesian information is being compiled under \url{https://web.archive.org/web/20150206004608/http://www.bayesian-inference.com/bayesian}. %\item Bayesian news is aggregated daily as ``The Bayesian Bulletin'': \url{http://www.bayesian-inference.com/newsbayesian}. %\item Consulting services are available here: \url{http://www.bayesian-inference.com/consulting}. \item C++ examples of model functions: \url{https://web.archive.org/web/20140513065103/http://www.bayesian-inference.com/cpp/LaplacesDemonExamples.txt}. \item MCMC algorithms are described at \url{https://web.archive.org/web/20150430054005/http://www.bayesian-inference.com/mcmc}. \item Merchandise may be found at \url{http://www.zazzle.com/statisticat}, such as \pkg{LaplacesDemon} t-shirts, coffee mugs, and more. \item \pkg{LaplacesDemon} and \pkg{LaplacesDemonCpp} development is public and occurs at \url{https://github.com/LaplacesDemonR/LaplacesDemon} and \url{https://github.com/LaplacesDemonR/LaplacesDemonCpp}, respectively. %\item \pkg{LaplacesDemon} screencasts are available at \url{http://www.bayesian-inference.com/softwarescreencasts}. %\item \pkg{LaplacesDemon} updates are announced at \url{https://plus.google.com/+Bayesian-inference}. %\item Opinion polls for Bayesian inference and \pkg{LaplacesDemon} are here: \url{http://www.bayesian-inference.com/polls}. %\item Technical support services are available at \url{http://www.bayesian-inference.com/support}. \item And, the home of \pkg{LaplacesDemon} is \url{https://web.archive.org/web/20150430054143/http://www.bayesian-inference.com/software}. \end{itemize} \section{Conclusion} \label{conclusion} The \pkg{LaplacesDemon} package is a significant contribution toward Bayesian inference in \proglang{R}. In turn, contributions toward the development of \pkg{LaplacesDemon} are welcome. Please visit \url{https://github.com/LaplacesDemonR} to contribute to development or report software bugs by opening an issue. \bibliography{References} \end{document} LaplacesDemon/vignettes/Examples.Stex0000755000176200001440000142647615144316355017452 0ustar liggesusers\documentclass[nojss]{jss} %% need no \usepackage{Sweave.sty} \usepackage{amsmath} %\VignetteIndexEntry{LaplacesDemon Examples} %\VignettePackage{LaplacesDemon} %\VignetteDepends{LaplacesDemon} \author{Statisticat, LLC} \title{\includegraphics[height=1in,keepaspectratio]{LDlogo} \\ \pkg{LaplacesDemon} Examples} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Statisticat LLC} %% comma-separated \Plaintitle{LaplacesDemon Examples} %% without formatting \Shorttitle{Examples} %% a short title (if necessary) \Abstract{The \pkg{LaplacesDemon} package is a complete environment for Bayesian inference within \proglang{R}. Virtually any probability model may be specified. This vignette is a compendium of examples of how to specify different model forms. } \Keywords{Bayesian, LaplacesDemon, LaplacesDemonCpp, R} \Plainkeywords{bayesian, laplacesdemon, laplacesdemoncpp, r} %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2011} %% \Submitdate{2011-01-18} %% \Acceptdate{2011-01-18} \Address{ Statisticat, LLC\\ Farmington, CT\\ E-mail: defunct\\ URL: \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index} } %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} \begin{document} \pkg{LaplacesDemon} \citep{r:laplacesdemon}, often referred to as LD, is an \proglang{R} package that is available at \url{https://web.archive.org/web/20150430054143/http://www.bayesian-inference.com/software}. \pkg{LaplacesDemonCpp} is an extension package that uses \proglang{C++}. A formal introduction to \pkg{LaplacesDemon} is provided in an accompanying vignette entitled ``\pkg{LaplacesDemon} Tutorial'', and an introduction to Bayesian inference is provided in the ``Bayesian Inference'' vignette. The purpose of this document is to provide users of the \pkg{LaplacesDemon} package with examples of a variety of Bayesian methods. It is also a testament to the diverse applicability of \pkg{LaplacesDemon} to Bayesian inference. To conserve space, the examples are not worked out in detail, and only the minimum of necessary materials is provided for using the various methodologies. Necessary materials include the form expressed in notation, data (which is often simulated), the \code{Model} function, and initial values. The provided data, model specification, and initial values may be copy/pasted into an \proglang{R} file and updated with the \code{LaplacesDemon} or (usually) \code{LaplaceApproximation} functions. Although many of these examples update quickly, some examples are computationally intensive. All examples are provided in R code, but the model specification function can be in another language. A goal is to provide these example model functions in C++ as well, and some are now available at \url{https://web.archive.org/web/20140513065103/http://www.bayesian-inference.com/cpp/LaplacesDemonExamples.txt}. Initial values are usually hard-coded in the examples, though the Parameter-Generating Function (PGF) is also specified. It is recommended to generate initial values with the \code{GIV} function according to the user-specified \code{PGF}. Notation in this vignette follows these standards: Greek letters represent parameters, lower case letters represent indices, lower case bold face letters represent scalars or vectors, probability distributions are represented with calligraphic font, upper case letters represent index limits, and upper case bold face letters represent matrices. More information on notation is available at \url{https://web.archive.org/web/20150501205317/http://www.bayesian-inference.com/notation}. This vignette may grow over time as examples of more methods become included. Contributed examples are welcome via \url{https://github.com/LaplacesDemonR/LaplacesDemon/issues}. All accepted contributions are, of course, credited. \begin{center} \Large{\textbf{Contents}} \end{center} \begin{itemize} \item Adaptive Logistic Basis (ALB) Regression \ref{alb} \item ANCOVA \ref{ancova} \item ANOVA, One-Way \ref{anova.one.way} \item ANOVA, Two-Way \ref{anova.two.way} \item Approximate Bayesian Computation (ABC) \ref{abc} \item AR(p) \ref{arp} \item AR(p)-ARCH(q) \ref{arparchq} \item AR(p)-ARCH(q)-M \ref{arparchqm} \item AR(p)-GARCH(1,1) \ref{arpgarch} \item AR(p)-GARCH(1,1)-M \ref{arpgarchm} \item AR(p)-TARCH(q) \ref{arptarchq} \item AR(p)-TARCH(q)-M \ref{arptarchqm} \item Autoregressive Moving Average, ARMA(p,q) \ref{armapq} \item Beta Regression \ref{beta.reg} \item Beta-Binomial \ref{beta.binomial} \item Binary Logit \ref{binary.logit} \item Binary Log-Log Link Mixture \ref{binary.loglog.mixture} \item Binary Probit \ref{binary.probit} \item Binary Robit \ref{binary.robit} \item Binomial Logit \ref{binomial.logit} \item Binomial Probit \ref{binomial.probit} \item Binomial Robit \ref{binomial.robit} \item Change Point Regression \ref{changepoint} \item Cluster Analysis, Confirmatory (CCA) \ref{cca} \item Cluster Analysis, Exploratoryy (ECA) \ref{eca} \item Collaborative Filtering (CF) \ref{eofa} \item Conditional Autoregression (CAR), Poisson \ref{car.poisson} \item Conditional Predictive Ordinate (CPO) \ref{cpo} \item Contingency Table \ref{contingency.table} \item Dirichlet Process \ref{eca} \ref{imm} \item Discrete Choice, Conditional Logit \ref{conditional.logit} \item Discrete Choice, Mixed Logit \ref{dc.mixed.logit} \item Discrete Choice, Multinomial Probit \ref{dc.mnp} \item Distributed Lag, Koyck \ref{dl.koyck} \item Dynamic Linear Model (DLM) \ref{dfa} \ref{ssm.lin.reg} \ref{ssm.ll} \ref{ssm.llt} \item Dynamic Sparse Factor Model (DSFM) \ref{dsfm} \item Exponential Smoothing \ref{exp.smo} \item Factor Analysis, Approximate Dynamic (ADFA) \ref{adfa} \item Factor Analysis, Confirmatory (CFA) \ref{cfa} \item Factor Analysis, Dynamic (DFA) \ref{dsfm} \item Factor Analysis, Exploratory (EFA) \ref{efa} \item Factor Analysis, Exploratory Ordinal (EOFA) \ref{eofa} \item Factor Regression \ref{factor.reg} \item Gamma Regression \ref{gamma.reg} \item Gaussian Process Regression \ref{kriging} \item Geographically Weighted Regression \ref{gwr} \item Hidden Markov Model \ref{hmm} \item Hierarchical Bayes \ref{linear.reg.hb} \item Horseshoe Regression \ref{horseshoe} \item Inverse Gaussian Regression \ref{ig.reg} \item Kriging \ref{kriging} \item Kriging, Predictive Process \ref{kriging.pp} \item Laplace Regression \ref{laplace.reg} \item LASSO \ref{bal} \ref{lasso} \item Latent Dirichlet Allocation (LDA) \ref{lda} \item Linear Regression \ref{linear.reg} \item Linear Regression, Frequentist \ref{linear.reg.freq} \item Linear Regression, Hierarchical Bayesian \ref{linear.reg.hb} \item Linear Regression, Multilevel \ref{linear.reg.ml} \item Linear Regression with Full Missingness \ref{linear.reg.full.miss} \item Linear Regression with Missing Response \ref{linear.reg.miss.resp} \item Linear Regression with Missing Response via ABB \ref{linear.reg.miss.resp.abb} \item Linear Regression with Power Priors \ref{linear.reg.pp} \item Linear Regression with Zellner's g-Prior \ref{linear.reg.g} \item LSTAR \ref{lstar} \item MANCOVA \ref{mancova} \item MANOVA \ref{manova} \item Missing Values \ref{linear.reg.full.miss} \ref{linear.reg.miss.resp} \ref{linear.reg.miss.resp.abb} \item Mixed Logit \ref{mixed.logit} \item Mixture Model, Finite \ref{cca} \ref{fmm} \item Mixture Model, Infinite \ref{eca} \ref{imm} \item Mixture Model, Poisson-Gamma \ref{poisson.gamma} \item Model Averaging \ref{ssvs} \ref{rj} \item Multilevel Model \ref{linear.reg.ml} \item Multinomial Logit \ref{mnl} \item Multinomial Logit, Nested \ref{nmnl} \item Multinomial Probit \ref{mnp} \item Multiple Discrete-Continuous Choice \ref{mdcc} \item Multivariate Binary Probit \ref{multiv.bin.probit} \item Multivariate Laplace Regression \ref{multivariate.lap.reg} \item Multivariate Poisson Regression \ref{multivariate.pois.reg} \item Multivariate Regression \ref{multivariate.reg} \item Negative Binomial Regression \ref{negbin.reg} \item Normal, Multilevel \ref{norm.ml} \item Ordinal Logit \ref{ordinal.logit} \item Ordinal Probit \ref{ordinal.probit} \item Panel, Autoregressive Poisson \ref{panel.ap} \item Penalized Spline Regression \ref{pspline} \item Poisson Regression \ref{poisson.reg} \item Poisson Regression, Overdispersed \ref{poisson.gamma} \ref{negbin.reg} \item Poisson-Gamma Regression \ref{poisson.gamma} \item Polynomial Regression \ref{polynomial.reg} \item Power Priors \ref{linear.reg.pp} \item Proportional Hazards Regression, Weibull \ref{prop.haz.weib} \item PVAR(p) \ref{pvarp} \item Quantile Regression \ref{quantile.reg} \item Revision, Normal \ref{revision.normal} \item Ridge Regression \ref{ridge.reg} \item Robust Regression \ref{robust.reg} \item Seemingly Unrelated Regression (SUR) \ref{sur} \item Simultaneous Equations \ref{simultaneous} \item Space-Time, Dynamic \ref{spacetime.dynamic} \item Space-Time, Nonseparable \ref{spacetime.nonsep} \item Space-Time, Separable \ref{spacetime.sep} \item Spatial Autoregression (SAR) \ref{sar} \item STARMA(p,q) \ref{starma} \item State Space Model (SSM), Dynamic Sparse Factor Model (DSFM) \ref{dsfm} \item State Space Model (SSM), Linear Regression \ref{ssm.lin.reg} \item State Space Model (SSM), Local Level \ref{ssm.ll} \item State Space Model (SSM), Local Linear Trend \ref{ssm.llt} \item State Space Model (SSM), Stochastic Volatility (SV) \ref{sv} \item Stochastic Volatility (SV) \ref{sv} \item Survival Model \ref{prop.haz.weib} \item T-test \ref{anova.one.way} \item Threshold Autoregression (TAR) \ref{tar} \item Topic Model \ref{lda} \item Time Varying AR(1) with Chebyshev Series \ref{tvarcs} \item Variable Selection, BAL \ref{bal} \item Variable Selection, Horseshoe \ref{horseshoe} \item Variable Selection, LASSO \ref{lasso} \item Variable Selection, RJ \ref{rj} \item Variable Selection, SSVS \ref{ssvs} \item VARMA(p,q) - SSVS \ref{varmapqssvs} \item VAR(p)-GARCH(1,1)-M \ref{varpgarchm} \item VAR(p) with Minnesota Prior \ref{varp} \item VAR(p) with SSVS \ref{varpssvs} \item Variety Model \ref{mdcc} \item Weighted Regression \ref{weighted.reg} \item Zellner's g-Prior \ref{linear.reg.g} \item Zero-Inflated Poisson (ZIP) \ref{zip} \end{itemize} \section{Adaptive Logistic Basis (ALB) Regression} \label{alb} Adaptive Logistic Basis (ALB) regression is an essentially automatic non-parametric approach to estimating the nonlinear relationship between each of multiple independent variables (IVs) and the dependent variable (DV). It is automatic because when using the suggested $K = 2J + 1$ components (see below) given $J$ IVs, the data determines the nonlinear relationships, whereas in other methods, such as with splines, the user must specify the number of knots and possibly consider placement of the knots. Knots do not exist in ALB. Both the DV and IVs should be centered and scaled. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{S}\delta$$ $$\textbf{S}_{i,m} = \frac{\phi_{i,m}}{\sum^M_{m=1} \phi_{i,m}}$$ $$\phi_{i,m} = \exp(\alpha_m + \textbf{X}_{i,1:J}\beta_{1:J,m}), \quad i=1,\dots,N, \quad m=1,\dots,M$$ $$\alpha_m \sim \mathcal{N}(0, 10), \quad m=1,\dots,(M-1)$$ $$\alpha_M = 0$$ $$\beta_{j,m} \sim \mathcal{N}(0, 100), \quad j=1,\dots,J, \quad m=1,\dots,(M-1)$$ $$\beta_{j,M} = 0$$ $$\delta_m \sim \mathcal{N}(\zeta, \tau^2), \quad m=1,\dots,M$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\zeta \sim \mathcal{N}(0, 10)$$ $$\tau \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- as.matrix(log(demonsnacks[,c(1,4,10)]+1)) \\ J <- ncol(X) \\ y <- CenterScale(y) \\ for (j in 1:J) X[,j] <- CenterScale(X[,j]) \\ K <- 2*J+1 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,K-1), beta=matrix(0,J,K-1), \\ \hspace*{0.27 in} delta=rep(0,K), zeta=0, sigma=0, tau=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$K-1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J*(Data$K-1)) \\ \hspace*{0.27 in} delta <- rnorm(Data$K) \\ \hspace*{0.27 in} zeta <- rnorm(1) \\ \hspace*{0.27 in} sigma <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} tau <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} return(c(alpha, beta, delta, zeta, sigma, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.delta=pos.delta, pos.zeta=pos.zeta, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.tau=pos.tau) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J, Data$K-1) \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} zeta.prior <- dnormv(zeta, 0, 10, log=TRUE) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnorm(delta, zeta, tau, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} phi <- cbind(exp(matrix(alpha, Data$N, Data$K-1, byrow=TRUE) + \\ \hspace*{0.62 in} tcrossprod(Data$X, t(beta))),1) \\ \hspace*{0.27 in} mu <- tcrossprod(phi / rowSums(phi), t(delta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + delta.prior + zeta.prior \\ \hspace*{0.62 in} sigma.prior + tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), rep(0,J*(K-1)), rep(0,K-1), 0, 1, 1)} \section{ANCOVA} \label{ancova} This example is essentially the same as the two-way ANOVA (see section \ref{anova.two.way}), except that a covariate $\textbf{X}_{,3}$ has been added, and its parameter is $\delta$. \subsection{Form} $$\textbf{y}_i \sim \mathcal{N}(\mu_i, \sigma^2_1)$$ $$\mu_i = \alpha + \beta[\textbf{X}_{i,1}] + \gamma[\textbf{X}_{i,2}] + \delta \textbf{X}_{i,2}, \quad i=1,\dots,N$$ $$\epsilon_i = \textbf{y}_i - \mu_i$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=1,\dots,J$$ $$\beta_J = - \sum^{J-1}_{j=1} \beta_j$$ $$\gamma_k \sim \mathcal{N}(0, \sigma^2_3), \quad k=1,\dots,K$$ $$\gamma_K = - \sum^{K-1}_{k=1} \gamma_k$$ $$\delta \sim \mathcal{N}(0, 1000)$$ $$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,3$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \#Number of levels in factor (treatment) 1 \\ K <- 3 \#Number of levels in factor (treatment) 2 \\ X <- cbind(rcat(N,rep(1/J,J)), rcat(N,rep(1/K,K)), runif(N,-2,2)) \\ alpha <- runif(1,-1,1) \\ beta <- runif(J-1,-2,2) \\ beta <- c(beta, -sum(beta)) \\ gamma <- runif(K-1,-2,2) \\ gamma <- c(gamma, -sum(gamma)) \\ delta <- runif(1,-2,2) \\ y <- alpha + beta[X[,1]] + gamma[X[,2]] + delta*X[,3] + rnorm(N,0,0.1) \\ mon.names <- c("LP", paste("beta[",J,"]",sep=""), \\ \hspace*{0.27 in} paste("gamma[",K,"]",sep=""),"s.beta","s.gamma","s.epsilon") \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), gamma=rep(0,K-1), \\ \hspace*{0.27 in} delta=0, sigma=rep(0,3))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J-1) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K-1) \\ \hspace*{0.27 in} delta <- rnorm(1) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, delta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.gamma=pos.gamma, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} beta <- c(beta, -sum(beta)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} gamma <- c(gamma, -sum(gamma)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[3], log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- dnormv(delta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- alpha + beta[Data$X[,1]] + gamma[Data$X[,2]] + \\ \hspace*{0.62 in} delta*Data$X[,3] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Variance Components \\ \hspace*{0.27 in} s.beta <- sd(beta) \\ \hspace*{0.27 in} s.gamma <- sd(gamma) \\ \hspace*{0.27 in} s.epsilon <- sd(Data$y - mu) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + delta.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, beta[Data$J], \\ \hspace*{0.62 in} gamma[Data$K], s.beta, s.gamma, s.epsilon), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,(J-1)), rep(0,(K-1)), 0, rep(1,3))} \section{ANOVA, One-Way} \label{anova.one.way} When $J=2$, this is a Bayesian form of a t-test. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$\mu_i = \alpha + \beta[\textbf{x}_i], \quad i=1,\dots,N$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=1,\dots,J$$ $$\beta_J = - \displaystyle\sum^{J-1}_{j=1} \beta_j$$ $$\sigma_{1:2} \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 1000 \\ J <- 3 \\ x <- rcat(N, rep(1/J, J)) \\ alpha <- runif(1,-1,1) \\ beta <- runif(J-1,-2,2) \\ beta <- c(beta, -sum(beta)) \\ y <- alpha + beta[x] + rnorm(N,0,0.2) \\ mon.names <- c("LP",paste("beta[",J,"]",sep="")) \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), sigma=rep(0,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J-1) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, x=x, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} beta <- c(beta, -sum(beta)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- alpha + beta[Data$x] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,beta[Data$J]), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,(J-1)), rep(1,2))} \section{ANOVA, Two-Way} \label{anova.two.way} In this representation, $\sigma^m$ are the superpopulation variance components, \code{s.beta} and \code{s.gamma} are the finite-population within-variance components of the factors or treatments, and \code{s.epsilon} is the finite-population between-variance component. \subsection{Form} $$\textbf{y}_i \sim \mathcal{N}(\mu_i, \sigma^2_1)$$ $$\mu_i = \alpha + \beta[\textbf{X}_{i,1}] + \gamma[\textbf{X}_{i,2}], \quad i=1,\dots,N$$ $$\epsilon_i = \textbf{y}_i - \mu_i$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=1,\dots,J$$ $$\beta_J = - \sum^{J-1}_{j=1} \beta_j$$ $$\gamma_k \sim \mathcal{N}(0, \sigma^2_3), \quad k=1,\dots,K$$ $$\gamma_K = - \sum^{K-1}_{k=1} \gamma_k$$ $$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,3$$ \subsection{Data} \code{N <- 1000 \\ J <- 5 \#Number of levels in factor (treatment) 1 \\ K <- 3 \#Number of levels in factor (treatment) 2 \\ X <- cbind(rcat(N,rep(1/J,J)), rcat(N,rep(1/K,K))) \\ alpha <- runif(1,-1,1) \\ beta <- runif(J-1,-2,2) \\ beta <- -sum(beta) \\ gamma <- runif(K-1,-2,2) \\ gamma <- -sum(gamma) \\ y <- alpha + beta[X[,1]] + gamma[X[,2]] + rnorm(N,0,0.1) \\ mon.names <- c("LP", paste("beta[",J,"]",sep=""), \\ \hspace*{0.27 in} paste("gamma[",K,"]",sep=""), "s.beta", "s.gamma", "s.epsilon") \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), gamma=rep(0,K-1), \\ \hspace*{0.27 in} sigma=rep(0,3))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J-1) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K-1) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} beta <- c(beta, -sum(beta)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} gamma <- c(gamma, -sum(gamma)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[3], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- alpha + beta[Data$X[,1]] + gamma[Data$X[,2]] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Variance Components \\ \hspace*{0.27 in} s.beta <- sd(beta) \\ \hspace*{0.27 in} s.gamma <- sd(gamma) \\ \hspace*{0.27 in} s.epsilon <- sd(Data$y - mu) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, beta[Data$J], \\ \hspace*{0.62 in} gamma[Data$K], s.beta, s.gamma, s.epsilon), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,(J-1)), rep(0,(K-1)), rep(1,3))} \section{Approximate Bayesian Computation (ABC)} \label{abc} Approximate Bayesian Computation (ABC), also called likelihood-free estimation, is not a statistical method, but a family of numerical approximation techniques in Bayesian inference. ABC is especially useful when evaluation of the likelihood, $p(\textbf{y} | \Theta)$ is computationally prohibitive, or when suitable likelihoods are unavailable. The current example is the application of ABC in the context of linear regression. The log-likelihood is replaced with the negative sum of the distance between $\textbf{y}$ and $\textbf{y}^{rep}$ as the approximation of the log-likelihood. Distance reduces to the absolute difference. Although linear regression has an easily calculated likelihood, it is used as an example due to its generality. This example demonstrates how ABC may be estimated either with MCMC via the \code{LaplacesDemon} function or with Laplace Approximation via the \code{LaplaceApproximation} function. In this method, a tolerance (which is found often in ABC) does not need to be specified, and the logarithm of the unnormalized joint posterior density is maximized, as usual. The negative and summed distance, above, may be replaced with the negative and summed distance between summaries of the data, rather than the data itself, but this has not been desirable in testing. \subsection{Form} $$\textbf{y} = \mu + \epsilon$$ $$\mu = \textbf{X} \beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP","sigma") \\ parm.names <- as.parm.names(list(beta=rep(0,J))) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood Approximation \\ \hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma <- sd(epsilon) \\ \hspace*{0.27 in} LL <- -sum(abs(epsilon)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior Approximation \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,sigma), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J))} \section{AR(p)} \label{arp} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p}, \quad t=1,\dots,T$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} sigma <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} return(c(alpha, phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L=L, PGF=PGF, P=P, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L[p])] <- mu[-c(1:Data$L[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L[p])] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-c(1:Data$L[Data$P])], mu[-c(1:Data$L[Data$P])], \\ \hspace*{0.62 in} sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,P+1), 1)} \section{AR(p)-ARCH(q)} \label{arparchq} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p}, \quad t=1,\dots,T$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_q \epsilon^2_{t-q}, \quad t=2,\dots,T$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_q \sim \mathcal{U}(0, 1), \quad q=1,\dots,Q$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Volatility lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Volatility order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), omega=0, \\ \hspace*{0.27 in} theta=rep(0,Q))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(Data$Q, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} theta[q]*epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + omega.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,P+1), 1, rep(0.5,Q))} \section{AR(p)-ARCH(q)-M} \label{arparchqm} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p} + \delta \sigma^2_{t-1}, \quad t=1,\dots,T$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\delta \sim \mathcal{N}(0, 1000)$$ $$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_q \epsilon^2_{t-q}, \quad t=2,\dots,T$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_q \sim \mathcal{U}(0, 1), \quad q=1,\dots,Q$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Volatility lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Volatility order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), delta=0, omega=0, \\ \hspace*{0.27 in} theta=rep(0,Q))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} delta <- rnorm(1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(Data$Q, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, phi, delta, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.delta=pos.delta, pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- dnormv(delta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} theta[q]*epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\ \hspace*{0.27 in} mu <- mu + delta*sigma2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + delta.prior + omega.prior + \\ \hspace*{0.62 in} theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.62 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,P+2), 1, rep(0.5,Q))} \section{AR(p)-GARCH(1,1)} \label{arpgarch} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p}, \quad t=1,\dots,T$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma^2_t = \theta_1 + \theta_2 \epsilon^2_{t-1} + \theta_3 \sigma^2_{t-1}$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_k = \frac{1}{1 + \exp(-\theta_k)}, \quad k=1,\dots,3$$ $$\theta_k \sim \mathcal{N}(0, 1000) \in [-10,10], \quad k=1,\dots,3$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), omega=0, \\ \hspace*{0.27 in} theta=rep(0,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(2, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L=L, P=P, PGF=PGF, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\ \hspace*{0.27 in} if(sum(theta) >= 1) theta[2] <- 1 - 1e-5 - theta[1] \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L[p])] <- mu[-c(1:Data$L[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma2 <- c(omega, omega + theta[1]*epsilon[-Data$T]\textasciicircum 2) \\ \hspace*{0.27 in} sigma2[-1] <- sigma2[-1] + theta[2]*sigma2[-Data$T] \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L[Data$P])], sigma2[-c(1:Data$L[Data$P])], \\ \hspace*{0.95 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + omega.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm)\\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,P), rep(0.4,3))} \section{AR(p)-GARCH(1,1)-M} \label{arpgarchm} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p} + \delta \sigma^2_{t-1}, \quad t=1,\dots,(T+1)$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma^2_t = \omega + \theta_1 \epsilon^2_{t-1} + \theta_2 \sigma^2_{t-1}$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_k \sim \mathcal{U}(0, 1), \quad k=1,\dots,2$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, delta=0, phi=rep(0,P), omega=0, \\ \hspace*{0.27 in} theta=rep(0,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} delta <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(2, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, delta, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L=L, P=P, PGF=PGF, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\ \hspace*{0.27 in} if(sum(theta) >= 1) theta[2] <- 1 - 1e-5 - theta[1] \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} delta.prior <- dnormv(delta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L[p])] <- mu[-c(1:Data$L[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma2 <- c(omega, omega + theta[1]*epsilon[-Data$T]\textasciicircum 2) \\ \hspace*{0.27 in} sigma2[-1] <- sigma2[-1] + theta[2]*sigma2[-Data$T] \\ \hspace*{0.27 in} mu <- mu + delta*sigma2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L[Data$P])], sigma2[-c(1:Data$L[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + delta.prior + phi.prior + omega.prior + \\ \hspace*{0.62 in} theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,2), rep(0,P), rep(0.4,3))} \section{AR(p)-TARCH(q)} \label{arptarchq} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=2,\dots,T$$ $$\mu_t = \alpha + \phi^P_{p=1} \textbf{y}_{t-p}, \quad t=(p+1),\dots,T$$ $$\epsilon = \textbf{y} - \mu$$ $$\delta = (\epsilon > 0) \times 1$$ $$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_{q,1} \delta_{t-1} \epsilon^2_{t-1} + \theta_{q,2} (1-\delta_{t-1}) \epsilon^2_{t-1}$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_{q,j} \sim \mathcal{U}(0, 1), \quad q=1\dots,Q, \quad j=1,\dots,2$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Volatility lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Volatility order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), omega=0, \\ \hspace*{0.27 in} theta=matrix(0,Q,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(Data$Q*2, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- matrix(interval(parm[Data$pos.theta], 1e-10, 1-1e-5), Data$Q, \\ \hspace*{0.62 in} 2) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- as.vector(theta) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} delta <- (epsilon > 0) * 1 \\ \hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} delta[1:(Data$T-Data$L.Q[q])] * theta[q,1] * \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 + \\ \hspace*{0.95 in} (1 - delta[1:(Data$T-Data$L.Q[q])]) * theta[q,2] * \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + omega.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,P), 1, rep(0.5,Q*2))} \section{AR(p)-TARCH(q)-M} \label{arptarchqm} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=2,\dots,T$$ $$\mu_t = \alpha + \phi^P_{p=1} \textbf{y}_{t-p} + \delta_{t-1} \gamma_1 \sigma^2_{t-1} + (1 - \delta_{t-1}) \gamma_2 \sigma^2_{t-1}, \quad t=(p+1),\dots,T$$ $$\epsilon = \textbf{y} - \mu$$ $$\delta = (\epsilon > 0) \times 1$$ $$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_{q,1} \delta_{t-1} \epsilon^2_{t-1} + \theta_{q,2} (1-\delta_{t-1}) \epsilon^2_{t-1}$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\gamma_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,2$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_{q,j} \sim \mathcal{U}(0, 1), \quad q=1\dots,Q, \quad j=1,\dots,2$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Volatility lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Volatility order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, gamma=rep(0,2), phi=rep(0,P), \\ \hspace*{0.27 in} omega=0, theta=matrix(0,Q,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} gamma <- rnorm(2) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(Data$Q*2, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, gamma, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- matrix(interval(parm[Data$pos.theta], 1e-10, 1-1e-5), Data$Q, \\ \hspace*{0.62 in} 2) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- as.vector(theta) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} delta <- (epsilon > 0) * 1 \\ \hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} delta[1:(Data$T-Data$L.Q[q])] * theta[q,1] * \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 + \\ \hspace*{0.95 in} (1 - delta[1:(Data$T-Data$L.Q[q])]) * theta[q,2] * \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\ \hspace*{0.27 in} mu <- mu + delta*gamma[1]*sigma2 + (1 - delta)*gamma[2]*sigma2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + gamma.prior + phi.prior + omega.prior + \\ \hspace*{0.62 in} theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,3), rep(0,P), 1, rep(0.5,Q*2))} \section{Autoregressive Moving Average, ARMA(p,q)} \label{armapq} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p} + \sum^Q_{q=1} \theta_q \epsilon_{t-q}$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\theta_q \sim \mathcal{N}(0, 1000), \quad q=1,\dots,Q$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Moving average lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Moving average order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), sigma=0, \\ \hspace*{0.27 in} theta=rep(0,Q))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} sigma <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- rnorm(Data$Q) \\ \hspace*{0.27 in} return(c(alpha, phi, sigma, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dnormv(theta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} mu[-c(1:Data$L.Q[q])] <- mu[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} theta[q]*epsilon[1:(Data$T-Data$L.Q[q])] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + sigma.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,P), 1, rep(0,Q))} \section{Beta Regression} \label{beta.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{BETA}(a,b)$$ $$a = \mu \phi$$ $$b = (1 - \mu) \phi$$ $$\mu = \Phi(\beta_1 + \beta_2 \textbf{x}), \quad \mu \in (0, 1)$$ $$\beta_j \sim \mathcal{N}(0, 10), \quad j=1,\dots,J$$ $$\phi \sim \mathcal{HC}(25)$$ where $\Phi$ is the normal CDF. \subsection{Data} \code{N <- 100 \\ x <- runif(N) \\ y <- rbeta(N, (0.5-0.2*x)*3, (1-(0.5-0.2*x))*3) mon.names <- "LP" \\ parm.names <- c("beta[1]","beta[2]","phi") \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ PGF <- function(Data) return(c(rnormv(2,0,10), rhalfcauchy(1,5))) \\ MyData <- list(PGF=PGF, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.phi=pos.phi, x=x, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dhalfcauchy(phi, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- interval(pnorm(beta[1] + beta[2]*Data$x), 0.001, 0.999, \\ \hspace*{0.62 in} reflect=FALSE) \\ \hspace*{0.27 in} a <- mu * phi \\ \hspace*{0.27 in} b <- (1 - mu) * phi \\ \hspace*{0.27 in} LL <- sum(dbeta(Data$y, a, b, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + phi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbeta(length(mu), a, b), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,2), 0.01)} \section{Beta-Binomial} \label{beta.binomial} \subsection{Form} $$\textbf{y}_i \sim \mathcal{BIN}(\textbf{n}_i, \pi_i), \quad i=1,\dots,N$$ $$\pi_i \sim \mathcal{BETA}(\alpha, \beta) \in [0.001,0.999]$$ \subsection{Data} \code{N <- 20 \\ n <- round(runif(N, 50, 100)) \\ y <- round(runif(N, 1, 10)) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(pi=rep(0,N))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} pi <- rbeta(Data$N,1,1) \\ \hspace*{0.27 in} return(pi) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, mon.names=mon.names, n=n, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[1:Data$N] <- pi <- interval(parm[1:Data$N], 0.001, 0.999) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} pi.prior <- sum(dbeta(pi, 1, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, pi, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + pi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbinom(Data$N, Data$n, pi), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0.5,N))} \section{Binary Logit} \label{binary.logit} \subsection{Form} $$\textbf{y} \sim \mathcal{BERN}(\eta)$$ $$\eta = \frac{1}{1 + \exp(-\mu)}$$ $$\mu = \textbf{X} \beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{data(demonsnacks) \\ J <- 3 \\ y <- ifelse(demonsnacks$Calories <= 137, 0, 1) \\ X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} eta <- invlogit(mu) \\ \hspace*{0.27 in} LL <- sum(dbern(Data$y, eta, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbern(length(eta), eta), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Binary Log-Log Link Mixture} \label{binary.loglog.mixture} A weighted mixture of the log-log and complementary log-log link functions is used, where $\alpha$ is the weight. Since the log-log and complementary log-log link functions are asymmetric (as opposed to the symmetric logit and probit link functions), it may be unknown \textit{a priori} whether the log-log or complementary log-log will perform better. \subsection{Form} $$\textbf{y} \sim \mathcal{BERN}(\eta)$$ $$\eta = \alpha \exp(-\exp(\mu)) + (1 - \alpha) (1 - \exp(-\exp(\mu)))$$ $$\mu = \textbf{X} \beta$$ $$\alpha \sim \mathcal{U}(0, 1)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{N <- 100 \\ J <- 3 \\ X <- cbind(1, matrix(rnorm(N*(J-1),N,J-1))) \\ alpha <- runif(1) \\ beta <- rnorm(J) \\ mu <- tcrossprod(X, t(beta)) \\ eta <- alpha*invloglog(mu) + (1-alpha)*invcloglog(mu) \\ y <- rbern(N, eta) \\ mon.names <- c("LP","alpha") \\ parm.names <- as.parm.names(list(beta=rep(0,J), logit.alpha=0)) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} logit.alpha <- rnorm(1) \\ \hspace*{0.27 in} return(c(beta, logit.alpha)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$J+1] <- alpha <- interval(parm[Data$J+1], -700, 700) \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dunif(alpha, 0, 1, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} eta <- alpha*invloglog(mu) + (1-alpha)*invcloglog(mu) \\ \hspace*{0.27 in} LL <- sum(dbern(Data$y, eta, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,alpha), \\ \hspace*{0.62 in} yhat=rbern(length(eta), eta), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 0)} \section{Binary Probit} \label{binary.probit} \subsection{Form} $$\textbf{y} \sim \mathcal{BERN}(\textbf{p})$$ $$\textbf{p} = \phi(\mu)$$ $$\mu = \textbf{X} \beta \in [-10,10]$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ where $\phi$ is the CDF of the standard normal distribution, and $J$=3. \subsection{Data} \code{data(demonsnacks) \\ J <- 3 \\ y <- ifelse(demonsnacks$Calories <= 137, 0, 1) \\ X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\ \hspace*{0.27 in} p <- pnorm(mu) \\ \hspace*{0.27 in} LL <- sum(dbern(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbern(length(p), p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Binary Robit} \label{binary.robit} \subsection{Form} $$\textbf{y} \sim \mathcal{BERN}(\textbf{p})$$ $$\textbf{p} = \textbf{T}_\nu(\mu)$$ $$\mu = \textbf{X} \beta \in [-10,10]$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\nu \sim \mathcal{U}(5, 10)$$ where $\textbf{T}_\nu$ is the CDF of the standard t-distribution with $\nu$ degrees of freedom. \subsection{Data} \code{data(demonsnacks) \\ y <- ifelse(demonsnacks$Calories <= 137, 0, 1) \\ X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), nu=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} nu <- runif(1,5,10) \\ \hspace*{0.27 in} return(c(beta, nu)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.nu=pos.nu, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, 1000) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} nu.prior <- dunif(nu, 1e-100, 1000, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\ \hspace*{0.27 in} p <- pst(mu, nu=nu) \\ \hspace*{0.27 in} LL <- sum(dbern(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + nu.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbern(length(p), p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 5)} \section{Binomial Logit} \label{binomial.logit} \subsection{Form} $$\textbf{y} \sim \mathcal{BIN}(\textbf{p}, \textbf{n})$$ $$\textbf{p} = \frac{1}{1 + \exp(-\mu)}$$ $$\mu = \beta_1 + \beta_2 \textbf{x}$$ $$\beta_j \sim \mathcal{N}(0,1000), \quad j=1,\dots,J$$ \subsection{Data} \code{\#10 Trials \\ exposed <- c(100,100,100,100,100,100,100,100,100,100) \\ deaths <- c(10,20,30,40,50,60,70,80,90,100) \\ dose <- c(1,2,3,4,5,6,7,8,9,10) \\ J <- 2 \#Number of parameters \\ mon.names <- "LP" \\ parm.names <- c("beta[1]","beta[2]") \\ PGF <- function(Data) return(rnormv(Data$J,0,1000)) \\ MyData <- list(J=J, PGF=PGF, n=exposed, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, x=dose, y=deaths) } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- beta[1] + beta[2]*Data$x \\ \hspace*{0.27 in} p <- invlogit(mu) \\ \hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbinom(length(p), Data$n, p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Binomial Probit} \label{binomial.probit} \subsection{Form} $$\textbf{y} \sim \mathcal{BIN}(\textbf{p}, \textbf{n})$$ $$\textbf{p} = \phi(\mu)$$ $$\mu = \beta_1 + \beta_2 \textbf{x} \in [-10,10]$$ $$\beta_j \sim \mathcal{N}(0,1000), \quad j=1,\dots,J$$ where $\phi$ is the CDF of the standard normal distribution, and $J$=2. \subsection{Data} \code{\#10 Trials \\ exposed <- c(100,100,100,100,100,100,100,100,100,100) \\ deaths <- c(10,20,30,40,50,60,70,80,90,100) \\ dose <- c(1,2,3,4,5,6,7,8,9,10) \\ J <- 2 \#Number of parameters \\ mon.names <- "LP" \\ parm.names <- c("beta[1]","beta[2]") \\ PGF <- function(Data) return(rnormv(Data$J,0,1000)) \\ MyData <- list(J=J, PGF=PGF, n=exposed, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, x=dose, y=deaths) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- beta[1] + beta[2]*Data$x \\ \hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\ \hspace*{0.27 in} p <- pnorm(mu) \\ \hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbinom(length(p), Data$n, p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Binomial Robit} \label{binomial.robit} \subsection{Form} $$\textbf{y} \sim \mathcal{BIN}(\textbf{p}, \textbf{n})$$ $$\textbf{p} = \textbf{T}_\nu(\mu)$$ $$\mu = \beta_1 + \beta_2 \textbf{x} \in [-10,10]$$ $$\beta_j \sim \mathcal{N}(0,1000), \quad j=1,\dots,J$$ $$\nu \sim \mathcal{U}(5, 10)$$ where $\textbf{T}_\nu$ is the CDF of the standard t-distribution with $\nu$ degrees of freedom. \subsection{Data} \code{\#10 Trials \\ exposed <- c(100,100,100,100,100,100,100,100,100,100) \\ deaths <- c(10,20,30,40,50,60,70,80,90,100) \\ dose <- c(1,2,3,4,5,6,7,8,9,10) \\ J <- 2 \#Number of parameters \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,2), nu=0)) \\ PGF <- function(Data) return(c(rnormv(Data$J,0,1000), runif(1,5,10))) \\ MyData <- list(J=J, PGF=PGF, n=exposed, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, x=dose, y=deaths) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} parm[Data$J+1] <- nu <- interval(parm[Data$J+1], 5, 10) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} nu.prior <- dunif(nu, 5, 10, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- beta[1] + beta[2]*Data$x \\ \hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\ \hspace*{0.27 in} p <- pst(mu, nu=nu) \\ \hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + nu.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbinom(length(p), Data$n, p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 5)} \section{Change Point Regression} \label{changepoint} This example uses a popular variant of the stagnant water data set. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \alpha + \beta_1 \textbf{x} + \beta_2 (\textbf{x} - \theta)[(\textbf{x} - \theta) > 0]$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta \sim \mathcal{N}(0, 1000)$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\theta \sim \mathcal{U}(-1.3, 1.1)$$ \subsection{Data} \code{N <- 29 \\ y <- c(1.12, 1.12, 0.99, 1.03, 0.92, 0.90, 0.81, 0.83, 0.65, 0.67, 0.60, \\ \hspace*{0.27 in} 0.59, 0.51, 0.44, 0.43, 0.43, 0.33, 0.30, 0.25, 0.24, 0.13, -0.01, \\ \hspace*{0.27 in} -0.13, -0.14, -0.30, -0.33, -0.46, -0.43, -0.65) \\ x <- c(-1.39, -1.39, -1.08, -1.08, -0.94, -0.80, -0.63, -0.63, -0.25, -0.25, \\ \hspace*{0.27 in} -0.12, -0.12, 0.01, 0.11, 0.11, 0.11, 0.25, 0.25, 0.34, 0.34, 0.44, \\ \hspace*{0.27 in} 0.59, 0.70, 0.70, 0.85, 0.85, 0.99, 0.99, 1.19) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,2), sigma=0, theta=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(2) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} theta <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.theta=pos.theta, x=x, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], -1.3, 1.1) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- dunif(theta, -1.3, 1.1, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- alpha + beta[1]*x + beta[2]*(x - theta)*{(x - theta) > 0} \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0.2, -0.45, 0, 0.2, 0)} \section{Cluster Analysis, Confirmatory (CCA)} \label{cca} This is a parametric, model-based, cluster analysis, also called a finite mixture model or latent class cluster analysis, where the number of clusters $C$ is fixed. When the number of clusters is unknown, exploratory cluster analysis should be used. The record-level cluster membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. \subsection{Form} $$\textbf{Y}_{i,j} \sim \mathcal{N}(\mu_{\theta[i],j}, \sigma^2_{\theta[i]}), \quad i=1,\dots,N, \quad j=1,\dots,J$$ $$\theta_i \sim \mathcal{CAT}(\pi_{1:C}), \quad i=1,\dots,N$$ $$\pi_{1:C} \sim \mathcal{D}(\alpha_{1:C})$$ $$\alpha_c = 1$$ $$\mu_{c,j} \sim \mathcal{N}(0, \nu^2_c), \quad c=1,\dots,C, \quad j=1,\dots,J$$ $$\sigma_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$ $$\nu_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$ \subsection{Data} \code{data(demonsnacks) \\ Y <- as.matrix(log(demonsnacks + 1)) \\ N <- nrow(Y) \\ J <- ncol(Y) \\ for (j in 1:J) Y[,j] <- CenterScale(Y[,j]) \\ C <- 3 \#Number of clusters \\ alpha <- rep(1,C) \#Prior probability of cluster proportion \\ mon.names <- c("LP", paste("pi[", 1:C, "]", sep="")) \\ parm.names <- as.parm.names(list(theta=rep(0,N), mu=matrix(0,C,J), \\ \hspace*{0.27 in} nu=rep(0,C), sigma=rep(0,C))) \\ pos.theta <- grep("theta", parm.names) \\ pos.mu <- grep("mu", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} theta <- rcat(Data$N, p=rep(1/Data$C, Data$C)) \\ \hspace*{0.27 in} mu <- rnorm(Data$J*Data$J) \\ \hspace*{0.27 in} nu <- runif(Data$C) \\ \hspace*{0.27 in} sigma <- runif(Data$C) \\ \hspace*{0.27 in} return(c(theta, mu, nu, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, N=N, PGF=PGF, Y=Y, alpha=alpha, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.theta=pos.theta, \\ \hspace*{0.27 in} pos.mu=pos.mu, pos.nu=pos.nu, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} mu <- matrix(parm[Data$pos.mu], Data$C, Data$J) \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} pi <- rep(0, Data$C) \\ \hspace*{0.27 in} tab <- table(theta) \\ \hspace*{0.27 in} pi[as.numeric(names(tab))] <- as.vector(tab) \\ \hspace*{0.27 in} pi <- pi / sum(pi) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, pi, log=TRUE)) \\ \hspace*{0.27 in} mu.prior <- sum(dnorm(mu, 0, matrix(nu, Data$C, Data$J), log=TRUE)) \\ \hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\ \hspace*{0.27 in} pi.prior <- ddirichlet(pi, Data$alpha, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu[theta,], sigma[theta], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + theta.prior + mu.prior + nu.prior + pi.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,pi), \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu[theta,])), mu[theta,], sigma[theta]), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rcat(N,rep(1/C,C)), rep(0,C*J), rep(1,C), rep(1,C))} \section{Cluster Analysis, Exploratory (ECA)} \label{eca} This is a nonparametric, model-based, cluster analysis, also called an infinite mixture model or latent class cluster analysis, where the number of clusters $C$ is unknown, and a Dirichlet process via truncated stick-breaking is used to estimated the number of clusters. The record-level cluster membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. \subsection{Form} $$\textbf{Y}_{i,j} \sim \mathcal{N}(\mu_{\theta[i],j}, \sigma^2_{\theta[i]}), \quad i=1,\dots,N, \quad j=1,\dots,J$$ $$\theta_i \sim \mathcal{CAT}(\pi_{1:C}), \quad i=1,\dots,N$$ $$\mu_{c,j} \sim \mathcal{N}(0, \nu^2_c), \quad c=1,\dots,C, \quad j=1,\dots,J$$ $$\sigma_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$ $$\pi = \mathrm{Stick}(\delta)$$ $$\delta_c \sim \mathcal{BETA}(1, \gamma), c=1,\dots,(C-1)$$ $$\gamma \sim \mathcal{G}(\alpha, \beta)$$ $$\alpha \sim \mathcal{HC}(25)$$ $$\beta \sim \mathcal{HC}(25)$$ $$\nu_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$ \subsection{Data} \code{data(demonsnacks) \\ Y <- as.matrix(log(demonsnacks + 1)) \\ N <- nrow(Y) \\ J <- ncol(Y) \\ for (j in 1:J) Y[,j] <- CenterScale(Y[,j]) \\ C <- 5 \#Maximum number of clusters to explore \\ mon.names <- c("LP", paste("pi[", 1:C, "]", sep="")) \\ parm.names <- as.parm.names(list(theta=rep(0,N), delta=rep(0,C-1), \\ \hspace*{0.27 in} mu=matrix(0,C,J), nu=rep(0,C), sigma=rep(0,C), alpha=0, beta=0, \\ \hspace*{0.27 in} gamma=0)) \\ pos.theta <- grep("theta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.mu <- grep("mu", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} mu <- rnorm(Data$C*Data$J) \\ \hspace*{0.27 in} nu <- runif(Data$C) \\ \hspace*{0.27 in} sigma <- runif(Data$C) \\ \hspace*{0.27 in} alpha <- runif(1) \\ \hspace*{0.27 in} beta <- runif(1) \\ \hspace*{0.27 in} gamma <- rgamma(1, alpha, beta) \\ \hspace*{0.27 in} delta <- rev(sort(rbeta(Data$C-1, 1, gamma))) \\ \hspace*{0.27 in} theta <- rcat(Data$N, Stick(delta)) \\ \hspace*{0.27 in} return(c(theta, delta, mu, nu, sigma, alpha, beta, gamma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, N=N, PGF=PGF, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.theta=pos.theta, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.mu=pos.mu, pos.nu=pos.nu, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.gamma=pos.gamma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperhyperparameters \\ \hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} beta <- interval(parm[Data$pos.beta], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.beta] <- beta \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-10, 1-1e-10) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} mu <- matrix(parm[Data$pos.mu], Data$C, Data$J) \\ \hspace*{0.27 in} pi <- Stick(delta) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperhyperprior \\ \hspace*{0.27 in} alpha.prior <- dhalfcauchy(alpha, 25, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- dhalfcauchy(beta, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} delta.prior <- dStick(delta, gamma, log=TRUE) \\ \hspace*{0.27 in} gamma.prior <- dgamma(gamma, alpha, beta, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, pi, log=TRUE)) \\ \hspace*{0.27 in} mu.prior <- sum(dnorm(mu, 0, matrix(nu, Data$C, Data$J), log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu[theta,], sigma[theta], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + theta.prior + delta.prior + mu.prior + nu.prior + \\ \hspace*{0.62 in} alpha.prior + beta.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,pi), \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu[theta,])), mu[theta,], sigma[theta]), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rcat(N, rev(sort(rStick(C-1,1)))), rep(0.5,C-1), \\ \hspace*{0.27 in} rep(0,C*J), rep(1,C), rep(1,C), rep(1,3))} \section{Conditional Autoregression (CAR), Poisson} \label{car.poisson} This CAR example is a slightly modified form of example 7.3 (Model A) in \citet{congdon03}. The Scottish lip cancer data also appears in the WinBUGS \citep{spiegelhalter03} examples and is a widely analyzed example. The data $\textbf{y}$ consists of counts for $i=1,\dots,56$ counties in Scotland. A single predictor $\textbf{x}$ is provided. The errors, $\epsilon$, are allowed to include spatial effects as smoothing by spatial effects from areal neighbors. The vector $\epsilon_\mu$ is the mean of each area's error, and is a weighted average of errors in contiguous areas. Areal neighbors are indicated in adjacency matrix $\textbf{A}$. \subsection{Form} $$\textbf{y} \sim \mathcal{P}(\lambda)$$ $$\lambda = \exp(\log(\textbf{E}) + \beta_1 + \beta_2 \textbf{x} + \epsilon)$$ $$\epsilon \sim \mathcal{N}(\epsilon_\mu, \sigma^2)$$ $$\epsilon_{\mu[i]} = \rho \sum^J_{j=1} \textbf{A}_{i,j} \epsilon_i, \quad i=1,\dots,N$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\rho \sim \mathcal{U}(-1,1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 56 \#Number of areas \\ NN <- 264 \#Number of adjacent areas \\ y <- c(9,39,11,9,15,8,26,7,6,20,13,5,3,8,17,9,2,7,9,7,16,31,11,7,19,15,7, \\ \hspace*{0.27 in} 10,16,11,5,3,7,8,11,9,11,8,6,4,10,8,2,6,19,3,2,3,28,6,1,1,1,1,0,0) \\ E <- c( 1.4,8.7,3.0,2.5,4.3,2.4,8.1,2.3,2.0,6.6,4.4,1.8,1.1,3.3,7.8,4.6, \\ \hspace*{0.27 in} 1.1,4.2,5.5,4.4,10.5,22.7,8.8,5.6,15.5,12.5,6.0,9.0,14.4,10.2,4.8, \\ \hspace*{0.27 in} 2.9,7.0,8.5,12.3,10.1,12.7,9.4,7.2,5.3,18.8,15.8,4.3,14.6,50.7,8.2, \\ \hspace*{0.27 in} 5.6,9.3,88.7,19.6,3.4,3.6,5.7,7.0,4.2,1.8) \#Expected \\ x <- c(16,16,10,24,10,24,10,7,7,16,7,16,10,24,7,16,10,7,7,10,7,16,10,7,1,1, \\ \hspace*{0.27 in} 7,7,10,10,7,24,10,7,7,0,10,1,16,0,1,16,16,0,1,7,1,1,0,1,1,0,1,1,16,10) \\ A <- matrix(0, N, N) \\ A[1,c(5,9,11,19)] <- 1 \#Area 1 is adjacent to areas 5, 9, 11, and 19 \\ A[2,c(7,10)] <- 1 \#Area 2 is adjacent to areas 7 and 10 \\ A[3,c(6,12)] <- 1; A[4,c(18,20,28)] <- 1; A[5,c(1,11,12,13,19)] <- 1 \\ A[6,c(3,8)] <- 1; A[7,c(2,10,13,16,17)] <- 1; A[8,6] <- 1 \\ A[9,c(1,11,17,19,23,29)] <- 1; A[10,c(2,7,16,22)] <- 1 \\ A[11,c(1,5,9,12)] <- 1; A[12,c(3,5,11)] <- 1; A[13,c(5,7,17,19)] <- 1 \\ A[14,c(31,32,35)] <- 1; A[15,c(25,29,50)] <- 1 \\ A[16,c(7,10,17,21,22,29)] <- 1; A[17,c(7,9,13,16,19,29)] <- 1 \\ A[18,c(4,20,28,33,55,56)] <- 1; A[19,c(1,5,9,13,17)] <- 1 \\ A[20,c(4,18,55)] <- 1; A[21,c(16,29,50)] <- 1; A[22,c(10,16)] <- 1 \\ A[23,c(9,29,34,36,37,39)] <- 1; A[24,c(27,30,31,44,47,48,55,56)] <- 1 \\ A[25,c(15,26,29)] <- 1; A[26,c(25,29,42,43)] <- 1 \\ A[27,c(24,31,32,55)] <- 1; A[28,c(4,18,33,45)] <- 1 \\ A[29,c(9,15,16,17,21,23,25,26,34,43,50)] <- 1 \\ A[30,c(24,38,42,44,45,56)] <- 1; A[31,c(14,24,27,32,35,46,47)] <- 1 \\ A[32,c(14,27,31,35)] <- 1; A[33,c(18,28,45,56)] <- 1 \\ A[34,c(23,29,39,40,42,43,51,52,54)] <- 1; A[35,c(14,31,32,37,46)] <- 1 \\ A[36,c(23,37,39,41)] <- 1; A[37,c(23,35,36,41,46)] <- 1 \\ A[38,c(30,42,44,49,51,54)] <- 1; A[39,c(23,34,36,40,41)] <- 1 \\ A[40,c(34,39,41,49,52)] <- 1; A[41,c(36,37,39,40,46,49,53)] <- 1 \\ A[42,c(26,30,34,38,43,51)] <- 1; A[43,c(26,29,34,42)] <- 1 \\ A[44,c(24,30,38,48,49)] <- 1; A[45,c(28,30,33,56)] <- 1 \\ A[46,c(31,35,37,41,47,53)] <- 1; A[47,c(24,31,46,48,49,53)] <- 1 \\ A[48,c(24,44,47,49)] <- 1; A[49,c(38,40,41,44,47,48,52,53,54)] <- 1 \\ A[50,c(15,21,29)] <- 1; A[51,c(34,38,42,54)] <- 1 \\ A[52,c(34,40,49,54)] <- 1; A[53,c(41,46,47,49)] <- 1 \\ A[54,c(34,38,49,51,52)] <- 1; A[55,c(18,20,24,27,56)] <- 1 \\ A[56,c(18,24,30,33,45,55)] <- 1 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,2), epsilon=rep(0,N), rho=0, \\ \hspace*{0.27 in} sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.epsilon <- grep("epsilon", parm.names) \\ pos.rho <- grep("rho", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(2) \\ \hspace*{0.27 in} epsilon <- rnorm(Data$N) \\ \hspace*{0.27 in} rho <- runif(1,-1,1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, epsilon, rho, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(A=A, E=E, N=N, PGF=PGF, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.epsilon=pos.epsilon, \\ \hspace*{0.27 in} pos.rho=pos.rho, pos.sigma=pos.sigma, x=x, y=y) } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} epsilon <- parm[Data$pos.epsilon] \\ \hspace*{0.27 in} parm[Data$pos.rho] <- rho <- interval(parm[Data$pos.rho], -1, 1) \\ \hspace*{0.27 in} epsilon.mu <- rho * rowSums(epsilon * Data$A) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} epsilon.prior <- sum(dnorm(epsilon, epsilon.mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} rho.prior <- dunif(rho, -1, 1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(log(Data$E) + beta[1] + beta[2]*Data$x/10 + epsilon) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$y, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + epsilon.prior + rho.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(length(lambda), lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,2), rep(0,N), 0, 1)} \section{Conditional Predictive Ordinate} \label{cpo} For a more complete introduction to the conditional predictive ordinate (CPO), see the vignette entitled ``Bayesian Inference''. Following is a brief guide to the applied use of CPO. To include CPO in any model that is to be updated with MCMC, calculate and monitor the record-level inverse of the likelihood, $\mathrm{InvL}_i$ for records $i=1,\dots,N$. $\mathrm{CPO}_i$ is the inverse of the posterior mean of $\mathrm{InvL}_i$. The inverse $\mathrm{CPO}_i$, or $\mathrm{ICPO}_i$, is the posterior mean of $\mathrm{InvL}_i$. ICPOs larger than 40 can be considered as possible outliers, and higher than 70 as extreme values. Here, CPO is added to the linear regression example in section \ref{linear.reg}. In this data, record 6 is a possible outlier, and record 8 is an extreme value. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP",as.parm.names(list(InvL=rep(0,N)))) \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- dnorm(Data$y, mu, sigma, log=TRUE) \\ \hspace*{0.27 in} InvL <- 1 / exp(LL) \\ \hspace*{0.27 in} LL <- sum(LL) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,InvL), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Contingency Table} \label{contingency.table} The two-way contingency table, matrix $\textbf{Y}$, can easily be extended to more dimensions. Contingency table $\textbf{Y}$ has J rows and K columns. The cell counts are fit with Poisson regression, according to intercept $\alpha$, main effects $\beta_j$ for each row, main effects $\gamma_k$ for each column, and interaction effects $\delta_{j,k}$ for dependence effects. An omnibus (all cells) test of independence is done by estimating two models (one with $\delta$, and one without), and a large enough Bayes Factor indicates a violation of independence when the model with $\delta$ fits better than the model without $\delta$. In an ANOVA-like style, main effects contrasts can be used to distinguish rows or groups of rows from each other, as well as with columns. Likewise, interaction effects contrasts can be used to test independence in groups of $\delta_{j,k}$ elements. Finally, single-cell interactions can be used to indicate violations of independence for a given cell, such as when zero is not within its 95\% probability interval. \subsection{Form} $$\textbf{Y}_{j,k} \sim \mathcal{P}(\lambda_{j,k}), \quad j=1,\dots,J, \quad k=1,\dots,K$$ $$\lambda_{j,k} = \exp(\alpha + \beta_j + \gamma_k + \delta_{j,k}), \quad j=1,\dots,J, \quad k=1,\dots,K$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \beta^2_\sigma), \quad j=1,\dots,J$$ $$\beta_J = - \displaystyle\sum^{J-1}_{j=1} \beta_j$$ $$\beta_\sigma \sim \mathcal{HC}(25)$$ $$\gamma_k \sim \mathcal{N}(0, \gamma^2_\sigma), \quad k=1,\dots,K$$ $$\gamma_K = - \displaystyle\sum^{K-1}_{k=1} \gamma_k$$ $$\gamma_\sigma \sim \mathcal{HC}(25)$$ $$\delta_{j,k} \sim \mathcal{N}(0, \delta^2_\sigma)$$ $$\delta_{J,K} = - \displaystyle\sum \delta_{-J,-K}$$ $$\delta_\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{J <- 4 \#Rows \\ K <- 4 \#Columns \\ Y <- matrix(c(20,94,84,17,68,7,119,26,5,16,29,14,15,10,54,14), 4, 4) \\ rownames(Y) <- c("Black", "Blond", "Brunette", "Red") \\ colnames(Y) <- c("Blue", "Brown", "Green", "Hazel") \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), \\ \hspace*{0.27 in} gamma=rep(0,K-1), delta=rep(0,J*K-1), b.sigma=0, g.sigma=0, \\ \hspace*{0.27 in} d.sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.b.sigma <- grep("b.sigma", parm.names) \\ pos.g.sigma <- grep("g.sigma", parm.names) \\ pos.d.sigma <- grep("d.sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1,log(mean(Y)),1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J-1) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K-1) \\ \hspace*{0.27 in} delta <- rnorm(Data$J*Data$K-1) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, delta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, PGF=PGF, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.delta=pos.delta, pos.b.sigma=pos.b.sigma, \\ \hspace*{0.27 in} pos.g.sigma=pos.g.sigma, pos.d.sigma=pos.d.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} beta.sigma <- interval(parm[Data$pos.b.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.b.sigma] <- beta.sigma \\ \hspace*{0.27 in} gamma.sigma <- interval(parm[Data$pos.g.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.g.sigma] <- gamma.sigma \\ \hspace*{0.27 in} delta.sigma <- interval(parm[Data$pos.d.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.d.sigma] <- delta.sigma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} beta <- c(beta, -sum(beta)) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} gamma <- c(gamma, -sum(gamma)) \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} delta <- c(delta, -sum(delta)) \\ \hspace*{0.27 in} delta <- matrix(delta, Data$J, Data$K) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} beta.sigma.prior <- dhalfcauchy(beta.sigma, 25, log=TRUE) \\ \hspace*{0.27 in} gamma.sigma.prior <- dhalfcauchy(gamma.sigma, 25, log=TRUE) \\ \hspace*{0.27 in} delta.sigma.prior <- dhalfcauchy(delta.sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, beta.sigma, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, gamma.sigma, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnorm(delta, 0, delta.sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} beta <- matrix(beta, Data$J, Data$K) \\ \hspace*{0.27 in} gamma <- matrix(gamma, Data$J, Data$K, byrow=TRUE) \\ \hspace*{0.27 in} lambda <- exp(alpha + beta + gamma + delta) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$Y, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + beta.sigma.prior + \\ \hspace*{0.62 in} gamma.prior + gamma.sigma.prior + delta.prior + \\ \hspace*{0.62 in} delta.sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(length(lambda), lambda), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(log(mean(Y)), rep(0,J-1), rep(0,K-1), rep(0,J*K-1), \\ \hspace*{0.27 in} rep(1,3)) \\} \section{Discrete Choice, Conditional Logit} \label{conditional.logit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N, \quad j=1,\dots,J$$ $$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}$$ $$\phi = \exp(\mu)$$ $$\mu_{i,j} = \beta_{j,1:K} \textbf{X}_{i,1:K} + \gamma \textbf{Z}_{i,1:C} \in [-700,700], \quad j=1,\dots,(J-1)$$ $$\mu_{i,J} = \gamma \textbf{Z}_{i,1:C}$$ $$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1)$$ $$\gamma_c \sim \mathcal{N}(0, 1000)$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ Z <- as.matrix(demonchoice[,4:9]) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ for (j in 1:ncol(Z)) Z[,j] <- CenterScale(Z[,j]) \\ N <- length(y) \#Number of records \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of individual attributes (including the intercept) \\ C <- ncol(Z) \#Number of choice-based attributes (intercept is not included) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,J-1,K), gamma=rep(0,C))) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} gamma <- rnorm(Data$C) \\ \hspace*{0.27 in} return(c(beta, gamma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, K=K, N=N, PGF=PGF, X=X, Z=Z, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(tcrossprod(gamma, Data$Z), Data$N, Data$J) \\ \hspace*{0.27 in} mu[,-Data$J] <- mu[,-Data$J] + tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} phi <- exp(mu) \\ \hspace*{0.27 in} p <- phi / rowSums(phi) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,(J-1)*K), rep(0,C))} \section{Discrete Choice, Mixed Logit} \label{dc.mixed.logit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N$$ $$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}$$ $$\phi = \exp(\mu)$$ $$\mu_{i,j} = \beta_{j,1:K,i} \textbf{X}_{i,1:K} + \gamma \textbf{Z}_{i,1:C} \in [-700,700], \quad i=1,\dots,N, \quad j=1,\dots,(J-1)$$ $$\mu_{i,J} = \gamma \textbf{Z}_{i,1:C}$$ $$\beta_{j,k,i} \sim \mathcal{N}(\zeta^\mu_{j,k}, \zeta^\sigma2_{j,k}), \quad i=1,\dots,N, \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\gamma_c \sim \mathcal{N}(0, 1000), \quad c=1,\dots,C$$ $$\zeta^\mu_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\zeta^\sigma_{j,k} \sim \mathcal{HC}{25}), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ Z <- as.matrix(demonchoice[,4:9]) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ for (j in 1:ncol(Z)) Z[,j] <- CenterScale(Z[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ C <- ncol(Z) \#Number of choice-based attributes (intercept is not included) \\ S <- diag(J-1) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=array(0, dim=c(J-1,K,N)), \\ \hspace*{0.27 in} gamma=rep(0,C), zeta.mu=matrix(0,J-1,K), zeta.sigma=matrix(0,J-1,K))) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.zeta.mu <- grep("zeta.mu", parm.names) \\ pos.zeta.sigma <- grep("zeta.sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} zeta.mu <- matrix(rnorm((Data$J-1)*Data$K), Data$J-1, Data$K) \\ \hspace*{0.27 in} zeta.sigma <- matrix(runif((Data$J-1)*Data$K), Data$J-1, Data$K) \\ \hspace*{0.27 in} beta <- array(rnorm((Data$J-1)*Data$K*Data$N), \\ \hspace*{0.62 in} dim=c( Data$J-1, Data$K, Data$N)) \\ \hspace*{0.27 in} gamma <- rnorm(Data$C) \\ \hspace*{0.27 in} return(c(beta, gamma, as.vector(zeta.mu), as.vector(zeta.sigma))) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, K=K, N=N, PGF=PGF, S=S, X=X, Z=Z, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.zeta.mu=pos.zeta.mu, \\ \hspace*{0.27 in} pos.zeta.sigma=pos.zeta.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- array(parm[Data$pos.beta], dim=c(Data$J-1, Data$K, Data$N)) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} zeta.mu <- matrix(parm[Data$pos.zeta.mu], Data$J-1, Data$K) \\ \hspace*{0.27 in} zeta.sigma <- matrix(interval(parm[Data$pos.zeta.sigma], 1e-100, Inf), \\ \hspace*{0.62 in} Data$J-1, Data$K) \\ \hspace*{0.27 in} parm[Data$pos.zeta.sigma] <- as.vector(zeta.sigma) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} zeta.mu.prior <- sum(dnormv(zeta.mu, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.sigma.prior <- sum(dhalfcauchy(zeta.sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, zeta.mu, zeta.sigma, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(tcrossprod(Data$Z, t(gamma)), Data$N, Data$J) \\ \hspace*{0.27 in} for (j in 1:(Data$J-1)) mu[,j] <- rowSums(Data$X * t(beta[j, , ])) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} phi <- exp(mu) \\ \hspace*{0.27 in} p <- phi / rowSums(phi) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + zeta.mu.prior + zeta.sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,(J-1)*K*N), rep(0,C), rep(0,(J-1)*K), \\ \hspace*{0.27 in} rep(1,(J-1)*K))} \section{Discrete Choice, Multinomial Probit} \label{dc.mnp} \subsection{Form} $$\textbf{W}_{i,1:(J-1)} \sim \mathcal{N}_{J-1}(\mu_{i,1:(J-1)}, \Sigma), \quad i=1,\dots,N$$ \[\textbf{W}_{i,j} \in \left\{ \begin{array}{l l} $[0,10]$ & \quad \mbox{if $\textbf{y}_i = j$}\\ $[-10,0]$ \\ \end{array} \right. \] $$\mu_{1:N,j} = \textbf{X} \beta_{j,1:K} + \textbf{Z} \gamma$$ $$\Sigma = \textbf{U}^T \textbf{U}$$ $$\beta_{j,k} \sim \mathcal{N}(0, 10), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\gamma_c \sim \mathcal{N}(0, 10), \quad c=1,\dots,C$$ $$\textbf{U}_{j,k} \sim \mathcal{N}(0,1), \quad j=1,\dots,(J-1), \quad k=1,\dots,(J-1), \quad j \ge k, \quad j \ne k = 1$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ Z <- as.matrix(demonchoice[,4:9]) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ for (j in 1:ncol(Z)) Z[,j] <- CenterScale(Z[,j]) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ C <- ncol(Z) \#Number of choice-based attributes (intercept is not included) \\ S <- diag(J-1) \\ U <- matrix(NA,J-1,J-1) \\ U[upper.tri(U, diag=TRUE)] <- 0 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,(J-1),K), gamma=rep(0,C), \\ \hspace*{0.27 in} U=U, W=matrix(0,N,J-1))) \\ parm.names <- parm.names[-which(parm.names == "U[1,1]")] \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.U <- grep("U", parm.names) \\ pos.W <- grep("W", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} gamma <- rnorm(Data$C) \\ \hspace*{0.27 in} U <- rnorm((Data$J-2) + (factorial(Data$J-1) / \\ \hspace*{0.62 in} (factorial(Data$J-1-2)*factorial(2))),0,1) \\ \hspace*{0.27 in} W <- matrix(runif(Data$N*(Data$J-1),-10,0), Data$N, Data$J-1) \\ \hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\ \hspace*{0.27 in} W <- ifelse(Y[,-Data$J] == 1, abs(W), W) \\ \hspace*{0.27 in} return(c(beta, gamma, U, as.vector(W)))\} \\ MyData <- list(C=C, J=J, K=K, N=N, PGF=PGF, S=S, X=X, Z=Z, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.U=pos.U, pos.W=pos.W, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} u <- c(0, parm[Data$pos.U]) \\ \hspace*{0.27 in} U <- diag(Data$J-1) \\ \hspace*{0.27 in} U[upper.tri(U, diag=TRUE)] <- u \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} Sigma <- t(U) \%*\% U \\ \hspace*{0.27 in} Sigma[1,] <- Sigma[,1] <- U[1,] \\ \hspace*{0.27 in} W <- matrix(parm[Data$pos.W], Data$N, Data$J-1) \\ \hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\ \hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 1) \\ \hspace*{0.27 in} W[temp] <- interval(W[temp], 0, 10) \\ \hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 0) \\ \hspace*{0.27 in} W[temp] <- interval(W[temp], -10, 0) \\ \hspace*{0.27 in} parm[Data$pos.W] <- as.vector(W) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- sum(dnorm(u[-1], 0, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) + \\ \hspace*{0.62 in} as.vector(tcrossprod(Data$Z, t(gamma))) \\ \hspace*{0.27 in} \#eta <- exp(cbind(mu,0)) \\ \hspace*{0.27 in} \#p <- eta / rowSums(eta) \\ \hspace*{0.27 in} LL <- sum(dmvn(W, mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=max.col(cbind(rmvn(nrow(mu), mu, Sigma),0)), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)} \section{Distributed Lag, Koyck} \label{dl.koyck} This example applies Koyck or geometric distributed lags to $k=1,\dots,K$ discrete events in covariate $\textbf{x}$, transforming the covariate into a $N$ x $K$ matrix $\textbf{X}$ and creates a $N$ x $K$ lag matrix $\textbf{L}$. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_t = \alpha + \phi \textbf{y}_{t-1} + \sum^K_{k=1} \textbf{X}_{t,k} \beta \lambda^{\textbf{L}[t,k]}, \quad k=1,\dots,K, \quad t=2,\dots,T$$ $$\mu_1 = \alpha + \sum^K_{k=1} \textbf{X}_{1,k} \beta \lambda^{\textbf{L}[1,k]}, \quad k=1,\dots,K$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta \sim \mathcal{N}(0, 1000)$$ $$\lambda \sim \mathcal{U}(0, 1)$$ $$\phi \sim \mathcal{N}(0, 1000)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ x <- (y > 0.01)*1 \#Made-up distributed lag IV \\ T <- length(y) \\ K <- length(which(x != 0)) \\ L <- X <- matrix(0, T, K) \\ for (i in 1:K) \{ \\ \hspace*{0.27 in} X[which(x != 0)[i]:T,i] <- x[which(x != 0)[i]] \\ \hspace*{0.27 in} L[(which(x != 0)[i]):T,i] <- 0:(T - which(x != 0)[i])\} \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, beta=0, lambda=0, phi=0, sigma=0)) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(1) \\ \hspace*{0.27 in} lambda <- runif(1) \\ \hspace*{0.27 in} phi <- rnorm(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, lambda, phi, sigma)) \\ \hspace*{0.27 in} \} \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ MyData <- list(L=L, PGF=PGF, T=T, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.lambda=pos.lambda, pos.phi=pos.phi, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 0, 1) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- dnormv(beta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} lambda.prior <- dunif(lambda, 0, 1, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- dnormv(phi, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- c(alpha, alpha + phi*Data$y[-Data$T]) + \\ \hspace*{0.62 in} rowSums(Data$X * beta * lambda\textasciicircum Data$L) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], mu[-1], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + lambda.prior + phi.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,2), 0.5, 0, 1)} \section{Dynamic Sparse Factor Model (DSFM)} \label{dsfm} \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\alpha{t,j} + \textbf{F}_{t,1:P} \Lambda_{1:P,1:j,t}, \Sigma^2_{t,j}), \quad t=1,\dots,T, \quad j=1,\dots,J$$ $$\alpha_{t,j} \sim \mathcal{N}(\alpha^\mu_j + \alpha^\phi_j(\alpha_{t-1,j} - \alpha^mu_j), \alpha^\sigma2_j)$$ $$\textbf{F}_{t,1:P} \sim \mathcal{N}_P(\textbf{F}^\phi \textbf{F}_{t-1,1:P}, \textbf{f}^\Sigma_{t,1:P})$$ $$\textbf{f}^\Sigma_{t,1:P} = t(\textbf{f}^\textbf{U}_{1:P,1:P,t})\textbf{f}^\textbf{U}_{1:P,1:P,t}$$ $$\textbf{f}^\textbf{U}_{p,q,t} \sim \mathcal{N}(\textbf{f}^{\textbf{u}_\mu}_{p,q} + \textbf{f}^{\textbf{u}_\phi}_{p,q}(\textbf{f}^\textbf{U}_{p,q,t-1} - \textbf{f}^{\textbf{u}_\mu}_{p,q}), \textbf{f}^{\textbf{u}_\sigma^2}_{p,q})$$ $$\Lambda_{p,j,t} \sim \mathcal{N}(\lambda^\mu_{p,j} + \lambda^\phi_{p,j}(\Lambda_{p,j,t-1} - \lambda^mu_{p,j}), \lambda^\sigma2_{p,j})$$ $$\Sigma_{t,j} = \exp(\log(\Sigma_{t,j}))$$ $$log(\Sigma_{t,j}) \sim \mathcal{N}(\sigma^\mu_j + \sigma^\phi_j(log(\Sigma_{t-1,j}) - \sigma^mu_j), \sigma^\sigma2_j)$$ $$\alpha^0_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\alpha^\mu_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\alpha^\phi_j+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$ $$\alpha^\sigma_j \sim \mathcal{HC}(5), \quad j=1,\dots,J$$ $$\textbf{f}^0_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\textbf{f}^\phi_j+1}{2} \sim \mathcal{BETA}(1, 1), \quad j=1,\dots,J$$ $$\textbf{f}^{\textbf{u}0}_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\textbf{f}^{\textbf{u}\mu}_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\textbf{f}^{\textbf{u}\phi}_j+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$ $$\textbf{f}^{\textbf{u}\sigma}_j \sim \mathcal{HC}(1), \quad j=1,\dots,J$$ $$\lambda^0_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\lambda^d_j \sim \mathcal{U}(0, |\lambda^\mu_j| + 3\sqrt{\frac{\lambda^\sigma_j}{1 - \lambda^\phi_j\lambda^\phi_j}}), \quad j=1,\dots,J$$ $$\lambda^\mu_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\lambda^\phi_j+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$ $$\lambda^\sigma_j \sim \mathcal{HC}(1), \quad j=1,\dots,J$$ $$\log(\sigma^0_j) \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\log(\sigma^\mu_j) \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\log(\sigma^\phi_j)+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$ $$\log(\sigma^\sigma_j) \sim \mathcal{HC}(1), \quad j=1,\dots,J$$ \subsection{Data} \code{data(demonfx) \\ Y.orig <- demonfx \\ Y <- log(as.matrix(Y.orig[1:20,1:3])) \\ Y.means <- colMeans(Y) \\ Y <- Y - matrix(Y.means, nrow(Y), ncol(Y), byrow=TRUE) \#Center \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \#Scale \\ T <- nrow(Y) \#Number of time-periods \\ J <- ncol(Y) \#Number of time-series \\ P <- 2 \#Number of dynamic factors \\ mon.names <- "LP" \\ U1 <- matrix(NA,P,P); U2 <- matrix(NA,P,J) \\ U1[upper.tri(U1, diag=TRUE)] <- 0; U2[upper.tri(U2)] <- 0 \\ Lambda <- array(NA, dim=c(P,J,T)) \\ U <- array(NA, dim=c(P,P,T)) \\ for (t in 1:T) \{ \\ \hspace*{0.27 in} U[ , , t] <- U1 \\ \hspace*{0.27 in} Lambda[ , , t] <- U2\} \\ parm.names <- as.parm.names(list(alpha0=rep(0,J), Alpha=matrix(0,T,J), \\ \hspace*{0.27 in} alpha.mu=rep(0,J), alpha.phi=rep(0,J), alpha.sigma=rep(0,J), \\ \hspace*{0.27 in} f0=rep(0,P), F=matrix(0,T,P), f.phi=rep(0,P), f.u0=U1, f.U=U, \\ \hspace*{0.27 in} f.u.mu=U1, f.u.phi=U1, f.u.sigma=U1, lambda0=U2, Lambda=Lambda, \\ \hspace*{0.27 in} lambda.d=U2, lambda.mu=U2, lambda.phi=U2, lambda.sigma=U2, \\ \hspace*{0.27 in} lsigma0=rep(0,J), lSigma=matrix(0,T,J), \\ \hspace*{0.27 in} lsigma.mu=rep(0,J), lsigma.phi=rep(0,J), lsigma.sigma=rep(0,J))) \\ pos.alpha0 <- grep("alpha0", parm.names) \\ pos.Alpha <- grep("Alpha", parm.names) \\ pos.alpha.mu <- grep("alpha.mu", parm.names) \\ pos.alpha.phi <- grep("alpha.phi", parm.names) \\ pos.alpha.sigma <- grep("alpha.sigma", parm.names) \\ pos.f0 <- grep("f0", parm.names) \\ pos.F <- grep("F", parm.names) \\ pos.f.phi <- grep("f.phi", parm.names) \\ pos.f.u0 <- grep("f.u0", parm.names) \\ pos.f.U <- grep("f.U", parm.names) \\ pos.f.u.mu <- grep("f.u.mu", parm.names) \\ pos.f.u.phi <- grep("f.u.phi", parm.names) \\ pos.f.u.sigma <- grep("f.u.sigma", parm.names) \\ pos.lambda0 <- grep("lambda0", parm.names) \\ pos.Lambda <- grep("Lambda", parm.names) \\ pos.lambda.d <- grep("lambda.d", parm.names) \\ pos.lambda.mu <- grep("lambda.mu", parm.names) \\ pos.lambda.phi <- grep("lambda.phi", parm.names) \\ pos.lambda.sigma <- grep("lambda.sigma", parm.names) \\ pos.lsigma0 <- grep("lsigma0", parm.names) \\ pos.lSigma <- grep("lSigma", parm.names) \\ pos.lsigma.mu <- grep("lsigma.mu", parm.names) \\ pos.lsigma.phi <- grep("lsigma.phi", parm.names) \\ pos.lsigma.sigma <- grep("lsigma.sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha0 <- rnorm(Data$J) \\ \hspace*{0.27 in} Alpha <- rnorm(Data$T*Data$J) \\ \hspace*{0.27 in} alpha.mu <- rnorm(Data$J) \\ \hspace*{0.27 in} alpha.phi <- rbeta(Data$J, 20, 1.5) * 2 - 1 \\ \hspace*{0.27 in} alpha.sigma <- runif(Data$J) \\ \hspace*{0.27 in} f0 <- rnorm(Data$P) \\ \hspace*{0.27 in} F <- rnorm(Data$T*Data$P) \\ \hspace*{0.27 in} f.phi <- rbeta(Data$P, 1, 1) * 2 - 1 \\ \hspace*{0.27 in} f.u0 <- rnorm(length(Data$pos.f.u0)) \\ \hspace*{0.27 in} f.U <- rnorm(length(Data$pos.f.U)) \\ \hspace*{0.27 in} f.u.mu <- rnorm(length(Data$pos.f.u.mu)) \\ \hspace*{0.27 in} f.u.phi <- runif(length(Data$pos.f.u.phi)) \\ \hspace*{0.27 in} f.u.sigma <- runif(length(Data$pos.f.u.sigma)) \\ \hspace*{0.27 in} lambda0 <- rnorm(length(Data$pos.lambda0)) \\ \hspace*{0.27 in} Lambda <- rnorm(length(Data$pos.Lambda)) \\ \hspace*{0.27 in} lambda.mu <- rnorm(length(Data$pos.lambda.mu)) \\ \hspace*{0.27 in} lambda.phi <- rbeta(length(Data$pos.lambda.phi), 20, 1.5) \\ \hspace*{0.27 in} lambda.sigma <- runif(length(Data$pos.lambda.sigma)) \\ \hspace*{0.27 in} lambda.d <- runif(length(Data$pos.lambda.d), 0, abs(lambda.mu) + \\ \hspace*{0.62 in} 3*sqrt(lambda.sigma/(1-lambda.phi\textasciicircum 2))) \\ \hspace*{0.27 in} lsigma0 <- rnorm(Data$J) \\ \hspace*{0.27 in} lSigma <- rnorm(Data$T*Data$J) \\ \hspace*{0.27 in} lsigma.mu <- rnorm(Data$J) \\ \hspace*{0.27 in} lsigma.phi <- rbeta(Data$J, 20, 1.5) * 2 - 1 \\ \hspace*{0.27 in} lsigma.sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha0, Alpha, alpha.mu, alpha.phi, alpha.sigma, f0, F, \\ \hspace*{0.62 in} f.phi, f.u0, f.U, f.u.mu, f.u.phi, f.u.sigma, lambda0, Lambda, \\ \hspace*{0.62 in} lambda.d, lambda.mu, lambda.phi, lambda.sigma, lsigma0, lSigma, \\ \hspace*{0.62 in} lsigma.mu, lsigma.phi, lsigma.sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, P=P, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha0=pos.alpha0, pos.Alpha=pos.Alpha, \\ \hspace*{0.27 in} pos.alpha.mu=pos.alpha.mu, pos.alpha.phi=pos.alpha.phi, \\ \hspace*{0.27 in} pos.alpha.sigma=pos.alpha.sigma, pos.f0=pos.f0, pos.F=pos.F, \\ \hspace*{0.27 in} pos.f.phi=pos.f.phi, pos.f.u0=pos.f.u0, pos.f.U=pos.f.U, \\ \hspace*{0.27 in} pos.f.u.mu=pos.f.u.mu, pos.f.u.phi=pos.f.u.phi, \\ \hspace*{0.27 in} pos.f.u.sigma=pos.f.u.sigma, pos.lambda0=pos.lambda0, \\ \hspace*{0.27 in} pos.Lambda=pos.Lambda, pos.lambda.d=pos.lambda.d, \\ \hspace*{0.27 in} pos.lambda.mu=pos.lambda.mu, pos.lambda.phi=pos.lambda.phi, \\ \hspace*{0.27 in} pos.lambda.sigma=pos.lambda.sigma, pos.lsigma0=pos.lsigma0, \\ \hspace*{0.27 in} pos.lSigma=pos.lSigma, pos.lsigma.mu=pos.lsigma.mu, \\ \hspace*{0.27 in} pos.lsigma.phi=pos.lsigma.phi, pos.lsigma.sigma=pos.lsigma.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha0 <- parm[Data$pos.alpha0] \\ \hspace*{0.27 in} Alpha <- matrix(parm[Data$pos.Alpha], Data$T, Data$J)\\ \hspace*{0.27 in} alpha.mu <- parm[Data$pos.alpha.mu] \\ \hspace*{0.27 in} alpha.phi <- interval(parm[Data$pos.alpha.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.alpha.phi] <- alpha.phi \\ \hspace*{0.27 in} alpha.sigma <- interval(parm[Data$pos.alpha.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.alpha.sigma] <- alpha.sigma \\ \hspace*{0.27 in} f0 <- parm[Data$pos.f0] \\ \hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$T, Data$P) \\ \hspace*{0.27 in} f.phi <- interval(parm[Data$pos.f.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.f.phi] <- f.phi \\ \hspace*{0.27 in} f.u0 <- parm[Data$pos.f.u0] \\ \hspace*{0.27 in} f.U <- parm[Data$pos.f.U] \\ \hspace*{0.27 in} f.u.mu <- parm[Data$pos.f.u.mu] \\ \hspace*{0.27 in} f.u.phi <- interval(parm[Data$pos.f.u.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.f.u.phi] <- f.u.phi \\ \hspace*{0.27 in} f.u.sigma <- interval(parm[Data$pos.f.u.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.f.u.sigma] <- f.u.sigma \\ \hspace*{0.27 in} lambda0 <- parm[Data$pos.lambda0] \\ \hspace*{0.27 in} Lambda <- parm[Data$pos.Lambda] \\ \hspace*{0.27 in} lambda.mu <- parm[Data$pos.lambda.mu] \\ \hspace*{0.27 in} lambda.phi <- interval(parm[Data$pos.lambda.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.lambda.phi] <- lambda.phi \\ \hspace*{0.27 in} lambda.sigma <- interval(parm[Data$pos.lambda.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda.sigma] <- lambda.sigma \\ \hspace*{0.27 in} lambda.d <- parm[Data$pos.lambda.d] \\ \hspace*{0.27 in} for (i in 1:length(lambda.d)) \\ \hspace*{0.62 in} lambda.d[i] <- interval(lambda.d[i], 0, abs(lambda.mu[i]) + \\ \hspace*{0.62 in} 3*sqrt(lambda.sigma[i]/(1-lambda.phi[i]\textasciicircum 2))) \\ \hspace*{0.27 in} parm[Data$pos.lambda.d] <- lambda.d \\ \hspace*{0.27 in} lsigma0 <- parm[Data$pos.lsigma0] \\ \hspace*{0.27 in} lSigma <- matrix(parm[Data$pos.lSigma], Data$T, Data$J) \\ \hspace*{0.27 in} lsigma.mu <- parm[Data$pos.lsigma.mu] \\ \hspace*{0.27 in} lsigma.phi <- interval(parm[Data$pos.lsigma.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.lsigma.phi] <- lsigma.phi \\ \hspace*{0.27 in} lsigma.sigma <- interval(parm[Data$pos.lsigma.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lsigma.sigma] <- lsigma.sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha0.prior <- sum(dnorm(alpha0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} Alpha.prior <- sum(dnorm(Alpha, \\ \hspace*{0.62 in} matrix(alpha.mu, Data$T, Data$J, byrow=TRUE) + \\ \hspace*{0.62 in} matrix(alpha.phi, Data$T, Data$J, byrow=TRUE) * \\ \hspace*{0.62 in} (rbind(alpha0, Alpha[-Data$T,]) - \\ \hspace*{0.62 in} matrix(alpha.mu, Data$T, Data$J, byrow=TRUE)),\\ \hspace*{0.62 in} matrix(alpha.sigma, Data$T, Data$J, byrow=TRUE), log=TRUE)) \\ \hspace*{0.27 in} alpha.mu.prior <- sum(dnorm(alpha.mu, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} alpha.phi.prior <- sum(dbeta((alpha.phi + 1) / 2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} alpha.sigma.prior <- sum(dhalfcauchy(alpha.sigma, 5, log=TRUE)) \\ \hspace*{0.27 in} f0.prior <- sum(dnorm(f0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} f.phi.prior <- sum(dbeta((f.phi + 1) / 2, 1, 1, log=TRUE)) \\ \hspace*{0.27 in} f.u0.prior <- sum(dnorm(f.u0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} f.U.prior <- sum(dnorm(matrix(f.U, nrow=Data$T, byrow=TRUE), \\ \hspace*{0.62 in} matrix(f.u.mu, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE) + \\ \hspace*{0.62 in} matrix(f.u.phi, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE) * \\ \hspace*{0.62 in} (rbind(f.u0, matrix(f.U, nrow=Data$T, byrow=TRUE)[-Data$T,]) - \\ \hspace*{0.62 in} matrix(f.u.mu, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE)), \\ \hspace*{0.62 in} matrix(f.u.sigma, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE), \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} f.u.mu.prior <- sum(dnorm(f.u.mu, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} f.u.phi.prior <- sum(dbeta((f.u.phi + 1) / 2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} f.u.sigma.prior <- sum(dhalfcauchy(f.u.sigma, 1, log=TRUE)) \\ \hspace*{0.27 in} lambda0.prior <- sum(dnorm(lambda0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} Lambda.prior <- sum(dnorm(matrix(Lambda, nrow=Data$T, byrow=TRUE), \\ \hspace*{0.62 in} matrix(lambda.mu, Data$T, length(lambda.mu), byrow=TRUE) + \\ \hspace*{0.62 in} (rbind(lambda0, matrix(Lambda, nrow=Data$T, byrow=TRUE))[-(Data$T+1),] - \\ \hspace*{0.62 in} matrix(lambda.mu, Data$T, length(lambda.mu), byrow=TRUE)), \\ \hspace*{0.62 in} matrix(lambda.sigma, Data$T, length(lambda.sigma), byrow=TRUE), \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} lambda.d.prior <- sum(dunif(lambda.d, 0, abs(lambda.mu) + \\ \hspace*{0.62 in} 3*sqrt(lambda.sigma/(1-lambda.phi\textasciicircum 2)), log=TRUE)) \\ \hspace*{0.27 in} lambda.mu.prior <- sum(dnorm(lambda.mu, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} lambda.phi.prior <- sum(dbeta((lambda.phi + 1) / 2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} lambda.sigma.prior <- sum(dhalfcauchy(lambda.sigma, 1, log=TRUE)) \\ \hspace*{0.27 in} lsigma0.prior <- sum(dnorm(lsigma0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} lSigma.prior <- sum(dnorm(lSigma, \\ \hspace*{0.62 in} matrix(lsigma.mu, Data$T, Data$J, byrow=TRUE) + \\ \hspace*{0.62 in} matrix(lsigma.phi, Data$T, Data$J, byrow=TRUE) * \\ \hspace*{0.62 in} (rbind(lsigma0, lSigma[-Data$T,]) - \\ \hspace*{0.62 in} matrix(lsigma.mu, Data$T, Data$J, byrow=TRUE)), \\ \hspace*{0.62 in} matrix(lsigma.sigma, Data$T, Data$J, byrow=TRUE), log=TRUE)) \\ \hspace*{0.27 in} lsigma.mu.prior <- sum(dnorm(lsigma.mu, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} lsigma.phi.prior <- sum(dbeta((lsigma.phi + 1) / 2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} lsigma.sigma.prior <- sum(dhalfcauchy(lsigma.sigma, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- 0; Yhat <- Data$Y; F.prior <- 0 \\ \hspace*{0.27 in} for (t in 1:Data$T) \{ \\ \hspace*{0.62 in} f.U.temp <- matrix(0, Data$P, Data$P) \\ \hspace*{0.62 in} f.U.temp[upper.tri(f.U.temp, diag=TRUE)] <- matrix(f.U, nrow=Data$T, \\ \hspace*{0.95 in} byrow=TRUE)[t,] \\ \hspace*{0.62 in} diag(f.U.temp) <- exp(diag(f.U.temp)) \\ \hspace*{0.62 in} f.Sigma <- as.symmetric.matrix(t(f.U.temp) \%*\% f.U.temp) \\ \hspace*{0.62 in} F.prior <- F.prior + dmvn(F[t,], rbind(f0, F)[t,] \%*\% diag(f.phi), \\ \hspace*{0.95 in} f.Sigma, log=TRUE) \\ \hspace*{0.62 in} Lambda.temp <- matrix(1, Data$P, Data$J) \\ \hspace*{0.62 in} Lambda.temp[lower.tri(Lambda.temp)] <- 0 \\ \hspace*{0.62 in} Lambda.temp[upper.tri(Lambda.temp)] <- matrix(Lambda, \\ \hspace*{0.95 in} nrow=Data$T, byrow=TRUE)[t,]*(abs(matrix(Lambda, \\ \hspace*{0.95 in} nrow=Data$T, byrow=TRUE)[t,]) > lambda.d) \\ \hspace*{0.62 in} mu <- Alpha[t,] + F[t,] \%*\% Lambda.temp \\ \hspace*{0.62 in} LL <- LL + sum(dnorm(Data$Y[t,], mu, exp(lSigma[t,]), log=TRUE)) \\ \hspace*{0.62 in} Yhat[t,] <- rnorm(Data$J, mu, exp(lSigma[t,])) \#Fitted \\ \hspace*{0.62 in} \} \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha0.prior + Alpha.prior + alpha.mu.prior + \\ \hspace*{0.62 in} alpha.phi.prior + alpha.sigma.prior + f0.prior + F.prior + \\ \hspace*{0.62 in} f.phi.prior + f.u0.prior + f.U.prior + f.u.mu.prior + \\ \hspace*{0.62 in} f.u.phi.prior + f.u.sigma.prior + lambda0.prior + \\ \hspace*{0.62 in} Lambda.prior + lambda.d.prior + lambda.mu.prior + \\ \hspace*{0.62 in} lambda.phi.prior + lambda.sigma.prior + lsigma0.prior + \\ \hspace*{0.62 in} lSigma.prior + lsigma.mu.prior + lsigma.phi.prior + \\ \hspace*{0.62 in} lsigma.sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=Yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rnorm(J), rnorm(T*J), rnorm(J), runif(J), runif(J), \\ \hspace*{0.27 in} rnorm(P), rnorm(T*P), rbeta(P,1,1)*2-1, rnorm(P*(P-1)/2+P), \\ \hspace*{0.27 in} rnorm((P*(P-1)/2+P)*T), rnorm(P*(P-1)/2+P), \\ \hspace*{0.27 in} rbeta(P*(P-1)/2+P,1,1)*2-1, runif(P*(P-1)/2+P), \\ \hspace*{0.27 in} rnorm(P*J-P-P*(P-1)/2), rnorm((P*J-P-P*(P-1)/2)*T), \\ \hspace*{0.27 in} runif(P*J-P-P*(P-1)/2,0,1e-3), rnorm(P*J-P-P*(P-1)/2), \\ \hspace*{0.27 in} rbeta(P*J-P-P*(P-1)/2,20,1.5)*2-1, runif(P*J-P-P*(P-1)/2), \\ \hspace*{0.27 in} rnorm(J), rnorm(T*J), rnorm(J), rbeta(J,20,1.5)*2-1, runif(J)) \\ } \section{Exponential Smoothing} \label{exp.smo} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_t = \alpha \textbf{y}_{t-1} + (1 - \alpha) \mu_{t-1}, \quad t=2,\dots,T$$ $$\alpha \sim \mathcal{U}(0,1)$$ $$\sigma \sim \mathcal{HC}$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ mon.names <- "LP" \\ parm.names <- c("alpha","sigma") \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[1] <- alpha <- interval(parm[1], 0, 1) \\ \hspace*{0.27 in} parm[2] <- sigma <- interval(parm[2], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dunif(alpha, 0, 1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- y \\ \hspace*{0.27 in} mu[-1] <- alpha*Data$y[-1] \\ \hspace*{0.27 in} mu[-1] <- mu[-1] + (1 - alpha) * mu[-Data$T] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], mu[-Data$T], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0.5, 1)} \section{Factor Analysis, Approximate Dynamic} \label{adfa} The Approximate Dynamic Factor Analysis (ADFA) model has many names, including the approximate factor model and approximate dynamic factor model. An ADFA is a Dynamic Factor Analysis (DFA) in which the factor scores of the dynamic factors are approximated with principal components. This is a combination of principal components and common factor analysis, in which the factor loadings of common factors are estimated from the data and factor scores are estimated from principal components. This is a two-stage model: principal components are estimated in the first stage and a decision is made regarding how many principal components to retain, and ADFA is estimated in the second stage. For more information on DFA, see section \ref{dsfm}. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=2,\dots,T, \quad j=1,\dots,J$$ $$\mu_{t,} = \textbf{F}_{t-1,} \Lambda$$ $$\Lambda_{p,j} \sim \mathcal{N}(0, 1), \quad p=1,\dots,P, \quad j=1,\dots,J$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,J$$ \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \#Number of time-periods \\ J <- ncol(Y) \#Number of time-series \\ P <- 7 \#Number of approximate factors \\ PCA <- prcomp(Y, scale=TRUE) \\ F <- PCA$x[,1:P] \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(Lambda=matrix(0,P,J), sigma=rep(0,J))) \\ pos.Lambda <- grep("Lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} Lambda <- rnorm(Data$P*Data$J) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(Lambda, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(F=F, J=J, P=P, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.Lambda=pos.Lambda, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} Lambda <- matrix(parm[Data$pos.Lambda], Data$P, Data$J) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} Lambda.prior <- sum(dnorm(Lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(rbind(rep(0,Data$P), F[-Data$T,]), t(Lambda)) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[-1,], mu[-1,], Sigma[-1,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + Lambda.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,P*J), rep(1,J))} \section{Factor Analysis, Confirmatory} \label{cfa} Factor scores are in matrix \textbf{F}, factor loadings for each variable are in vector $\lambda$, and $\textbf{f}$ is a vector that indicates which variable loads on which factor. \subsection{Form} $$\textbf{Y}_{i,m} \sim \mathcal{N}(\mu_{i,m}, \sigma^2_m), \quad i=1,\dots,N, \quad m=1,\dots,M$$ $$\mu = \textbf{F}_{1:N,\textbf{f}} \lambda^T$$ $$\textbf{F}_{i,1:P} \sim \mathcal{N}_P(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\lambda_m \sim \mathcal{N}(0, 1), \quad m=1,\dots,M$$ $$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$ $$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_P$$ \subsection{Data} \code{data(swiss) \\ Y <- cbind(swiss$Agriculture, swiss$Examination, swiss$Education, \\ \hspace*{0.27 in} swiss$Catholic, swiss$Infant.Mortality) \\ M <- ncol(Y) \#Number of variables \\ N <- nrow(Y) \#Number of records \\ P <- 3 \#Number of factors \\ f <- c(1,3,2,2,1) \#Indicator f for the factor for each variable m \\ for (m in 1:M) Y[,m] <- CenterScale(Y[,m]) \\ S <- diag(P) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(F=matrix(0,N,P), lambda=rep(0,M), \\ \hspace*{0.27 in} U=diag(P), sigma=rep(0,M)), uppertri=c(0,0,1,0)) \\ pos.F <- grep("F", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} U <- rwishartc(Data$N, Data$S) \\ \hspace*{0.27 in} F <- as.vector(rmvnpc(Data$N, rep(0,Data$P), U)) \\ \hspace*{0.27 in} U <- U[upper.tri(U, diag=TRUE)] \\ \hspace*{0.27 in} lambda <- rnorm(Data$M) \\ \hspace*{0.27 in} sigma <- runif(Data$M) \\ \hspace*{0.27 in} return(c(F, lambda, U, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(M=M, N=N, P=P, PGF=PGF, S=S, Y=Y, f=f, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.F=pos.F, pos.lambda=pos.lambda, \\ \hspace*{0.27 in} pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} lambda <- parm[Data$pos.lambda] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$N, Data$P) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$P, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$N, Data$S, log=TRUE) \\ \hspace*{0.27 in} F.prior <- sum(dmvnpc(F, rep(0,Data$P), U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- F[,Data$f] * matrix(lambda, Data$N, Data$M, byrow=TRUE) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$N, Data$M, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + lambda.prior + sigma.prior + F.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N*P), rep(0,M), upper.triangle(S, diag=TRUE), \\ \hspace*{0.27 in} rep(1,M))} \section{Factor Analysis, Exploratory} \label{efa} Factor scores are in matrix \textbf{F} and factor loadings are in matrix $\Lambda$. \subsection{Form} $$\textbf{Y}_{i,m} \sim \mathcal{N}(\mu_{i,m}, \sigma^2_m), \quad i=1,\dots,N, \quad m=1,\dots,M$$ $$\mu = \textbf{F} \Lambda$$ $$\textbf{F}_{i,1:P} \sim \mathcal{N}_P(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\Lambda_{p,m} \sim \mathcal{N}(0, 1), \quad p=1,\dots,P, \quad m=(p+1),\dots,M$$ $$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_P$$ $$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$ \subsection{Data} \code{data(USJudgeRatings) \\ Y <- as.matrix(USJudgeRatings) \\ for (m in 1:M) Y[,m] <- CenterScale(Y[,m]) \\ M <- ncol(Y) \#Number of variables \\ N <- nrow(Y) \#Number of records \\ P <- 3 \#Number of factors \\ Lambda <- matrix(NA, P, M) \\ Lambda[upper.tri(Lambda)] <- 0 \\ S <- diag(P) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(F=matrix(0,N,P), Lambda=Lambda, U=S, \\ \hspace*{0.27 in} sigma=rep(0,M)), uppertri=c(0,0,1,0)) \\ pos.F <- grep("F", parm.names) \\ pos.Lambda <- grep("Lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} U <- rwishartc(Data$N, Data$S) \\ \hspace*{0.27 in} F <- as.vector(rmvnpc(Data$N, rep(0,Data$P), U)) \\ \hspace*{0.27 in} Lambda <- rnorm(Data$P*Data$M-Data$P-Data$P*(Data$P-1)/2,0,1) \\ \hspace*{0.27 in} sigma <- runif(Data$M) \\ \hspace*{0.27 in} return(c(F, Lambda, U[upper.tri(U, diag=TRUE)], sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(M=M, N=N, P=P, PGF=PGF, S=S, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.F=pos.F, pos.Lambda=pos.Lambda, \\ \hspace*{0.27 in} pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$N, Data$P) \\ \hspace*{0.27 in} lambda <- parm[Data$pos.Lambda] \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$P, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} F.prior <- sum(dmvnpc(F, rep(0,Data$P), U, log=TRUE)) \\ \hspace*{0.27 in} Lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$N, Data$S, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Lambda <- matrix(1, Data$P, Data$M) \\ \hspace*{0.27 in} Lambda[lower.tri(Lambda)] <- 0 \\ \hspace*{0.27 in} Lambda[upper.tri(Lambda)] <- lambda \\ \hspace*{0.62 in} mu <- tcrossprod(F, t(Lambda)) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$N, Data$M, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + F.prior + Lambda.prior + U.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.27 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N*P), rep(0,P*M-P-P*(P-1)/2), rep(0,P*(P-1)/2+P), \\ \hspace*{0.27 in} rep(1,M))} \section{Factor Analysis, Exploratory Ordinal} \label{eofa} This exploratory ordinal factor analysis (EOFA) model form is also suitable for collaborative filtering. \subsection{Form} $$\textbf{Y}_{i,m} \sim \mathcal{CAT}(\textbf{P}_{i,m,1:K}), \quad i=1,\dots,N, \quad m=1,\dots,M$$ $$\textbf{P}_{,,K} = 1 - Q_{,,(K-1)}$$ $$\textbf{P}_{,,k} = |Q_{,,k} - Q_{,,(k-1)}|, \quad k=2,\dots,(K-1)$$ $$\textbf{P}_{,,1} = Q_{,,1}$$ $$Q = \phi(\mu)$$ $$\mu_{,,k} = \alpha_k - \textbf{F} \Lambda, \quad k=1,\dots,(K-1)$$ $$\textbf{F}_{i,1:P} \sim \mathcal{N}_P(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\gamma_p = 0, \quad p=1,\dots,P$$ $$\Lambda_{p,m} \sim \mathcal{N}(0, 1), \quad p=1,\dots,P, \quad m=(p+1),\dots,M$$ $$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_P$$ $$\alpha_k \sim \mathcal{N}(0, 1) \in [(k-1),k] \in [-5,5], \quad k=2,\dots,(K-1)$$ \subsection{Data} \code{M <- 10 \#Number of variables \\ N <- 20 \#Number of records \\ K <- 3 \#Number of discrete values \\ P <- 3 \#Number of factors \\ alpha <- sort(rnorm(K-1)) \\ Lambda <- matrix(1, P, M) \\ Lambda[lower.tri(Lambda)] <- 0 \\ Lambda[upper.tri(Lambda)] <- rnorm(P*M-P-P*(P-1)/2) \\ Omega <- runif(P) \\ F <- rmvnp(N, rep(0,P), Omega) \\ mu <- aperm(array(alpha, dim=c(K-1, M, N)), perm=c(3,2,1)) \\ mu <- mu - array(tcrossprod(F, t(Lambda)), dim=c(N, M, K-1)) \\ Pr <- Q <- pnorm(mu) \\ Pr[ , , -1] <- abs(Q[ , , -1] - Q[ , , -(K-1)]) \\ Pr <- array(Pr, dim=c(N, M, K)) \\ Pr[ , , K] <- 1 - Q[ , , (K-1)] \\ dim(Pr) <- c(N*M, K) \\ Y <- matrix(rcat(nrow(Pr), Pr), N, M) \#Make sure Y has all values \\ S <- diag(P) \\ Lambda <- matrix(0, P, M) \\ Lambda[lower.tri(Lambda, diag=TRUE)] <- NA \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(F=matrix(0,N,P), Omega=rep(0,P), \\ \hspace*{0.27 in} Lambda=Lambda, alpha=rep(0,K-1))) \\ pos.F <- grep("F", parm.names) \\ pos.Omega <- grep("Omega", parm.names) \\ pos.Lambda <- grep("Lambda", parm.names) \\ pos.alpha <- grep("alpha", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} Omega <- runif(Data$P) \\ \hspace*{0.27 in} F <- as.vector(rmvnp(Data$N, rep(0,Data$P), diag(Omega))) \\ \hspace*{0.27 in} Lambda <- rnorm(Data$P*Data$M-Data$P-Data$P*(Data$P-1)/2) \\ \hspace*{0.27 in} alpha <- sort(rnorm(Data$K-1)) \\ \hspace*{0.27 in} return(c(F, Omega, Lambda, alpha)) \\ \hspace*{0.27 in} \} \\ MyData <- list(K=K, M=M, N=N, P=P, PGF=PGF, S=S, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.F=pos.F, \\ \hspace*{0.27 in} pos.Omega=pos.Omega, pos.Lambda=pos.Lambda, pos.alpha=pos.alpha) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$N, Data$P) \\ \hspace*{0.27 in} Omega <- interval(parm[Data$pos.Omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.Omega] <- Omega \\ \hspace*{0.27 in} lambda <- parm[Data$pos.Lambda] \\ \hspace*{0.27 in} alpha <- sort(interval(parm[Data$pos.alpha], -5, 5)) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} F.prior <- sum(dmvnp(F, rep(0,Data$P), diag(Omega), log=TRUE)) \\ \hspace*{0.27 in} Omega.prior <- dwishart(diag(Omega), Data$N, Data$S, log=TRUE) \\ \hspace*{0.27 in} Lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Lambda <- matrix(1, Data$P, Data$M) \\ \hspace*{0.27 in} Lambda[lower.tri(Lambda)] <- 0 \\ \hspace*{0.27 in} Lambda[upper.tri(Lambda)] <- lambda \\ \hspace*{0.27 in} mu <- aperm(array(alpha, dim=c(Data$K-1, Data$M, Data$N)), \\ \hspace*{0.62 in} perm=c(3,2,1)) \\ \hspace*{0.27 in} mu <- mu - array(tcrossprod(F, t(Lambda)), \\ \hspace*{0.62 in} dim=c(Data$N, Data$M, Data$K-1)) \\ \hspace*{0.27 in} P <- Q <- pnorm(mu) \\ \hspace*{0.27 in} P[ , , -1] <- abs(Q[ , , -1] - Q[ , , -(Data$K-1)]) \\ \hspace*{0.27 in} P <- array(P, dim=c(Data$N, Data$M, Data$K)) \\ \hspace*{0.27 in} P[ , , Data$K] <- 1 - Q[ , , (Data$K-1)] \\ \hspace*{0.27 in} y <- as.vector(Data$Y) \\ \hspace*{0.27 in} dim(P) <- c(Data$N*Data$M, Data$K) \\ \hspace*{0.27 in} LL <- sum(dcat(y, P, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + F.prior + Omega.prior + Lambda.prior + alpha.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=matrix(rcat(nrow(P), P), Data$N, Data$M), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N*P), rep(0,P), rep(0,P*M-P-P*(P-1)/2), \\ \hspace*{0.27 in} seq(from=-1, to=1, len=K-1)) } \section{Factor Regression} \label{factor.reg} This example of factor regression is constrained to the case where the number of factors is equal to the number of independent variables (IVs) less the intercept. The purpose of this form of factor regression is to orthogonalize the IVs with respect to $\textbf{y}$, rather than variable reduction. This method is the combination of confirmatory factor analysis in section \ref{cfa} and linear regression in section \ref{linear.reg}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\nu, \sigma^2_{J+1})$$ $$\nu = \textbf{F} \beta$$ $$\mu_{i,1} = 1$$ $$\mu_{i,j+1} = \mu_{i,j}, \quad j=1,\dots,J$$ $$\textbf{X}_{i,j} \sim \mathcal{N}(\mu_{i,j}, \sigma^2_j), \quad i=1,\dots,N, \quad j=2,\dots,J$$ $$\mu_{i,j} = \lambda_j \textbf{F}_{i,j}, \quad i=1,\dots,N, \quad j=2,\dots,J$$ $$\textbf{F}_{i,1:J} \sim \mathcal{N}_{J-1}(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\lambda_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,(J-1)$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,(J+1)$$ $$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- as.matrix(log(demonsnacks[,c(1,4,10)]+1)) \\ J <- ncol(X) \\ for (j in 1:J) X[,j] <- CenterScale(X[,j]) \\ S <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J+1), lambda=rep(0,J), \\ \hspace*{0.27 in} sigma=rep(0,J+1), F=matrix(0,N,J), Omega=rep(0,J))) \\ pos.beta <- grep("beta", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.F <- grep("F", parm.names) \\ pos.Omega <- grep("Omega", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J+1) \\ \hspace*{0.27 in} lambda <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(Data$J+1) \\ \hspace*{0.27 in} Omega <- runif(Data$J) \\ \hspace*{0.27 in} F <- as.vector(rmvnp(Data$N, rep(0,Data$J), diag(Omega))) \\ \hspace*{0.27 in} return(c(beta, lambda, sigma, F, Omega)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, S=S, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.lambda=pos.lambda, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, pos.F=pos.F, pos.Omega=pos.Omega, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} lambda <- parm[Data$pos.lambda] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} F <- matrix(Data$pos.F], Data$N, Data$J) \\ \hspace*{0.27 in} Omega <- interval(parm[Data$pos.Omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.Omega] <- Omega \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} F.prior <- sum(dmvnp(F, rep(0,Data$J), diag(Omega), log=TRUE)) \\ \hspace*{0.27 in} Omega.prior <- dwishart(diag(Omega), Data$N, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- F * matrix(lambda, Data$N, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} nu <- tcrossprod(cbind(1,F), t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$X, mu, matrix(sigma[1:Data$J], Data$N, Data$J, \\ \hspace*{0.62 in} byrow=TRUE), log=TRUE)) \\ \hspace*{0.27 in} LL <- LL + dnorm(Data$y, nu, sigma[Data$J+1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + lambda.prior + sigma.prior + F.prior \\ \hspace*{0.62 in} Omega.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(Data$N, nu, sigma[Data$J+1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J+1), rep(0,J), rep(0,J+1), rep(0,N*J), rep(1,J))} \section{Gamma Regression} \label{gamma.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{G}(\lambda \tau, \tau)$$ $$\lambda = \exp(\textbf{X} \beta)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\tau \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 20 \\ J <- 3 \\ X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \\ beta <- runif(J,-2,2) \\ y <- round(exp(tcrossprod(X, t(beta)))) + 0.1 \#Must be > 0 \\ mon.names <- c("LP","sigma2") \\ parm.names <- as.parm.names(list(beta=rep(0,J), tau=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} return(c(beta, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.tau=pos.tau, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau \\ \hspace*{0.27 in} sigma2 <- 1/tau \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(tcrossprod(Data$X, t(beta))) \\ \hspace*{0.27 in} LL <- sum(dgamma(Data$y, tau*lambda, tau, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,sigma2), \\ \hspace*{0.62 in} yhat=rgamma(nrow(lambda), tau*lambda, tau), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Geographically Weighted Regression} \label{gwr} \subsection{Form} $$\textbf{y}_{i,k} \sim \mathcal{N}(\mu_{i,k}, \tau^{-1}_{i,k}), \quad i=1,\dots,N, \quad k=1,\dots,N$$ $$\mu_{i,1:N} = \textbf{X} \beta_{i,1:J}$$ $$\tau = \frac{1}{\sigma^2} \textbf{w} \nu$$ $$\textbf{w} = \frac{\exp(-0.5 \textbf{Z}^2)}{\textbf{h}}$$ $$\alpha \sim \mathcal{U}(1.5, 100)$$ $$\beta_{i,j} \sim \mathcal{N}(0, 1000), \quad i=1,\dots,N, \quad j=1,\dots,J$$ $$\textbf{h} \sim \mathcal{N}(0.1, 1000) \in [0.1, \infty]$$ $$\nu_{i,k} \sim \mathcal{G}(\alpha, 2), \quad i=1,\dots,N, \quad k=1,\dots,N$$ $$\sigma_i \sim \mathcal{HC}(25), \quad i=1,\dots,N$$ \subsection{Data} \code{crime <- c(18.802, 32.388, 38.426, 0.178, 15.726, 30.627, 50.732, \\ \hspace*{0.27 in} 26.067, 48.585, 34.001, 36.869, 20.049, 19.146, 18.905, 27.823, \\ \hspace*{0.27 in} 16.241, 0.224, 30.516, 33.705, 40.970, 52.794, 41.968, 39.175, \\ \hspace*{0.27 in} 53.711, 25.962, 22.541, 26.645, 29.028, 36.664, 42.445, 56.920, \\ \hspace*{0.27 in} 61.299, 60.750, 68.892, 38.298, 54.839, 56.706, 62.275, 46.716, \\ \hspace*{0.27 in} 57.066, 54.522, 43.962, 40.074, 23.974, 17.677, 14.306, 19.101, \\ \hspace*{0.27 in} 16.531, 16.492) \\ income <- c(21.232, 4.477, 11.337, 8.438, 19.531, 15.956, 11.252, \\ \hspace*{0.27 in} 16.029, 9.873, 13.598, 9.798, 21.155, 18.942, 22.207, 18.950, \\ \hspace*{0.27 in} 29.833, 31.070, 17.586, 11.709, 8.085, 10.822, 9.918, 12.814, \\ \hspace*{0.27 in} 11.107, 16.961, 18.796, 11.813, 14.135, 13.380, 17.017, 7.856, \\ \hspace*{0.27 in} 8.461, 8.681, 13.906, 14.236, 7.625, 10.048, 7.467, 9.549, \\ \hspace*{0.27 in} 9.963, 11.618, 13.185, 10.655, 14.948, 16.940, 18.739, 18.477, \\ \hspace*{0.27 in} 18.324, 25.873) \\ housing <- c(44.567, 33.200, 37.125, 75.000, 80.467, 26.350, 23.225, \\ \hspace*{0.27 in} 28.750, 18.000, 96.400, 41.750, 47.733, 40.300, 42.100, 42.500, \\ \hspace*{0.27 in} 61.950, 81.267, 52.600, 30.450, 20.300, 34.100, 23.600, 27.000, \\ \hspace*{0.27 in} 22.700, 33.500, 35.800, 26.800, 27.733, 25.700, 43.300, 22.850, \\ \hspace*{0.27 in} 17.900, 32.500, 22.500, 53.200, 18.800, 19.900, 19.700, 41.700, \\ \hspace*{0.27 in} 42.900, 30.600, 60.000, 19.975, 28.450, 31.800, 36.300, 39.600, \\ \hspace*{0.27 in} 76.100, 44.333) \\ easting <- c(35.62, 36.50, 36.71, 33.36, 38.80, 39.82, 40.01, 43.75, \\ \hspace*{0.27 in} 39.61, 47.61, 48.58, 49.61, 50.11, 51.24, 50.89, 48.44, 46.73, \\ \hspace*{0.27 in} 43.44, 43.37, 41.13, 43.95, 44.10, 43.70, 41.04, 43.23, 42.67, \\ \hspace*{0.27 in} 41.21, 39.32, 41.09, 38.3, 41.31, 39.36, 39.72, 38.29, 36.60, \\ \hspace*{0.27 in} 37.60, 37.13, 37.85, 35.95, 35.72, 35.76, 36.15, 34.08, 30.32, \\ \hspace*{0.27 in} 27.94, 27.27, 24.25, 25.47, 29.02) \\ northing <- c(42.38, 40.52, 38.71, 38.41, 44.07, 41.18, 38.00, 39.28, \\ \hspace*{0.27 in} 34.91, 36.42, 34.46, 32.65, 29.91, 27.80, 25.24, 27.93, 31.91, \\ \hspace*{0.27 in} 35.92, 33.46, 33.14, 31.61, 30.40, 29.18, 28.78, 27.31, 24.96, \\ \hspace*{0.27 in} 25.90, 25.85, 27.49, 28.82, 30.90, 32.88, 30.64, 30.35, 32.09, \\ \hspace*{0.27 in} 34.08, 36.12, 36.30, 36.40, 35.60, 34.66, 33.92, 30.42, 28.26, \\ \hspace*{0.27 in} 29.85, 28.21, 26.69, 25.71, 26.58) \\ N <- length(crime) \\ J <- 3 \#Number of predictors, including the intercept \\ X <- matrix(c(rep(1,N), income, housing),N,J) \\ D <- as.matrix(dist(cbind(northing,easting), diag=TRUE, upper=TRUE)) \\ Z <- D / sd(as.vector(D)) \\ y <- matrix(0,N,N); for (i in 1:N) \{for (k in 1:N) \{y[i,k] <- crime[k]\}\} \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, beta=matrix(0,N,J), H=0, \\ \hspace*{0.27 in} nu=matrix(0,N,N), sigma=rep(0,N))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.H <- grep("H", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- runif(1,1.5,100) \\ \hspace*{0.27 in} beta <- rnorm(Data$N*Data$J) \\ \hspace*{0.27 in} H <- runif(1,0.1,1000) \\ \hspace*{0.27 in} nu <- rgamma(Data$N*Data$N,alpha,2) \\ \hspace*{0.27 in} sigma <- runif(Data$N) \\ \hspace*{0.27 in} return(c(alpha, beta, H, nu, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, X=X, Z=Z, latitude=northing, \\ \hspace*{0.27 in} longitude=easting, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.H=pos.H, pos.nu=pos.nu, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], 1.5, 100) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$N, Data$J) \\ \hspace*{0.27 in} parm[Data$pos.H] <- H <- interval(parm[Data$pos.H], 0.1, Inf) \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} nu <- matrix(nu, Data$N, Data$N) \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dunif(alpha, 1.5, 100, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} h.prior <- dhalfnorm(H-0.1, 1000, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- sum(dgamma(nu, alpha, 2, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} w <- exp(-0.5 * Data$Z\textasciicircum 2) / H \\ \hspace*{0.27 in} tau <- (1/sigma\textasciicircum 2) * w * nu \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} LL <- sum(dnormp(Data$y, mu, tau, log=TRUE)) \\ \hspace*{0.27 in} \#WSE <- w * nu * (Data$y - mu)\textasciicircum 2; w.y <- w * nu * Data$y \\ \hspace*{0.27 in} \#WMSE <- rowMeans(WSE); y.w <- rowSums(w.y) / rowSums(w) \\ \hspace*{0.27 in} \#LAR2 <- 1 - WMSE / sd(y.w)\textasciicircum 2 \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + h.prior + nu.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormp(prod(dim(mu)), mu, tau), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(runif(1,1.5,100), rep(0,N*J), 1, rep(1,N*N), rep(1,N))} \section{Hidden Markov Model} \label{hmm} \subsection{Form} This introductory hidden Markov model (HMM) includes $N$ discrete states. $$\textbf{y}_t \sim \mathcal{N}(\mu_\theta, \sigma^2_\theta), \quad t=1,\dots,T$$ $$\mu \sim \mathcal{N}(\mu_0, \sigma^2)$$ $$\sigma^2 \sim \mathcal{HC}(25)$$ $$\theta_t \sim \mathcal{CAT}(\phi_{\theta_{t-1},1:N}), \quad t=1,\dots,T$$ $$\phi_{i,1:N} \sim \mathcal{D}(\alpha_{1:N}), \quad i=1,\dots,N$$ $$\mu_0 \sim \mathcal{N}(0, 1000)$$ $$\sigma^2_0 \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(log(as.matrix(demonfx[1:50,1]))) \\ T <- length(y) \#Number of time-periods \\ N <- 2 \#Number of discrete (hidden) states \\ alpha <- matrix(1,N,N) \#Concentration hyperparameter \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(mu0=rep(0,N), mu1=rep(0,N), \\ \hspace*{0.27 in} phi=matrix(0,N,N), sigma2=rep(0,N), theta=rep(0,T))) \\ pos.mu0 <- grep("mu0", parm.names) \\ pos.mu1 <- grep("mu1", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma2 <- grep("sigma2", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} mu0 <- sort(runif(Data$N, min(Data$y), max(Data$y))) \\ \hspace*{0.27 in} mu1 <- sort(runif(Data$N, min(Data$y), max(Data$y))) \\ \hspace*{0.27 in} phi <- matrix(runif(Data$N*Data$N), Data$N, Data$N) \\ \hspace*{0.27 in} phi <- as.vector(phi / rowSums(phi)) \\ \hspace*{0.27 in} sigma2 <- runif(Data$N) \\ \hspace*{0.27 in} theta <- rcat(Data$T, rep(1/Data$N,Data$N)) \\ \hspace*{0.27 in} return(c(mu0, mu1, phi, sigma2, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, T=T, alpha=alpha, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.mu0=pos.mu0, pos.mu1=pos.mu1, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.sigma2=pos.sigma2, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} mu0 <- interval(parm[Data$pos.mu0], min(Data$y), max(Data$y)) \\ \hspace*{0.27 in} parm[Data$pos.mu0] <- mu0 \\ \hspace*{0.27 in} mu <- interval(parm[Data$pos.mu1], min(Data$y), max(Data$y)) \\ \hspace*{0.27 in} parm[Data$pos.mu1] <- mu <- sort(mu) \\ \hspace*{0.27 in} phi <- matrix(abs(parm[Data$pos.phi]), Data$N, Data$N) \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- phi / rowSums(phi) \\ \hspace*{0.27 in} sigma2 <- interval(parm[Data$pos.sigma2], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma2] <- sigma2 \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} mu0.prior <- sum(dnormv(mu0, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} mu.prior <- sum(dnormv(mu, mu0, sigma2, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- 0 \\ \hspace*{0.27 in} for (i in 1:Data$N) \\ \hspace*{0.62 in} phi.prior <- phi.prior + sum(ddirichlet(phi[i,], Data$alpha[i,], \\ \hspace*{0.95 in} log=TRUE)) \\ \hspace*{0.27 in} sigma2.prior <- sum(dhalfcauchy(sigma2, 25, log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, rbind(rep(1/Data$N,Data$N), \\ \hspace*{0.62 in} phi[theta[-Data$T],]), log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y, mu[theta], sigma2[theta], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + mu0.prior + mu.prior + phi.prior + sigma2.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(theta), mu[theta], sigma2[theta]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(sort(runif(N, min(y), max(y))), \\ \hspace*{0.27 in} sort(runif(N, min(y), max(y))), runif(N*N), runif(N), \\ \hspace*{0.27 in} rcat(T, rep(1/N,N)))} \section{Inverse Gaussian Regression} \label{ig.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{N}^{-1}(\mu, \lambda)$$ $$\mu = \exp(\textbf{X}\beta) + C$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\lambda \sim \mathcal{HC}(25)$$ where $C$ is a small constant, such as 1.0E-10. \subsection{Data} \code{N <- 100 \\ J <- 3 \#Number of predictors, including the intercept \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta.orig <- runif(J,-3,3) \\ e <- rnorm(N,0,0.1) \\ y <- exp(tcrossprod(X, t(beta.orig)) + e) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), lambda=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} lambda <- runif(1) \\ \hspace*{0.27 in} return(c(beta, lambda)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.lambda=pos.lambda, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} lambda.prior <- dhalfcauchy(lambda, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- exp(tcrossprod(Data$X, t(beta))) + 1.0E-10 \\ \hspace*{0.27 in} LL <- sum(dinvgaussian(Data$y, mu, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + lambda.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rinvgaussian(length(mu), mu, lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Kriging} \label{kriging} This is an example of universal kriging of $\textbf{y}$ given $\textbf{X}$, regression effects $\beta$, and spatial effects $\zeta$. Euclidean distance between spatial coordinates (longitude and latitude) is used for each of $i=1,\dots,N$ records of $\textbf{y}$. An additional record is created from the same data-generating process to compare the accuracy of interpolation. For the spatial component, $\phi$ is the rate of spatial decay and $\kappa$ is the scale. $\kappa$ is often difficult to identify, so it is set to 1 (Gaussian), but may be allowed to vary up to 2 (Exponential). In practice, $\phi$ is also often difficult to identify. While $\Sigma$ is spatial covariance, spatial correlation is $\rho = \exp(-\phi \textbf{D})$. To extend this to a large data set, consider the predictive process kriging example in section \ref{kriging.pp}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$ \mu = \textbf{X} \beta + \zeta$$ $$ \textbf{y}^{new} = \textbf{X} \beta + \sum^N_{i=1} \left ( \frac{\rho_i}{\sum \rho} \zeta_i \right )$$ $$ \rho = \exp(-\phi \textbf{D}^{new})^\kappa$$ $$ \zeta \sim \mathcal{N}_N(\zeta_\mu, \Sigma)$$ $$ \Sigma = \sigma^2_2 \exp(-\phi \textbf{D})^\kappa$$ $$ \beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,2$$ $$ \sigma_j \sim \mathcal{HC}(25) \in [0.1,10], \quad j=1,\dots,2$$ $$ \phi \sim \mathcal{U}(1, 5)$$ $$ \zeta_\mu = 0$$ $$ \kappa = 1$$ \subsection{Data} \code{N <- 20 \\ longitude <- runif(N+1,0,100) \\ latitude <- runif(N+1,0,100) \\ D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ Sigma <- 10000 * exp(-1.5 * D) \\ zeta <- colMeans(rmvn(1000, rep(0,N+1), Sigma)) \\ beta <- c(50,2) \\ X <- matrix(runif((N+1)*2,-2,2),(N+1),2); X[,1] <- 1 \\ mu <- as.vector(tcrossprod(X, t(beta))) \\ y <- mu + zeta \\ longitude.new <- longitude[N+1]; latitude.new <- latitude[N+1] \\ Xnew <- X[N+1,]; ynew <- y[N+1] \\ longitude <- longitude[1:N]; latitude <- latitude[1:N] \\ X <- X[1:N,]; y <- y[1:N] \\ D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ D.new <- sqrt((longitude - longitude.new)\textasciicircum 2 + (latitude - latitude.new)\textasciicircum 2) \\ mon.names <- c("LP","ynew") \\ parm.names <- as.parm.names(list(zeta=rep(0,N), beta=rep(0,2), \\ \hspace*{0.27 in} sigma=rep(0,2), phi=0)) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(2) \\ \hspace*{0.27 in} sigma <- runif(2,0.1,10) \\ \hspace*{0.27 in} phi <- runif(1,1,5) \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} zeta <- rmvn(1, rep(0,Data$N), \\ \hspace*{0.62 in} sigma[2]*sigma[2]*exp(-phi*Data$D)\textasciicircum kappa) \\ \hspace*{0.27 in} return(c(zeta, beta, sigma, phi)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, D.new=D.new, latitude=latitude, longitude=longitude, \\ \hspace*{0.27 in} N=N, PGF=PGF, X=X, Xnew=Xnew, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.zeta=pos.zeta, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, pos.phi=pos.phi, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 0.1, 10) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\ \hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-phi * Data$D)\textasciicircum kappa \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.prior <- dmvn(zeta, rep(0, Data$N), Sigma, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma - 1, 25, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dunif(phi, 1, 5, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Interpolation \\ \hspace*{0.27 in} rho <- exp(-phi * Data$D.new)\textasciicircum kappa \\ \hspace*{0.27 in} ynew <- rnorm(1, sum(beta * Data$Xnew) + sum(rho / sum(rho) * zeta), \\ \hspace*{0.62 in} sigma[1]) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) + zeta \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + sigma.prior + phi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,ynew), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N), rep(0,2), rep(1,2), 1)} \section{Kriging, Predictive Process} \label{kriging.pp} The first $K$ of $N$ records in $\textbf{y}$ are used as knots for the parent process, and the predictive process involves records $(K+1),\dots,N$. For more information on kriging, see section \ref{kriging}. \subsection{Form} $$ \textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$ \mu_{1:K} = \textbf{X}_{1:K,1:J} \beta + \zeta$$ $$ \mu_{(K+1):N} = \textbf{X}_{(K+1):N,1:J} \beta + \sum^{N-K}_{p=1} \frac{\lambda_{p,1:K}}{\sum^{N-K}_{q=1} \lambda_{q,1:K}} \zeta^T$$ $$ \lambda = \exp(-\phi \textbf{D}_P)^\kappa$$ $$ \textbf{y}^{new} = \textbf{X} \beta + \sum^K_{k=1} (\frac{\rho_k}{\sum \rho} \zeta_k)$$ $$ \rho = \exp(-\phi \textbf{D}^{new})^\kappa$$ $$ \zeta \sim \mathcal{N}_K(0, \Sigma)$$ $$ \Sigma = \sigma^2_2 \exp(-\phi \textbf{D})^\kappa$$ $$ \beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,2$$ $$ \sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$ $$ \phi \sim \mathrm{N}(0, 1000) \in [1, 5]$$ $$ \kappa = 1$$ \subsection{Data} \code{N <- 100 \\ K <- 30 \#Number of knots \\ longitude <- runif(N+1,0,100) \\ latitude <- runif(N+1,0,100) \\ D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ Sigma <- 10000 * exp(-1.5 * D) \\ zeta <- colMeans(rmvn(1000, rep(0,N+1), Sigma)) \\ beta <- c(50,2) \\ X <- matrix(runif((N+1)*2,-2,2),(N+1),2); X[,1] <- 1 \\ mu <- as.vector(tcrossprod(X, t(beta))) \\ y <- mu + zeta \\ longitude.new <- longitude[N+1]; latitude.new <- latitude[N+1] \\ Xnew <- X[N+1,]; ynew <- y[N+1] \\ longitude <- longitude[1:N]; latitude <- latitude[1:N] \\ X <- X[1:N,]; y <- y[1:N] \\ D <- as.matrix(dist(cbind(longitude[1:K],latitude[1:K]), diag=TRUE, \\ \hspace*{0.27 in} upper=TRUE)) \\ D.P <- matrix(0, N-K, K) \\ for (i in (K+1):N) \{ \\ \hspace*{0.27 in} D.P[K+1-i,] <- sqrt((longitude[1:K] - longitude[i])\textasciicircum 2 + \\ \hspace*{0.62 in} (latitude[1:K] - latitude[i])\textasciicircum 2)\} \\ D.new <- sqrt((longitude[1:K] - longitude.new)\textasciicircum 2 + \\ \hspace*{0.27 in} (latitude[1:K] - latitude.new)\textasciicircum 2) \\ mon.names <- c("LP","ynew") \\ parm.names <- as.parm.names(list(zeta=rep(0,K), beta=rep(0,2), \\ \hspace*{0.27 in} sigma=rep(0,2), phi=0)) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(2) \\ \hspace*{0.27 in} sigma <- runif(2,0.1,10) \\ \hspace*{0.27 in} phi <- runif(1,1,5) \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} zeta <- rmvn(1, rep(0,Data$K), \\ \hspace*{0.62 in} sigma[2]*sigma[2]*exp(-phi*Data$D)\textasciicircum kappa) \\ \hspace*{0.27 in} return(c(zeta, beta, sigma, phi)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, D.new=D.new, D.P=D.P, K=K, N=N, PGF=PGF, X=X, \\ \hspace*{0.27 in} Xnew=Xnew, latitude=latitude, longitude=longitude, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.zeta=pos.zeta, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.sigma=pos.sigma, pos.phi=pos.phi, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\ \hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-phi * Data$D)\textasciicircum kappa \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.prior <- dmvn(zeta, rep(0, Data$K), Sigma, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma - 1, 25, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dunif(phi, 1, 5, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Interpolation \\ \hspace*{0.27 in} rho <- exp(-phi * Data$D.new)\textasciicircum kappa \\ \hspace*{0.27 in} ynew <- rnorm(1, sum(beta * Data$Xnew) + sum(rho / sum(rho) * zeta), \\ \hspace*{0.62 in} sigma) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} mu[1:Data$K] <- mu[1:Data$K] + zeta \\ \hspace*{0.27 in} lambda <- exp(-phi * Data$D.P)\textasciicircum kappa \\ \hspace*{0.27 in} mu[(Data$K+1):Data$N] <- mu[(Data$K+1):Data$N] + \\ \hspace*{0.62 in} rowSums(lambda / rowSums(lambda) * \\ \hspace*{0.62 in} matrix(zeta, Data$N - Data$K, Data$K, byrow=TRUE)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + sigma.prior + phi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,ynew), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), c(mean(y), 0), rep(1,2), 3)} \section{Laplace Regression} \label{laplace.reg} This linear regression specifies that $\textbf{y}$ is Laplace-distributed, where it is usually Gaussian or normally-distributed. It has been claimed that it should be surprising that the normal distribution became the standard, when the Laplace distribution usually fits better and has wider tails \citep{kotz01}. Another popular alternative is to use the t-distribution (see Robust Regression in section \ref{robust.reg}), though it is more computationally expensive to estimate, because it has three parameters. The Laplace distribution has only two parameters, location and scale like the normal distribution, and is computationally easier to fit. This example could be taken one step further, and the parameter vector $\beta$ could be Laplace-distributed. Laplace's Demon recommends that users experiment with replacing the normal distribution with the Laplace distribution. \subsection{Form} $$\textbf{y} \sim \mathcal{L}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 10000 \\ J <- 5 \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta <- runif(J,-3,3) \\ e <- rlaplace(N,0,0.1) \\ y <- tcrossprod(X, t(beta)) + e \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dlaplace(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rlaplace(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Latent Dirichlet Allocation} \label{lda} \subsection{Form} $$\textbf{Y}_{m,n} \sim \mathcal{CAT}(\phi[\textbf{Z}_{m,n},]), \quad m=1,\dots,M, \quad n=1,\dots,N$$ $$\textbf{Z}_{m,n} \sim \mathcal{CAT}(\theta_{m,1:K})$$ $$\phi_{k,v} \sim \mathcal{D}(\beta)$$ $$\theta_{m,k} \sim \mathcal{D}(\alpha)$$ $$\alpha_k = 1, \quad k=1,\dots,K$$ $$\beta_v = 1, \quad v=1,\dots,V$$ \subsection{Data} \code{K <- 2 \#Number of (latent) topics \\ M <- 4 \#Number of documents in corpus \\ N <- 15 \#Maximum number of (used) words per document \\ V <- 5 \#Maximum number of occurrences of any word (Vocabulary size) \\ Y <- matrix(rcat(M*N,rep(1/V,V)), M, N) \\ rownames(Y) <- paste("doc", 1:nrow(Y), sep="") \\ colnames(Y) <- paste("word", 1:ncol(Y), sep="") \\ \#Note: Y is usually represented as w, a matrix of word counts. \\ if(min(Y) == 0) Y <- Y + 1 \#A zero cannot occur, Y must be 1,2,...,V. \\ V <- max(Y) \#Maximum number of occurrences of any word (Vocabulary size) \\ alpha <- rep(1,K) \# hyperparameters (constant) \\ beta <- rep(1,V) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(phi=matrix(0,K,V), theta=matrix(0,M,K), \\ \hspace*{0.27 in} Z=matrix(0,M,N))) \\ pos.phi <- grep("phi", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ pos.Z <- grep("Z", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} phi <- matrix(runif(Data$J*Data$V), Data$K, Data$V) \\ \hspace*{0.27 in} phi <- phi / rowSums(phi) \\ \hspace*{0.27 in} theta <- matrix(runif(Data$M*Data$K), Data$M, Data$K) \\ \hspace*{0.27 in} theta <- theta / rowSums(theta) \\ \hspace*{0.27 in} z <- rcat(Data$M*Data$N, rep(1/Data$K,Data$K)) \\ \hspace*{0.27 in} return(c(as.vector(phi), as.vector(theta), z))\} \\ MyData <- list(K=K, M=M, N=N, PGF=PGF, V=V, Y=Y, alpha=alpha, beta=beta, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.theta=pos.theta, pos.Z=pos.Z) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} phi <- matrix(interval(parm[Data$pos.phi], 0, 1), Data$K, Data$V) \\ \hspace*{0.27 in} phi <- phi / rowSums(phi) \\ \hspace*{0.27 in} parm[Data$pos.phi] <- as.vector(phi) \\ \hspace*{0.27 in} theta <- matrix(interval(parm[Data$pos.theta], 0, 1), Data$M, Data$K) \\ \hspace*{0.27 in} theta <- theta / rowSums(theta) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- as.vector(theta) \\ \hspace*{0.27 in} Z <- matrix(parm[Data$pos.Z], Data$M, Data$N) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} phi.prior <- sum(ddirichlet(phi, beta, log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- sum(ddirichlet(theta, alpha, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- Z.prior <- 0 \\ \hspace*{0.27 in} Yhat <- Data$Y \\ \hspace*{0.27 in} for (m in 1:Data$M) \{for (n in 1:Data$N) \{ \\ \hspace*{0.62 in} Z.prior + Z.prior + dcat(Z[m,n], theta[m,], log=TRUE) \\ \hspace*{0.62 in} LL <- LL + dcat(Data$Y[m,n], as.vector(phi[Z[m,n],]), log=TRUE) \\ \hspace*{0.62 in} Yhat[m,n] <- rcat(1, as.vector(phi[Z[m,n],]))\}\} \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + phi.prior + theta.prior + Z.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=Yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(1/V,K*V), rep(1/K,M*K), rcat(M*N,rep(1/K,K)))} \section{Linear Regression} \label{linear.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 10000 \\ J <- 5 \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta <- runif(J,-3,3) \\ e <- rnorm(N,0,0.1) \\ y <- tcrossprod(X, t(beta)) + e \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dgamma(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Linear Regression, Frequentist} \label{linear.reg.freq} By eliminating prior probabilities, a frequentist linear regression example is presented. Although frequentism is not endorsed here, the purpose of this example is to illustrate how the \pkg{LaplacesDemon} package can be used for Bayesian or frequentist inference. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ \subsection{Data} \code{N <- 10000 \\ J <- 5 \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta <- runif(J,-3,3) \\ e <- rnorm(N,0,0.1) \\ y <- tcrossprod(X, t(beta)) + e \\ mon.names <- "LL" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma, 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} Modelout <- list(LP=LL, Dev=-2*LL, Monitor=LL, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Linear Regression, Hierarchical Bayesian} \label{linear.reg.hb} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(\gamma, \delta), \quad j=1,\dots,J$$ $$\gamma \sim \mathcal{N}(0, 1000)$$ $$\delta \sim \mathcal{HC}(25)$$ $$\sigma \sim \mathcal{HC}(\tau)$$ $$\tau \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), gamma=0, delta=0, sigma=0, \\ \hspace*{0.27 in} tau=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} gamma <- rnorm(1) \\ \hspace*{0.27 in} delta <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} return(c(beta, gamma, delta, sigma, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} \\ pos.delta=pos.delta, pos.sigma=pos.sigma, pos.tau=pos.tau, y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} gamma.prior <- dnormv(gamma, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} delta.prior <- dhalfcauchy(delta, 25, log=TRUE) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, gamma, delta, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, tau, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + delta.prior + sigma.prior + \\ \hspace*{0.62 in} tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 0, rep(1,3))} \section{Linear Regression, Multilevel} \label{linear.reg.ml} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_i = \textbf{X} \beta_{\textbf{m}[i],1:J}$$ $$\beta_{g,1:J} \sim \mathcal{N}_J(\gamma, \Omega^{-1}), \quad g=1,\dots,G$$ $$\Omega \sim \mathcal{W}_{J+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$ $$\gamma_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ where $\textbf{m}$ is a vector of length $N$, and each element indicates the multilevel group ($g=1,\dots,G$) for the associated record. \subsection{Data} \code{N <- 30 \\ J <- 2 \#\#\# Number of predictors (including intercept) \\ G <- 2 \#\#\# Number of Multilevel Groups \\ X <- cbind(1, matrix(rnorm(N*(J-1),0,1),N,J-1)) \\ Sigma <- matrix(runif(J*J,-1,1),J,J) \\ diag(Sigma) <- runif(J,1,5) \\ Sigma <- as.positive.definite(Sigma) \\ gamma <- runif(J,-1,1) \\ beta <- matrix(NA,G,J) \\ for (g in 1:G) \{beta[g,] <- rmvn(1, gamma, Sigma)\} \\ m <- rcat(N, rep(1/G,G)) \#\#\# Multilevel group indicator \\ y <- rowSums(beta[m,] * X) + rnorm(N,0,0.1) \\ S <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,G,J), gamma=rep(0,J), \\ \hspace*{0.27 in} sigma=0, U=S), uppertri=c(0,0,0,1)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} U <- rwishartc(Data$J+1, Data$S) \\ \hspace*{0.27 in} gamma <- rnorm(Data$J) \\ \hspace*{0.27 in} beta <- as.vector(rmvnpc(Data$G, gamma, U)) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, gamma, sigma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(G=G, J=J, N=N, PGF=PGF, S=S, X=X, m=m, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$G, Data$J) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$J+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dmvnpc(beta, gamma, U, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rowSums(beta[Data$m,] * Data$X) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + U.prior + beta.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial.Values} \code{Initial.Values <- c(rep(0,G*J), rep(0,J), 1, \\ \hspace*{0.27 in} upper.triangle(S, diag=TRUE))} \section{Linear Regression with Full Missingness} \label{linear.reg.full.miss} With `full missingness', there are missing values for both the dependent variable (DV) and at least one independent variable (IV). The `full likelihood` approach to full missingness is excellent as long as the model is identifiable. When it is not identifiable, imputation may be done in a previous stage, such as with the \code{MISS} function. In this example, matrix $\alpha$ is for regression effects for IVs, vector $\beta$ is for regression effects for the DV, vector $\gamma$ is for missing values for IVs, and $\delta$ is for missing values for the DV. \subsection{Form} $$\textbf{y}^{imp} \sim \mathcal{N}(\nu, \sigma^2_J)$$ $$\textbf{X}^{imp} \sim \mathcal{N}(\mu, \sigma^2_{-J}$$ $$\nu = \textbf{X}^{imp} \beta$$ $$\mu = \textbf{X}^{imp} \alpha$$ \[\textbf{y}^{imp} = \left\{ \begin{array}{l l} $$\delta$$ & \quad \mbox{if $\textbf{y}^{mis}$}\\ \textbf{y}^{obs} \\ \end{array} \right. \] \[\textbf{X}^{imp} = \left\{ \begin{array}{l l} $$\gamma$$ & \quad \mbox{if $\textbf{X}^{mis}$}\\ \textbf{X}^{obs} \\ \end{array} \right. \] $$\alpha_{j,l} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad l=1,\dots,(J-1)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\gamma_m \sim \mathcal{N}(0, 1000), \quad m=1,\dots,M$$ $$\delta_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,J$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \\ X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \#Design matrix X \\ M <- matrix(round(runif(N*J)-0.45),N,J); M[,1] <- 0 \#Missing indicators \\ X <- ifelse(M == 1, NA, X) \#Simulated X gets missings according to M \\ beta.orig <- runif(J,-2,2) \\ y <- as.vector(tcrossprod(X, t(beta.orig)) + rnorm(N,0,0.1)) \\ y[sample(1:N, round(N*.05))] <- NA \\ m <- ifelse(is.na(y), 1, 0) \#Missing indicator for vector y \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=matrix(0,J-1,J-1), \\ \hspace*{0.27 in} beta=rep(0,J), \\ \hspace*{0.27 in} gamma=rep(0,sum(is.na(X))), \\ \hspace*{0.27 in} delta=rep(0,sum(is.na(y))), \\ \hspace*{0.27 in} sigma=rep(0,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm((Data$J-1)*(Data$J-1)) \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} gamma <- rnorm(sum(is.na(Data$X))) \\ \hspace*{0.27 in} delta <- rnorm(sum(is.na(Data$y)), mean(Data$y, na.rm=TRUE), 1) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, delta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.delta=pos.delta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- matrix(parm[Data$pos.alpha], Data$J-1, Data$J-1) \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnormv(delta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- X.imputed <- Data$X \\ \hspace*{0.27 in} X.imputed[which(is.na(X.imputed))] <- gamma \\ \hspace*{0.27 in} y.imputed <- Data$y \\ \hspace*{0.27 in} y.imputed[which(is.na(y.imputed))] <- delta \\ \hspace*{0.27 in} for (j in 2:Data$J) \{mu[,j] <- tcrossprod(X.imputed[,-j], \\ \hspace*{0.62 in} t(alpha[,(j-1)]))\} \\ \hspace*{0.27 in} nu <- tcrossprod(X.imputed, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(X.imputed[,-1], mu[,-1], \\ \hspace*{0.62 in} matrix(sigma[1:(Data$J-1)], Data$N, Data$J-1), log=TRUE), \\ \hspace*{0.62 in} dnorm(y.imputed, nu, sigma[Data$J], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + delta.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(nu), nu, sigma[Data$J]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0, (J-1)\textasciicircum 2), rep(0,J), rep(0, sum(is.na(X))), \\ \hspace*{0.27 in} rep(0, sum(is.na(y))), rep(1,J))} \section{Linear Regression with Missing Response} \label{linear.reg.miss.resp} This is an introductory example to missing values using data augmentation with auxiliary variables. The dependent variable, or response, has both observed values, $\textbf{y}^{obs}$, and missing values, $\textbf{y}^{mis}$. The $\alpha$ vector is for missing value imputation, and enables the use of the full-likelihood by augmenting te state with these auxiliary variables. In the model form, $M$ is used to denote the number of missing values, though it is used as an indicator in the data. \subsection{Form} $$\textbf{y}^{imp} \sim \mathcal{N}(\mu, \sigma^2)$$ \[\textbf{y}^{imp} = \left\{ \begin{array}{l l} $$\alpha$$ & \quad \mbox{if $\textbf{y}^{mis}$}\\ \textbf{y}^{obs} \\ \end{array} \right. \] $$\mu = \textbf{X}\beta$$ $$\alpha_m \sim \mathcal{N}(0, 1000), \quad m=1,\dots,M$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ y[sample(1:N, round(N*0.05))] <- NA \\ M <- ifelse(is.na(y), 1, 0) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,sum(M)), beta=rep(0,J), \\ \hspace*{0.27 in} sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(sum(Data$M), mean(y, na.rm=TRUE), 1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, M=M, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dgamma(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} y.imputed <- Data$y \\ \hspace*{0.27 in} y.imputed[which(is.na(Data$y))] <- alpha \\ \hspace*{0.27 in} LL <- sum(dnorm(y.imputed, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,sum(M)), rep(0,J), 1)} \section{Linear Regression with Missing Response via ABB} \label{linear.reg.miss.resp.abb} The Approximate Bayesian Bootstrap (ABB), using the \code{ABB} function, is used to impute missing values in the dependent variable (DV), or response, given a propensity score. In this example, vector $\alpha$ is used to estimate propensity score $\eta$, while vector $\beta$ is for regression effects, and vector $\gamma$ has the monitored missing values. For more information on ABB, see the \code{ABB} function. \subsection{Form} $$\textbf{y}^{imp} \sim \mathcal{N}(\mu, \sigma^2)$$ \[\textbf{y}^{imp} = \left\{ \begin{array}{l l} $$\gamma$$ & \quad \mbox{if $\textbf{y}^{mis}$}\\ \textbf{y}^{obs} \\ \end{array} \right. \] $$\mu = \textbf{X}\beta$$ $$\gamma \sim p(\textbf{y}^{obs} | \textbf{y}^{obs}, \textbf{y}^{mis}, \eta)$$ $$\eta = \frac{1}{1 + \exp(-\nu)}$$ $$\nu = \textbf{X} \alpha$$ $$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ y[sample(1:N, round(N*0.05))] <- NA \\ M <- ifelse(is.na(y), 1, 0) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP",paste("gamma[",1:sum(is.na(y)),"]",sep="")) \\ parm.names <- as.parm.names(list(alpha=rep(0,J), beta=rep(0,J), sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, M=M, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dgamma(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} y.imputed <- Data$y \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} nu <- as.vector(tcrossprod(Data$X, t(alpha))) \\ \hspace*{0.27 in} eta <- invlogit(nu) \\ \hspace*{0.27 in} breaks <- as.vector(quantile(eta, probs=c(0,0.2,0.4,0.6,0.8,1))) \\ \hspace*{0.27 in} B <- matrix(breaks[-length(breaks)], length(Data$y), 5, byrow=TRUE) \\ \hspace*{0.27 in} z <- rowSums(eta >= B) \\ \hspace*{0.27 in} for (i in 1:5) \{ \\ \hspace*{0.62 in} if(any(is.na(Data$y[which(z == i)]))) \{ \\ \hspace*{0.95 in} imp <- unlist(ABB(Data$y[which(z == i)])) \\ \hspace*{0.95 in} y.imputed[which(\{z == i\} \& is.na(Data$y))] <- imp\}\} \\ \hspace*{0.27 in} gamma <- y.imputed[which(is.na(Data$y))] \\ \hspace*{0.27 in} LL <- sum(dbern(Data$M, eta, log=TRUE), \\ \hspace*{0.62 in} dnorm(y.imputed, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,gamma), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(0,J), 1)} \section{Linear Regression with Power Priors} \label{linear.reg.pp} Power priors \citep{ibrahim00} are a class of informative priors when relevant historical data is available. Power priors may be used when it is desirable to take historical data into account while analyzing similar, current data. Both the current data, $\textbf{y}$ and $\textbf{X}$, and historical data, $\textbf{y}_h$ and $\textbf{X}_h$, are included in the power prior analysis, where $h$ indicates historical data. Each data set receives its own likelihood function, though the likelihood of the historical data is raised to an exponential power, $\alpha \in [0,1]$. In this example, $\alpha$ is a constant. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\textbf{y}_h \sim \mathcal{N}(\mu_h, \sigma^2)^\alpha$$ $$\mu = \textbf{X}\beta$$ $$\mu_h = \textbf{X}_h\beta$$ $$\alpha = 0.5$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \#Number of predictors, including the intercept \\ X <- Xh <- matrix(1,N,J) \\ for (j in 2:J) \{ \\ \hspace*{0.27 in} X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1)) \\ \hspace*{0.27 in} Xh[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta.orig <- runif(J,-3,3) \\ e <- rnorm(N,0,0.1) \\ yh <- as.vector(tcrossprod(beta.orig, Xh) + e) \\ y <- as.vector(tcrossprod(beta.orig, X) + e) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(alpha=0.5, J=J, PGF=PGF, X=X, Xh=Xh, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y, \\ \hspace*{0.27 in} yh=yh) \\ } \\ \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} muh <- tcrossprod(Data$Xh, t(beta)) \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(Data$alpha*dnorm(Data$yh, muh, sigma, log=TRUE) + \\ \hspace*{0.62 in} dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Linear Regression with Zellner's g-Prior} \label{linear.reg.g} For more information on Zellner's g-prior, see the documentation for the \code{dzellner} function. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta \sim \mathcal{N}_J(0, g \sigma^2 (\textbf{X}^T \textbf{X})^{-1})$$ $$g \sim \mathcal{HG}(\alpha), \quad \alpha = 3$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), g0=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.g <- grep("g0", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} g0 <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, g0, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.g=pos.g, \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.g] <- g <- interval(parm[Data$pos.g], 1e-100, Inf) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} g.prior <- dhyperg(g, alpha=3, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- dzellner(beta, g, sigma, Data$X, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + g.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(1,J), rep(1,2))} \section{LSTAR} \label{lstar} This is a Logistic Smooth-Threshold Autoregression (LSTAR), and is specified with a transition function that includes $\gamma$ as the shape parameter, $\textbf{y}$ as the transition variable, $\theta$ as the location parameter, and $d$ as the delay parameter. \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$ $$\mu_t = \pi_t (\alpha_1 + \phi_1 \textbf{y}_{t-1}) + (1 - \pi_t) (\alpha_2 + \phi_2 \textbf{y}_{t-1}), \quad t=2,\dots,T$$ $$\pi_t = \frac{1}{1 + \exp(-(\gamma (\textbf{y}_{t-d} - \theta)))}$$ $$\alpha_j \sim \mathcal{N}(0, 1000) \in [\textbf{y}_{min}, \textbf{y}_{max}], \quad j=1,\dots,2$$ $$\frac{\phi_j+1}{2} \sim \mathcal{BETA}(1, 1), \quad j=1,\dots,2$$ $$\gamma \sim \mathcal{HC}(25)$$ $$\theta \sim \mathcal{U}(\textbf{y}_{min}, \textbf{y}_{max})$$ $$\pi_1 \sim \mathcal{U}(0.001, 0.999)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector((log(as.matrix(demonfx[,1])))) \\ T <- length(y) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,2), phi=rep(0,2), gamma=0, \\ \hspace*{0.27 in} theta=0, pi=0, sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ pos.pi <- grep("pi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- runif(2,min(Data$y),max(Data$y)) \\ \hspace*{0.27 in} phi <- runif(2, -1, 1) \\ \hspace*{0.27 in} gamma <- runif(1) \\ \hspace*{0.27 in} theta <- runif(1,min(Data$y),max(Data$y)) \\ \hspace*{0.27 in} pi <- runif(1, 0.001, 0.999) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, phi, gamma, theta, pi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.phi=pos.phi, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.theta=pos.theta, pos.pi=pos.pi, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], min(Data$y), max(Data$y)) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], min(Data$y), max(Data$y)) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} parm[Data$pos.pi] <- pi <- interval(parm[Data$pos.pi], 0.001, 0.999) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dbeta((phi+1)/2, 1, 1, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- dhalfcauchy(gamma, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- dunif(theta, min(Data$y), max(Data$y), log=TRUE) \\ \hspace*{0.27 in} pi.prior <- dunif(pi, 0.001, 0.999, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} pi <- c(pi, 1 / (1 + exp(-(gamma*(Data$y[-Data$T]-theta))))) \\ \hspace*{0.27 in} mu <- pi * c(alpha[1], alpha[1] + phi[1]*Data$y[-Data$T]) + \\ \hspace*{0.62 in} (1-pi) * c(alpha[2], alpha[2] + phi[2]*Data$y[-Data$T]) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], mu[-1], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + gamma.prior + theta.prior + \\ \hspace*{0.62 in} pi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(mean(y),2), rep(0.5,2), 1, mean(y), 0.5, 1)} \section{MANCOVA} \label{mancova} Since this is a multivariate extension of ANCOVA, please see the ANCOVA example in section \ref{ancova} for a univariate introduction. \subsection{Form} $$\textbf{Y}_{i,1:J} \sim \mathcal{N}_K(\mu_{i,1:J}, \Sigma), \quad i=1,\dots,N$$ $$\mu_{i,k} = \alpha_k + \beta_{k,\textbf{X}[i,1]} + \gamma_{k,\textbf{X}[i,1]} + \textbf{X}_{1:N,3:(C+J)} \delta_{k,1:C}$$ $$\epsilon_{i,k} = \textbf{Y}_{i,k} - \mu_{i,k}$$ $$\alpha_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\beta_{k,l} \sim \mathcal{N}(0, \sigma^2_1), \quad l=1,\dots,(L-1)$$ $$\beta_{1:K,L} = - \sum^{L-1}_{l=1} \beta_{1:K,l}$$ $$\gamma_{k,m} \sim \mathcal{N}(0, \sigma^2_2), \quad m=1,\dots,(M-1)$$ $$\gamma_{1:K,M} = - \sum^{M-1}_{m=1} \beta_{1:K,m}$$ $$\delta_{k,c} \sim \mathcal{N}(0, 1000)$$ $$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$ $$\Sigma = \Omega^{-1}$$ $$\sigma_{1:J} \sim \mathcal{HC}(25)$$ \subsection{Data} \code{C <- 2 \#Number of covariates \\ J <- 2 \#Number of factors (treatments) \\ K <- 3 \#Number of endogenous (dependent) variables \\ L <- 4 \#Number of levels in factor (treatment) 1 \\ M <- 5 \#Number of levels in factor (treatment) 2 \\ N <- 100 \\ X <- matrix(c(rcat(N, rep(1/L,L)), rcat(N, rep(1/M,M)), \\ \hspace*{0.27 in} runif(N*C,0,1)), N, J + C) \\ alpha <- runif(K,-1,1) \\ beta <- matrix(runif(K*L,-2,2), K, L) \\ beta[,L] <- -rowSums(beta[,-L]) \\ gamma <- matrix(runif(K*M,-2,2), K, M) \\ gamma[,M] <- -rowSums(gamma[,-M]) \\ delta <- matrix(runif(K*C), K, C) \\ Y <- matrix(NA,N,K) \\ for (k in 1:K) \{ \\ \hspace*{0.27 in} Y[,k] <- alpha[k] + beta[k,X[,1]] + gamma[k,X[,2]] + \\ \hspace*{0.27 in} tcrossprod(delta[k,], X[,-c(1,2)]) + rnorm(1,0,0.1)\} \\ S <- diag(K) \\ mon.names <- c("LP", "s.o.beta", "s.o.gamma", "s.o.epsilon", \\ \hspace*{0.27 in} as.parm.names(list(s.beta=rep(0,K), s.gamma=rep(0,K), \\ \hspace*{0.27 in} s.epsilon=rep(0,K)))) \\ parm.names <- as.parm.names(list(alpha=rep(0,K), beta=matrix(0,K,(L-1)), \\ \hspace*{0.27 in} gamma=matrix(0,K,(M-1)), delta=matrix(0,K,C), U=diag(K), \\ \hspace*{0.27 in} sigma=rep(0,2)), uppertri=c(0,0,0,0,1,0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$K) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} beta <- rnorm(Data$K*(Data$L-1), 0, sigma[1]) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K*(Data$M-1), 0, sigma[2]) \\ \hspace*{0.27 in} delta <- rnorm(Data$K*Data$C) \\ \hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, delta, U[upper.tri(U, diag=TRUE)], \\ \hspace*{0.62 in} sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, K=K, L=L, M=M, N=N, PGF=PGF, S=S, X=X, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.gamma=pos.gamma, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- matrix(c(parm[Data$pos.beta], rep(0,Data$K)), Data$K, Data$L) \\ \hspace*{0.27 in} beta[,Data$L] <- -rowSums(beta[,-Data$L]) \\ \hspace*{0.27 in} gamma <- matrix(c(parm[Data$[pos.gamma], \\ \hspace*{0.62 in} rep(0,Data$K)), Data$K, Data$M) \\ \hspace*{0.27 in} gamma[,Data$M] <- -rowSums(gamma[,-Data$M]) \\ \hspace*{0.27 in} delta <- matrix(parm[Data$pos.delta], Data$K, Data$C) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnormv(delta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$K+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0,Data$N,Data$K) \\ \hspace*{0.27 in} for (k in 1:Data$K) \{ \\ \hspace*{0.62 in} mu[,k] <- alpha[k] + beta[k,Data$X[,1]] + gamma[k,Data$X[,2]] + \\ \hspace*{0.62 in} tcrossprod(Data$X[,-c(1,2)], t(delta[k,]))\} \\ \hspace*{0.27 in} LL <- sum(dmvnpc(Data$Y, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Variance Components, Omnibus \\ \hspace*{0.27 in} s.o.beta <- sd(as.vector(beta)) \\ \hspace*{0.27 in} s.o.gamma <- sd(as.vector(gamma)) \\ \hspace*{0.27 in} s.o.epsilon <- sd(as.vector(Data$Y - mu)) \\ \hspace*{0.27 in} \#\#\# Variance Components, Univariate \\ \hspace*{0.27 in} s.beta <- sqrt(.rowVars(beta)) \\ \hspace*{0.27 in} s.gamma <- sqrt(.rowVars(gamma)) \\ \hspace*{0.27 in} s.epsilon <- sqrt(.colVars(Data$Y - mu)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + delta.prior + \\ \hspace*{0.62 in} U.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, s.o.beta, s.o.gamma, \\ \hspace*{0.62 in} s.o.epsilon, s.beta, s.gamma, s.epsilon), \\ \hspace*{0.62 in} yhat=rmvnpc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), rep(0,K*(L-1)), rep(0,K*(M-1)), \\ \hspace*{0.27 in} rep(0,C*K), upper.triangle(S, diag=TRUE), rep(1,2))} \section{MANOVA} \label{manova} Since this is a multivariate extension of ANOVA, please see the two-way ANOVA example in section \ref{anova.two.way} for a univariate introduction. \subsection{Form} $$\textbf{Y}_{i,1:J} \sim \mathcal{N}_K(\mu_{i,1:J}, \Omega^{-1}), \quad i=1,\dots,N$$ $$\mu_{i,k} = \alpha_k + \beta_{k,\textbf{X}[i,1]} + \gamma_{k,\textbf{X}[i,1]}$$ $$\epsilon_{i,k} = \textbf{Y}_{i,k} - \mu_{i,k}$$ $$\alpha_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\beta_{k,l} \sim \mathcal{N}(0, \sigma^2_1), \quad l=1,\dots,(L-1)$$ $$\beta_{1:K,L} = - \sum^{L-1}_{l=1} \beta_{1:K,l}$$ $$\gamma_{k,m} \sim \mathcal{N}(0, \sigma^2_2), \quad m=1,\dots,(M-1)$$ $$\gamma_{1:K,M} = - \sum^{M-1}_{m=1} \beta_{1:K,m}$$ $$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$ $$\sigma_{1:J} \sim \mathcal{HC}(25)$$ \subsection{Data} \code{J <- 2 \#Number of factors (treatments) \\ K <- 3 \#Number of endogenous (dependent) variables \\ L <- 4 \#Number of levels in factor (treatment) 1 \\ M <- 5 \#Number of levels in factor (treatment) 2 \\ N <- 100 \\ X <- cbind(rcat(N, rep(1/L,L)), rcat(N, rep(1/M,M))) \\ alpha <- runif(K,-1,1) \\ beta <- matrix(runif(K*L,-2,2), K, L) \\ beta[,L] <- -rowSums(beta[,-L]) \\ gamma <- matrix(runif(K*M,-2,2), K, M) \\ gamma[,M] <- -rowSums(gamma[,-M]) \\ Y <- matrix(NA,N,K) \\ for (k in 1:K) \{ \\ \hspace*{0.27 in} Y[,k] <- alpha[k] + beta[k,X[,1]] + gamma[k,X[,2]] + rnorm(1,0,0.1)\} \\ S <- diag(K) \\ mon.names <- c("LP", "s.o.beta", "s.o.gamma", "s.o.epsilon", \\ \hspace*{0.27 in} as.parm.names(list(s.beta=rep(0,K), s.gamma=rep(0,K), \\ \hspace*{0.27 in} s.epsilon=rep(0,K)))) \\ parm.names <- as.parm.names(list(alpha=rep(0,K), beta=matrix(0,K,(L-1)), \\ \hspace*{0.27 in} gamma=matrix(0,K,(M-1)), U=diag(K), sigma=rep(0,2)), \\ \hspace*{0.27 in} uppertri=c(0,0,0,1,0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$K) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} beta <- rnorm(Data$K*(Data$L-1), 0, sigma[1]) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K*(Data$M-1), 0, sigma[2]) \\ \hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, U[upper.tri(U, diag=TRUE)], sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, L=L, M=M, N=N, PGF=PGF, S=S, X=X, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.gamma=pos.gamma, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- matrix(c(parm[Data$pos.beta], rep(0,Data$K)), \\ \hspace*{0.27 in} beta[,Data$L] <- -rowSums(beta[,-Data$L]) \\ \hspace*{0.27 in} gamma <- matrix(c(parm[Data$pos.gamma], \\ \hspace*{0.62 in} rep(0,Data$K)), Data$K, Data$M) \\ \hspace*{0.27 in} gamma[,Data$M] <- -rowSums(gamma[,-Data$M]) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$K+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0,Data$N,Data$K) \\ \hspace*{0.27 in} for (k in 1:Data$K) \{ \\ \hspace*{0.62 in} mu[,k] <- alpha[k] + beta[k,Data$X[,1]] + gamma[k,Data$X[,2]]\} \\ \hspace*{0.27 in} LL <- sum(dmvnpc(Data$Y, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Variance Components, Omnibus \\ \hspace*{0.27 in} s.o.beta <- sd(as.vector(beta)) \\ \hspace*{0.27 in} s.o.gamma <- sd(as.vector(gamma)) \\ \hspace*{0.27 in} s.o.epsilon <- sd(as.vector(Data$Y - mu)) \\ \hspace*{0.27 in} \#\#\# Variance Components, Univariate \\ \hspace*{0.27 in} s.beta <- sqrt(.rowVars(beta)) \\ \hspace*{0.27 in} s.gamma <- sqrt(.rowVars(gamma)) \\ \hspace*{0.27 in} s.epsilon <- sqrt(.colVars(Data$Y - mu)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + U.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, s.o.beta, s.o.gamma, \\ \hspace*{0.62 in} s.o.epsilon, s.beta, s.gamma, s.epsilon), \\ \hspace*{0.62 in} yhat=rmvnpc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), rep(0,K*(L-1)), rep(0,K*(M-1)), \\ \hspace*{0.27 in} upper.triangle(S, diag=TRUE), rep(1,2))} \section{Mixed Logit} \label{mixed.logit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N$$ $$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}$$ $$\phi = \exp(\mu)$$ $$\mu_{i,j} = \beta_{j,1:K,i} \textbf{X}_{i,1:K} \in [-700,700], \quad i=1,\dots,N, \quad j=1,\dots,(J-1)$$ $$\mu_{i,J} = 0$$ $$\beta_{j,k,i} \sim \mathcal{N}(\zeta^\mu_{j,k}, \zeta^\sigma2_{j,k}), \quad i=1,\dots,N, \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\zeta^\mu_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\zeta^\sigma_{j,k} \sim \mathcal{HC}{25}), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ S <- diag(J-1) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=array(0, dim=c(J-1,K,N)), \\ \hspace*{0.27 in} zeta.mu=matrix(0,J-1,K), zeta.sigma=matrix(0,J-1,K))) \\ pos.beta <- grep("beta", parm.names) \\ pos.zeta.mu <- grep("zeta.mu", parm.names) \\ pos.zeta.sigma <- grep("zeta.sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} zeta.mu <- matrix(rnorm((Data$J-1)*Data$K), Data$J-1, Data$K) \\ \hspace*{0.27 in} zeta.sigma <- matrix(runif((Data$J-1)*Data$K), Data$J-1, Data$K) \\ \hspace*{0.27 in} beta <- array(rnorm((Data$J-1)*Data$K*Data$N), \\ \hspace*{0.62 in} dim=c( Data$J-1, Data$K, Data$N)) \\ \hspace*{0.27 in} return(c(beta, as.vector(zeta.mu), as.vector(zeta.sigma))) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.zeta.mu=pos.zeta.mu, \\ \hspace*{0.27 in} pos.zeta.sigma=pos.zeta.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- array(parm[Data$pos.beta], dim=c(Data$J-1, Data$K, Data$N)) \\ \hspace*{0.27 in} zeta.mu <- matrix(parm[Data$pos.zeta.mu], Data$J-1, Data$K) \\ \hspace*{0.27 in} zeta.sigma <- matrix(interval(parm[Data$pos.zeta.sigma], 1e-100, Inf), \\ \hspace*{0.62 in} Data$J-1, Data$K) \\ \hspace*{0.27 in} parm[Data$pos.zeta.sigma] <- as.vector(zeta.sigma) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} zeta.mu.prior <- sum(dnormv(zeta.mu, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.sigma.prior <- sum(dhalfcauchy(zeta.sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, zeta.mu, zeta.sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0, Data$N, Data$J) \\ \hspace*{0.27 in} for (j in 1:(Data$J-1)) mu[,j] <- rowSums(Data$X * t(beta[j, , ])) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} phi <- exp(mu) \\ \hspace*{0.27 in} p <- phi / rowSums(phi) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.mu.prior + zeta.sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,(J-1)*K*N), rep(0,(J-1)*K), rep(1,(J-1)*K))} \section{Mixture Model, Finite} \label{fmm} This finite mixture model (FMM) imposes a multilevel structure on each of the $J$ regression effects in $\beta$, so that mixture components share a common residual standard deviation, $\nu_m$. Identifiability is gained at the expense of some shrinkage. The record-level mixture membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_i = \textbf{X}_{i,1:J}\beta_{\theta[i],1:J}, \quad i=1,\dots,N$$ $$\theta_i \sim \mathcal{CAT}(\pi_{1:M}), \quad i=1,\dots,N$$ $$\beta_{m,j} \sim \mathcal{N}(0, \nu^2_m), \quad j=1,\dots,J, \quad m=2,\dots,M$$ $$\beta_{1,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\nu_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\pi_{1:M} \sim \mathcal{D}(\alpha_{1:M})$$ $$\alpha_m = 1$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ M <- 2 \#Number of mixtures \\ N <- length(y) \#Number of records \\ J <- ncol(X) \#Number of predictors, including the intercept \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ alpha <- rep(1,M) \#Prior probability of mixing probabilities \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(theta=rep(0,N), beta=matrix(0,M,J), \\ \hspace*{0.27 in} nu=rep(0,M), sigma=0)) \\ pos.theta <- grep("theta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} theta <- rcat(Data$N, rep(1/Data$M, Data$M)) \\ \hspace*{0.27 in} nu <- runif(Data$M) \\ \hspace*{0.27 in} beta <- rnormv(Data$M*Data$J, 0, \\ \hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1))) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(theta, beta, nu, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, M=M, N=N, PGF=PGF, X=X, alpha=alpha, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.theta=pos.theta, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.nu=pos.nu, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$M, Data$J) \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} pi <- rep(0, Data$M) \\ \hspace*{0.27 in} tab <- table(theta) \\ \hspace*{0.27 in} pi[as.numeric(names(tab))] <- as.vector(tab) \\ \hspace*{0.27 in} pi <- pi / sum(pi) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, \\ \hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1)), log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, p=pi, log=TRUE)) \\ \hspace*{0.27 in} pi.prior <- ddirichlet(pi, Data$alpha, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rowSums(beta[theta,] * Data$X) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + theta.prior + pi.prior + nu.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rcat(N,rep(1/M,M)), rep(0,M*J), rep(1,M), 1)} \section{Mixture Model, Infinite} \label{imm} This infinite mixture model (IMM) uses a Dirichlet process via truncated stick-breaking. The record-level mixture membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_i = \textbf{X}_{i,1:J}\beta_{\theta[i],1:J}, \quad i=1,\dots,N$$ $$\theta_i \sim \mathcal{CAT}(\pi_{1:M}), \quad i=1,\dots,N$$ $$\beta_{m,j} \sim \mathcal{N}(0, \nu^2_m), \quad j=1,\dots,J, \quad m=2,\dots,M$$ $$\beta_{1,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\nu_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\pi = \mathrm{Stick}(\delta)$$ $$\delta_m \sim \mathcal{BETA}(1, \gamma), m=1,\dots,(M-1)$$ $$\gamma \sim \mathcal{G}(\alpha, \iota)$$ $$\alpha \sim \mathcal{HC}(25)$$ $$\iota \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ M <- 3 \#Maximum number of mixtures to explore \\ N <- length(y) \#Number of records \\ J <- ncol(X) \#Number of predictors, including the intercept \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP", as.parm.names(list(pi=rep(0,M)))) \\ parm.names <- as.parm.names(list(theta=rep(0,N), delta=rep(0,M-1), \\ \hspace*{0.27 in} beta=matrix(0,M,J), nu=rep(0,M), sigma=0, alpha=0, iota=0, gamma=0)) \\ pos.theta <- grep("theta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.iota <- grep("iota", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} nu <- runif(Data$M) \\ \hspace*{0.27 in} beta <- rnormv(Data$M*Data$J, 0, \\ \hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1))) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} alpha <- runif(1) \\ \hspace*{0.27 in} iota <- runif(1) \\ \hspace*{0.27 in} gamma <- rgamma(1, alpha, iota) \\ \hspace*{0.27 in} delta <- rev(sort(rbeta(Data$M-1, 1, gamma))) \\ \hspace*{0.27 in} theta <- rcat(Data$N, Stick(delta)) \\ \hspace*{0.27 in} return(c(theta, delta, beta, nu, sigma, alpha, iota, gamma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, M=M, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.theta=pos.theta, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.nu=pos.nu, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.iota=pos.iota, pos.gamma=pos.gamma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperhyperparameters \\ \hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} iota <- interval(parm[Data$pos.iota], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.iota] <- iota \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-10, 1-1e-10) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$M, Data$J) \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} pi <- Stick(delta) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperhyperprior \\ \hspace*{0.27 in} alpha.prior <- dhalfcauchy(alpha, 25, log=TRUE) \\ \hspace*{0.27 in} iota.prior <- dhalfcauchy(iota, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} delta.prior <- dStick(delta, gamma, log=TRUE) \\ \hspace*{0.27 in} gamma.prior <- dgamma(gamma, alpha, iota, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, \\ \hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1)), log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, pi, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rowSums(beta[theta,]*Data$X) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + delta.prior + theta.prior + nu.prior + \\ \hspace*{0.62 in} sigma.prior + alpha.prior + iota.prior + gamma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,pi), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rcat(N, rev(sort(rStick(M-1,1)))), rep(0.5,M-1), \\ \hspace*{0.27 in} rep(0,M*J), rep(1,M), rep(1,4))} \section{Multinomial Logit} \label{mnl} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N$$ $$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}, \quad \sum^J_{j=1} \textbf{p}_{i,j} = 1$$ $$\phi = \exp(\mu)$$ $$\mu_{i,J} = 0, \quad i=1,\dots,N$$ $$\mu_{i,j} = \textbf{X}_{i,1:K} \beta_{j,1:K} \in [-700,700], \quad j=1,\dots,(J-1)$$ $$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,J-1,K))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm, Data$J-1, Data$K) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0, Data$N, Data$J) \\ \hspace*{0.27 in} mu[,-Data$J] <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} phi <- exp(mu) \\ \hspace*{0.27 in} p <- phi / rowSums(phi) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,(J-1)*K))} \section{Multinomial Logit, Nested} \label{nmnl} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{P}_{i,1:J}), \quad i=1,\dots,N$$ $$\textbf{P}_{1:N,1} = \frac{\textbf{R}}{\textbf{R} + \exp(\alpha \textbf{I})}$$ $$\textbf{P}_{1:N,2} = \frac{(1 - \textbf{P}_{1:N,1}) \textbf{S}_{1:N,1}}{\textbf{V}}$$ $$\textbf{P}_{1:N,3} = \frac{(1 - \textbf{P}_{1:N,1}) \textbf{S}_{1:N,2}}{\textbf{V}}$$ $$\textbf{R}_{1:N} = \exp(\mu_{1:N,1})$$ $$\textbf{S}_{1:N,1:2} = \exp(\mu_{1:N,2:3})$$ $$\textbf{I} = \log(\textbf{V})$$ $$\textbf{V}_i = \displaystyle\sum^K_{k=1} \textbf{S}_{i,k}, \quad i=1,\dots,N$$ $$\mu_{1:N,1} = \textbf{X} \iota \in [-700,700]$$ $$\mu_{1:N,2} = \textbf{X} \beta_{2,1:K} \in [-700,700]$$ $$\iota = \alpha \beta_{1,1:K}$$ $$\alpha \sim \mathcal{EXP}(1) \in [0,2]$$ $$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1) \quad k=1,\dots,K$$ where there are $J=3$ categories of $\textbf{y}$, $K=3$ predictors, $\textbf{R}$ is the non-nested alternative, $\textbf{S}$ is the nested alternative, $\textbf{V}$ is the observed utility in the nest, $\alpha$ is effectively 1 - correlation and has a truncated exponential distribution, and $\iota$ is a vector of regression effects for the isolated alternative after $\alpha$ is taken into account. The third alternative is the reference category. \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ mon.names <- c("LP", as.parm.names(list(iota=rep(0,K)))) \\ parm.names <- as.parm.names(list(alpha=0, beta=matrix(0,J-1,K))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rtrunc(1, "exp", a=0, b=2, rate=1) \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} return(c(alpha, beta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, y=y) } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} alpha.rate <- 1 \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha],0,2) \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dtrunc(alpha, "exp", a=0, b=2, rate=alpha.rate, \\ \hspace*{0.62 in} log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- P <- matrix(0, Data$N, Data$J) \\ \hspace*{0.27 in} iota <- alpha * beta[1,] \\ \hspace*{0.27 in} mu[,1] <- tcrossprod(Data$X, t(iota)) \\ \hspace*{0.27 in} mu[,2] <- tcrossprod(Data$X, t(beta[2,])) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} R <- exp(mu[,1]) \\ \hspace*{0.27 in} S <- exp(mu[,-1]) \\ \hspace*{0.27 in} V <- rowSums(S) \\ \hspace*{0.27 in} I <- log(V) \\ \hspace*{0.27 in} P[,1] <- R / (R + exp(alpha*I)) \\ \hspace*{0.27 in} P[,2] <- (1 - P[,1]) * S[,1] / V \\ \hspace*{0.27 in} P[,3] <- (1 - P[,1]) * S[,2] / V \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, P, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,iota), \\ \hspace*{0.62 in} yhat=rcat(nrow(P), P), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0.5, rep(0.1,(J-1)*K))} \section{Multinomial Probit} \label{mnp} \subsection{Form} $$\textbf{W}_{i,1:(J-1)} \sim \mathcal{N}_{J-1}(\mu_{i,1:(J-1)}, \Sigma), \quad i=1,\dots,N$$ \[\textbf{W}_{i,j} \in \left\{ \begin{array}{l l} $[0,10]$ & \quad \mbox{if $\textbf{y}_i = j$}\\ $[-10,0]$ \\ \end{array} \right. \] $$\mu_{1:N,j} = \textbf{X} \beta_{j,1:K}$$ $$\Sigma = \textbf{U}^T \textbf{U}$$ $$\beta_{j,k} \sim \mathcal{N}(0, 10), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\textbf{U}_{j,k} \sim \mathcal{N}(0,1), \quad j=1,\dots,(J-1), \quad k=1,\dots,(J-1), \quad j \ge k, \quad j \ne k = 1$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ S <- diag(J-1) \\ U <- matrix(NA,J-1,J-1) \\ U[upper.tri(U, diag=TRUE)] <- 0 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,(J-1),K), \\ \hspace*{0.27 in} U=U, W=matrix(0,N,J-1))) \\ parm.names <- parm.names[-which(parm.names == "U[1,1]")] \\ pos.beta <- grep("beta", parm.names) \\ pos.U <- grep("U", parm.names) \\ pos.W <- grep("W", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} U <- rnorm((Data$J-2) + (factorial(Data$J-1) / \\ \hspace*{0.62 in} (factorial(Data$J-1-2)*factorial(2)))) \\ \hspace*{0.27 in} W <- matrix(runif(Data$N*(Data$J-1),-10,0), Data$N, Data$J-1) \\ \hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\ \hspace*{0.27 in} W <- ifelse(Y[,-Data$J] == 1, abs(W), W) \\ \hspace*{0.27 in} return(c(beta, U, as.vector(W)))\} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.U=pos.U, pos.W=pos.W, \\ \hspace*{0.27 in} y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\ \hspace*{0.27 in} u <- c(0, parm[Data$pos.U]) \\ \hspace*{0.27 in} U <- diag(Data$J-1) \\ \hspace*{0.27 in} U[upper.tri(U, diag=TRUE)] <- u \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} Sigma <- t(U) \%*\% U \\ \hspace*{0.27 in} Sigma[1,] <- Sigma[,1] <- U[1,] \\ \hspace*{0.27 in} W <- matrix(parm[Data$pos.W], Data$N, Data$J-1) \\ \hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\ \hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 1) \\ \hspace*{0.27 in} W[temp] <- interval(W[temp], 0, 10) \\ \hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 0) \\ \hspace*{0.27 in} W[temp] <- interval(W[temp], -10, 0) \\ \hspace*{0.27 in} parm[Data$pos.W] <- as.vector(W) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- sum(dnorm(u[-1], 0, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} \#eta <- exp(cbind(mu,0)) \\ \hspace*{0.27 in} \#p <- eta / rowSums(eta) \\ \hspace*{0.27 in} LL <- sum(dmvn(W, mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=max.col(cbind(rmvn(nrow(mu), mu, Sigma),0)), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)} \section{Multiple Discrete-Continuous Choice} \label{mdcc} This form of a multivariate discrete-continuous choice model was introduced in \citet{kim02} and referred to as a variety model. The original version is presented with log-normally distributed errors, but a gamma regression form is used here instead, which has always mixed better in testing. Note that the $\gamma$ parameters are fixed here, as recommended for identifiability in future articles by these authors. \subsection{Form} $$\textbf{Y} \sim \mathcal{G}(\lambda\tau, \tau)$$ $$\lambda_{i,j} = \exp(\textbf{Z}_{i,j}\log(\psi1_{m[i],j}) + \textbf{X1}_{i,1:K}\log(\beta) + \textbf{X2}_{i,1:L}\log(\delta))(\textbf{Y}_{i,j} + \gamma_j)^\alpha_j), \quad i=1,\dots,N, j=1,\dots,J$$ $$\alpha_j \sim \mathcal{U}(0,1), \quad j=1,\dots,J$$ $$\log(\beta_k) \sim \mathcal{N}(0,1000), \quad k=1,\dots,K$$ $$\gamma_j = 1, \quad j=1,\dots,J$$ $$\log(\delta_{j,l}) \sim \mathcal{N}(0,1000), \quad j=1,\dots,(J-1), \quad l=1,\dots,L$$ $$\log(\psi0_j) \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\log(\psi1_{g,j}) \sim \mathcal{N}_{J}(\log(\psi0), \Omega^{-1}), \quad g=1,\dots,G, \quad j1=,\dots,J$$ $$\Omega \sim \mathcal{W}_{J+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$ $$\tau_j \sim \mathcal{HC}(25), \quad j=1,\dots,J$$ \subsection{Data} \code{G <- 6 \#Number of Multilevel Groups (decision-makers, households, etc.) \\ J <- 3 \#Number of products \\ K <- 4 \#Number of product attributes \\ L <- 5 \#Number of decision-maker attributes \\ N <- 30 \#Number of records \\ X1 <- matrix(rnorm(N*K), N, K) \#Product attributes \\ X2 <- matrix(rnorm(N*L), N, L) \#Decision-maker attributes \\ Sigma <- matrix(runif((J-1)*(J-1),-1,1),J-1,J-1) \\ diag(Sigma) <- runif(J-1,1,5) \\ Sigma <- as.positive.definite(Sigma) / 100 \\ alpha <- runif(J) \\ log.beta <- rnorm(K,0,0.1) \\ log.delta <- matrix(rnorm((J-1)*L,0,0.1), J-1, L) \\ log.psi0 <- rnorm(J) \\ log.psi1 <- rmvn(G, log.psi0, Sigma) \\ m <- rcat(N, rep(1/G,G)) \# Multilevel group indicator \\ Z <- as.indicator.matrix(m) \\ Y <- matrix(0, N, J) \\ Y <- round(exp(tcrossprod(Z, t(cbind(log.psi1,0))) + \\ \hspace*{0.27 in} matrix(tcrossprod(X1, t(log.beta)), N, J) + \\ \hspace*{0.27 in} tcrossprod(X2, rbind(log.delta, colSums(log.delta)*-1))) * \\ \hspace*{0.27 in} (Y + 1)\textasciicircum matrix(alpha,N,J,byrow=TRUE) + \\ \hspace*{0.27 in} matrix(rnorm(N*J,0,0.1),N,J)) \\ S <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), log.beta=rep(0,K), \\ \hspace*{0.27 in} log.delta=matrix(0,J-1,L), log.psi0=rep(0,J), \\ \hspace*{0.27 in} log.psi1=matrix(0,G,J), tau=rep(0,J), U=S), \\ \hspace*{0.27 in} uppertri=c(0,0,0,0,0,0,1)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.log.beta <- grep("log.beta", parm.names) \\ pos.log.delta <- grep("delta", parm.names) \\ pos.log.psi0 <- grep("log.psi0", parm.names) \\ pos.log.psi1 <- grep("log.psi1", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- runif(Data$J,0.9,1) \\ \hspace*{0.27 in} log.beta <- rnorm(Data$K,0,0.1) \\ \hspace*{0.27 in} log.delta <- rnorm((Data$J-1)*Data$L,0,0.1) \\ \hspace*{0.27 in} log.psi0 <- rnorm(Data$J) \\ \hspace*{0.27 in} U <- rwishartc(Data$J+1, Data$S) \\ \hspace*{0.27 in} log.psi1 <- as.vector(rmvnpc(Data$G, log.psi0, U)) \\ \hspace*{0.27 in} tau <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, log.beta, log.delta, log.psi0, log.psi1, tau, \\ \hspace*{0.62 in} U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(G=G, J=J, K=K, L=L, N=N, PGF=PGF, S=S, X1=X1, X2=X2, Y=Y, \\ \hspace*{0.27 in} Z=Z, m=m, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.log.beta=pos.log.beta, \\ \hspace*{0.27 in} pos.log.delta=pos.log.delta, pos.log.psi0=pos.log.psi0, \\ \hspace*{0.27 in} pos.log.psi1=pos.log.psi1, pos.tau=pos.tau) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha], 0, 1) \\ \hspace*{0.27 in} log.beta <- parm[Data$pos.log.beta] \\ \hspace*{0.27 in} log.delta <- matrix(parm[Data$pos.log.delta], Data$J-1, Data$L) \\ \hspace*{0.27 in} log.psi0 <- parm[Data$pos.log.psi0] \\ \hspace*{0.27 in} log.psi1 <- matrix(parm[Data$pos.log.psi1], Data$G, Data$J) \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} lambda <- tcrossprod(Data$Z, t(log.psi1)) + \\ \hspace*{0.62 in} matrix(tcrossprod(Data$X1, t(log.beta)), Data$N, Data$J) + \\ \hspace*{0.62 in} tcrossprod(Data$X2, rbind(log.delta, colSums(log.delta)*-1)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$J+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} alpha.prior <- sum(dunif(alpha, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} log.beta.prior <- sum(dnormv(log.beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} log.delta.prior <- sum(dnormv(log.delta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} log.psi0.prior <- sum(dnormv(log.psi0, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} log.psi1.prior <- sum(dmvnpc(lambda, \\ \hspace*{0.62 in} matrix(log.psi0, Data$N, Data$J, byrow=TRUE), U, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- sum(dhalfcauchy(tau, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} alpha <- matrix(alpha, Data$N, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} lambda <- exp(lambda)*(Data$Y + 1)\textasciicircum alpha \\ \hspace*{0.27 in} tau <- matrix(tau, Data$N, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dgamma(Data$Y+1, lambda*tau, tau, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + U.prior + alpha.prior + log.beta.prior + log.delta.prior + \\ \hspace*{0.62 in} log.psi0.prior + log.psi1.prior + tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rgamma(prod(dim(lambda)), lambda*tau, tau)-1, \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(runif(J,0.9,1), rnorm(K,0,0.1), \\ \hspace*{0.27 in} rnorm((J-1)*L,0,0.1), rnorm(J,0,0.1), \\ \hspace*{0.27 in} rmvnpc(G, rnorm(J,0,0.1), rwishartc(J+1,S)), runif(J), \\ \hspace*{0.27 in} upper.triangle(rwishartc(J+1,S), diag=TRUE))} \section{Multivariate Binary Probit} \label{multiv.bin.probit} \subsection{Form} $$\textbf{W}_{i,1:J} \sim \mathcal{N}_J(\mu_{i,1:J}, \Omega^{-1}), \quad i=1,\dots,N$$ \[\textbf{W}_{i,j} \in \left\{ \begin{array}{l l} $[0,10]$ & \quad \mbox{if $\textbf{y}_i = j$}\\ $[-10,0]$ \\ \end{array} \right. \] $$\mu_{1:N,j} = \textbf{X} \beta_{j,1:K}$$ $$\Omega = \rho^{-1}$$ $$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\beta_{J,k} = - \sum^{J-1}_{j=1} \beta_{j,k}$$ $$\rho \sim \mathcal{U}(-1, 1)$$ \subsection{Data} \code{N <- 30 \\ J <- 2 \#Number of binary dependent variables \\ K <- 3 \#Number of columns to be in design matrix X \\ X <- cbind(1, matrix(rnorm(N*(K-1),0,1), N, K-1)) \\ beta <- matrix(rnorm(J*K), J, K) \\ mu <- tcrossprod(X, beta) \\ u <- runif(length(which(upper.tri(diag(J)) == TRUE)), -1, 1) \\ rho <- diag(J) \\ rho[upper.tri(rho)] <- u \\ rho[lower.tri(rho)] <- t(rho)[lower.tri(rho)] \\ rho <- as.positive.semidefinite(rho) \\ Omega <- as.inverse(rho) \\ U <- chol(Omega) \\ W <- interval(rmvnpc(N, mu, U) + matrix(rnorm(N*J,0,0.1), N, J), \\ \hspace*{0.27 in} -10, 10) \\ Y <- 1 * (W >= 0) \\ apply(Y, 2, table) \\ mon.names <- "LP" \\ rho <- matrix(NA, J, J) \\ rho[upper.tri(rho)] <- 0 \\ parm.names <- as.parm.names(list(beta=matrix(0,J,K), rho=rho, \\ \hspace*{0.27 in} W=matrix(0,N,J))) \\ pos.beta <- grep("beta", parm.names) \\ pos.rho <- grep("rho", parm.names) \\ pos.W <- grep("W", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J*Data$K) \\ \hspace*{0.27 in} rho <- rep(0, length(which(upper.tri(diag(Data$J))))) \\ \hspace*{0.27 in} W <- matrix(runif(Data$N*Data$J,-10,0), Data$N, Data$J) \\ \hspace*{0.27 in} W <- ifelse(Y == 1, abs(W), W) \\ \hspace*{0.27 in} return(c(beta, rho, as.vector(W)))\} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.rho=pos.rho, pos.W=pos.W) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J, Data$K) \\ \hspace*{0.27 in} u <- interval(parm[Data$pos.rho], -1, 1) \\ \hspace*{0.27 in} rho <- diag(MyData$J) \\ \hspace*{0.27 in} rho[upper.tri(rho)] <- u \\ \hspace*{0.27 in} rho[lower.tri(rho)] <- t(rho)[lower.tri(rho)] \\ \hspace*{0.27 in} if(is.positive.semidefinite(rho) == FALSE) \\ \hspace*{0.62 in} rho <- as.positive.semidefinite(rho) \\ \hspace*{0.27 in} parm[Data$pos.rho] <- upper.triangle(rho) \\ \hspace*{0.27 in} Omega <- as.inverse(rho) \\ \hspace*{0.27 in} U <- chol(Omega) \\ \hspace*{0.27 in} W <- matrix(parm[Data$pos.W], Data$N, Data$J) \\ \hspace*{0.27 in} W[Data$Y == 0] <- interval(W[Data$Y == 0], -10, 0) \\ \hspace*{0.27 in} W[Data$Y == 1] <- interval(W[Data$Y == 1], 0, 10) \\ \hspace*{0.27 in} parm[Data$pos.W] <- as.vector(W) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} rho.prior <- sum(dunif(u, -1, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} LL <- sum(dmvnpc(W, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + rho.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=1*(rmvnpc(nrow(mu), mu, U) >= 0), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)} \section{Multivariate Laplace Regression} \label{multivariate.lap.reg} \subsection{Form} $$\textbf{Y}_{i,k} \sim \mathcal{L}_K(\mu_{i,k}, \Sigma), \quad i=1,\dots,N; \quad k=1,\dots,K$$ $$\mu_{i,k} = \textbf{X}_{1:N,k} \beta_{k,1:J}$$ $$\Sigma = \Omega^{-1}$$ $$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$ $$\beta_{k,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{data(mtcars) \\ Y <- as.matrix(mtcars[,c(1,7)]) \\ X <- cbind(1, as.matrix(mtcars[,c(3,4,6)])) \\ N <- nrow(Y) \#Number of records \\ J <- ncol(X) \#Number of columns in design matrix \\ K <- ncol(Y) \#Number of DVs \\ S <- diag(K) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,K,J), U=diag(K)), \\ \hspace*{0.27 in} uppertri=c(0,1)) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K*Data$J) \\ \hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\ \hspace*{0.27 in} return(c(beta, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$J) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishart(U, Data$K+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} LL <- sum(dmvlc(Data$Y, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rmvlc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J*K), upper.triangle(S, diag=TRUE))} \section{Multivariate Poisson Regression} \label{multivariate.pois.reg} \subsection{Form} $$\textbf{Y}_{i,k} \sim \mathcal{P}(\lambda_{i,k}), \quad i=1,\dots,N \quad k=1,\dots,K$$ $$\lambda_{i,k} = \exp(\textbf{X}_{i,k}\beta_{k,1:J} + \gamma_{i,k}), \quad i=1,\dots,N, \quad k=1,\dots,K$$ $$\beta_{k,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J, \quad k=1,\dots,K$$ $$\gamma_{i,1:K} \sim \mathcal{N}_K(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$ \subsection{Data} \code{N <- 20 \#Number of records \\ J <- 4 \#Number of columns in design matrix \\ K <- 3 \#Number of DVs \\ X <- matrix(runif(N*J),N,J); X[,1] <- 1 \\ beta <- matrix(rnorm(K*J),K,J) \\ Omega <- matrix(runif(K*K),K,K); diag(Omega) <- runif(K,1,K) \\ Omega <- as.symmetric.matrix(Omega) \\ gamma <- rmvnp(N, 0, Omega) \\ Y <- round(exp(tcrossprod(X, beta) + gamma)) \\ S <- diag(K) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,K,J), gamma=matrix(0,N,K), \\ \hspace*{0.27 in} U=S), uppertri=c(0,0,1)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K*Data$J) \\ \hspace*{0.27 in} gamma <- rnorm(Data$N*Data$K) \\ \hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\ \hspace*{0.27 in} return(c(beta, gamma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$J) \\ \hspace*{0.27 in} gamma <- matrix(parm[Data$pos.gamma], Data$N, Data$K) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dmvnpc(gamma, 0, U, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$K+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(tcrossprod(Data$X, beta) + gamma) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$Y, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(prod(dim(lambda)), lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K*J), rep(0,N*K), rep(0,K*(K+1)/2))} \section{Multivariate Regression} \label{multivariate.reg} \subsection{Form} $$\textbf{Y}_{i,k} \sim \mathcal{N}_K(\mu_{i,k}, \Sigma), \quad i=1,\dots,N; \quad k=1,\dots,K$$ $$\mu_{i,k} = \textbf{X}_{1:N,k} \beta_{k,1:J}$$ $$\Sigma \sim \mathcal{HW}_{2}(\gamma, 1e6)$$ $$\beta_{k,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J, \quad k=1,\dots,K$$ \subsection{Data} \code{data(mtcars) \\ Y <- as.matrix(mtcars[,c(1,7)]) \\ X <- cbind(1, as.matrix(mtcars[,c(3,4,6)])) \\ N <- nrow(Y) \#Number of records \\ J <- ncol(X) \#Number of columns in design matrix \\ K <- ncol(Y) \#Number of DVs \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,K,J), gamma=rep(0,K), \\ \hspace*{0.27 in} U=diag(K)), uppertri=c(0,0,1)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K*Data$J) \\ \hspace*{0.27 in} gamma <- runif(Data$K) \\ \hspace*{0.27 in} U <- rhuangwandc(2, gamma, rep(1,Data$K)) \\ \hspace*{0.27 in} return(c(beta, gamma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$J) \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} HW.prior <- dhuangwandc(U, 2, gamma, rep(1e6,Data$K), log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} LL <- sum(dmvnc(Data$Y, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rmvnc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J*K), rep(1,K), rep(0,K*(K+1)/2))} \section{Negative Binomial Regression} \label{negbin.reg} This example was contributed by Jim Robison-Cox. \subsection{Form} $$\textbf{y} \sim \mathcal{NB}(\mu, \kappa)$$ $$p = \frac{\kappa}{\kappa + \mu}$$ $$\mu = \exp(\textbf{X} \beta)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\kappa \sim \mathcal{HC}(25) \in (0,\infty]$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \#Number of predictors, including the intercept \\ kappa.orig <- 2 \\ beta.orig <- runif(J,-2,2) \\ X <- matrix(runif(J*N,-2, 2), N, J); X[,1] <- 1 \\ mu <- exp(tcrossprod(X, t(beta.orig)) + rnorm(N)) \\ p <- kappa.orig / (kappa.orig + mu) \\ y <- rnbinom(N, size=kappa.orig, mu=mu) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), kappa=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.kappa <- grep("kappa", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} kappa <- runif(1) \\ \hspace*{0.27 in} return(c(beta, kappa)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.kappa=pos.kappa, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$J + 1] <- kappa <- interval(parm[Data$pos.kappa], \\ \hspace*{0.62 in} .Machine$double.xmin, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} kappa.prior <- dhalfcauchy(kappa, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- as.vector(exp(tcrossprod(Data$X, t(beta)))) \\ \hspace*{0.27 in} \#p <- kappa / (kappa + mu) \\ \hspace*{0.27 in} LL <- sum(dnbinom(Data$y, size=kappa, mu=mu, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + kappa.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnbinom(length(mu), size=kappa, mu=mu), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Normal, Multilevel} \label{norm.ml} This is Gelman's school example \citep{gelman04}. Note that \pkg{LaplacesDemon} is slower to converge than \proglang{WinBUGS} through the \pkg{R2WinBUGS} package \citep{r:r2winbugs}, an \proglang{R} package on CRAN. This example is very sensitive to the prior distributions. The recommended, default, half-Cauchy priors with scale 25 on scale parameters overwhelms the likelihood, so uniform priors are used. \subsection{Form} $$\textbf{y}_j \sim \mathcal{N}(\theta_j, \sigma^2_j), \quad j=1,\dots,J$$ $$\theta_j \sim \mathcal{N}(\theta_{\mu}, \theta_\sigma^2)$$ $$\theta_{\mu} \sim \mathcal{N}(0, 1000000)$$ $$\theta_{\sigma[j]} \sim \mathcal{N}(0, 1000)$$ $$\sigma \sim \mathcal{U}(0, 1000)$$ \subsection{Data} \code{J <- 8 \\ y <- c(28.4, 7.9, -2.8, 6.8, -0.6, 0.6, 18.0, 12.2) \\ sd <- c(14.9, 10.2, 16.3, 11.0, 9.4, 11.4, 10.4, 17.6) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(theta=rep(0,J), theta.mu=0, \\ \hspace*{0.27 in} theta.sigma=0)) \\ pos.theta <- 1:J \\ pos.theta.mu <- J+1 \\ pos.theta.sigma <- J+2 \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} theta.mu <- rnorm(1) \\ \hspace*{0.27 in} theta.sigma <- runif(1) \\ \hspace*{0.27 in} theta <- rnorm(Data$J, theta.mu, theta.sigma) \\ \hspace*{0.27 in} return(c(theta, theta.mu, theta.sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.theta=pos.theta, pos.theta.mu=pos.theta.mu, \\ \hspace*{0.27 in} pos.theta.sigma=pos.theta.sigma, sd=sd, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} theta.mu <- parm[Data$pos.theta.mu] \\ \hspace*{0.27 in} theta.sigma <- interval(parm[Data$pos.theta.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.theta.sigma] <- theta.sigma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} theta.mu.prior <- dnormp(theta.mu, 0, 1.0E-6, log=TRUE) \\ \hspace*{0.27 in} theta.sigma.prior <- dunif(theta.sigma, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} theta.prior <- sum(dnorm(theta, theta.mu, theta.sigma, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dunif(Data$sd, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, theta, Data$sd, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + theta.prior + theta.mu.prior + theta.sigma.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(theta), theta, Data$sd), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(mean(y),J), mean(y), 1)} \section{Ordinal Logit} \label{ordinal.logit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(P_{i,1:J})$$ $$P_{,J} = 1 - Q_{,(J-1)}$$ $$P_{,j} = |Q_{,j} - Q_{,(j-1)}|, \quad j=2,\dots,(J-1)$$ $$P_{,1} = Q_{,1}$$ $$Q = \frac{1}{1 + \exp(\mu)}$$ $$\mu_{,j} = \delta_j - \textbf{X} \beta, \quad \in [-5,5]$$ $$\beta_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\delta_j \sim \mathcal{N}(0, 1) \in [(j-1),j] \in [-5,5], \quad j=1,\dots,(J-1)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- 3 \#Number of categories in y \\ X <- as.matrix(demonsnacks[,c(1,3:10)]) \\ K <- ncol(demonsnacks) \#Number of columns in design matrix X \\ y <- log(demonsnacks$Calories) \\ y <- ifelse(y < 4.5669, 1, ifelse(y > 5.5268, 3, 2)) \#Discretize \\ for (k in 1:K) X[,k] <- CenterScale(X[,k]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,K), delta=rep(0,J-1))) \\ pos.beta <- grep("beta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K) \\ \hspace*{0.27 in} delta <- sort(rnorm(Data$J-1)) \\ \hspace*{0.27 in} return(c(beta, delta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.delta=pos.delta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], -5, 5) \\ \hspace*{0.27 in} delta <- sort(delta) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dtrunc(delta, "norm", a=-5, b=5, log=TRUE, \\ \hspace*{0.62 in} mean=0, sd=1) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(delta, Data$N, Data$J-1, byrow=TRUE) - \\ \hspace*{0.62 in} matrix(tcrossprod(Data$X, t(beta)), Data$N, Data$J-1) \\ \hspace*{0.27 in} P <- Q <- invlogit(mu) \\ \hspace*{0.27 in} P[,-1] <- abs(Q[,-1] - Q[,-(Data$J-1)]) \\ \hspace*{0.27 in} P <- cbind(P, 1 - Q[,(Data$J-1)]) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, P, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + delta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(P), P) \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), seq(from=-1, to=1, len=(J-1)))} \section{Ordinal Probit} \label{ordinal.probit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(P_{i,1:J})$$ $$P_{,J} = 1 - Q_{,(J-1)}$$ $$P_{,j} = |Q_{,j} - Q_{,(j-1)}|, \quad j=2,\dots,(J-1)$$ $$P_{,1} = Q_{,1}$$ $$Q = \phi(\mu)$$ $$\mu_{,j} = \delta_j - \textbf{X} \beta, \quad \in [-5,5]$$ $$\beta_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\delta_j \sim \mathcal{N}(0, 1) \in [(j-1),j] \in [-5,5], \quad j=1,\dots,(J-1)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- 3 \#Number of categories in y \\ X <- as.matrix(demonsnacks[,c(1,3:10)]) \\ K <- ncol(demonsnacks) \#Number of columns in design matrix X \\ y <- log(demonsnacks$Calories) \\ y <- ifelse(y < 4.5669, 1, ifelse(y > 5.5268, 3, 2)) \#Discretize \\ for (k in 1:K) X[,k] <- CenterScale(X[,k]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,K), delta=rep(0,J-1))) \\ pos.beta <- grep("beta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K) \\ \hspace*{0.27 in} delta <- sort(rnorm(Data$J-1)) \\ \hspace*{0.27 in} return(c(beta, delta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.delta=pos.delta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], -5, 5) \\ \hspace*{0.27 in} delta <- sort(delta) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dtrunc(delta, "norm", a=-5, b=5, log=TRUE, \\ \hspace*{0.62 in} mean=0, sd=1) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(delta, Data$N, Data$J-1, byrow=TRUE) - \\ \hspace*{0.62 in} matrix(tcrossprod(Data$X, t(beta)), Data$N, Data$J-1) \\ \hspace*{0.27 in} P <- Q <- pnorm(mu) \\ \hspace*{0.27 in} P[,-1] <- abs(Q[,-1] - Q[,-(Data$J-1)]) \\ \hspace*{0.27 in} P <- cbind(P, 1 - Q[,(Data$J-1)]) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, P, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + delta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(P), P) \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), seq(from=-1, to=1, len=(J-1)))} \section{Panel, Autoregressive Poisson} \label{panel.ap} \subsection{Form} $$\textbf{Y} \sim \mathcal{P}(\Lambda)$$ $$\Lambda_{1:N,1} = \exp(\alpha + \beta \textbf{x})$$ $$\Lambda_{1:N,t} = \exp(\alpha + \beta \textbf{x} + \rho \log(\textbf{Y}_{1:N,t-1})), \quad t=2,\dots,T$$ $$\alpha_i \sim \mathcal{N}(\alpha_\mu, \alpha^2_\sigma), \quad i=1,\dots,N$$ $$\alpha_\mu \sim \mathcal{N}(0, 1000)$$ $$\alpha_\sigma \sim \mathcal{HC}(25)$$ $$\beta \sim \mathcal{N}(0, 1000)$$ $$\rho \sim \mathcal{N}(0, 1000)$$ \subsection{Data} \code{N <- 10 \\ T <- 10 \\ alpha <- rnorm(N,2,0.5) \\ rho <- 0.5 \\ beta <- 0.5 \\ x <- runif(N,0,1) \\ Y <- matrix(NA,N,T) \\ Y[,1] <- exp(alpha + beta*x) \\ for (t in 2:T) \{Y[,t] <- exp(alpha + beta*x + rho*log(Y[,t-1]))\} \\ Y <- round(Y) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,N), alpha.mu=0, \\ \hspace*{0.27 in} alpha.sigma=0, beta=0, rho=0)) \\ pos.alpha <- 1:N \\ pos.alpha.mu <- grep("alpha.mu", parm.names) \\ pos.alpha.sigma <- grep("alpha.sigma", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.rho <- grep("rho", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha.mu <- rnorm(1) \\ \hspace*{0.27 in} alpha.sigma <- runif(1) \\ \hspace*{0.27 in} alpha <- rnorm(Data$N, alpha.mu, alpha.sigma) \\ \hspace*{0.27 in} beta <- rnorm(1) \\ \hspace*{0.27 in} rho <- rnorm(1) \\ \hspace*{0.27 in} return(c(alpha, alpha.mu, alpha.sigma, beta, rho)) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.alpha.mu=pos.alpha.mu, \\ \hspace*{0.27 in} pos.alpha.sigma=pos.alpha.sigma, pos.beta=pos.beta, pos.rho=pos.rho, \\ \hspace*{0.27 in} x=x) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} alpha.mu <- parm[Data$pos.alpha.mu] \\ \hspace*{0.27 in} alpha.sigma <- interval(parm[Data$pos.alpha.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.alpha.sigma] <- alpha.sigma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} rho <- parm[Data$pos.rho] \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} alpha.mu.prior <- dnormv(alpha.mu, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} alpha.sigma.prior <- dhalfcauchy(alpha.sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnorm(alpha, alpha.mu, alpha.sigma, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- dnormv(beta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} rho.prior <- dnormv(rho, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Lambda <- Data$Y \\ \hspace*{0.27 in} Lambda[,1] <- exp(alpha + beta*x) \\ \hspace*{0.27 in} Lambda[,2:Data$T] <- exp(alpha + beta*Data$x + \\ \hspace*{0.62 in} rho*log(Data$Y[,1:(Data$T-1)])) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$Y, Lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + alpha.mu.prior + alpha.sigma.prior + \\ \hspace*{0.62 in} beta.prior + rho.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(prod(dim(Lambda)), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N), 0, 1, 0, 0)} \section{Penalized Spline Regression} \label{pspline} This example applies penalized splines to one predictor in a linear regression. The user selects the degree of the polynomial, $D$, and the number of knots, $K$. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$\mu = \textbf{X} \beta + \textbf{S}$$ $$\textbf{S} = \textbf{Z} \gamma$$ \[\textbf{Z}_{i,k} = \left\{ \begin{array}{l l} (\textbf{x}_i - k)^D & \quad \mbox{if $\textbf{Z}_{i,k} > 0$}\\ 0 \\ \end{array} \right. \] $$\beta_d \sim \mathcal{N}(0, 1000), \quad d=1,\dots,(D+1)$$ $$\gamma_k \sim \mathcal{N}(0, \sigma^2_2), \quad k=1,\dots,K$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$ \subsection{Data} \code{N <- 100 \\ x <- 1:N \\ y <- sin(2*pi*x/N) + runif(N,-1,1) \\ K <- 10 \#Number of knots \\ D <- 2 \#Degree of polynomial \\ x <- CenterScale(x) \\ k <- as.vector(quantile(x, probs=(1:K / (K+1)))) \\ X <- cbind(1, matrix(x, N, D)) \\ for (d in 1:D) \{X[,d+1] <- X[,d+1]\textasciicircum d\} \\ Z <- matrix(x, N, K) - matrix(k, N, K, byrow=TRUE) \\ Z <- ifelse(Z > 0, Z, 0); Z <- Z\textasciicircum D \\ mon.names <- c("LP", paste("S[", 1:nrow(X) ,"]", sep="")) \\ parm.names <- as.parm.names(list(beta=rep(0,1+D), gamma=rep(0,K), \\ \hspace*{0.27 in} log.sigma=rep(0,2))) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(1+Data$D) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} return(c(beta, gamma, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, K=K, N=N, PGF=PGF, Z=Z, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} S <- as.vector(tcrossprod(Data$Z, t(gamma))) \\ \hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) + S \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,S), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,1+D), rep(0,K), c(1,1))} \section{Poisson Regression} \label{poisson.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{P}(\lambda)$$ $$\lambda = \exp(\textbf{X}\beta)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{N <- 10000 \\ J <- 5 \\ X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \\ beta <- runif(J,-2,2) \\ y <- round(exp(tcrossprod(X, t(beta)))) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(tcrossprod(Data$X, t(beta))) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$y, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(length(lambda), lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Polynomial Regression} \label{polynomial.reg} In this univariate example, the degree of the polynomial is specified as $D$. For a more robust extension to estimating nonlinear relationships between $\textbf{y}$ and $\textbf{x}$, see penalized spline regression in section \ref{penalized.spline}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X} \beta$$ $$\textbf{X}_{i,d} = \textbf{x}^{d-1}_i, \quad d=1,\dots,(D+1)$$ $$\textbf{X}_{i,1} = 1$$ $$\beta_d \sim \mathcal{N}(0, 1000), \quad d=1,\dots,(D+1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ D <- 2 \#Degree of polynomial \\ y <- log(demonsnacks$Calories) \\ x <- log(demonsnacks[,10]+1) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,D+1), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(1+Data$D) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, N=N, PGF=PGF, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, x=x, \\ \hspace*{0.27 in} y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} X <- matrix(Data$x, Data$N, Data$D) \\ \hspace*{0.27 in} for (d in 2:Data$D) \{X[,d] <- X[,d]\textasciicircum d\} \\ \hspace*{0.27 in} X <- cbind(1,X) \\ \hspace*{0.27 in} mu <- tcrossprod(X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,D+1), 1)} \section{Proportional Hazards Regression, Weibull} \label{prop.haz.weib} Although the dependent variable is usually denoted as $\textbf{t}$ in survival analysis, it is denoted here as $\textbf{y}$ so Laplace's Demon recognizes it as a dependent variable for posterior predictive checks. This example does not support censoring, but it will be included soon. \subsection{Form} $$\textbf{y}_i \sim \mathcal{WEIB}(\gamma, \mu_i), \quad i=1,\dots,N$$ $$\mu = \exp(\textbf{X} \beta)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\gamma \sim \mathcal{G}(1, 0.001)$$ \subsection{Data} \code{N <- 50 \\ J <- 5 \\ X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \\ beta <- c(1,runif(J-1,-1,1)) \\ y <- round(exp(tcrossprod(X, t(beta)))) + 1 \# Undefined at zero \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), gamma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} gamma <- rgamma(1,1e-3) \\ \hspace*{0.27 in} return(c(beta, gamma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- dgamma(gamma, 1, 1.0E-3, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- exp(tcrossprod(Data$X, t(beta))) \\ \hspace*{0.27 in} LL <- sum(dweibull(Data$y, gamma, mu, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rweibull(length(mu), gamma, mu), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{PVAR(p)} \label{pvarp} This is a Poisson vector autoregression, with autoregressive order $p$, for multivariate time-series of counts. It allows for dynamic processes and accounts for overdispersion. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{P}(\lambda_{t,j}), \quad t=1,\dots,T \quad j=1,\dots,J$$ $$\lambda_{t,j} = \sum^P_{p=1} \Phi_{1:J,j,p} \textbf{Y}_{t-p,j} + \exp(\alpha_j + \gamma_{t,j})$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\Phi_{i,k,p} \sim \mathcal{N}(\Phi^\mu_{i,k,p}, \Sigma_{i,k,p}), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\gamma_{t,1:J} \sim \mathcal{N}_J(0, \Omega^{-1}), \quad t=1,\dots,T$$ $$\Omega \sim \mathcal{W}_{J+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$ where $\Phi^\mu$ and $\Sigma$ are set according to the Minnesota prior. \subsection{Data} \code{data(demonsessions) \\ Y.orig <- as.matrix(demonsessions) \\ Y <- Y.orig[1:24,1:5] \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L <- c(1,2,3) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ Phi.mu <- array(0, dim=c(J,J,P)) \\ Phi.mu[, , 1] <- diag(J) \\ S <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), \\ \hspace*{0.27 in} Phi=array(0, dim=c(J,J,P)), gamma=matrix(0,T-L[P],J), U=S), \\ \hspace*{0.27 in} uppertri=c(0,0,0,1)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1e-10, 1e-10) \\ \hspace*{0.27 in} gamma <- rnorm((Data$T-Data$L[Data$P])*Data$J) \\ \hspace*{0.27 in} U <- rwishartc(Data$J+1, diag(Data$J)) \\ \hspace*{0.27 in} return(c(alpha, Phi, gamma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, L=L, P=P, PGF=PGF, Phi.mu=Phi.mu, S=S, T=T, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.Phi=pos.Phi, pos.gamma=pos.gamma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} gamma <- matrix(parm[Data$pos.gamma], Data$T-Data$L[Data$P], Data$J) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} Omega <- t(U) \%*\% U \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, theta=0.5, \\ \hspace*{0.62 in} diag(as.inverse(Omega))) \\ \hspace*{0.27 in} Phi.prior <- sum(dnormv(Phi, Data$Phi.mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dmvnp(gamma, 0, Omega, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishart(Omega, Data$J+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(matrix(alpha, Data$T, Data$J, byrow=TRUE) + \\ \hspace*{0.62 in} rbind(matrix(0, Data$L[Data$P], Data$J), gamma)) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} lambda[(1+Data$L[p]):Data$T,] <- lambda[(1+Data$L[p]):Data$T,] + \\ \hspace*{0.95 in} Data$Y[1:(Data$T-Data$L[p]),] %*% Phi[, , p] \\ \hspace*{0.27 in} LL <- sum(dpois(Data$Y[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} lambda[(1+Data$L[Data$P]):Data$T,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + Phi.prior + gamma.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(prod(dim(lambda)), lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(0,J*J*P), rep(0,(T-L[P])*J), \\ \hspace*{0.27 in} rep(0,J*(J+1)/2))} \section{Quantile Regression} \label{quantile.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\phi, \sigma^2)$$ $$\phi = \frac{(1 - 2P)}{P(1 - P)} \zeta + \mu$$ $$\mu = \textbf{X} \beta$$ $$\sigma = \frac{P (1 - P) \tau}{2 \zeta}$$ $$\beta \sim \mathcal{N}(0, 1000)$$ $$\tau \sim \mathcal{HC}(25)$$ $$\zeta \sim \mathcal{EXP}(\tau)$$ where $P$ is the user-specified quantile in $(0,1)$. \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ N <- nrow(X) \\ J <- ncol(X) \\ P <- 0.5 \#Quantile in (0,1) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), tau=0, zeta=rep(0,N))) \\ pos.beta <- grep("beta", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ pos.zeta <- grep("zeta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} zeta <- rexp(Data$N, tau) \\ \hspace*{0.27 in} return(c(beta, tau, zeta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, P=P, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.tau=pos.tau, \\ \hspace*{0.27 in} pos.zeta=pos.zeta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} zeta <- interval(parm[Data$pos.zeta], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.zeta] <- zeta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} zeta.prior <- sum(dexp(zeta, tau, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} phi <- (1 - 2*Data$P) / (Data$P*(1 - Data$P))*zeta + mu \\ \hspace*{0.27 in} sigma <- (Data$P*(1 - Data$P)*tau) / (2*zeta) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, phi, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + tau.prior + zeta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(phi), phi, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1, rep(1,N))} \section{Revision, Normal} \label{revision.normal} This example provides both an analytic solution and numerical approximation of the revision of a normal distribution. Given a normal prior distribution ($\alpha$) and data distribution ($\beta$), the posterior ($\gamma$) is the revised normal distribution. This is an introductory example of Bayesian inference, and allows the user to experiment with numerical approximation, such as with MCMC in \code{LaplacesDemon}. Note that, regardless of the data sample size $N$ in this example, Laplace Approximation is inappropriate due to asymptotics since the data ($\beta$) is perceived by the algorithm as a single datum rather than a collection of data. MCMC, on the other hand, is biased only by the effective number of samples taken of the posterior. \\ \code{\#\#\# Analytic Solution \\ prior.mu <- 0 \\ prior.sigma <- 10 \\ N <- 10 \\ data.mu <- 1 \\ data.sigma <- 2 \\ posterior.mu <- (prior.sigma\textasciicircum -2 * prior.mu + N * data.sigma\textasciicircum -2 * data.mu) / \\ \hspace*{0.27 in} (prior.sigma\textasciicircum -2 + N * data.sigma\textasciicircum -2) \\ posterior.sigma <- sqrt(1/(prior.sigma\textasciicircum -2 + data.sigma\textasciicircum -2)) \\ posterior.mu \\ posterior.sigma \\ } \subsection{Form} $$\alpha \sim \mathcal{N}(0,10)$$ $$\beta \sim \mathcal{N}(1,2)$$ $$\gamma = \frac{\alpha^{-2}_\sigma \alpha + N \beta^{-2}_\sigma \beta}{\alpha^{-2}_\sigma + N \beta^{-2}_\sigma}$$ \subsection{Data} \code{N <- 10 \\ mon.names <- c("LP","gamma") \\ parm.names <- c("alpha","beta") \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1,0,10) \\ \hspace*{0.27 in} beta <- rnorm(1,1,2) \\ \hspace*{0.27 in} return(c(alpha, beta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, mon.names=mon.names, parm.names=parm.names) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} alpha.mu <- 0 \\ \hspace*{0.27 in} alpha.sigma <- 10 \\ \hspace*{0.27 in} beta.mu <- 1 \\ \hspace*{0.27 in} beta.sigma <- 2 \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[1] \\ \hspace*{0.27 in} beta <- parm[2] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnorm(alpha, alpha.mu, alpha.sigma, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- dnorm(beta, beta.mu, beta.sigma, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Posterior \\ \hspace*{0.27 in} gamma <- (alpha.sigma\textasciicircum -2 * alpha + N * beta.sigma\textasciicircum -2 * beta) / \\ \hspace*{0.62 in} (alpha.sigma\textasciicircum -2 + N * beta.sigma\textasciicircum -2) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,gamma), \\ \hspace*{0.62 in} yhat=rnorm(1, beta.mu, beta.sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0,0)} \section{Ridge Regression} \label{ridge.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$\mu = \textbf{X}\beta$$ $$\beta_1 \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=2,\dots,J$$ $$\sigma_k \sim \mathcal{HC}(25), \quad k=1,\dots,2$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,-2]+1))) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=rep(0,2))) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, c(1000, rep(sigma[2], Data$J-1)), \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(1,J), rep(1,2))} \section{Robust Regression} \label{robust.reg} By replacing the normal distribution with the Student t distribution, linear regression is often called robust regression. As an alternative approach to robust regression, consider Laplace regression (see section \ref{laplace.reg}). \subsection{Form} $$\textbf{y} \sim \mathrm{t}(\mu, \sigma^2, \nu)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\nu \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta <- runif(J,-3,3) \\ e <- rst(N,0,1,5) \\ y <- tcrossprod(X, t(beta)) + e \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0, nu=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} nu <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma, nu)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.nu=pos.nu, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- dhalfcauchy(nu, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dst(Data$y, mu, sigma, nu, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior + nu.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rst(length(mu), mu, sigma, nu), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1, 5)} \section{Seemingly Unrelated Regression (SUR)} \label{sur} The following data was used by \citet{zellner62} when introducing the Seemingly Unrelated Regression methodology. This model uses the Yang-Berger prior distribution for the precision matrix of a multivariate normal distribution. \subsection{Form} $$\textbf{Y}_{t,k} \sim \mathcal{N}_K(\mu_{t,k}, \Omega^{-1}), \quad t=1,\dots,T, \quad k=1,\dots,K$$ $$\mu_{1,t} = \alpha_1 + \alpha_2 \textbf{X}_{t-1,1} + \alpha_3 \textbf{X}_{t-1,2}, \quad t=2,\dots,T$$ $$\mu_{2,t} = \beta_1 + \beta_2 \textbf{X}_{t-1,3} + \beta_3 \textbf{X}_{t-1,4}, \quad t=2,\dots,T$$ $$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ where $J=3$, $K=2$, and $T=20$. \subsection{Data} \code{T <- 20 \#Time-periods \\ year <- c(1935,1936,1937,1938,1939,1940,1941,1942,1943,1944,1945,1946, \\ \hspace*{0.27 in} 1947,1948,1949,1950,1951,1952,1953,1954) \\ IG <- c(33.1,45.0,77.2,44.6,48.1,74.4,113.0,91.9,61.3,56.8,93.6,159.9, \\ \hspace*{0.27 in} 147.2,146.3,98.3,93.5,135.2,157.3,179.5,189.6) \\ VG <- c(1170.6,2015.8,2803.3,2039.7,2256.2,2132.2,1834.1,1588.0,1749.4, \\ \hspace*{0.27 in} 1687.2,2007.7,2208.3,1656.7,1604.4,1431.8,1610.5,1819.4,2079.7, \\ \hspace*{0.27 in} 2371.6,2759.9) \\ CG <- c(97.8,104.4,118.0,156.2,172.6,186.6,220.9,287.8,319.9,321.3,319.6, \\ \hspace*{0.27 in} 346.0,456.4,543.4,618.3,647.4,671.3,726.1,800.3,888.9) \\ IW <- c(12.93,25.90,35.05,22.89,18.84,28.57,48.51,43.34,37.02,37.81, \\ \hspace*{0.27 in} 39.27,53.46,55.56,49.56,32.04,32.24,54.38,71.78,90.08,68.60) \\ VW <- c(191.5,516.0,729.0,560.4,519.9,628.5,537.1,561.2,617.2,626.7, \\ \hspace*{0.27 in} 737.2,760.5,581.4,662.3,583.8,635.2,723.8,864.1,1193.5,1188.9) \\ CW <- c(1.8,0.8,7.4,18.1,23.5,26.5,36.2,60.8,84.4,91.2,92.4,86.0,111.1, \\ \hspace*{0.27 in} 130.6,141.8,136.7,129.7,145.5,174.8,213.5) \\ J <- 2 \#Number of dependent variables \\ Y <- matrix(c(IG,IW), T, J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,3), beta=rep(0,3), \\ \hspace*{0.27 in} U=diag(J)), uppertri=c(0,0,1)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(3) \\ \hspace*{0.27 in} beta <- rnorm(3) \\ \hspace*{0.27 in} U <- runif(Data$J*(Data$J+1)/2) \\ \hspace*{0.27 in} return(c(alpha, beta, U)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, T=T, Y=Y, CG=CG, CW=CW, IG=IG, IW=IW, \\ \hspace*{0.27 in} VG=VG, VW=VW, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dyangbergerc(U, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- Data$Y \\ \hspace*{0.27 in} mu[-1,1] <- alpha[1] + alpha[2]*Data$CG[-Data$T] + \\ \hspace*{0.62 in} alpha[3]*Data$VG[-Data$T] \\ \hspace*{0.27 in} mu[-1,2] <- beta[1] + beta[2]*Data$CW[-Data$T] + \\ \hspace*{0.62 in} beta[3]*Data$VW[-Data$T] \\ \hspace*{0.27 in} LL <- sum(dmvnpc(Data$Y[-1,], mu[-1,], U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rmvnpc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,3), rep(0,3), rep(0,J*(J+1)/2))} \section{Simultaneous Equations} \label{simultaneous} This example of simultaneous equations uses Klein's Model I \citep{kleine50} regarding economic fluctations in the United States in 1920-1941 (\textbf{N}=22). Usually, this example is modeled with 3-stage least sqaures (3SLS), excluding the uncertainty from multiple stages. By constraining each element in the instrumental variables matrix $\nu \in [-10,10]$, this example estimates the model without resorting to stages. The dependent variable is matrix \textbf{Y}, in which $\textbf{Y}_{1,1:N}$ is \textbf{C} or Consumption, $\textbf{Y}_{2,1:N}$ is \textbf{I} or Investment, and $\textbf{Y}_{3,1:N}$ is \textbf{Wp} or Private Wages. Here is a data dictionary: \\ \code{\hspace*{0.27 in} A = Time Trend measured as years from 1931 \\ \hspace*{0.27 in} \textbf{C} = Consumption \\ \hspace*{0.27 in} \textbf{G} = Government Nonwage Spending \\ \hspace*{0.27 in} \textbf{I} = Investment \\ \hspace*{0.27 in} \textbf{K} = Capital Stock \\ \hspace*{0.27 in} \textbf{P} = Private (Corporate) Profits \\ \hspace*{0.27 in} \textbf{T} = Indirect Business Taxes Plus Neg Exports \\ \hspace*{0.27 in} \textbf{Wg} = Government Wage Bill \\ \hspace*{0.27 in} \textbf{Wp} = Private Wages \\ \hspace*{0.27 in} \textbf{X} = Equilibrium Demand (GNP) \\ } See \citet{kleine50} for more information. \subsection{Form} $$\textbf{Y} \sim \mathcal{N}_3(\mu, \Omega^{-1})$$ $$ \mu_{1,1} = \alpha_1 + \alpha_2 \nu_{1,1} + \alpha_4 \nu_{2,1}$$ $$ \mu_{1,i} = \alpha_1 + \alpha_2 \nu_{1,i} + \alpha_3 \textbf{P}_{i-1} + \alpha_4 \nu_{2,i}, \quad i=2,\dots,N$$ $$ \mu_{2,1} = \beta_1 + \beta_2 \nu_{1,1} + \beta_4 \textbf{K}_1$$ $$ \mu_{2,i} = \beta_1 + \beta_2 \nu_{1,i} + \beta_3 \textbf{P}_{i-1} + \beta_4 \textbf{K}_i, \quad i=2,\dots,N$$ $$\mu_{3,1} = \gamma_1 + \gamma_2 \nu_{3,1} + \gamma_4 \textbf{A}_1$$ $$\mu_{3,i} = \gamma_1 + \gamma_2 \nu_{3,i} + \gamma_3 \textbf{X}_{i-1} + \gamma_4 \textbf{A}_i, \quad i=2,\dots,N$$ $$\textbf{Z}_{j,i} \sim \mathcal{N}(\nu_{j,i}, \sigma^2_j), \quad j=1,\dots,3$$ $$\nu_{j,1} = \pi_{j,1} + \pi_{j,3} \textbf{K}_1 + \pi_{j,5} \textbf{A}_1 + \pi_{j,6} \textbf{T}_1 + \pi_{j,7} \textbf{G}_1, \quad j=1,\dots,3$$ $$\nu_{j,i} = \pi_{j,1} + \pi_{j,2} \textbf{P}_{i-1} + \pi_{j,3} \textbf{K}_i + \pi_{j,4} \textbf{X}_{i-1} + \pi_{j,5} \textbf{A}_i + \pi_{j,6} \textbf{T}_i + \pi \textbf{G}_i, \quad i=1,\dots,N, \quad j=1,\dots,3$$ $$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,4$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,4$$ $$\gamma_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,4$$ $$\pi_{j,i} \sim \mathcal{N}(0, 1000) \in [-10,10], \quad j=1,\dots,3, \quad i=1,\dots,N$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,3$$ $$\Omega \sim \mathcal{W}_4(\textbf{S}), \quad \textbf{S} = \textbf{I}_3$$ \subsection{Data} \code{N <- 22 \\ A <- c(-11,-10,-9,-8,-7,-6,-5,-4,-3,-2,-1,0,1,2,3,4,5,6,7,8,9,10) \\ C <- c(39.8,41.9,45,49.2,50.6,52.6,55.1,56.2,57.3,57.8,55,50.9,45.6,46.5, \\ \hspace*{0.27 in} 48.7,51.3,57.7,58.7,57.5,61.6,65,69.7) \\ G <- c(2.4,3.9,3.2,2.8,3.5,3.3,3.3,4,4.2,4.1,5.2,5.9,4.9,3.7,4,4.4,2.9,4.3, \\ \hspace*{0.27 in} 5.3,6.6,7.4,13.8) \\ I <- c(2.7,-0.2,1.9,5.2,3,5.1,5.6,4.2,3,5.1,1,-3.4,-6.2,-5.1,-3,-1.3,2.1,2, \\ \hspace*{0.27 in} -1.9,1.3,3.3,4.9) \\ K <- c(180.1,182.8,182.6,184.5,189.7,192.7,197.8,203.4,207.6,210.6,215.7, \\ \hspace*{0.27 in} 216.7,213.3,207.1,202,199,197.7,199.8,201.8,199.9,201.2,204.5) \\ P <- c(12.7,12.4,16.9,18.4,19.4,20.1,19.6,19.8,21.1,21.7,15.6,11.4,7,11.2, \\ \hspace*{0.27 in} 12.3,14,17.6,17.3,15.3,19,21.1,23.5) \\ T <- c(3.4,7.7,3.9,4.7,3.8,5.5,7,6.7,4.2,4,7.7,7.5,8.3,5.4,6.8,7.2,8.3,6.7, \\ \hspace*{0.27 in} 7.4,8.9,9.6,11.6) \\ Wg <- c(2.2,2.7,2.9,2.9,3.1,3.2,3.3,3.6,3.7,4,4.2,4.8,5.3,5.6,6,6.1,7.4, \\ \hspace*{0.27 in} 6.7,7.7,7.8,8,8.5) \\ Wp <- c(28.8,25.5,29.3,34.1,33.9,35.4,37.4,37.9,39.2,41.3,37.9,34.5,29,28.5, \\ \hspace*{0.27 in} 30.6,33.2,36.8,41,38.2,41.6,45,53.3) \\ X <- c(44.9,45.6,50.1,57.2,57.1,61,64,64.4,64.5,67,61.2,53.4,44.3,45.1, \\ \hspace*{0.27 in} 49.7,54.4,62.7,65,60.9,69.5,75.7,88.4) \\ year <- c(1920,1921,1922,1923,1924,1925,1926,1927,1928,1929,1930,1931,1932, \\ \hspace*{0.27 in} 1933,1934,1935,1936,1937,1938,1939,1940,1941) \\ Y <- matrix(c(C,I,Wp),3,N, byrow=TRUE) \\ Z <- matrix(c(P, Wp+Wg, X), 3, N, byrow=TRUE) \\ S <- diag(nrow(Y)) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,4), beta=rep(0,4), \\ \hspace*{0.27 in} gamma=rep(0,4), pi=matrix(0,3,7), sigma=rep(0,3), \\ \hspace*{0.27 in} U=diag(3)), uppertri=c(0,0,0,0,0,1)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.pi <- grep("pi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(4) \\ \hspace*{0.27 in} beta <- rnorm(4) \\ \hspace*{0.27 in} gamma <- rnorm(4) \\ \hspace*{0.27 in} pi <- rnorm(3*7) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} U <- rwishartc(ncol(Data$Y)+1, Data$S) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, pi, sigma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(A=A, C=C, G=G, I=I, K=K, N=N, P=P, PGF=PGF, S=S, T=T, Wg=Wg, \\ \hspace*{0.27 in} Wp=Wp, X=X, Y=Y, Z=Z, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.pi=pos.pi, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} parm[Data$pos.pi] <- pi <- interval(parm[Data$pos.pi], -10, 10) \\ \hspace*{0.27 in} pi <- matrix(pi, 3, 7) \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \hspace*{0.27 in} U <- as.parm.matrix(U, nrow(Data$S), parm, Data, chol=TRUE) \\ \hspace*{0.27 in} parm[grep("Omega", Data$parm.names)] <- upper.triangle(Omega, \\ \hspace*{0.62 in} diag=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} pi.prior <- sum(dnormv(pi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, nrow(Data$S)+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- nu <- matrix(0,3,Data$N) \\ \hspace*{0.27 in} for (i in 1:3) \{ \\ \hspace*{0.62 in} nu[i,1] <- pi[i,1] + pi[i,3]*Data$K[1] + pi[i,5]*Data$A[1] + \\ \hspace*{0.95 in} pi[i,6]*Data$T[1] + pi[i,7]*Data$G[1] \\ \hspace*{0.62 in} nu[i,-1] <- pi[i,1] + pi[i,2]*Data$P[-Data$N] + \\ \hspace*{0.95 in} pi[i,3]*Data$K[-1] + pi[i,4]*Data$X[-Data$N] + \\ \hspace*{0.95 in} pi[i,5]*Data$A[-1] + pi[i,6]*Data$T[-1] + \\ \hspace*{0.95 in} pi[i,7]*Data$G[-1]\} \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Z, nu, matrix(sigma, 3, Data$N), log=TRUE)) \\ \hspace*{0.27 in} mu[1,1] <- alpha[1] + alpha[2]*nu[1,1] + alpha[4]*nu[2,1] \\ \hspace*{0.27 in} mu[1,-1] <- alpha[1] + alpha[2]*nu[1,-1] + \\ \hspace*{0.62 in} alpha[3]*Data$P[-Data$N] + alpha[4]*nu[2,-1] \\ \hspace*{0.27 in} mu[2,1] <- beta[1] + beta[2]*nu[1,1] + beta[4]*Data$K[1] \\ \hspace*{0.27 in} mu[2,-1] <- beta[1] + beta[2]*nu[1,-1] + \\ \hspace*{0.62 in} beta[3]*Data$P[-Data$N] + beta[4]*Data$K[-1] \\ \hspace*{0.27 in} mu[3,1] <- gamma[1] + gamma[2]*nu[3,1] + gamma[4]*Data$A[1] \\ \hspace*{0.27 in} mu[3,-1] <- gamma[1] + gamma[2]*nu[3,-1] + \\ \hspace*{0.62 in} gamma[3]*Data$X[-Data$N] + gamma[4]*Data$A[-1] \\ \hspace*{0.27 in} LL <- LL + sum(dmvnpc(t(Data$Y), t(mu), U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + pi.prior + \\ \hspace*{0.62 in} sigma.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=t(rmvnp(ncol(mu), t(mu), U)), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,4), rep(0,4), rep(0,4), rep(0,3*7), rep(1,3), \\ \hspace*{0.27 in} upper.triangle(S, diag=TRUE))} \section{Space-Time, Dynamic} \label{spacetime.dynamic} This approach to space-time or spatiotemporal modeling applies kriging to a stationary spatial component for points in space $s=1,\dots,S$ first at time $t=1$, where space is continuous and time is discrete. Vector $\zeta$ contains these spatial effects. Next, SSM (State Space Model) or DLM (Dynamic Linear Model) components are applied to the spatial parameters ($\phi$, $\kappa$, and $\lambda$) and regression effects ($\beta$). These parameters are allowed to vary dynamically with time $t=2,\dots,T$, and the resulting spatial process is estimated for each of these time-periods. When time is discrete, a dynamic space-time process can be applied. The matrix $\Theta$ contains the dynamically varying stationary spatial effects, or space-time effects. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across discrete time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. The dependent variable is also a function of design matrix $\textbf{X}$ (which may also be dynamic, but is static in this example) and dynamic regression effects matrix $\beta_{1:K,1:T}$. For more information on kriging, see section \ref{kriging}. For more information on SSMs or DLMs, see section \ref{ssm.lin.reg}. To extend this to a large spatial data set, consider incorporating the predictive process kriging example in section \ref{kriging.pp}. \subsection{Form} $$\textbf{Y}_{s,t} \sim \mathcal{N}(\mu_{s,t}, \sigma^2_1), \quad s=1,\dots,S, \quad t=1,\dots,T$$ $$\mu_{s,t} = \textbf{X}_{s,1:K} \beta_{1:K,t} + \Theta_{s,t}$$ $$\Theta_{s,t} = \frac{\Sigma_{s,s,t}}{\sum^S_{r=1} \Sigma_{r,s,t}} \Theta_{s,t-1}, \quad s=1,\dots,S, \quad t=2,\dots,T$$ $$\Theta_{s,1} = \zeta_s$$ $$\zeta \sim \mathcal{N}_S(0, \Sigma_{1:S,1:S,1})$$ $$\Sigma_{1:S,1:S,t} = \lambda^2_t \exp(-\phi_t \textbf{D})^{\kappa[t]}$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,4$$ $$\beta_{k,1} \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\beta_{k,t} \sim \mathcal{N}(\beta_{k,t-1}, \tau^2_k), \quad k=1,\dots,K, \quad t=2,\dots,T$$ $$\phi_1 \sim \mathcal{HN}(1000)$$ $$\phi_t \sim \mathcal{N}(\phi_{t-1}, \sigma^2_2) \in [0,\infty], \quad t=2,\dots,T$$ $$\kappa_1 \sim \mathcal{HN}(1000)$$ $$\kappa_t \sim \mathcal{N}(\kappa_{t-1}, \sigma^2_3) \in [0,\infty], \quad t=2,\dots,T$$ $$\lambda_1 \sim \mathcal{HN}(1000)$$ $$\lambda_t \sim \mathcal{N}(\lambda_{t-1}, \sigma^2_4) \in [0,\infty], \quad t=2,\dots,T$$ \subsection{Data} \code{data(demontexas) \\ Y <- as.matrix(demontexas[1:20,c(18:30)]) \\ X <- cbind(1,as.matrix(demontexas[1:20,c(1,4)])) \#Static predictors \\ latitude <- demontexas[1:20,2] \\ longitude <- demontexas[1:20,3] \\ D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ S <- nrow(Y) \#Number of sites, or points in space \\ T <- ncol(Y) \#Number of time-periods \\ K <- ncol(X) \#Number of columns in design matrix X including the intercept \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(zeta=rep(0,S), beta=matrix(0,K,T), \\ \hspace*{0.27 in} phi=rep(0,T), kappa=rep(0,T), lambda=rep(0,T), sigma=rep(0,4), \\ \hspace*{0.27 in} tau=rep(0,K))) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.kappa <- grep("kappa", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K*Data$T, rbind(mean(Data$Y), \\ \hspace*{0.62 in} matrix(0, Data$K-1, Data$T)), 1) \\ \hspace*{0.27 in} phi <- rhalfnorm(Data$T, 1) \\ \hspace*{0.27 in} kappa <- rhalfnorm(Data$T, 1) \\ \hspace*{0.27 in} lambda <- rhalfnorm(Data$T, 1) \\ \hspace*{0.27 in} Sigma <- lambda[1]*lambda[1]*exp(-phi[1]*Data$D)\textasciicircum kappa[1] \\ \hspace*{0.27 in} zeta <- as.vector(rmvn(1, rep(0,Data$S), Sigma)) \\ \hspace*{0.27 in} sigma <- runif(4) \\ \hspace*{0.27 in} tau <- runif(Data$K) \\ \hspace*{0.27 in} return(c(zeta, beta, phi, kappa, lambda, sigma, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, K=K, PGF=PGF, S=S, T=T, X=X, Y=Y, latitude=latitude, \\ \hspace*{0.27 in} longitude=longitude, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.zeta=pos.zeta, pos.beta=pos.beta, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.kappa=pos.kappa, pos.lambda=pos.lambda, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.tau=pos.tau) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$T) \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1e-100, Inf) \\ \hspace*{0.27 in} kappa <- interval(parm[Data$pos.kappa], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.kappa] <- kappa \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} Sigma <- array(0, dim=c(Data$S, Data$S, Data$T)) \\ \hspace*{0.27 in} for (t in 1:Data$T) \{ \\ \hspace*{0.62 in} Sigma[ , ,t] <- lambda[t]\textasciicircum 2 * exp(-phi[t] * Data$D)\textasciicircum kappa[t]\} \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta[,1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dnorm(beta[,-1], beta[,-Data$T], matrix(tau, Data$K, \\ \hspace*{0.62 in} Data$T-1), log=TRUE)) \\ \hspace*{0.27 in} zeta.prior <- dmvn(zeta, rep(0,Data$S), Sigma[ , , 1], log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dhalfnorm(phi[1], sqrt(1000), log=TRUE), \\ \hspace*{0.62 in} dtrunc(phi[-1], "norm", a=0, b=Inf, mean=phi[-Data$T], \\ \hspace*{0.62 in} sd=sigma[2], log=TRUE)) \\ \hspace*{0.27 in} kappa.prior <- sum(dhalfnorm(kappa[1], sqrt(1000), log=TRUE), \\ \hspace*{0.62 in} dtrunc(kappa[-1], "norm", a=0, b=Inf, mean=kappa[-Data$T], \\ \hspace*{0.62 in} sd=sigma[3], log=TRUE)) \\ \hspace*{0.27 in} lambda.prior <- sum(dhalfnorm(lambda[1], sqrt(1000), log=TRUE), \\ \hspace*{0.62 in} dtrunc(lambda[-1], "norm", a=0, b=Inf, mean=lambda[-Data$T], \\ \hspace*{0.62 in} sd=sigma[4], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- sum(dhalfcauchy(tau, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} Theta <- matrix(zeta, Data$S, Data$T) \\ \hspace*{0.27 in} for (t in 2:Data$T) \{ \\ \hspace*{0.62 in} for (s in 1:Data$S) \{ \\ \hspace*{0.98 in} Theta[s,t] <- sum(Sigma[,s,t] / sum(Sigma[,s,t]) * Theta[,t-1])\}\} \\ \hspace*{0.27 in} mu <- mu + Theta \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + sum(phi.prior) + \\ \hspace*{0.62 in} sum(kappa.prior) + sum(lambda.prior) + sigma.prior + tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,S), rep(c(mean(Y),rep(0,K-1)),T), rep(1,T), \\ \hspace*{0.27 in} rep(1,T), rep(1,T), rep(1,4), rep(1,K))} \section{Space-Time, Nonseparable} \label{spacetime.nonsep} This approach to space-time or spatiotemporal modeling applies kriging both to the stationary spatial and temporal components, where space is continuous and time is discrete. Matrix $\Xi$ contains the space-time effects. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. The dependent variable is also a function of design matrix $\textbf{X}$ and regression effects vector $\beta$. For more information on kriging, see section \ref{kriging}. This example uses a nonseparable, stationary covariance function in which space and time are separable only when $\psi=0$. To extend this to a large space-time data set, consider incorporating the predictive process kriging example in section \ref{kriging.pp}. \subsection{Form} $$\textbf{Y}_{s,t} \sim \mathcal{N}(\mu_{s,t}, \sigma^2_1), \quad s=1,\dots,S, \quad t=1,\dots,T$$ $$\mu = \textbf{X} \beta + \Xi$$ $$\Xi \sim \mathcal{N}_{ST}(\Xi_\mu, \Sigma)$$ $$ \Sigma = \sigma^2_2 \exp \left (-\frac{\textbf{D}_S}{\phi_1}^\kappa - \frac{\textbf{D}_T}{\phi_2}^\lambda - \psi \frac{\textbf{D}_S}{\phi_1}^\kappa \frac{\textbf{D}_T}{\phi_2}^\lambda \right )$$ $$\beta_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\phi_j \sim \mathcal{U}(1, 5), \quad j=1,\dots,2$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$ $$\psi \sim \mathcal{HC}(25)$$ $$\Xi_\mu = 0$$ $$\kappa = 1, \quad \lambda = 1$$ \subsection{Data} \code{data(demontexas) \\ Y <- as.matrix(demontexas[1:10,c(18:30)]) \\ X <- cbind(1,as.matrix(demontexas[1:10,c(1,4)])) \#Static predictors \\ latitude <- demontexas[1:10,2] \\ longitude <- demontexas[1:10,3] \\ S <- nrow(Y) \#Number of sites, or points in space \\ T <- ncol(Y) \#Number of time-periods \\ K <- ncol(X) \#Number of columns in design matrix X including the intercept \\ D.S <- as.matrix(dist(cbind(rep(longitude,T),rep(latitude,T)), diag=TRUE, \\ \hspace*{0.27 in} upper=TRUE)) \\ D.T <- as.matrix(dist(cbind(rep(1:T,each=S),rep(1:T,each=S)), diag=TRUE, \\ \hspace*{0.27 in} upper=TRUE)) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(Xi=matrix(0,S,T), beta=rep(0,K), \\ \hspace*{0.27 in} phi=rep(0,2), sigma=rep(0,2), psi=0)) \\ pos.Xi <- grep("Xi", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.psi <- grep("psi", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K, c(mean(Data$Y),rep(0,Data$K-1)), 1) \\ \hspace*{0.27 in} phi <- runif(2,1,5) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} psi <- runif(1) \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} lambda <- 1 \\ \hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-(Data$D.S / phi[1])\textasciicircum kappa - \hspace*{0.62 in} (Data$D.T / phi[2])\textasciicircum lambda - \hspace*{0.62 in} psi*(Data$D.S / phi[1])\textasciicircum kappa * (Data$D.T / phi[2])\textasciicircum lambda) \hspace*{0.27 in} Xi <- as.vector(rmvn(1, rep(0,Data$S*Data$T), Sigma)) \\ \hspace*{0.27 in} return(c(Xi, beta, phi, sigma, psi)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D.S=D.S, D.T=D.T, K=K, PGF=PGF, S=S, T=T, X=X, Y=Y, \\ \hspace*{0.27 in} latitude=latitude, longitude=longitude, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.Xi=pos.Xi, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.sigma=pos.sigma, pos.psi=pos.psi) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} Xi.mu <- rep(0,Data$S*Data$T) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} Xi <- parm[Data$pos.Xi] \\ \hspace*{0.27 in} kappa <- 1; lambda <- 1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\ \hspace*{0.27 in} parm[Data$pos.psi] <- psi <- interval(parm[Data$pos.psi], 1e-100, Inf) \\ \hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-(Data$D.S / phi[1])\textasciicircum kappa - \\ \hspace*{0.62 in} (Data$D.T / phi[2])\textasciicircum lambda - \\ \hspace*{0.62 in} psi*(Data$D.S / phi[1])\textasciicircum kappa * (Data$D.T / phi[2])\textasciicircum lambda) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Xi.prior <- dmvn(Xi, Xi.mu, Sigma, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dunif(phi, 1, 5, log=TRUE)) \\ \hspace*{0.27 in} psi.prior <- dhalfcauchy(psi, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Xi <- matrix(Xi, Data$S, Data$T) \\ \hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) + Xi \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + Xi.prior + sigma.prior + phi.prior + psi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma[1]), parm=parm)\\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,S*T), c(mean(Y),rep(0,K-1)), rep(1,2), rep(1,2), \\ \hspace*{0.27 in} 1)} \section{Space-Time, Separable} \label{spacetime.sep} This introductory approach to space-time or spatiotemporal modeling applies kriging both to the stationary spatial and temporal components, where space is continuous and time is discrete. Vector $\zeta$ contains the spatial effects and vector $\theta$ contains the temporal effects. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. The dependent variable is also a function of design matrix $\textbf{X}$ and regression effects vector $\beta$. For more information on kriging, see section \ref{kriging}. This example uses separable space-time covariances, which is more convenient but usually less appropriate than a nonseparable covariance function. To extend this to a large space-time data set, consider incorporating the predictive process kriging example in section \ref{kriging.pp}. \subsection{Form} $$\textbf{Y}_{s,t} \sim \mathcal{N}(\mu_{s,t}, \sigma^2_1), \quad s=1,\dots,S, \quad t=1,\dots,T$$ $$\mu_{s,t} = \textbf{X}_{s,1:J} \beta + \zeta_s + \Theta_{s,t}$$ $$\Theta_{s,1:T} = \theta$$ $$\theta \sim \mathcal{N}_N(\theta_\mu, \Sigma_T)$$ $$\Sigma_T = \sigma^2_3 \exp(-\phi_2 \textbf{D}_T)^\lambda$$ $$\zeta \sim \mathcal{N}_N(\zeta_\mu, \Sigma_S)$$ $$\Sigma_S = \sigma^2_2 \exp(-\phi_1 \textbf{D}_S)^\kappa$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,2$$ $$\sigma_k \sim \mathcal{HC}(25), \quad k=1,\dots,3$$ $$\phi_k \sim \mathcal{U}(1, 5), \quad k=1,\dots,2$$ $$\zeta_\mu = 0$$ $$\theta_\mu = 0$$ $$\kappa = 1, \quad \lambda = 1$$ \subsection{Data} \code{data(demontexas) \\ Y <- as.matrix(demontexas[1:20,c(18:30)]) \\ X <- cbind(1,as.matrix(demontexas[1:20,c(1,4)])) \#Static predictors \\ latitude <- demontexas[1:20,2] \\ longitude <- demontexas[1:20,3] \\ S <- nrow(Y) \#Number of sites, or points in space \\ T <- ncol(Y) \#Number of time-periods \\ K <- ncol(X) \#Number of columns in design matrix X including the intercept \\ D.S <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ D.T <- as.matrix(dist(cbind(c(1:T),c(1:T)), diag=TRUE, upper=TRUE)) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(zeta=rep(0,S), theta=rep(0,T), \\ \hspace*{0.27 in} beta=rep(0,K), phi=rep(0,2), sigma=rep(0,3))) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K, c(mean(Data$Y),rep(0,Data$K-1)), 1) \\ \hspace*{0.27 in} phi <- runif(2,1,5) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} lambda <- 1 \\ \hspace*{0.27 in} Sigma.S <- sigma[2]\textasciicircum 2 * exp(-phi[1] * Data$D.S)\textasciicircum kappa \\ \hspace*{0.27 in} Sigma.T <- sigma[3]\textasciicircum 2 * exp(-phi[2] * Data$D.T)\textasciicircum lambda \\ \hspace*{0.27 in} zeta <- as.vector(rmvn(1, rep(0,Data$S), Sigma.S)) \\ \hspace*{0.27 in} theta <- as.vector(rmvn(1, rep(0,Data$T), Sigma.T)) \\ \hspace*{0.27 in} return(c(zeta, theta, beta, phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D.S=D.S, D.T=D.T, K=K, PGF=PGF, S=S, T=T, X=X, Y=Y, \\ \hspace*{0.27 in} latitude=latitude, longitude=longitude, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.zeta=pos.zeta, pos.theta=pos.theta, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.phi=pos.phi, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} zeta.mu <- rep(0,Data$S) \\ \hspace*{0.27 in} theta.mu <- rep(0,Data$T) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} kappa <- 1; lambda <- 1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\ \hspace*{0.27 in} Sigma.S <- sigma[2]\textasciicircum 2 * exp(-phi[1] * Data$D.S)\textasciicircum kappa \\ \hspace*{0.27 in} Sigma.T <- sigma[3]\textasciicircum 2 * exp(-phi[2] * Data$D.T)\textasciicircum lambda \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.prior <- dmvn(zeta, zeta.mu, Sigma.S, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- dmvn(theta, theta.mu, Sigma.T, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dunif(phi, 1, 5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Theta <- matrix(theta, Data$S, Data$T, byrow=TRUE) \\ \hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) + zeta + Theta \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + theta.prior + sigma.prior + \\ \hspace*{0.62 in} phi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,S), rep(0,T), rep(0,2), rep(1,2), rep(1,3))} \section{Spatial Autoregression (SAR)} \label{sar} The spatial autoregressive (SAR) model in this example uses areal data that consists of first-order neighbors that were specified and converted from point-based data with longitude and latitude coordinates. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta + \phi \textbf{z}$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\phi \sim \mathcal{U}(-1, 1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 100 \\ latitude <- runif(N,0,100); longitude <- runif(N,0,100) \\ J <- 3 \#Number of predictors, including the intercept \\ X <- matrix(runif(N*J,0,3), N, J); X[,1] <- 1 \\ beta.orig <- runif(J,0,3); phi <- runif(1,0,1) \\ D <- as.matrix(dist(cbind(longitude, latitude), diag=TRUE, upper=TRUE)) \\ W <- exp(-D) \#Inverse distance as weights \\ W <- ifelse(D == 0, 0, W) \\ epsilon <- rnorm(N,0,1) \\ y <- tcrossprod(X, t(beta.orig)) + sqrt(latitude) + sqrt(longitude) + \\ \hspace*{0.27 in} epsilon \\ Z <- W / matrix(rowSums(W), N, N) * matrix(y, N, N, byrow=TRUE) \\ z <- rowSums(Z) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), phi=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} phi <- runif(1,-1,1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, latitude=latitude, longitude=longitude, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.sigma=pos.sigma, y=y, z=z)} \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dunif(phi, -1, 1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) + phi*Data$z \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 0.5, 1)} \section{STARMA(p,q)} \label{starma} The data in this example of a space-time autoregressive moving average (STARMA) are coordinate-based, and the adjacency matrix \textbf{A} is created from $K$ nearest neighbors. Otherwise, an adjacency matrix may be specified as usual for areal data. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. \subsection{Form} $$\textbf{Y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_{s,t} = \sum^J_{j=1} \textbf{X}_{s,t,j} \beta_j + \sum^L_{l=1} \sum^P_{p=1} \phi_{l,p} \textbf{W}^1_{s,t-p,l} + \sum^M_{m=1} \sum^Q_{q=1} \theta_{m,q} \textbf{W}^2_{s,t-q,m}, \quad j=1,\dots,J, \quad s=1,\dots,S, \quad t=p,\dots,T$$ $$\textbf{W}^1_{1:S,1:T,l} = \textbf{V}_{1:S,1:S,l} \textbf{Y}, \quad l=1,\dots,L$$ $$\textbf{W}^2_{1:S,1:T,m} = \textbf{V}_{1:S,1:S,m} \epsilon, \quad m=1,\dots,M$$ $$\epsilon = \textbf{Y} - \mu$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\phi_{l,p} \sim \mathcal{U}(-1, 1), \quad l=1,\dots,L, \quad p=1,\dots,P$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\theta_{m,q} \sim \mathcal{N}(0, 1000), \quad m=1,\dots,M, \quad q=1,\dots,Q$$ where \textbf{V} is an adjacency array that is scaled so that each row sums to one, $\beta$ is a vector of regression effects, $\phi$ is a matrixr of autoregressive space-time parameters, $\sigma$ is the residual variance, and $\theta$ is a matrix of moving average space-time parameters. \subsection{Data} \code{data(demontexas) \\ Y <- t(diff(t(as.matrix(demontexas[,c(18:30)])))) \#Note this is not stationary \\ X <- array(1, dim=c(369,13-1,3)) \\ X[, , 2] <- CenterScale(demontexas[,1]) \\ X[, , 3] <- demontexas[,4] \\ latitude <- demontexas[,2] \\ longitude <- demontexas[,3] \\ S <- nrow(Y) \#Number of sites, or points in space \\ T <- ncol(Y) \#Number of time-periods \\ J <- dim(X)[3] \#Number of columns in design matrix X including the intercept \\ K <- 5 \#Number of nearest neighbors \\ L <- 2 \#Spatial autoregressive order \\ M <- 2 \#Spatial moving average order \\ P <- 2 \#Autoregressive order \\ Q <- 2 \#Moving average order \\ D <- as.matrix(dist(cbind(longitude, latitude), diag=TRUE, upper=TRUE)) \\ A <- V <- array(0, dim=c(nrow(D),ncol(D),P)) \\ W1 <- array(0, dim=c(S,T,max(L,M))) \\ for (l in 1:max(L,M)) \{ \\ \hspace*{0.27 in} A[, , l] <- exp(-D) \\ \hspace*{0.27 in} A[, , l] <- apply(A[, , l], 1, rank) \\ \hspace*{0.27 in} A[, , l] <- ifelse(A[, , l] > (l-1)*K \& A[, , l] <= l*K, 1, 0) \\ \hspace*{0.27 in} V[, , l] <- A[, , l] / rowSums(A[, , l]) \\ \hspace*{0.27 in} V[, , l] <- ifelse(is.nan(V[, , l]), 1/ncol(V[, , l]), V[, , l]) \\ \hspace*{0.27 in} W1[, , l] <- tcrossprod(V[, , l], t(Y))\} \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), phi=matrix(0,L,P), sigma=0, \\ \hspace*{0.27 in} theta=matrix(0,M,Q))) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} phi <- runif(Data$L*Data$P,-1,1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} theta <- rnorm(Data$M*Data$Q) \\ \hspace*{0.27 in} return(c(beta, phi, sigma, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, L=L, M=M, P=P, Q=Q, PGF=PGF, S=S, T=T, V=V, W1=W1, \\ \hspace*{0.27 in} X=X, Y=Y, latitude=latitude, longitude=longitude, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, pos.theta=pos.theta) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} phi <- matrix(interval(parm[Data$pos.phi], -1, 1), Data$L, Data$P) \\ \hspace*{0.27 in} parm[Data$pos.phi] <- as.vector(phi) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} theta <- matrix(parm[Data$pos.theta], Data$M, Data$Q) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dunif(phi, -1, 1, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dnormv(theta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- beta[1]*Data$X[, , 1] \\ \hspace*{0.27 in} for (j in 2:Data$J) mu <- mu + beta[j]*Data$X[, , j] \\ \hspace*{0.27 in} for (l in 1:Data$L) \{for (p in 1:Data$P) \{ \\ \hspace*{0.62 in} mu[,-c(1:p)] <- mu[,-c(1:p)] + \\ \hspace*{0.95 in} phi[l,p]*Data$W1[, 1:(Data$T - p), l]\}\} \\ \hspace*{0.27 in} epsilon <- Data$Y - mu \\ \hspace*{0.27 in} for (m in 1:Data$M) \{ \\ \hspace*{0.62 in} W2 <- tcrossprod(Data$V[, , m], t(epsilon)) \\ \hspace*{0.62 in} for (q in 1:Data$Q) \{ \\ \hspace*{0.95 in} mu[,-c(1:q)] <- mu[,-c(1:q)] + \\ \hspace*{0.95 in} theta[m,q]*W2[,1:(Data$T - q)]\}\} \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[,-c(1:max(Data$P,Data$Q))], \\ \hspace*{0.62 in} mu[,-c(1:max(Data$P,Data$Q))], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + phi.prior + sigma.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(0,L*P), 1, rep(0,M*Q))} \section{State Space Model (SSM), Linear Regression} \label{ssm.lin.reg} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_{J+1}), \quad t=1,\dots,T$$ $$\mu = \textbf{X}\beta$$ $$\beta_{t,j} \sim \mathcal{N}(\mu_j + \phi_j(\beta_{t-1,j} - \mu_j), \sigma^2_j), \quad t=2,\dots,T, \quad j=1,\dots,J$$ $$\beta_{1,j} \sim \mathcal{N}(\mu_j + \phi_j(b^0_j - \mu_j), \sigma^2_j), \quad j=1,\dots,J$$ $$b^0_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\mu_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\phi_j \sim \mathcal{BETA}(20, 1.5) \quad j=1,\dots,J$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,(J+1)$$ \subsection{Data} \code{data(demonfx) \\ y <- demonfx[1:50,1] \\ X <- cbind(1, as.matrix(demonfx[1:50,2:3])) \\ T <- nrow(X) \\ J <- ncol(X) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(b0=rep(0,J), beta=matrix(0,T,J), \\ \hspace*{0.27 in} mu=rep(0,J), phi=rep(0,J), sigma=rep(0,J+1))) \\ pos.b0 <- grep("b0", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.mu <- grep("mu", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} b0 <- rnorm(Data$J) \\ \hspace*{0.27 in} beta <- c(rnorm(Data$T,mean(Data$y),1), rnorm(Data$T*(Data$J-1))) \\ \hspace*{0.27 in} mu <- rnorm(Data$J) \\ \hspace*{0.27 in} phi <- runif(Data$J, -1, 1) \\ \hspace*{0.27 in} sigma <- runif(Data$J+1) \\ \hspace*{0.27 in} return(c(beta, mu, phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, T=T, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.b0=pos.b0, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.mu=pos.mu, pos.phi=pos.phi, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} b0 <- parm[Data$pos.b0] \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$T, Data$J) \\ \hspace*{0.27 in} mu <- parm[Data$pos.mu] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} b0.prior <- sum(dnormv(b0, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, matrix(mu, Data$T, Data$J, byrow=TRUE) + \\ \hspace*{0.62 in} matrix(phi, Data$T, Data$J, byrow=TRUE) * \\ \hspace*{0.62 in} (rbind(b0, beta[-Data$T,]) - \\ \hspace*{0.62 in} matrix(mu, Data$T, Data$J, byrow=TRUE)), \\ \hspace*{0.62 in} matrix(sigma[1:Data$J], Data$T, Data$J, byrow=TRUE), log=TRUE)) \\ \hspace*{0.27 in} mu.prior <- sum(dnormv(mu, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dbeta((phi+1)/2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rowSums(beta*Data$X) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[Data$J+1], log=TRUE)) \\ \hspace*{0.27 in} yhat <- rnorm(length(mu), mu, sigma[Data$J+1]) \#Fitted \\ \hspace*{0.27 in} \#yhat <- rnorm(length(mu), rowSums(matrix(rnorm(Data$T*Data$J, \\ \hspace*{0.62 in} \# rbind(b0, beta[-Data$T,]), matrix(sigma[-Data$J], Data$T, Data$J, \\ \hspace*{0.62 in} \# byrow=TRUE)), Data$T, Data$J) * Data$X), sigma[Data$J+1]) \#One-step ahead \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + b0.prior + beta.prior + mu.prior + phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(mean(y),T), rep(0,T*(J-1)), rep(0,J), \\ \hspace*{0.27 in} rep(0,J), rep(1,J+1))} \section{State Space Model (SSM), Local Level} \label{ssm.ll} The local level model is the simplest, non-trivial example of a state space model (SSM). As such, this version of a local level SSM has static variance parameters. \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_1), \quad t=1,\dots,T$$ $$\mu_t \sim \mathcal{N}(\mu_{t-1}, \sigma^2_2), \quad t=2,\dots,T$$ $$\mu_1 \sim \mathcal{N}(0, 1000)$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$ \subsection{Data} \code{T <- 20 \\ T.m <- 14 \\ mu.orig <- rep(0,T) \\ for (t in 2:T) \{mu.orig[t] <- mu.orig[t-1] + rnorm(1,0,1)\} \\ y <- mu.orig + rnorm(T,0,0.1) \\ y[(T.m+2):T] <- NA \\ mon.names <- rep(NA, (T-T.m)) \\ for (i in 1:(T-T.m)) mon.names[i] <- paste("yhat[",(T.m+i),"]", sep="") \\ parm.names <- as.parm.names(list(mu=rep(0,T), sigma=rep(0,2))) \\ pos.mu <- grep("mu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} mu <- rnorm(Data$T) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} return(c(mu, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, T.m=T.m, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.mu=pos.mu, pos.sigma=pos.sigma, y=y) \\ Dyn <- matrix(paste("mu[",1:T,"]",sep=""), T, 1) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} mu <- parm[Data$pos.mu] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} mu.prior <- sum(dnormv(mu[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dnorm(mu[-1], mu[-Data$T], sigma[2], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[1:Data$T.m], mu[1:Data$T.m], sigma[1], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} yhat <- rnorm(length(mu), c(mu[1], rnorm(Data$T-1, mu[-Data$T], \\ \hspace*{0.62 in} sigma[2])), sigma[1]) \#One-step ahead \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + mu.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=mu[(Data$T.m+1):Data$T], \\ \hspace*{0.62 in} yhat=yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,T), rep(1,2))} \section{State Space Model (SSM), Local Linear Trend} \label{ssm.llt} The local linear trend model is a state space model (SSM) that extends the local level model to include a dynamic slope parameter. For more information on the local level model, see section \ref{ssm.ll}. This example has static variance parameters. \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_1), \quad t=1,\dots,T$$ $$\mu_t \sim \mathcal{N}(\mu_{t-1} + \delta_{t-1}, \sigma^2_2), \quad t=2,\dots,T$$ $$\mu_1 \sim \mathcal{N}(0, 1000)$$ $$\delta_t \sim \mathcal{N}(\delta_{t-1}, \sigma^2_3), \quad t=2,\dots,T$$ $$\delta_1 \sim \mathcal{N}(0, 1000)$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,3$$ \subsection{Data} \code{T <- 20 \\ T.m <- 14 \\ mu.orig <- delta.orig <- rep(0,T) \\ for (t in 2:T) \{ \\ \hspace*{0.27 in} delta.orig[t] <- delta.orig[t-1] + rnorm(1,0,0.1) \\ \hspace*{0.27 in} mu.orig[t] <- mu.orig[t-1] + delta.orig[t-1] + rnorm(1,0,1)\} \\ y <- mu.orig + rnorm(T,0,0.1) \\ y[(T.m+2):T] <- NA \\ mon.names <- rep(NA, (T-T.m)) \\ for (i in 1:(T-T.m)) mon.names[i] <- paste("yhat[",(T.m+i),"]", sep="") \\ parm.names <- as.parm.names(list(mu=rep(0,T), delta=rep(0,T), \\ \hspace*{0.27 in} sigma=rep(0,3))) \\ pos.mu <- grep("mu", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} mu <- rnorm(Data$T) \\ \hspace*{0.27 in} delta <- rnorm(Data$T) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} return(c(mu, delta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, T.m=T.m, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.mu=pos.mu, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} mu <- parm[Data$pos.mu] \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} mu.prior <- sum(dnormv(mu[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dnorm(mu[-1], mu[-Data$T]+delta[-Data$T], sigma[2], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnormv(delta[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dnorm(delta[-1], delta[-Data$T], sigma[3], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[1:Data$T.m], mu[1:Data$T.m], sigma[1], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} yhat <- rnorm(length(mu), c(mu[1], rnorm(Data$T-1, mu[-Data$T], \\ \hspace*{0.62 in} sigma[2])), sigma[1]) \#One-step ahead \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + mu.prior + delta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=mu[(Data$T.m+1):Data$T], \\ \hspace*{0.62 in} yhat=yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,T), rep(0,T), rep(1,3))} \section{State Space Model (SSM), Stochastic Volatility (SV)} \label{sv} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(0, \sigma^2)$$ $$\sigma^2 = \frac{1}{\exp(\theta)}$$ $$\beta = \exp(\mu / 2)$$ $$\theta_1 \sim \mathcal{N}(\mu + \phi (\alpha - \mu), \tau)$$ $$\theta_t \sim \mathcal{N}(\mu + \phi (\theta_{t-1} - \mu), \tau), \quad t=2,\dots,T$$ $$\alpha \sim \mathcal{N}(\mu, \tau)$$ $$\phi \sim \mathcal{U}(-1, 1)$$ $$\mu \sim \mathcal{N}(0, 10)$$ $$\tau \sim \mathcal{HC}(25)$$ \subsection{Data} \code{T <- 20 \\ y <- rep(10,T); epsilon <- rnorm(T,0,1) \\ for (t in 2:T) \{y[t] <- 0.8*y[t-1] + epsilon[t-1]\} \\ mon.names <- c("LP",paste("sigma2[",1:T,"]",sep="")) \\ parm.names <- as.parm.names(list(theta=rep(0,T), alpha=0, phi=0, mu=0, \\ \hspace*{0.27 in} tau=0)) \\ pos.theta <- grep("theta", parm.names) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.mu <- grep("mu", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} phi <- runif(1,-1,1) \\ \hspace*{0.27 in} mu <- rnorm(1) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} alpha <- rnorm(1, mu, tau) \\ \hspace*{0.27 in} theta <- rnorm(Data$T, mu + phi*(alpha - mu), tau) \\ \hspace*{0.27 in} return(c(theta, alpha, phi, mu, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \hspace*{0.27 in} pos.theta=pos.theta, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.mu=pos.mu, pos.tau=pos.tau y=y) \\ Dyn <- matrix(paste("theta[",1:T,"]",sep=""), T, 1) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} mu <- parm[Data$pos.mu] \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, mu, tau, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dnormv(theta[1], mu + phi*(alpha-mu), tau, \\ \hspace*{0.62 in} log=TRUE), dnormv(theta[-1], mu + phi*(theta[-Data$T]-mu), tau, \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dunif(phi, -1, 1, log=TRUE) \\ \hspace*{0.27 in} mu.prior <- dnormv(mu, 0, 10, log=TRUE) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} beta <- exp(mu / 2) \\ \hspace*{0.27 in} sigma2 <- 1 / exp(theta) \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y, 0, sigma2, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + theta.prior + phi.prior + mu.prior + \\ \hspace*{0.62 in} tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, sigma2), \\ \hspace*{0.62 in} yhat=rnormv(length(Data$y), 0, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,T), 0, 0, 0, 1)} \section{Threshold Autoregression (TAR)} \label{tar} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\nu_t, \sigma^2), \quad t=1,\dots,T$$ \[\nu_t = \left\{ \begin{array}{l l} \alpha_1 + \phi_1 \textbf{y}_{t-1}, \quad t=1,\dots,T & \quad \mbox{if $t \ge \theta$}\\ \alpha_2 + \phi_2 \textbf{y}_{t-1}, \quad t=1,\dots,T & \quad \mbox{if $t < \theta$} \\ \end{array} \right. \] $$\alpha_j \sim \mathcal{N}(0, 1000) \in [-1,1], \quad j=1,\dots,2$$ $$\phi_j \sim \mathcal{N}(0, 1000), \in [-1,1], \quad j=1,\dots,2$$ $$\theta \sim \mathcal{U}(2, T-1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,2), phi=rep(0,2), theta=0, \\ \hspace*{0.27 in} sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rtrunc(2, "norm", a=-1, b=1, mean=0, sd=1) \\ \hspace*{0.27 in} phi <- rtrunc(2, "norm", a=-1, b=1, mean=0, sd=1) \\ \hspace*{0.27 in} theta <- runif(1,2,Data$T-1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, phi, theta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.phi=pos.phi, pos.theta=pos.theta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 2, Data$T-1) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dtrunc(alpha, "norm", a=-1, b=1, mean=0, \\ \hspace*{0.62 in} sd=sqrt(1000), log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dtrunc(phi, "norm", a=-1, b=1, mean=0, \\ \hspace*{0.62 in} sd=sqrt(1000), log=TRUE)) \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- dunif(theta, 2, Data$T-1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0, Data$T, 2) \\ \hspace*{0.27 in} mu[,1] <- c(alpha[1], alpha[1] + phi[1]*Data$y[-Data$T]) \\ \hspace*{0.27 in} mu[,2] <- c(alpha[2], alpha[2] + phi[2]*Data$y[-Data$T]) \\ \hspace*{0.27 in} nu <- mu[,2]; temp <- which(1:Data$T < theta) \\ \hspace*{0.27 in} nu[temp] <- mu[temp,1] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], nu[-1], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + theta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(nu), nu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,4), T/2, 1)} \section{Time Varying AR(1) with Chebyshev Series} \label{tvarcs} This example consists of a first-order autoregressive model, AR(1), with a time-varying parameter (TVP) $\phi$, that is a Chebyshev series constructed from a linear combination of orthonormal Chebyshev time polynomials (CTPs) and parameter vector $\beta$. The user creates basis matrix \textbf{P}, specifying polynomial degree $D$ and time $T$. Each column is a CTP of a different degree, and the first column is restricted to 1, the linear basis. CTPs are very flexible for TVPs, and estimate quickly because each is orthogonal, unlike simple polynomials and splines. \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \phi_{t-1} \textbf{y}_{t-1}$$ $$\phi_t = \textbf{P} \beta$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_d \sim \mathcal{N}(0, 1000), \quad d=1,\dots,(D+1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ D <- 6 \#Maximum degree of Chebyshev time polynomials \\ T <- length(y) \\ P <- matrix(1, T, D+1) \\ for (d in 1:D) \{P[,d+1] <- sqrt(2)*cos(d*pi*(c(1:T)-0.5)/T)\} \\ mon.names <- c("LP", "ynew", as.parm.names(list(phi=rep(0,T-1)))) \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,D+1), sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(Data$D+1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, P=P, PGF=PGF, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} phi <- tcrossprod(Data$P[-Data$T,], t(beta)) \\ \hspace*{0.27 in} mu <- c(alpha, alpha + phi*Data$y[-Data$T]) \\ \hspace*{0.27 in} ynew <- rnorm(1, alpha + tcrossprod(Data$P[Data$T,], t(beta))* \\ \hspace*{0.62 in} Data$y[Data$T], sigma) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,ynew,phi), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,D+2), 1)} \section{Variable Selection, BAL} \label{bal} This approach to variable selection is one of several forms of the Bayesian Adaptive Lasso (BAL). The lasso applies shrinkage to exchangeable scale parameters, $\gamma$, for the regression effects, $\beta$. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_1 \sim \mathcal{L}(0, 1000)$$ $$\beta_j \sim \mathcal{L}(0, \gamma_j), \quad j=2,\dots,J$$ $$\gamma_j \sim \mathcal{G}^{-1}(\delta, \tau), \quad \in [0,\infty]$$ $$\delta \sim \mathcal{HC}(25)$$ $$\tau \sim \mathcal{HC}(25)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), gamma=rep(0,J-1), delta=0, \\ \hspace*{0.27 in} tau=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} delta <- runif(1) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} gamma <- rinvgamma(Data$J-1, delta, tau) \\ \hspace*{0.27 in} beta <- rlaplace(Data$J, 0, c(1,gamma)) \\ \hspace*{0.27 in} return(c(beta, gamma, delta, tau, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.delta=pos.delta, pos.tau=pos.tau, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperhyperparameters \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperhyperprior \\ \hspace*{0.27 in} delta.prior <- dhalfcauchy(delta, 25, log=TRUE) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} gamma.prior <- sum(dinvgamma(gamma, delta, tau, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dlaplace(beta, 0, c(1000, gamma), log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + delta.prior + tau.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(0,J-1), rep(1,3))} \section{Variable Selection, Horseshoe} \label{horseshoe} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_1 \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{HS}(\lambda_j, \tau), \quad j=2,\dots,J$$ $$\lambda_j \sim \mathcal{HC}(1), \quad j=2,\dots,J$$ $$\tau \sim \mathcal{HC}(1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), lambda=rep(0,J-1), \\ \hspace*{0.27 in} tau=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} lambda <- runif(Data$J-1) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, lambda, tau, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.lambda=pos.lambda, \\ \hspace*{0.27 in} pos.tau=pos.tau, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dhs(beta[-1], lambda, tau, log=TRUE)) \\ \hspace*{0.27 in} lambda.prior <- sum(dhalfcauchy(lambda, 1, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(1,J-1), rep(1,2))} \section{Variable Selection, LASSO} \label{lasso} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_1 \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{LASSO}(0, \sigma, \tau, \lambda_j), \quad j=2,\dots,J$$ \subsection{Data} \code{data(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0, tau=rep(0,J-1), \\ \hspace*{0.27 in} lambda=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} tau <- runif(Data$J-1) \\ \hspace*{0.27 in} lambda <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma, tau, lambda)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.tau=pos.tau, pos.lambda=pos.lambda, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dlasso(beta[-1], sigma, tau, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1, rep(1,J-1), 1)} \section{Variable Selection, RJ} \label{rj} This example uses the RJ (Reversible-Jump) algorithm of the \code{LaplacesDemon} function for variable selection and Bayesian Model Averaging (BMA). Other MCMC algorithms will not perform variable selection with this example, as presented. This is an example of variable selection in a linear regression. The only difference between the following example, and the example of linear regression (\ref{linear.reg}), is that RJ specifications are also included for the RJ algorithm, and that the RJ algorithm must be used. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 1000 \\ J <- 100 \#Number of predictors, including the intercept \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta.orig <- runif(J,-3,3) \\ zero <- sample(2:J, round(J*0.9)) \#Assign most parameters to be zero \\ beta.orig[zero] <- 0 \\ e <- rnorm(N,0,0.1) \\ y <- as.vector(tcrossprod(beta.orig, X) + e) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ \#\#\# Reversible-Jump Specifications bin.n <- J-1 \#Maximum allowable model size \\ bin.p <- 0.4 \#Most probable size: bin.p x bin.n is binomial mean and median \\ parm.p <- rep(1/J,J+1) \\ selectable=c(0, rep(1,J-1), 0) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)} \section{Variable Selection, SSVS} \label{ssvs} This example uses a modified form of the random-effects (or global adaptation) Stochastic Search Variable Selection (SSVS) algorithm presented in \citet{ohara09}, which selects variables according to practical significance rather than statistical significance. Here, SSVS is applied to linear regression, though this method is widely applicable. For $J$ variables, each regression effect $\beta_j$ is conditional on $\gamma_j$, a binary inclusion variable. Each $\beta_j$ is a discrete mixture distribution with respect to $\gamma_j = 0$ or $\gamma_j = 1$, with precision 100 or $\beta_\sigma = 0.1$, respectively. As with other representations of SSVS, these precisions may require tuning. The binary inclusion variables are discrete parameters, and discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. When the goal is to select the best model, each $\textbf{X}_{1:N,j}$ is retained for a future run when the posterior mean of $\gamma_j \ge 0.5$. When the goal is model-averaging, the results of this model may be used directly, which would please L. J. Savage, who said that ``models should be as big as an elephant'' \citep{draper95}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X} \beta$$ $$\beta_1 \sim \mathcal{N}(0, 1000)$$ $$(\beta_j | \gamma_j) \sim (1 - \gamma_j)\mathcal{N}(0, 0.01) + \gamma_j \mathcal{N}(0, \beta^2_\sigma) \quad j=2,\dots,J$$ $$\beta_\sigma \sim \mathcal{HC}(25)$$ $$\gamma_j \sim \mathcal{BERN}(1/(J-1)), \quad j=1,\dots,(J-1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP", "min.beta.sigma") \\ parm.names <- as.parm.names(list(beta=rep(0,J), gamma=rep(0,J-1), \\ \hspace*{0.27 in} b.sd=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.b.sd <- grep("b.sd", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} gamma <- rep(1,Data$J-1) \\ \hspace*{0.27 in} b.sd <- rnorm(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, gamma, b.sd, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.b.sd=pos.b.sd, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} beta.sigma <- interval(parm[Data$pos.b.sd], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.b.sd] <- beta.sigma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} beta.sigma <- rep(beta.sigma, Data$J-1) \\ \hspace*{0.27 in} beta.sigma[gamma == 0] <- 0.1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} beta.sigma.prior <- sum(dhalfcauchy(beta.sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, c(sqrt(1000), beta.sigma, log=TRUE))) \\ \hspace*{0.27 in} gamma.prior <- sum(dbern(gamma, 1/(Data$J-1), log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta*c(1,gamma))) \\ \hspace*{0.27 in} LL <- sum(dnorm(y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + beta.sigma.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, min(beta.sigma)), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(1,J-1), rep(1,2))} \section{VARMA(p,q) - SSVS} \label{varmapqssvs} Stochastic search variable selection (SSVS) is applied to VARMA parameters. Note that the constants for the mixture variances are typically multiplied by the posterior standard deviations from an unrestricted VARMA that was updated previously, and these are not included in this example. Since an unrestricted VARMA model may be difficult to identify, this should be performed only on the AR parameters. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=1,\dots,T, \quad j=1,\dots,J$$ $$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Gamma^\Phi_{1:J,j,p}\Phi_{1:J,j,p}\textbf{Y}_{t-p,j} + \sum^Q_{q=1} \Gamma^\Theta_{1:J,j,q}\Theta_{1:J,j,q} \epsilon_{t-q,j}$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\Gamma^\Phi_{i,k,p} \sim \mathcal{BERN}(0.5), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$(\Phi_{i,k,p} | \Gamma^\Phi_{i,k,p}) \sim (1 - \Gamma^\Phi_{i,k,p})\mathcal{N}(0, 0.01) + \Gamma^\Phi_{i,k,p}\mathcal{N}(0, 10), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\Gamma^\Theta_{i,k,q} \sim \mathcal{BERN}(0.5), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad q=1,\dots,Q$$ $$(\Theta_{i,k,q} | \Gamma^\Theta_{i,k,q}) \sim (1 - \Gamma^\Theta_{i,k,q})\mathcal{N}(0, 0.01) + \Gamma^\Theta_{i,k,q}\mathcal{N}(0, 10), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad q=1,\dots,Q$$ $$\sigma_j \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx[,1:3]) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Moving average lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Moving average order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), \\ \hspace*{0.27 in} Gamma.phi=array(0, dim=c(J,J,P)), Phi=array(0, dim=c(J,J,P)), \\ \hspace*{0.27 in} Gamma.theta=array(0, dim=c(J,J,Q)), Theta=array(0, dim=c(J,J,Q)), \\ \hspace*{0.27 in} sigma=rep(0,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.Gamma.phi <- grep("Gamma.phi", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.Gamma.theta <- grep("Gamma.theta", parm.names) \\ pos.Theta <- grep("Theta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} Gamma.phi <- rep(1, Data$J*Data$J*Data$P) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\ \hspace*{0.27 in} Gamma.theta <- rep(1, Data$J*Data$J*Data$Q) \\ \hspace*{0.27 in} Theta <- rnorm(Data$J*Data$J*Data$Q) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, Gamma.phi, Phi, Gamma.theta, Theta, sigma)) \hspace*{0.27 in} \} \\ MyData <- list(J=J, L.P=L.P, L.Q=L.Q, P=P, Q=Q, PGF=PGF, T=T, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.Gamma.phi=pos.Gamma.phi, pos.Phi=pos.Phi, \\ \hspace*{0.27 in} pos.Gamma.theta=pos.Gamma.theta, pos.Theta=pos.Theta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} Gamma.phi <- array(parm[Data$pos.Gamma.phi], \\ \hspace*{0.62 in} dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} Phi.Sigma <- Gamma.phi * 10 \\ \hspace*{0.27 in} Phi.Sigma[Gamma.phi == 0] <- 0.1 \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} Gamma.theta <- array(parm[Data$pos.Gamma.theta], \\ \hspace*{0.62 in} dim=c(Data$J, Data$J, Data$Q)) \\ \hspace*{0.27 in} Theta.Sigma <- Gamma.theta * 10 \\ \hspace*{0.27 in} Theta.Sigma[Gamma.theta == 0] <- 0.1 \\ \hspace*{0.27 in} Theta <- array(parm[Data$pos.Theta], dim=c(Data$J, Data$J, Data$Q)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Gamma.phi.prior <- sum(dbern(Gamma.phi, 0.5, log=TRUE)) \\ \hspace*{0.27 in} Phi.prior <- sum(dnorm(Phi, 0, Phi.Sigma, log=TRUE)) \\ \hspace*{0.27 in} Gamma.theta.prior <- sum(dbern(Gamma.theta, 0.5, log=TRUE)) \\ \hspace*{0.27 in} Theta.prior <- sum(dnorm(Theta, 0, Theta.Sigma, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[(1+Data$L.P[p]):Data$T,] <- mu[(1+Data$L.P[p]):Data$T,] + \\ \hspace*{0.95 in} Data$Y[1:(Data$T-Data$L.P[p]),] \%*\% \\ \hspace*{0.95 in} (Gamma.phi[, , p] * Phi[, , p]) \\ \hspace*{0.27 in} epsilon <- Data$Y - mu \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} mu[(1+Data$L.Q[q]):Data$T,] <- mu[(1+Data$L.Q[q]):Data$T,] + \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q]),] \%*\% \\ \hspace*{0.95 in} (Gamma.theta[, , q] * Theta[, , q]) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[(1+Data$L.P[Data$P]):Data$T,], \\ \hspace*{0.62 in} mu[(1+Data$L.P[Data$P]):Data$T,], \\ \hspace*{0.62 in} Sigma[(1+Data$L.P[Data$P]):Data$T,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + Gamma.phi.prior + Phi.prior + \\ \hspace*{0.27 in} Gamma.theta.prior + Theta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(colMeans(Y), rep(1,J*J*P), runif(J*J*P,-1,1), \\ \hspace*{0.27 in} rep(1,J*J*Q), rep(0,J*J*Q), rep(1,J))} \section{VAR(p)-GARCH(1,1)-M} \label{varpgarchm} The Minnesota prior is applied to the VAR parameters, and the multivariate GARCH component is estimated with asymmetric BEKK. Compared to VAR(p) or VARMA(p,q), this is computationally intensive. However, it also tends to result in a substantial improvement when time for computation is feasible. This model also performs well when SSVS is applied to all parameters except \textbf{C}, though it is even more computationally intensive, and is not shown here. \subsection{Form} $$\textbf{Y}_{t,1:J} \sim \mathcal{N}_J(\mu_{t,1:J}, H_{1:J,1:J,t})$$ $$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Phi_{1:J,j,p} \textbf{Y}_{t-p,j} + \sum \textbf{H}_{1:J,j,t-1} \delta_{1:J,j}$$ $$\textbf{H}_{,,t} = \Omega + \textbf{A}^T \epsilon_{t-1,}\epsilon^T_{t-1} \textbf{A} + \textbf{B}^T \textbf{H}_{,,t-1}\textbf{B} + \textbf{D}^T\zeta_{t-1,}\zeta^T_{t-1,}\textbf{D}, \quad t=2,\dots,T$$ $$\Omega = \textbf{C}\textbf{C}^T$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\delta_{i,k} \sim \mathcal{N}(0, 1000), \quad i=1,\dots,J, \quad k=1,\dots,J$$ $$\Phi_{i,k,p} \sim \mathcal{N}(\Phi^\mu_{i,k,p}, \Sigma_{i,k,p}), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\textbf{C}_{i,j} \sim \mathcal{N}(0, 100)$$ $$\textbf{A}_{i,j} \sim \mathcal{N}(0, 100)$$ $$\textbf{B}_{i,j} \sim \mathcal{N}(0, 100)$$ $$\textbf{D}_{i,j} \sim \mathcal{N}(0, 100)$$ where $\Phi$ has a Minnesota prior, \textbf{C} is lower-triangular with positive-only diagonal elements, and $\textbf{A}_{1,1}$, $\textbf{B}_{1,1}$, and $\textbf{D}_{1,1}$ must be positive. \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx[,1:3]) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ Phi.mu <- array(0, dim=c(J,J,P)) \\ Phi.mu[, , 1] <- diag(J) \\ C <- matrix(NA, J, J) \\ C[lower.tri(C, diag=TRUE)] <- 0 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), delta=matrix(0,J,J), \\ \hspace*{0.27 in} Phi=array(0, dim=c(J,J,P)), C=C, A=matrix(0,J,J), B=matrix(0,J,J), \\ \hspace*{0.27 in} D=matrix(0,J,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.C <- grep("C", parm.names) \\ pos.A <- grep("A", parm.names) \\ pos.B <- grep("B", parm.names) \\ pos.D <- grep("D", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} delta <- rnorm(Data$J*Data$J) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\ \hspace*{0.27 in} C <- runif(Data$J*(Data$J+1)/2) \\ \hspace*{0.27 in} A <- as.vector(diag(Data$J)) + runif(Data$J*Data$J, -0.1, 0.1) \\ \hspace*{0.27 in} B <- as.vector(diag(Data$J)) + runif(Data$J*Data$J, -0.1, 0.1) \\ \hspace*{0.27 in} D <- as.vector(diag(Data$J)) + runif(Data$J*Data$J, -0.1, 0.1) \\ \hspace*{0.27 in} return(c(alpha, delta, Phi, C, A, B, D)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, L=L, P=P, PGF=PGF, Phi.mu=Phi.mu, T=T, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.delta=pos.delta, pos.Phi=pos.Phi, pos.C=pos.C, pos.A=pos.A, \\ \hspace*{0.27 in} pos.B=pos.B, pos.D=pos.D) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} delta <- matrix(parm[Data$pos.delta], Data$J, Data$J) \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} C <- matrix(0, Data$J, Data$J) \\ \hspace*{0.27 in} C[lower.tri(C, diag=TRUE)] <- parm[Data$pos.C] \\ \hspace*{0.27 in} diag(C) <- abs(diag(C)) \\ \hspace*{0.27 in} parm[Data$pos.C] <- C[lower.tri(C, diag=TRUE)] \\ \hspace*{0.27 in} Omega <- C \%*\% t(C) \\ \hspace*{0.27 in} A <- matrix(parm[Data$pos.A], Data$J, Data$J) \\ \hspace*{0.27 in} A[1,1] <- abs(A[1,1]) \\ \hspace*{0.27 in} parm[Data$pos.A] <- as.vector(A) \\ \hspace*{0.27 in} B <- matrix(parm[Data$pos.B], Data$J, Data$J) \\ \hspace*{0.27 in} B[1,1] <- abs(B[1,1]) \\ \hspace*{0.27 in} parm[Data$pos.B] <- as.vector(B) \\ \hspace*{0.27 in} D <- matrix(parm[Data$pos.D], Data$J, Data$J) \\ \hspace*{0.27 in} D[1,1] <- abs(D[1,1]) \\ \hspace*{0.27 in} parm[Data$pos.D] <- as.vector(D) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnormv(delta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, \\ \hspace*{0.62 in} theta=0.5, sqrt(diag(Omega))) \\ \hspace*{0.27 in} Phi.prior <- sum(dnormv(Phi, Data$Phi.mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} C.prior <- sum(dnormv(C[lower.tri(C, diag=TRUE)], 0, 100, log=TRUE)) \\ \hspace*{0.27 in} A.prior <- sum(dnormv(A, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} B.prior <- sum(dnormv(B, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} D.prior <- sum(dnormv(D, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[(1+Data$L[p]):Data$T,] <- mu[(1+Data$L[p]):Data$T,] + \\ \hspace*{0.95 in} Data$Y[1:(Data$T-Data$L[p]),] \%*\% Phi[, , p] \\ \hspace*{0.27 in} LL <- 0 \\ \hspace*{0.27 in} Yhat <- Data$Y \\ \hspace*{0.27 in} H <- array(Omega, dim=c(Data$J, Data$J, Data$T)) \\ \hspace*{0.27 in} for (t in 2:Data$T) \{ \\ \hspace*{0.62 in} eps <- Data$Y - mu \\ \hspace*{0.62 in} zeta <- matrix(interval(eps, -Inf, 0, reflect=FALSE), Data$T, \\ \hspace*{0.95 in} Data$J) \\ \hspace*{0.62 in} part1 <- t(A) \%*\% eps[t-1,] \%*\% t(eps[t-1,]) \%*\% A \\ \hspace*{0.62 in} part2 <- t(B) \%*\% H[, , t-1] \%*\% B \\ \hspace*{0.62 in} part3 <- t(D) \%*\% zeta[t-1,] \%*\% t(zeta[t-1,]) \%*\% D \\ \hspace*{0.62 in} H0 <- Omega + part1 + part2 + part3 \\ \hspace*{0.62 in} H0[upper.tri(H0, diag=TRUE)] <- t(H0)[upper.tri(H0, diag=TRUE)] \\ \hspace*{0.62 in} H[, , t] <- H0 \\ \hspace*{0.62 in} mu[t-1,] <- mu[t-1,] + colMeans(H[, , t-1]*delta) \\ \hspace*{0.62 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, \\ \hspace*{0.95 in} theta=0.5, sqrt(diag(H[, , t]))) \\ \hspace*{0.62 in} Phi.prior <- Phi.prior + sum(dnormv(Phi, Data$Phi.mu, Sigma, \\ \hspace*{0.95 in} log=TRUE)) \\ \hspace*{0.62 in} LL <- LL + dmvn(Y[t,], mu[t,], H[, , t], log=TRUE) \\ \hspace*{0.62 in} Yhat[t,] <- rmvn(1, mu[t,], H[, , t]) \\ \hspace*{0.62 in} \} \\ \hspace*{0.27 in} Phi.prior <- Phi.prior / Data$T \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + delta.prior + Phi.prior + C.prior + \\ \hspace*{0.62 in} A.prior + B.prior + D.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=Yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(colMeans(Y), rnorm(J*J), runif(J*J*P,-1,1), \\ \hspace*{0.27 in} runif(J*(J+1)/2), as.vector(diag(J)), as.vector(diag(J)), \\ \hspace*{0.27 in} as.vector(diag(J)))} \section{VAR(p) - Minnesota Prior} \label{varp} This is an example of a vector autoregression or VAR with $P$ lags that uses the Minnesota prior to estimate $\Sigma$. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=1,\dots,T, \quad j=1,\dots,J$$ $$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Phi_{1:J,j,p} \textbf{Y}_{t-p,j}$$ $$\textbf{y}^{new}_j = \alpha_j + \Phi_{1:J,j} \textbf{Y}_{T,j}$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\Phi_{i,k,p} \sim \mathcal{N}(\Phi^\mu_{i,k,p}, \Sigma_{i,k,p}), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\sigma_j \sim \mathcal{HC}(25)$$ where $\Phi^\mu$ and $\Sigma$ are set according to the Minnesota prior. \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx[,1:3]) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ Phi.mu <- array(0, dim=c(J,J,P)) \\ Phi.mu[, , 1] <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), \\ \hspace*{0.27 in} Phi=array(0, dim=c(J,J,P)), sigma=rep(0,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, Phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, L=L, P=P, PGF=PGF, Phi.mu=Phi.mu, T=T, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.Phi=pos.Phi, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, theta=0.5, \\ \hspace*{0.62 in} sigma) \\ \hspace*{0.27 in} Phi.prior <- sum(dnormv(Phi, Data$Phi.mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} for (p in 1:Data$P) \{ \\ \hspace*{0.62 in} mu[(1+Data$L[p]):Data$T,] <- mu[(1+Data$L[p]):Data$T,] + \\ \hspace*{0.62 in} Data$Y[1:(Data$T-Data$L[p]),] \%*\% Phi[ , , p]\} \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} mu[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} Sigma[(1+Data$L[Data$P]):Data$T,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + Phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(as.vector(colMeans(Y)), rep(0,J*J*P), rep(1,J))} \section{VAR(p) - SSVS} \label{varpsvss} Stochastic search variable selection (SSVS) is applied to VAR autoregressive parameters. Note that the constants for the mixture variances are typically multiplied by the posterior standard deviations from an unrestricted VAR that was updated previously, and these are not included in this example. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=1,\dots,T, \quad j=1,\dots,J$$ $$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Gamma_{1:J,j,p}\Phi_{1:J,j,p}\textbf{Y}_{t-p,j}$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\Gamma_{i,k,p} \sim \mathcal{BERN}(0.5), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$(\Phi_{i,k,p} | \Gamma_{i,k,p}) \sim (1 - \Gamma_{i,k,p})\mathcal{N}(0, 0.01) + \Gamma_{i,k,p}\mathcal{N}(0, 10), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\sigma_j \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx[,1:3]) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), \\ Gamma=array(0, dim=c(J,J,P)), Phi=array(0, dim=c(J,J,P)), \\ sigma=rep(0,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.Gamma <- grep("Gamma", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} Gamma <- rep(1, Data$J*Data$J*Data$P) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, Gamma, Phi, sigma)) \\ \hspace*{0.27 in} \} MyData <- list(J=J, L=L, P=P, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.Gamma=pos.Gamma, \\ \hspace*{0.27 in} pos.Phi=pos.Phi, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} Gamma <- array(parm[Data$pos.Gamma], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} Phi.Sigma <- Gamma * 10 \\ \hspace*{0.27 in} Phi.Sigma[Gamma == 0] <- 0.1 \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Gamma.prior <- sum(dbern(Gamma, 0.5, log=TRUE)) \\ \hspace*{0.27 in} Phi.prior <- sum(dnorm(Phi, 0, Phi.Sigma, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[(1+Data$L[p]):Data$T,] <- mu[(1+Data$L[p]):Data$T,] + \\ \hspace*{0.62 in} Data$Y[1:(Data$T-Data$L[p]),] \%*\% (Gamma[, , p]*Phi[, , p]) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} mu[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} Sigma[(1+Data$L[Data$P]):Data$T,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + Gamma.prior + Phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(colMeans(Y), rep(1,J*J*P), runif(J*J*P,-1,1), rep(1,J))} \section{Weighted Regression} \label{weighted.reg} It is easy enough to apply record-level weights to the likelihood. Here, weights are applied to the linear regression example in section \ref{linear.reg}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ w <- c(rep(1,5), 0.2, 1, 0.01, rep(1,31)) \\ w <- w * (sum(w) / N) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, w=w, \\ \hspace*{0.27 in} y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(w * dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Zero-Inflated Poisson (ZIP)} \label{zip} \subsection{Form} $$\textbf{y} \sim \mathcal{P}(\Lambda_{1:N,2})$$ $$\textbf{z} \sim \mathcal{BERN}(\Lambda_{1:N,1})$$ \[\textbf{z}_i = \left\{ \begin{array}{l l} 1 & \quad \mbox{if $\textbf{y}_i = 0$}\\ 0 \\ \end{array} \right. \] \[\Lambda_{i,2} = \left\{ \begin{array}{l l} 0 & \quad \mbox{if $\Lambda_{i,1} \ge 0.5$}\\ \Lambda_{i,2} \\ \end{array} \right. \] $$\Lambda_{1:N,1} = \frac{1}{1 + \exp(-\textbf{X}_1 \alpha)}$$ $$\Lambda_{1:N,2} = \exp(\textbf{X}_2 \beta)$$ $$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J_1$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J_2$$ \subsection{Data} \code{N <- 1000 \\ J1 <- 4 \\ J2 <- 3 \\ X1 <- matrix(runif(N*J1,-2,2),N,J1); X1[,1] <- 1 \\ X2 <- matrix(runif(N*J2,-2,2),N,J2); X2[,1] <- 1 \\ alpha <- runif(J1,-1,1) \\ beta <- runif(J2,-1,1) \\ p <- invlogit(tcrossprod(X1, t(alpha)) + rnorm(N,0,0.1)) \\ mu <- round(exp(tcrossprod(X2, t(beta)) + rnorm(N,0,0.1))) \\ y <- ifelse(p > 0.5, 0, mu) \\ z <- ifelse(y == 0, 1, 0) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J1), beta=rep(0,J2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J2) \\ \hspace*{0.27 in} return(c(alpha, beta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J1=J1, J2=J2, N=N, PGF=PGF, X1=X1, X2=X2, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.beta=pos.beta, y=y, z=z) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha], -5, 5) \\ \hspace*{0.27 in} parm[Data$pos.beta] <- beta <- interval(parm[Data$pos.beta], -5, 5) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 5, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Lambda <- matrix(NA, Data$N, 2) \\ \hspace*{0.27 in} Lambda[,1] <- invlogit(tcrossprod(Data$X1, t(alpha))) \\ \hspace*{0.27 in} Lambda[,2] <- exp(tcrossprod(Data$X2, t(beta))) + 1e-100 \\ \hspace*{0.27 in} Lambda[which(Lambda[,1] >= 0.5),2] <- 0 \\ \hspace*{0.27 in} LL <- sum(dbern(Data$z, Lambda[,1], log=TRUE), \\ \hspace*{0.62 in} dpois(Data$y, Lambda[,2], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(nrow(Lambda), Lambda[,2]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, n=10000)} \bibliography{References} \end{document} LaplacesDemon/vignettes/LDlogo.png0000755000176200001440000015657015144316355016707 0ustar liggesusersPNG  IHDR88jsRGBbKGD pHYs  tIME) IDATxy\y[{gͭYA6lj}8_`OSO{׷0"{*ltJt:uBL`gkb96:E,[?яػw//WLJY;hSe۵k]tp 9OvYom|5@}.xm:o޼k9_;c.d7{W>9:4vm'?';msq?SpAczQF87҇~[ot:ͺu͜9sPJ8 4i0Z<*|D\8]]]o>,Y2);0 vscܴ7׾ױK\l琥R).2>|_~lݺx c\=ޙXϹa}Xz5@]pyuw?۔coq_=gC=ğs!83]=F3[4y0 bpg;ƀ\lg{d2|c;vq9ti qg̙3q>Or}q7k.z{{g>4M ,LIJ _Ys-"4'fYz5֭cڵ\{QP s$ Υe`bǎ۷e˖q饗vZ,gttBg oz_+>F^{,^!yyg?iu5za`wޱM {Q8 n'? <Pcu<`ΝJ XeY3׾&B~zxsϱe:D2Q>;茈A.vQc{ܲ 444DWWms 5q>dž H&|[b޼yvl&HLx nQ\`pkΐp-좆=6:ߘY8Yf bÆ \veT* dj0`G- pQ;6| p}_k87-΢N# ~wyڦokkh\n*ՄILb37<<\5uM 3d29z.1pwd}D]z .nۚ'*k@֨l3C=zj?cЍ@,$p0b8YJR4&3b;W+sӢŭSS _P9) \l[Z` ׸L& pA.w RF 1+۔zl%K.v dJXn\7:슆[ߏ>zl1v6tl0+ 30M5VaP_FϿ:U2'Arw pM 31(0FA.|Llg{D>R3|S1ר}}] p۲8Zf;TͰ6bqQOi&ddd3>>N24> .wר^wtV)nd1 ^ysk6n͛1 o_|_\.}#G.Vbٲe;{%ꞇ zȰtEf 7{ZL.T6߹T|rlmƆ xN֬YÃ>H.c soLnj,x9M퍸FLY|`oԽRUK ۷}55H`vzb{ssb3l hRƾ>sru|`; _( 8wo40 !W{2(=gV1=ʢEXbi`<iRZ߉.>4}T7鍡QE}MjX(z.O/x9Lն\0l?dິ6" XBް<62-cEG9ye+޺ɾ+ȶji۶]T\;u)a$55b߹iii2zɬ^͝TJF)aҥg:טBнR S)xgA䖗eɸ,5M,f7+^ӆAܬY1/daPLbe2i7t0&'RBSx\(ztRpW{z+mS>9d###޽{)]]z@' MIεS.)2t(}u۟Ž'yq +@RBpЙN308.0u1,aPnnѳYXK 3"0[)a6Ą &`RXRb aMw'Y{E\x1Ts+c-d+F2iYH)'U9ŭC^7Brʘjq Тk^YA&b Mo[Oj+sݻg ]z\~|K.9#Ed90tֶӂEu67P!dsnȱc> =="EvT*@R\vȨ`}Z rOrB0f8AR!톁lm?ufT ]BR O)JJqe'{,MB1"%FZe"%%\DBqx!fxjҾ 2K._i1"ݎaZ6wE3oֽ*[1چlJʜͬ%ci v)"ibZ;EmtM2sL."ǡo}[<|{nh H?mr:Lbou(ه*Aqp=k_QTHJ1g\:g33|]-l5`fn88L0 ?ſq%`iF@.FZwN\A<]oZ\oo/r ooXx1JÇOOw}r-tM MC)cl9l17k6Da}'pJBP|ϣh BP (!|Cw3?U/B`AU*lm"Ӥ0>J1/0}à`(E8*&F>!o,R ~2 D|@J67 QR0t0Ż{MmRteOa zB/bea@] _qC ,Z|zV/2z̹,JW=5\OZ@6.:;;׿Χ?i:::XfMCp /pGQ-_ΒK. QpL 0*B /dU)Bp9e<W>k>7ow\Of2ttv,ˢ4im .T*ǰ\}##dz{)>45,tBxJ5G'w* H e\Ӟ+#8PR ץ国 6=͵W̥W2* тH&UhuKO#=\p>n;~JEy@z-i8D={H$ ipEz{{yGرc+WKnit:Su)9cl.BLfBBxUQHJx>,ﻰgl~.ۄ`L r@JRN!4Ml)9 %I,lf[f]t[r K0J$,:f4;Ł|);IǡR!;s&Kyip]Z XͪŠ/3yH}\)WJX]~BH1<0PI)oRb#|z+\pX陵^F)xY9qȹ.#œT 8j@(HL&I$5Fp)|wYww7۶m#J՚5X]v=w}7vdT 7 LbΝ;iя? .oȕ z-[xb&Ķm,EeȤ >!hڥ$?[eK (xkSk:tȬ9iDS-hb%A./qcMmCniRBԟq)&ɶ6&Y!HfjdAr˔K%*RVGyz<$+  }CK(_t9 [i$]qv住ɓr] +%R«@~< Dbyԣ7t,7۶ijjbpp 5C`rׯuOEf_!,R)GFxGYt)3gJjJ),zCJL_o/{6m Q!CBp\4୓BBf4Ms+Œl.EU89'MXa)8X5AqU ǫI+)eՂUTJr'OJtyMy\U*l2Mf A0P}RD(Ce\=Hݸs(^}̷H4et<g3OxTI+%a %us]*^b0E/mZ0Yfq7o~^zzs W_\.6p# N3h;?rjhg|U+W` q`޸8 twg-l۶) 1!Xk{Zq!` h1mӕN3#D&ϛ?gRII~Ok @a ܨHJ9Aq dh[RR)f573sle1.+{^EEE!(뤉NϣMJJ,{@^Q )1|$.[GF6#y!H+L)i查vt8 [ޝGx-$Z?|Dg'.8rDr:K\$+S*j`=&ڵK$IĨHAy1;G&7n{o?!V q__xhkkofE=jaP bom洷I[s3ٻ{7t ׬D"A:ndl "wtn=?/|BPT:@I)*ťJQPSBSmZokvƊ /XēE('$TG50؅ y>.,7[iG = *EN(+U-E\}'?}_T*U)R 54.sXJBRUV)Y>RU-JU_*Uca^BA2g*mZ0.2> ~ۘ7otwwۗeVX1A0Zh3t2R :aW>{i(:px!Omc AEw(~ ]{xIJ :.W%Wdoݧʸܣ"YpQ` #D7^=ՋQZGneG>wCqJR&TSQv)i2Z 儔}$~s~af rT\bRJaذ+B/U A3Iaxѭ% lۦR&fa\oNdkzڴ8|ӟG}?Lr\wub>->}dtkuJa9Ccc?:ʊ9s2c,MZ9.}r##ܹgzvB Vae1Ln .X7+%Xv)7 ;t|KfNN@diu;.h5# qL™Z¯04K5s=apţY1pN̸XA=F˦P\܌RZ:=ıR鿙P %'d\5P, ~-VUq FBSau pgpW7K_x;駟}nY| 3ѠRBhDjt]B'TLX$CΝ,bU[s-U P(0"f ;s&Rb.H_]۷ɓ>)m!p IDATa2 JQѐZa-OmFwq.+cXGSKRiRLd2I:&L֎(\Qh= pJJB\&Wΰ;bq=ye{tY)lUf.#RN;F!<g ǡˁՆAWW)o+ZI%ښFU7>V8UU!N3s,@al|>*a_}}ŏjO9II{B$߲VQ6 mc;O{:͜/fev]NO8y -`oA-X83ZObb#~]+ \v`Rp/b_ϳ;~xTn!9Xdpm@wVL3ozصg]Gd\gBТFzaO`+['f%ȏWQon6Zo{Aꅢ1FYB4,YoY:n<4(~д,w)AvYAUJ(+1|R )E0۟RaY$\Bf,F)l; ܚiiil6K6amnTKz475ՅD"Qs[dsu*b|b` HR:[M"t"JѦ,R8iZb:\T $`aQzƭMdF"S(TJZ cJ1&% 3A.O{PHzR1 .)9.yJt^s{;.\&Ѐ[nsd254 B3mbGa5(.yuTD~ibWSl"wgA~ui< }Bt>p)> !XBPf:7( fR$a*LխYJ4X[T 62 Qc8 JI~[z6k7O43%2`aK)P֟ԇ!lWlmetl֠d36dj -[fnap VOxᶤ\fר95mX)~A63:pB@ 𵘁Н$ hb ΄PNY' hQnKPmC[T2iuky^. U:WVNYf̠նy\FMBQ Gߴ8z*,R$}Bp0CT(%`F)/>Ls3/l{;ccs¥eE]S2*!fzgïQF.=Z#.R-v" :|ҥ&)TNT5N ΦB L( Bm6.XO%p e撐#L4Z ͸F`nV3O>rͲ/rMb/-JL).1-T#QE6MMKs3W&Xܢ-`i-F)M QpQ9D"An,ezR/M!֚y5&:d-@Bg@g:QvLF8%MJ R*Em<ݿ+ˑ$s[U ph hUxI<%%|["_(JQxuzejo>jeiF8m$lv\ثY[KK bmap ܷSx* KٜY8:z1h}Y{CA˗1\!LMbZ$Ǖb1?ZǠX`9ѐIul if5JN4|ޗ^PCB@;'=]ǀka4wt袋0jniNB[[mmm-`m)]uIRv=n7 ? ՗qQľ}\\JJѧ m`3{p/Uӟ -+OB˨?k=IsQwQb3zF=¶iYKr9{Gwz Z'䲤~L?T`wX,ˢ%+V`g25AD V{ EU?SGeǣjjrnrevAA8I~B)ՌZ[V ? A28TFh r'DA.ZwZFF9o{9Ӈ/N|xhH(H:a$,X@"edt2\{tzBWd uT4Pr޻K.皯o/Pl7C^UU})t\LX4O/Z[ ɥ8qbRhE]({JMJ%ulS{;=cL-+B` H !-H8Xݫ[ yu2p˵ew -}Gͧrl}jӤCJg`|g|jvtt@s!Q񃩐= ֭[;ؼys{Ї>t0QT68|=k38xܸ©SfifIR$- 3 MȘ&Y-Sݦƌ(EQc8Js]F ʥi2c׭ V[0C!h6E\0E*c1W̶TxR8Z>J1DVP.R=Au:t"O \\.3bھ};7x#֭c$I/xbN8wy`(x٤޳u/nߎ!MtI޶qLB)mQ|wU K=ʮ[sdi4(E*nvcmq[3~ʭuJ-9=VQmvX  \508Z25[28qjZNAGSAW)Ν;;xGj泟,N"`|_2N3'Zw p8}7lT*RiL$H\Ɣ0,OIˎ|<)c -Y&EE]h4<0N0:;2(a``800(cUUL- amt'8sZ;LtU^<6,^^Χx \EܢΔ<=S\%'.P'sP(J1${IR)~w~l6[x^cZ! znkxJT\c\+{8u +%ǩɒB dUit˖: )R:9 @XBuU©.g{}8G$.pj!oZԗgɐi3% %%%`J)9oH]Gˬf[&[I{"NO`J)ZZZWnmۆeYY .&qt@.Lgx9ܸG̳2V(XJTK P-|- -ne\t)ݡxae=ܛS>j*2 joGV8+4Q-ڌ(e0 2T3(Fv>|cO7#G}^8ƒ=ΘK>opB IUf~R\s5\q=zyKͦ*\s)JBP ɜZBR: &+ hR37S)f6M )p Ĝ9:ukX,ڛH57>&gY"*/5[zE#y5qy ڥ]$%n稔uCB%KN16?[{k W hѢ 0?E_91)4yNdL)!Y $Y =|s3[+ϴ$\.uiH4,[w dB1jبg}KN_Jq /KIX A42XRRRRh-:~>эm>m>CFuŽA)L_5΢Fmla/sKZ)iրe끽 T TUWU 6MҶMS2IsS3;:ڨ̙@6hP MdC1{sq7 (.ϲj ^R\-Z-$' gLQ)R:!$/?xSs9r|5Z*T*5&jg.€Vu,fpᛑCK6=|F*%v=\ZJZDk-Z 1KU5e eQ,"lqD%(߯nEuB lg'fۏrscS%|!T<`\ƄRc+E9(mT~F)v&}CARd<y H2I.4&ܫp:LzJc ?4KO_F bU=Ojn X R zso4MeQ s>_>. ybq9r7^G޺g+^!C]>,])=:,[G1C:WivZԙ >Y\z3?S/Ftn.jnCݺ%1@Ws Qi7tT{wjׯs|R20L)e)y>([8Ε,ĝ69%/(2`RmǂjLCE*!`L?Gf  IDATQOIE@R>e i[*TYX۴a[/5ǾJ>!Xg=m6 R8U5RtReJ4xH` \* Dqg=mK^ ״o~L.o p u=<7o&W(`fU__)ۊ7`g'Ld^ӤS)*AEJ 6f22@5(o 8U(0'L&3a(MXbQ .=ftQw+nOk|8~صc[neX i%u쒒)+%M=6JNx!TK ZrQK iaᎅz8vv]/4A.@gcS.ߧ׃Tib=RB_+g v(:"$.!h¨Rbs8… MMMJ%JT uk񬰴Лr-Usahi_{a޽OQ8tq0{9ߙZ n\ܾqL)0IB;MIҔT~])~|㯖 HfU XKD}wK%呧 njt r+u6n~r _9^sRyۦZhͲn )P7Qlך-JqZb  Z*i/I74KrI-Z-{O;כl:SH߻~6LO131cd7 iUi)$0FtN!SSSln-?#j7PzmŴv%╺S~[±IΝ#ry^.3"硚MZ̦)%en0Z*dJfSc;e:=U| 畫u -T)~hbv z&A'5ͨ>acX3!if%N xqBN|ź("t0 )ˈoT׽9s/}aqtkh&UFp05##$:T>g}(E0(b\)RqJL/)>ϣoVS$IJzw&n'c.* Ŗ#~$|dv?eZ w\)J7>k'mc,TZ$I Q1+]޶v:̄! 2^1٨ 24L& %`lPɻ(ϒckž=m+FoЋs3Q]#nW3kcANH'kSkδۨ(/I$@w$W4jssl;u0-|EryfV˥W]i6D8lҐJ4ffx5 ɴ7ࢀOFt9+2. u*3ZӐT¥WsjN+9?_Ƙk*_K?0;404 %?穀YIxӠ4*Rawg6;1b,Mu.\ΰ{wDs÷'&{5yJ&iӈ6ANx~N Kd2F4i2%#3` G*R 'kT4,ɯ?W*Pؽ{ f,\_{?COOyTҔ;yTdVS.n:w8 S/MiSpt:.!8FK6UYK594]ԶC̋^{B--, Ng+AEqW{ߎfa|jǏٳ8MiClAl-ea9Q*ӊ35 AKOa/>˝ Rh^۾8VO"w|Y `1M=9z 獅>32A1Y:DQDGx}o}O Ud-].ga-$a,DpiMfe o籱1EvCDQfрQcd "Ea-Ϟ|=þ?0b/3q7Az\fZ<:5z/[,l&Kc̒hlQ]{q{azٷҋ/bMI$S|+%P_Bg7ۥ^)<14YKC"a-SQD-IFC>MK]iFoK;}z1&&()덡I‚1 1PHdg!\J4J%l0Pe ^ː=a #Rc7G3E·ʕ(.b>˱Z:jup܊R=jG]ݦ)c+x\T ȹ.|[Hf1&ۭ͊٨2a n!e["F l+N;s<|M"~Zƭ%tc- XW}p1h){lP*a}@pF"b^׼uwMfZ-g&fjj6U#8& |tYwӔJbg}rN7avoyR U-0s67w8oj[K*OZiNEpZss޶8 nXj.m;qڲլHܤRm,K:{KӚ1ZjM5ROnyrȪ&j1aȑy"X}!@w -YX8J1 [rJ) ދyY޾cbb">dY+e-!w>(7gC, p!b[^n-_{;ƯR}Z.xJk t <\\X>tONV"8k)1$R)>QNbj?[f<:& 8}iSdc+OYsR#3&'#8jEQA@tԮG 7MS6~G9w"*>fdzmI֒bI$% CL6,*ӝt:tR,s E_mpasNݻ￟=<߿ peDY]VN 9ڀX0ONW8Jd̄.}&ObоOb[Āіr ,z,߻p?9"NӓMY,Ә)¿uOCi͠cyX)#bZkp64ikiϟgiy'iMQ8Ǚ*U-}OLM2e f| ZwGm"'Ky={HasacAk"kh=sf&n\m. s]uoIkaH0=Minb!#%p)FQ^zw}76P4vQ?|F/H]7\_ b#̴%u1ld]K8%N *||峟,ԧ>ŧ?i~~ c O^R]"r-F$=sFA\C$e7T>LYK3:B $:iB*ΞzYnPضǒNgP-T׏5n$6[A&=MԱwT+[sR(RiZYn-8.J /V25߇KwbAja14͒s[Y>_<5Ůyb_ƇsVŽUIo222'> oo__+_ ۿ-LslQ^|YG(=ܰӡT.u:33&4%QGihVdJ"瀣 H1ݚ#$T1񽣌k?c/uZ%"* I,3ܽY;&i^S||U@f,eVm*hxh/6( (dZGJ=8# I'3dJ7o#SO1==ݍ(J|=y;w$K y^cZ+9ZX`fjvj> &e]2^!-zFe\c:4%T(=/z!Z34lfS_/GNqz RWVjQtfϣ> wI])WxJcYj?RRB&'nZMQR#Jqx\"i(S R?Qtדo4߉.~7~o~!#[ pL)bfDD[ՒzJ6d-q2:l*|''&}$@5ѐotQ/wrBOr)~az_QJ-0فXģZ+ut"G]HPkL l^n $ o-}95v߫HkL&DyBo1,v#|ˢl|Zl2p[--Ӻ>2j pnl,>]f9_s?ayV1p\+47݀"ؤ(s&S2)ܹ!yky0πVXgRT"%8Hh~_C= /.\_"_Seqݻ;w^bm( C4%0ۥ*À1L!\dSk٭2'+D]z9Br[~Vtn=JΓH۠8ASz<ʾm4G 72UJ!s/^2|p,~kH)r^^G)^z)N>55}Rm+ń|dt?$d<8#@Y2-1GwZm pZk/u9m:< _lK/K/-'* V$IOSJqL_0,|G3Jq|N+qE,*i@DiJZ "襠ڪ7DnP 0V L6iv|<:tz[4ׯkyyRVIQ60d. i)#f^R+qD]#'K‹L6_EF|%A(lb4?{&]KƎ'5!n/CZ.LOm= IDAT'`+p/2DwIc^ظ;0@ZT,^WvZ0"y`ĝ8K;iֲ!R2#mw.'1oXc+h%SIaL6٬|G8o_5H:% u`}$[1~723b ?wqԧ+5>qF1Ҕ M)kAI,gjNnݿf6N'OS|'wiǀN*5wk5ZI|C$Zךs^3I!/{A(ʴȬeR|`X!T7K{Z&If87#*D!B: B9ڷ?QJHh4X C)IX+3%GSJ|HNS^t8@ >,G9&$:8 HYKGjNj0njZ"0Mgg1f <'QM%73:n2`\Óh "P{.܈ZKh>]]:aN"J1f-,)׸g,}騎Hd?R*L}G⢵Lr nzI*7JшkHR͓\.RE[ŗU* 1QD,DZ/VwT=69`FpZN7k4/I2Pb"Z5KQ{ " +'V+t4%2ڮ_l*_]5`%ӬWZctf$Y$a^RNcl<J1/_f$PbuOư8-7#ci%4SiJqLI)(8ΔX<Oh3iN-ukFr)yHa9P~al^Ⱥ[9μEF̣r Xk۱pp"f)`ZRy^TI7ukYdI3NA.\n(n5X ԊGLE[+35;;bL&"t);e1&{eC)hMI)9स{i4)I9ꁾ^Sx)Ill4". =ОcIG۬ERTr8J'9fg?Ӕ(I2;$*>dv=S܈жx@U][ᙯX 2][C):Zd{-N}!M[g^|Z:UAے#QUkTaA)N縘y|WtVԅ[{j,HEB^5Qo?9Krѩ$LN2^. 1t$ռE~IZY{bR) ËdZ|kQBNW* Wz-ݻyfn$>)2YxE(*Nj@٪ Ek٩ߵqLl 0f-HF2.9º3b_C86 wmN ;ppRi͸֌)ŢFbvee<ٷdDjJ~Q 5 1>#+SsGb9o*M{1H E]!ܠl, *BL6gDxH@JaJ9m-ryg"p޳{>c:,Gq`b6Wa_;sl-iJ$%* e]Eh0c-t=0r zLJ JjyJZWݨKk͙3gz~T*-jj56lذL˯ly|Yu壷^C8?~%N5Ep >&se^ ]ti^|1 ˿C"EkS?W _<^$=m-]Q2œYZHҔaIb/ ,k)yky^&<f9I+FGOi#'$?LFvQR4SJQJƠDEVJCNZu:Bf&6sVDQdLb~g ֬K6)[WcJqD).e.G|3STk-J%[A Zw=kbV(]纚 ELqM+2Aϰ\8 xL!)dO6:$J&a椁`$,uK|ѥ<ױl]'e9J>ZA)6)SaH9M%DO@)O-t>4Z\fer }C"掣O8 uP{GJhIF 8NK2(z-3ư>Ҕ|K åMUP+\*c/9{e&\ő;GZU n%s%C^X ܮ;zP |PctI1=&\{_E.(EG+Κp|Vu}\lE"2+#OqCZyn#S8"xENOdΩXKYkBL.TW$%oo.|-]%] n9Tq;M)FS%Ԑ^WE槦ih* .'/D%_(gZ^gזȵ#գ!nQ9/u4wzQzۛ$IB]J4|ǞrQ/nJ\ˍk] buV %$PD05kYP)+YDD iܐ]0uDŽ.2A~ЗkP<3|lB%5?)RC{Frq^pJtےbK>Ggd*eV\#hlkٮ~H/8nyny4a:7Z?7dž.yٕ51!h)Zr(X]^~3JBѠn׷VPJ8Qt[U壶iWV0Rح5Vۍ5ch)WW⎅Xh#!4fS(k(%Hl ژ@6e,묀ه:.uIKP,orrJ/[ ds9 |{{ךuJ1%*=KT]%M ěbDYQ-G56Ui z=P)O|M_kfDoWpNZMKW#_ѬꚉW^]+ЫQ Y5WI#J1yU.s 9ǙN.+zSu`n֥)߫(zCNV:NS} <.@~LR.)tv)EQykMZK$2&:7CJ ;-_6ԓdO\VfSsOXs~%}Mz7oTw4:ٵ ol,S|GYd(ki(EZZ#S($HkF+WwoQB=#P«X1ZuW.xIΔ0(!у|)}*A@_R% 5(ҕ+ŸԌ(Z1 _Z/;p+R$3Dl6YKUIU^gG6Io8+5{@ؗ,fƶ<-2e>ut)ȇ,U˭HrkIa`;z37u;9TO2f;2{`=-&}tA1lݺ{^.m܊vUJ\6Ea'UB ZciʄcK:[RX<| GC6 )ߢqޢ5G}a v%5 Ҕ\W_%) K{ Va*)EƎZ-ݝ&u d|Xˇn~ibqh;X몝X(i9o#;fn&yku`4cc20BB6R $R+ND(Hp=ITzZoZFGGS^2OEǽ]Z>^v=7yM()+i {0Fiw)l*Ey,RIBLYK[Rf9]{e6;VÿF+I{6T *k-;,s]!EmKf;7# <5-kYWI)oft+,  Ii]׿_Ӛz]@]ሼҔp^krRU!VئӞcg>7Tm^`$XKIhyYYDMOS^²@/WT8Cx]E]nsD߫Dq{ïe~Roj$7N֚l|#\l-4œٹ",|}3 QQ};`"FNKel@ZR̕ AP"÷%LiTӔuJ1'@ < ©E%^.3^. 8#rRlN*Н4eQ֜}.VyL[˩+:KA:}}TX|T?Miqv0j%&pRJtU;,y7>Kr:2C}{ӕ \qˏU|{ $o{3.n_3_8Ҕ1Ե#CY/u>х=ϣyTF+E8L+Ho2Vu}R!"vF)G"JauH`q%ʭJ/<c(E倈0NK_<} A:~v]Ex,hư!I2꟞Jأ5dD'EA\cTbDr\Q߻'OfMT*PP? [-Q 0+(dBO)FMd'%G:tkz^P)Ԩn(JXQ,'֢w.tYW Ǣm + #_WJ' (J U4y(eWVϾM ۭ1@M)Rϣ)>hM_BbhjQTsը sJxZӔIݺM0f~F1_.}sSiT*(SO"Y98yex~PkvH}J)E85D@4%4 t*k_Azk-852BuFLTe#jIo 3Ty"t0/(͂e-wϰkh%n:nUyW7vhxYV,aj.ʆ\Fa6~;#*|5 b֜Wqzi%9a U2J[0ﳡ\΢vuzaȦ&eAk nVGkbQpvF `D02bʡm>[BT*5UkeM-Tb#LhYVaHn1.h0m-IH)JE)Jr&?XJ{gZe<"l2+Vi jh1s僲>t^J!t}22=HpizVܣEˏ}Bm}ung Ae&ڛGy X$}Jtxe6IC1AkV _̭{)܈dC뷓۞QnNT"#OZ\U\fdxA"~݂$̢X:VF(Fm71>_G>s+uT | !J,#dž4eg06F )xR]Z:qL# 1Yף$2S3iGXT'IK&R x۬$b mkYO6IW:i͒^"~z`/M@(g/Z} ɤk63 ni+aku=$$l!Uych8$JZZtS^ UJl34;4Md-^'\Җ-:X9>ރR˖3Nj]U-` )gss2[cVǎ4:R HW CڍP ; 0Mڦ4Fvm q0͢)حH6"a{E~ID^/ pQ)n-9M{r3EoI/E^l/@{S ozW@{|$*&-*I8Cc2]1'V(|8%JH6iR,D[-}ư2v#6ځ[k3_gN!1%c2hG)][os'U&ٌ)Q]vҁ|wك H4phlgWxir B!匓O {|bmQ9w8'O)='da&yx5a-_##Z/Je IDAT΁J1).u`Z pa) [QS2/VH0Gq ?}(:q{:vmkhny@@e4 2s8&i6<{=)޵BB-kn-_t8ɻ'K6Ѽ(e-Rwn2JuXt_j =o.?X .J;pAZ+)I3nE֒Ź^'1XK--jzeVj%llby)iJUƲܦZ5=O5k4 [\\.SըT*ݗ zZ>^i\NAH,#.(>,>xY"8}1X}K/Qo4 ҨSu;V ^:2J" Ќ޴d VW%~ƇKjK7#sW^nըۢ pjFjO?uX >&cX!, .1SBh)ƠWqe"Md0$ѓS|1*JW&^S׻r'ZQ޸8op=g|_1.(o/ QD}a"T6S/(99RIRv5JeZcj̕b0gQbz:(ʭ]ZUW|ଵ_ Zq%ۺr:ܨyL%(YJRIsgaNk.s5@Ojl BYɬbσ[^~Fs.e-^ J**E5Wwћs[kt$|t4r+7`hZ{n?MEVzxncSk~Z[S"_*dS n| 8RD sIo;| uə%_:YV58GKr(b#˕Inkc-dZzdZw9p,@sQ@>R kx}Q;aL,^+Qhk9[yz~eHR] OVZvkqR+<+%saH "JT<#I}şV85r ,ӕ̭}d"wXZFvS̙Bg(IzwuI):7Sa%_{[ଵl޸o;Q2Ŗ,kyJ)~Y0pBNV7DDre)B8S`;޻xå6=_7\5f-Fk_JLyzJD^0W>s)DusuW*vcsz3I‚T"u tg%U_ ,JԕHy/{`ZtO]7,mGKwؙoF Y˴p+6V^  ũ+k}[@PuyVkL2s d6ywZ)I1 2Iq"==1zNn䕎G۷X^R?Vtch"yC;yz㽜{>\Pr nCCC -9gٖ,ELE=706B{g/r[xZv)8 (x^ΌeU6C!oPaSd"+ S[nI}k3OtQדyضsYG #-@)>7 w%5-NI_۶g٦UZWKwD)唵9Hc-۔d^Y˷5[嗴¼ʡS|61%[FCE~P*? e7=Rŭ[8Xڨuy׭ԁ`7=u[1(nyW"krI\,c|cG85yNkn_&x#B~ukZ.*yNeA[+ xC*s_.bs&Z)Jj$YpzKWݨY|YGoNkMWӔTΕ$[Td0pQ>`:TsqL+dΤǍZSRu[w15K3KZmYEn-KM5b=zJJt HdY}ҸAZ{^˯$%zrRDFmt~~3e FF8v^\d x d ;UiZDFZvPG U%{mdڹmpyͺamL<;g&)pL K}znր˓ 6L1&&f0'82< G@W$$p2PI blC<ʖ-k&khjt^:Z[նNu'sZ77¥3KOw7-g3.٤.Í_ϑ{a\3D,.6 m:?0\%J+Yy0BPT*> o0m`7q]It.|`]wsdbɝq/LۖqB+Svh>' Rw*rgZ(G;׮zR xxQBFH%JD#Zz ("'&+|&0q$BH53"ғs]&i&]#KTn7Sx5.K䲽+-XZ8%r!Xm7̸&w*sII-ˈ~'|\S倳$O a0Lf䂉l0H\(:m NX_YB08 8%"sA?ﯣٌ'MfFLTADFVݐV+M!8";OAϣyHs+u!quo3KY*9=iQsFM10ڣҵ/GEOjs19K;>|+0gUzVSlBD~{t5Lϣ00i9C=Zȅ6uJdaC5!T$M`<zu]hZfdn4_#5RB[E@:MA n_E*uNf^-^ { EkqS|YY*1knz3B*إyq$ZZi.DB0Ld3MJdڍs[ݴzz^a$'?>P+\DO>K!r<$4In7(ŵPMEdjA!!(d2BZ.GP`Xd [D\פUpt_s ž>^#kršRfŘg"R='|$2Do Вϔ ApyBT&C*&NSAqf_Ep[ 瑩?4%KkڳaY rD5}DNF{u7T?NHby<4HZ@n4l79 e2 rtg2]asAno2/U带`أg) F"&Q)I `ߋ/(c4RR+qs*4u7/g2uCBPv8߼韙sWTq!WtAijph( %)́pɪqI%t9d;zCG5vJo,\LLz}_(Cj2#Vp;3mi@hGjy(ޖYߏu+G7P)uS$J\RUD.4^DY[QћM+t"0P'0įTh4q]rCu> ? ۿ 9d󶻯Z"jT(x,ǵ%yr\L1׉.3[|9~kI: ؕI=߰D#\hr4zf\fؙinF{|/aZ\Rn" p]+D)Fi:]--/ðmISRlXTYZI(?I3eh⺫RǏDˉO?zZ+(aKߕʯ+LβVC'&F26- a zvnoμFv('v=GBl&LΤ;Ή2E S?_R(tLxA̵=$qՉ.p3+MoW/5Z|[D ,WZY/%i>ftpR:[KJSCn  ibHO"8Ԝ!N{:b676;Kr;>~ ƘCV jQ-@"-=&E?ǕRF 8DV#KY =;}.L ҥl۷{+ Dݜp: l )|^{jGo(%RH1VW=1??L8bfQ}k7no@8[pj2l2+b\C$?4/ ςCԥLGm;|G)z`R)EE)|=ۊRLJ*EkTNU&.p pUW1|}o4]^ V8Jt-Q7u1p?l!VtӁ ~'&H! ǙlJS.len;E3߷/6s;5~gOl6JQC^<8-׿)$i!EmpR\K$6ܢEP(0U&&Tuŋ1*yHUcSLӈ`^ =kBj0?ӆ47)ū5=O$T/W7.Jq\f4ᓢ7{d+);kUIbL$g&`s\&3b3ϰoAJR CeNj bm{C}0t6Wyf]wsRQ6!C&s9&s957i]kuyI4xօ8/fXx:Nj6 b-it6^Q;d!/y\^k~cX \ØHuZxN[]+E% yQT HRlxqg ٵx:w)@m0ݮa}33TMS0f+Y.5(Q̔@3D")&IXFM<,Q Vd3= CVpni>b R$҈Vjx:@xXB$JouR)fÐY{L=lIfW0f,o+?tRi4ucEn% mЊ7\ tjv>~;LjzFtp#kUJ)񍬹60*uz􂣥pz&`)*EM7"_"l쒺gËYqV.\Iz](+,+ųaȋ eV>)PZkX QqqK#JŽxx< gJ)zoedV&pIKB}h*E;6k. j.Q WnJQe͑#eH٤hIzv&\ރ7s?yhor)fKycby Ɵyp,f(4 X-#B0 a*!v]^\! IDATTiDii^pWYMYg2mc eH;-Nh7OeSBPT%.Wт3R4tI{4m>8|I~Ʌ$ Ԓs)G'P(D?裏266*x{ Wvы^O5t.Z^  ,]WM\t)ki@h{AGCdG4M ǡ)-!h.]C!]PTF1/"{e"`bVTRnBPGsBxJUJddh_K)IKI \8,R)^Jތ|ʸ,3؝o$N~^|E l~{׾6A'?mjDa]Ƚl]e7_/e>{ڣkQ`V>:"mBpui49Հ@Y\4>lNSnC)C*:e!xVJ*D :LM)ŋ? B555m q>Gp۹s|~W|+'я~tN!??ٴi$;;78;e6e嬽鶽M>))GK5ɖvⅎRBIL;Dj(Ύf9\'{yWjQOy~tbl-Rr4 Y&%) pe׮KJP*Ppu&cO?}GTx͢NQ#!!x:]mb?ih#W aRi[ gO_%7~7xǑ#GsxS1 W_z8r۷ogɒ%?S }`dd__?mAxde+cě/yjHΰ hlxٵe ^,%M!*""k5)E-CA9N;ut*EqP5Dl!g@MG"\f)X\8.4RSY~=~nv>MOTs~gZcNj?~泟,zkP*_e>nݺ6ZZX+?ILeNwQl2eXdrȑ1Ʀ+Q!XBd>SpB)]K)j!(0mJq\)8STTPI)͚Z Jɱ1x1m(Z`RT`L9Qf5]y!(uR"C`O?GGy bbHPhGpqр io066?y֮]5\ v3ߙYjpfo&@wo={|5kִSQSHݥ3bIWʖe`jqK[nʵkY8 *04ChpV)R;Fr2@, }dÐq) i6$Eq*:k͛yj.jRRtt :gJdi<Ѝ&Wȟ!"JѝJ.X~uᡃG}S6n`gJD7 2k׮ _;vn&zE4Mctg;/nռ[n;h/ ^[K1And oGo6]I;kWA"s0B-4O3`֯m?m~M<Qh(EhؾK"BEtq-~ U]['GHBO,q.زD"]:j+qȿah&1 fwfmw7^>OZP(PV'{8E~)d7.D9ܜV ҶU!"2FGyբkqݴeZ 6iԑ]hIdƾ={&Sr|.59:ʃ3Gizb]0LS])ZB0 k准絛 8\bU6pHחl#C)J;'=yo|cYq&ERԛ nW )9)j܀ yR:o0hVH|9/nɣ$|BӄrmgKR*]-g<6S3RٹkG[-RJQ+7KI Q lRF\)<(MϓAg qRzir|^v8@%Bbs^Z't}}<+֮%,8VrmM Ruj{z*xQe;dퟏC)_΃Tɘn~ھV:-SHsT "s ph&5tQ޻UkP>I,^`eǃҪTIJJZRk@uz) cي{z(W1t;z3v!z_Y?NIAXBz|H>4<fhfvbV\=6v޻g:n0%%Oل~C]sGsUW*vbhx$$% IbYZ= w}2 TBo>m>dxm}#JQtCP:Mi`opg qpodv0nI\/ yIRG\|hx>ۻ"U4\վOu߻Z0('0@wP7&L H C˾E('݈Xŝ[G+E#'h1_)Rʚ5ʥKvuqP`(7fRS;rLv!7LYԌJ*UG;[[\䀓d~!IWJ'pI)d2 H}x7RTYZ9rjOs>,e\-ӋhwNJ}}xwR鬞 Ðݻv/< |vTSZe9؛iMlOٖ 9iIr6bj* ԒJOq0wQM̬ v'Η{꠾p01BHIVCm];Tu~p{qoR.ؙ~[>SUFGީY l_#OK瀛yΦTeW8>` gɞwH ک|2_mT/2[J7rTJT*l0D4i03"8Aģru=gX)DR8<8>ζMX[(P\nt։ua.o1>6FNOhjn#AcdbҋZ&)-'D,/|F;1O. ?kwU+D8R)\/[FϕWѠhAj l܊I"Ro@hrOp@sqF0);^3W™͹H˗3uK鿛{"2 Dts( |/ ÐTI޵wd2s>SʡٝXe__$ ǺiQyQ,$ͅlx9hPD^jf '^n2Bfql".Ī8UqNUU x]hn~R] _Wl[oFa;'H&'8#)SVxxq<9Im:mo;\#9A<3;yC"oQ)%B)^8АÐ]DLeCC ^y%Je}ܒȼq}p&5xŝN`Ϧ@mv!^Psg2ғ(meo}dR3EV R_s9oh Na5)d+)D{!>;qh/G9Rq%—صM QznUcH҃6U#/; `i.Gyx.[rfΨ4 sƺ|S5;_Iv7sFr^^Zơw O=w@IK5SVǪ3T@~\}B5yu#0ZjPW&\t8LN[JZ Ce2G+> h !DJ)]]]/gzRHrkK'5 7@w\ٹ7[Ռ9@gj>|߶C8TE,yARNZ} 2> {tZsD[T} 334c_Ͳ9g8rMhJg?3[zegNKGgi(JIR9"<_#7֮.nJ^RG.ZV:j6?ҢIݰ.p;n!p ~qR3f pl~ܝ; SԜ ז3(U*G>vqh9A*K9YJ):3  *Ep,a|&nO0yu,[KПNiZ^WJ$ CTܳCܲ2x"y(f2Y.C/ {%fpuk7W`#ud̖9Ǯ-.iw] g!n=t\L6pmxd|F$CDYI!00 *$R`cRln6پy3{w P6u,,^򷽍ג[twI՝ $Z#۷S۲(@!ENoIDATPմp "%x2!t]*C#bQ@TBrH屮,Gǧі%O zۥLe/0Dʙ \nȁ4}T WK0D!)T:"aAOJ^TV,.Mٹ>ʪEXq,z׻Xa')9*IGab}x9쟙g*}4*%*$5"Bdq/(}eRdvJ 6u;wYFr1*v1ϳҒ%TȎܳ8~DRRCV!WuD3#{bX)I`Rj A)9li6*韘`f:JTB:k^GI AB!CEh4`]L>Lgq$[p))VuzCk+G<2躬!r%.*f0 گ]JM j-/Kz!4w;ؙC80\.GP Ej"/fzR:RJKv̭Fi!ն3WCXb-cxh+Iy-ZDW9!o;)T T4;+xqyflٷ33h>!u)# 6"Wy J'4:le^E4a\J&j3ml3I֑envTW/M ܙLl.GPe˸u6=(WOJJQ AȷWHDIhZ`Vc޽2z1==P__{-놇 zX_ `bNntBI/,8hPÐ9-CjaH# iX>R)2D+i {S[hA[p2TnWgb=zj9Gt. wܘL)Zi&Ux;Q[.k5~H8MCU W`w60$ԇJ)BxdT#79BDdX"in%%FCGsycv/j|eBH)e=r0 SN#K E5Cx VI;R%##t0h^&XFZm \gkǦf@DrvJ:}c:שŀԛh: کk%aUE>#565tI pT)&t#$ ^nb()Q51B9'h(8N2%pXq~؋0p%8MP^͖b !Օ>t^s A0h0;=~Ծiޚ/w3 g̷mNCpK[v[\6VQḏaWFSˬ|(|hf"Ԡ8IJCBpud^kz(׍6R" 9үH4fY)DJRx@lP7(ŀ-BPuB0躼+YxNx~`s ÀÀymP37S::cl:kA=oF0$|ߏh &FFA^ZRըVT* vj*ݙ:*Srܱ1Z*aȋ33<2;ˮ sE WJ\8S phuM4N .1\N6-!ѵ"uE_jt2}SZLjvf7@uK椔hDtfZ~3@WV@l6))E^)r U4uFءCR #4t8P RhbkcaGsr']`˖.Ѿ>&ճ(ͼ7qjmNKƁ& tpu@VcARd5U`J)|C]K7W!U7;zkky2;L*GCOYM1dYٍz[&fmO"$5:Kd^l?[rɤc&u/m5uZ6ZVa):CO&pJW>ylrN3s&m% ǰQ!,/Yveb"(d'5[3qd{">fjh6]R`v1%dgLݎXLeGt&#:j6&EC)AnTjqZ\JGh/DG6hпԧ>şɟtmzB+ r5ǩ kRz[Sƣ7L@g6S$Z666F>tӂݙۥtUU>p]ww{'.䮻(wq_ORLW9c8]S@;RKj:$N=Qm“nfI78%yJ\/}z'|4[Vn܅RKKСC|{OTa馛صklڴ] T*rxSœbZRD'Ar0rQZpKU_vIeppL&ѣG}e˖|c;{!Ւb]rI۷ogͬZEd?avw_'1[yǙc&Ǿqjo$G^I8< @O)|531{&Rjg~m۶߲fn~yO|,_ϩ~أKmJ%`ؓI{wL&??S,}Φ0Q9ŁBxg3)ōW>]TDRt_mϞ=|g۶mlܸ yƭJ*G>ƒ>ȲeI{,"s)eA^z5###8ދ:}sk__Yll,% N1O-&Ǥq'l)pa?i )Mj .!O?4<oy[9fs!v|_wt{,/>:w)T.Y/R6V/~_qƓxbqW7T H[#%[%=OWwرcZ-/twwωz|C<^|9xIL@bˢf;?{^nR?}snbxd{9.COi_jzxZYgLjcRwm ===(x'R] {w"d[o|,['x7w}|8wyg"6x'&բ.5/{)7̦RdJI;07js\.C)ŪUxG+صkwy'wy' {qꬅ.$fffxQJaÆKQKS;Exyg>y IM4;`YM8{կ~+V '$]wJR}|_L.n'WrOn%>>v7xcb2_ &ILԅ.k_??j%qS Ztt=Sٳo~'?${?MB w+*J*-DL^guBk|;!˱~z@. b-?s.zg]<7k!_aڵ o`hh nS%j&bח}?e#)q̿;6j+rҀy_$)\LIUٛ!pvf>p묅4`ͬi&ߥ?mS$SP>>rIwꬅNYq$:IF.@61i*>q2{r>sNY }7ʙJߓ!_J7ir q[,>(T*E E]J|l]TTp%dSPAn"mTR&56->~'ә.2(֤̽3{Ι3rd'竕BF>X,?Ν;u(x}M9a8vFFFP(.]'Nk֬q\O3dx/_(dluuu?B=U/l40<큁D"]===>}'O Lb֭Uј9gXz54fff6C6'y%$_6!aۋ^J%466H]*Z+(/j"J%twwϟطovڅ 6,ƶm=8ZRAkLT暐ׯ;-[f477333egpu Ǣ:66i?x`Nϟ?hkkz gϞ-~&jh[8JڅCT6{~(z*?P(T+ɮ0*N455&ALLLTc]-@W#p+J޽[n8z(N<7gp#RR1p5`ll (XЩj 86?~ǏF144سg\p8Bȧ ato߾;d2}vQV/{XeO!ǀc3pԛ) Ǎ7C>|ׯ_ʕ+dJ֢a{naӦM.\++7adK]/^D*n:\t ˗/r\YG1v<+Sg9sHH$Ƴgpe@<M-#iUf.G7͛77T /^@6E}}CTzGFa"?}4N:eqm޼:(eg1f*]/ pl&tuu!"# !J!ȑ#JMhE{q9x |>,4VX1O 8VVkllĵkq}| LpGww / 8q nA "#H /(Xi;Iƛ  QU tDXj{!E+W;~B!lٲhiiAsss*<%K,X@ ˲`=8*B6UT4|A;w;wDGG֯_˲1;;k_zÍVm7"TV)ɡCpAEyyupe"NCVqjfD]S9Z SU Nޟ`Ctk]p5Qv )M WUTj(XhYn:1plMVʠtTB>t^ɻW =VZ'w|׍KMplΣA'7Uw&nT]Oy:\2plUJRǢ97yqnjz, 妝d6\MNDhJsRbLMVΫ UP*;6g*q,Z LI^+ :YYT@ǹ8 ]%Nxk:[n(P]~]>*'yG"Qe h ]u,"0>{c 6B%hVL Hk{s:`5oJh!n)0i:lU:_@o"Y)‚JIENDB`LaplacesDemon/data/0000755000176200001440000000000015144316355013701 5ustar liggesusersLaplacesDemon/data/demontexas.txt0000644000176200001440000023241715144316355016622 0ustar liggesusersElevation Latitude Longitude Gulf Max1 Max2 Max3 Max4 Max5 Max6 Max7 Max8 Max9 Max10 Max11 Max12 Max13 Mean1 Mean2 Mean3 Mean4 Mean5 Mean6 Mean7 Mean8 Mean9 Mean10 Mean11 Mean12 Mean13 Min1 Min2 Min3 Min4 Min5 Min6 Min7 Min8 Min9 Min10 Min11 Min12 Min13 1790 32.42 99.68 0 55.2 60.7 69.1 77.3 84.7 91.1 94.8 93.7 86.7 77.6 65.1 56.9 76.1 43.5 48.6 56.4 64.6 72.8 79.8 83.5 82.6 75.5 66.0 53.7 45.4 64.4 31.8 36.5 43.8 51.8 61.0 68.5 72.3 71.4 64.4 54.4 42.3 33.9 52.7 1400 32.72 99.30 0 55.1 60.6 68.9 76.9 84.0 91.1 95.4 94.8 87.3 78.2 65.8 56.8 76.2 41.8 46.6 54.2 63.0 71.2 79.1 83.0 81.9 74.7 64.6 52.5 44.0 63.1 28.4 32.6 39.5 49.1 58.4 67.0 70.5 69.0 62.0 50.9 39.2 31.1 49.8 201 27.73 98.07 1 67.5 71.7 79.0 84.3 88.5 93.4 96.1 96.2 92.1 85.2 76.5 69.2 83.3 55.8 59.6 66.8 72.5 78.2 82.8 84.6 84.6 80.9 73.5 65.0 57.7 71.8 44.1 47.5 54.6 60.6 67.9 72.2 73.1 73.0 69.7 61.7 53.5 46.2 60.3 4530 30.37 103.67 0 61.1 65.7 71.9 78.7 85.4 90.1 88.7 87.1 83.2 77.6 68.5 61.7 76.6 46.2 50.0 55.7 62.3 70.1 75.9 76.2 74.5 70.2 62.8 53.4 47.2 62.0 31.3 34.3 39.5 45.8 54.7 61.7 63.6 61.9 57.2 48.0 38.3 32.6 47.4 28 29.37 95.23 1 62.2 65.7 72.0 77.3 83.6 88.8 91.2 91.6 87.7 80.8 72.2 64.7 78.2 52.7 55.9 62.5 68.5 75.5 80.7 82.7 82.7 78.7 70.6 62.2 54.9 69.0 43.1 46.1 53.0 59.6 67.3 72.5 74.2 73.8 69.6 60.4 52.1 45.1 59.7 3586 35.22 101.70 0 48.9 54.1 62.2 70.6 78.6 87.4 91.0 88.7 81.8 71.8 58.4 49.8 70.3 35.8 40.6 47.9 56.2 65.2 74.3 78.2 76.3 69.1 58.2 45.1 37.0 57.0 22.6 27.0 33.6 41.7 51.7 61.1 65.3 63.8 56.3 44.6 31.8 24.1 43.6 1157 29.47 101.03 1 61.8 67.0 75.4 82.8 89.0 94.0 96.6 96.6 91.0 81.5 70.5 62.4 80.7 50.3 55.1 63.0 70.4 77.4 82.7 85.0 84.7 79.6 70.1 59.5 51.4 69.1 38.7 43.1 50.5 58.0 65.8 71.3 73.3 72.8 68.2 58.6 48.4 40.4 57.4 24 29.78 94.67 0 61.2 64.7 71.5 77.4 84.0 89.6 91.9 92.1 88.6 81.1 71.4 63.6 78.1 51.5 54.8 61.7 67.8 75.2 81.0 83.2 82.8 78.8 70.0 61.0 53.7 68.5 41.7 44.8 51.8 58.2 66.3 72.3 74.4 73.5 68.9 58.9 50.5 43.8 58.8 3172 32.35 102.55 0 58.1 64.5 72.5 80.8 88.0 93.7 94.5 92.8 87.1 79.1 66.9 59.5 78.1 44.3 49.7 56.8 64.7 73.1 79.7 81.4 80.0 74.2 65.2 53.2 45.8 64.0 30.4 34.8 41.1 48.6 58.2 65.6 68.2 67.1 61.2 51.3 39.4 32.0 49.8 27 29.15 95.45 1 62.8 65.9 72.1 77.5 83.8 89.1 91.8 91.9 88.1 81.2 72.4 65.1 78.5 53.3 56.4 62.9 68.6 75.6 80.9 83.0 82.8 79.0 70.8 62.2 55.2 69.2 43.7 46.9 53.6 59.6 67.3 72.7 74.2 73.7 69.8 60.3 52.0 45.2 59.9 1710 32.77 99.90 0 55.5 61.3 69.7 78.4 86.0 92.4 96.3 95.1 87.8 78.3 65.9 57.2 77.0 43.1 48.4 56.2 64.7 73.3 80.3 84.1 83.0 75.9 65.9 53.6 45.0 64.5 30.7 35.5 42.7 51.0 60.5 68.1 71.9 70.8 63.9 53.5 41.2 32.7 51.9 15 28.32 96.80 1 62.0 65.0 71.5 76.6 82.2 87.7 90.0 89.9 87.3 80.8 71.6 64.9 77.5 53.3 56.5 63.3 70.1 76.9 82.2 83.8 83.7 80.3 73.0 63.3 55.9 70.2 44.5 48.0 55.1 63.6 71.5 76.6 77.6 77.5 73.3 65.1 54.9 46.8 62.9 1045 33.58 98.63 0 53.8 59.6 67.8 76.3 83.9 91.6 97.0 96.3 88.2 78.5 65.3 55.9 76.2 40.3 45.4 53.3 62.2 70.9 79.3 84.0 83.0 75.1 64.8 52.1 42.9 62.8 26.7 31.2 38.8 48.1 57.8 67.0 70.9 69.7 62.0 51.0 38.8 29.8 49.3 1670 33.15 100.23 0 54.4 60.0 69.1 78.0 86.1 93.3 97.4 95.5 87.4 78.0 64.8 56.2 76.7 40.8 45.8 53.9 62.4 71.7 79.8 83.7 82.1 74.2 64.0 50.9 42.5 62.7 27.2 31.6 38.6 46.8 57.3 66.3 70.0 68.7 61.0 49.9 36.9 28.8 48.6 448 32.17 95.83 0 56.7 62.1 69.3 75.7 82.2 88.8 93.4 94.0 87.9 78.4 67.0 58.7 76.2 46.0 50.6 57.6 64.9 72.6 79.5 83.1 82.8 77.0 66.9 55.8 48.0 65.4 35.2 39.0 45.8 54.0 62.9 70.2 72.8 71.6 66.1 55.4 44.6 37.2 54.6 621 30.30 97.70 0 60.3 65.1 72.5 78.9 84.8 90.9 95.0 95.6 90.1 81.4 70.1 62.3 78.9 50.2 54.6 61.7 68.3 75.1 81.0 84.2 84.5 79.5 70.6 59.7 52.1 68.5 40.0 44.0 50.9 57.6 65.4 71.1 73.4 73.3 68.8 59.8 49.3 41.9 58.0 590 30.18 97.68 0 61.5 66.5 73.5 79.6 85.2 91.1 95.2 95.3 90.1 81.8 70.9 63.2 79.5 51.1 55.5 62.6 68.9 75.6 81.5 84.6 84.5 79.5 70.8 60.5 52.9 69.0 40.6 44.4 51.7 58.1 65.9 71.8 74.0 73.6 68.9 59.7 50.1 42.5 58.4 2540 30.88 102.30 0 59.7 65.0 73.3 81.5 88.5 93.6 95.5 94.5 88.3 79.2 68.2 60.7 79.0 45.6 50.5 57.7 66.1 74.2 80.5 82.9 81.9 75.7 66.1 54.6 47.0 65.2 31.5 35.9 42.0 50.6 59.8 67.3 70.2 69.3 63.0 53.0 41.0 33.3 51.4 1755 31.73 99.98 0 57.7 63.7 71.2 79.5 85.4 91.0 94.3 93.3 87.1 78.8 67.1 58.8 77.3 43.1 48.7 56.2 65.3 72.9 79.3 82.2 81.3 75.0 65.2 53.5 44.6 63.9 28.5 33.6 41.2 51.1 60.4 67.5 70.1 69.3 62.8 51.5 39.8 30.4 50.5 3220 30.98 103.73 0 59.6 65.4 73.3 80.6 88.4 94.4 94.7 92.4 86.2 78.8 68.6 60.1 78.5 44.9 49.3 56.0 63.5 71.9 79.1 80.6 78.7 72.6 63.7 53.0 45.4 63.2 30.1 33.2 38.6 46.3 55.4 63.7 66.4 65.0 58.9 48.6 37.3 30.6 47.8 461 32.27 96.63 0 56.2 61.6 68.8 76.1 83.4 90.8 95.6 95.8 89.5 80.1 67.4 58.9 77.0 43.7 48.9 56.6 64.3 72.5 79.9 83.9 83.5 77.1 66.8 55.1 46.5 64.9 31.1 36.2 44.3 52.4 61.6 68.9 72.1 71.1 64.6 53.4 42.7 34.1 52.7 52 28.98 95.98 1 65.7 69.3 75.2 80.1 85.6 90.0 92.4 92.7 89.7 83.5 74.9 67.7 80.6 55.7 59.0 65.4 70.2 76.9 81.6 83.8 83.7 80.1 72.6 64.6 57.4 70.9 45.7 48.7 55.5 60.2 68.1 73.1 75.2 74.6 70.4 61.7 54.3 47.0 61.2 34 29.83 95.00 0 61.3 65.3 71.6 77.3 83.2 88.7 91.6 92.0 88.0 80.5 71.0 63.8 77.9 51.6 55.3 62.2 68.4 75.3 81.1 83.6 83.3 78.8 70.2 61.1 53.9 68.7 41.9 45.2 52.8 59.5 67.4 73.5 75.6 74.5 69.5 59.8 51.1 44.0 59.6 27 30.07 94.28 0 61.1 64.9 71.8 77.9 84.9 90.1 92.7 92.8 88.7 81.1 71.2 63.8 78.4 51.1 54.5 61.5 67.8 75.4 81.0 83.1 82.7 78.3 69.5 60.6 53.5 68.3 41.1 44.0 51.2 57.6 65.8 71.8 73.5 72.5 67.9 57.8 49.9 43.1 58.0 255 28.45 97.70 1 64.5 68.2 75.2 80.7 86.1 91.3 94.6 94.6 90.7 83.4 73.8 66.6 80.8 53.8 57.4 64.6 70.3 76.8 81.6 83.9 83.7 79.9 72.0 63.0 55.7 70.2 43.1 46.5 53.9 59.8 67.4 71.9 73.1 72.8 69.0 60.5 52.1 44.8 59.6 664 31.10 97.48 0 56.8 61.7 69.5 76.5 82.8 89.3 94.0 94.2 88.2 78.9 67.4 59.5 76.6 45.8 50.3 58.3 65.5 72.8 79.3 82.9 82.8 77.1 67.4 56.6 48.4 65.6 34.7 38.9 47.0 54.4 62.8 69.3 71.8 71.3 65.9 55.8 45.8 37.3 54.6 380 27.60 98.42 1 67.7 71.6 78.9 84.7 89.4 94.3 97.0 96.9 91.9 85.1 76.1 69.1 83.6 55.5 59.0 66.2 72.6 78.7 83.3 85.3 84.9 80.5 72.9 63.8 56.8 71.6 43.2 46.3 53.4 60.4 68.0 72.2 73.5 72.9 69.0 60.7 51.5 44.5 59.6 790 32.65 97.45 0 55.1 60.4 68.2 75.9 83.4 91.3 96.6 96.3 88.9 79.1 66.5 57.8 76.6 43.3 48.4 56.2 64.1 72.4 80.1 84.5 84.0 77.0 66.8 55.0 46.2 64.8 31.4 36.3 44.1 52.2 61.4 68.8 72.3 71.6 65.0 54.5 43.5 34.5 53.0 2690 31.20 101.48 0 56.4 61.8 69.8 78.1 85.7 90.9 93.4 92.3 86.0 76.8 65.6 57.6 76.2 42.8 47.7 55.8 63.8 72.2 78.3 80.7 79.5 73.3 63.7 52.4 44.2 62.9 29.1 33.5 41.7 49.4 58.7 65.6 68.0 66.6 60.5 50.5 39.2 30.8 49.5 2500 32.23 101.45 0 55.8 61.3 69.7 78.2 85.7 91.6 94.3 92.9 86.4 77.7 65.8 57.6 76.4 42.7 47.7 55.5 63.9 72.6 79.3 82.7 81.5 74.7 65.2 52.9 44.7 63.6 29.6 34.1 41.2 49.6 59.4 66.9 71.1 70.0 63.0 52.7 40.0 31.7 50.8 1370 30.10 98.42 0 59.2 63.7 71.1 77.7 83.7 89.6 93.7 94.1 88.4 79.6 68.6 60.9 77.5 46.6 50.7 58.1 64.7 72.4 78.6 81.9 81.7 76.3 66.9 56.3 48.5 65.2 34.0 37.7 45.1 51.7 61.0 67.6 70.0 69.2 64.1 54.2 43.9 36.0 52.9 1444 29.80 98.73 0 60.0 64.7 72.0 77.9 83.1 88.6 91.9 92.6 88.1 79.7 69.2 61.6 77.5 47.2 51.3 58.6 64.9 72.1 77.9 80.6 80.6 76.0 66.9 56.6 49.0 65.1 34.3 37.8 45.2 51.9 61.0 67.2 69.3 68.5 63.8 54.1 43.9 36.3 52.8 600 33.63 96.17 0 51.0 56.5 64.5 72.2 79.5 87.4 92.6 92.9 85.4 75.5 62.4 53.5 72.8 40.6 45.5 53.3 61.0 69.6 77.6 82.1 81.6 74.3 63.7 51.6 43.2 62.0 30.2 34.4 42.0 49.8 59.7 67.7 71.6 70.2 63.2 51.9 40.8 32.9 51.2 1880 29.18 102.97 1 69.0 75.1 83.4 91.2 98.6 103.2 102.8 100.9 96.4 88.5 77.8 69.1 88.0 48.5 54.2 62.3 70.4 80.0 86.2 86.8 84.9 80.1 70.1 58.3 49.7 69.3 28.0 33.2 41.2 49.5 61.3 69.2 70.7 68.9 63.7 51.6 38.8 30.3 50.5 3140 35.65 101.45 0 49.4 55.4 63.8 72.4 80.2 88.8 92.6 90.6 84.0 74.3 59.7 50.4 71.8 36.4 41.5 49.0 57.6 66.4 75.3 79.5 77.8 70.8 60.2 46.7 37.9 58.3 23.4 27.5 34.1 42.7 52.6 61.7 66.4 65.0 57.5 46.1 33.6 25.4 44.7 1080 33.55 97.85 0 52.1 58.2 66.1 74.2 81.3 89.1 94.7 94.3 86.3 76.3 63.6 54.9 74.3 40.2 45.4 53.2 61.8 69.9 78.2 82.8 82.2 74.5 64.1 51.5 42.9 62.2 28.3 32.6 40.2 49.3 58.5 67.2 70.9 70.1 62.7 51.9 39.4 30.8 50.2 3191 35.53 102.25 0 51.3 56.4 65.1 73.0 80.4 89.1 92.3 89.7 83.1 73.4 60.4 51.9 72.2 35.9 40.8 48.6 56.6 65.6 75.1 78.8 76.6 69.2 57.8 44.7 36.8 57.2 20.5 25.2 32.1 40.1 50.8 61.1 65.3 63.4 55.3 42.1 28.9 21.6 42.2 1118 29.32 100.42 1 63.8 68.7 76.3 83.1 88.1 92.9 95.5 95.9 91.1 82.9 72.9 64.9 81.3 50.6 54.9 62.7 69.5 76.3 81.4 83.8 83.9 79.2 70.5 59.8 52.0 68.7 37.3 41.1 49.1 55.8 64.4 69.9 72.1 71.8 67.2 58.0 46.6 39.1 56.0 1720 31.12 99.33 0 59.0 63.6 71.4 78.9 84.9 90.5 94.5 93.7 87.8 79.3 68.0 60.4 77.7 45.7 50.2 57.7 65.0 72.5 78.7 82.1 81.4 75.5 66.2 55.3 47.5 64.8 32.3 36.7 43.9 51.1 60.1 66.8 69.7 69.0 63.2 53.1 42.6 34.5 51.9 4160 35.62 103.00 0 50.6 55.6 63.5 71.2 79.0 87.6 91.2 89.4 82.3 73.4 60.2 51.4 71.3 34.8 39.3 46.3 54.3 63.1 72.2 76.4 75.0 67.2 56.8 44.2 35.7 55.4 18.9 22.9 29.0 37.4 47.2 56.7 61.5 60.5 52.1 40.1 28.1 19.9 39.5 1170 32.75 98.90 0 55.8 61.1 69.8 78.4 85.5 92.4 96.8 95.9 88.8 79.3 66.8 57.6 77.4 43.4 48.2 56.7 64.6 72.9 80.4 84.5 83.4 76.2 66.1 53.8 45.0 64.6 30.9 35.2 43.5 50.8 60.3 68.3 72.2 70.9 63.6 52.8 40.8 32.3 51.8 313 30.17 96.40 0 61.9 66.4 73.7 80.1 86.8 92.8 96.7 96.9 91.3 82.5 71.3 63.7 80.3 50.6 54.6 61.6 68.5 75.9 82.0 85.0 84.9 79.6 70.5 60.1 52.6 68.8 39.3 42.7 49.5 56.8 64.9 71.1 73.3 72.9 67.9 58.5 48.8 41.4 57.3 745 33.20 97.77 0 56.1 61.5 70.5 78.3 85.0 91.9 98.0 97.4 89.9 80.0 66.9 58.1 77.8 43.3 48.4 57.0 64.4 72.4 79.3 84.1 83.0 75.9 65.6 54.2 45.4 64.4 30.5 35.3 43.4 50.5 59.8 66.6 70.1 68.5 61.8 51.2 41.5 32.6 51.0 3300 33.18 102.27 0 54.0 59.9 68.0 76.1 84.0 90.8 92.5 90.7 84.6 76.3 63.9 55.6 74.7 40.1 44.8 51.8 60.0 69.2 76.9 79.6 77.9 71.4 61.6 49.5 41.7 60.4 26.1 29.6 35.5 43.9 54.3 62.9 66.6 65.1 58.2 46.9 35.1 27.7 46.0 19 25.90 97.43 1 68.7 72.2 78.0 82.3 86.9 90.5 92.4 92.6 89.4 84.0 76.8 70.2 82.0 59.6 62.7 68.8 73.8 79.3 82.7 83.9 84.0 81.0 75.0 67.7 61.1 73.3 50.5 53.3 59.5 65.2 71.6 74.9 75.4 75.3 72.6 65.9 58.6 52.0 64.6 1385 31.68 98.97 0 57.2 62.3 70.0 77.5 84.1 90.6 95.0 94.6 88.3 79.5 67.5 59.8 77.2 43.4 48.5 56.3 64.3 72.3 79.1 82.9 82.3 75.9 65.9 54.3 46.2 64.3 29.6 34.7 42.5 51.1 60.5 67.6 70.7 70.0 63.4 52.2 41.1 32.5 51.3 730 32.55 97.32 0 54.2 60.0 68.1 75.4 82.5 89.7 94.9 95.0 88.0 77.8 65.2 56.7 75.6 43.7 49.0 56.5 64.6 72.6 80.1 84.3 84.3 77.7 67.1 55.2 46.4 65.1 33.2 37.9 44.9 53.8 62.7 70.5 73.7 73.6 67.3 56.3 45.2 36.1 54.6 1275 30.75 98.23 0 58.5 63.1 70.3 77.3 83.5 89.5 93.6 93.7 88.1 79.2 67.9 60.1 77.1 45.9 50.4 58.0 65.1 72.5 78.7 82.2 81.9 76.4 66.6 56.0 48.0 65.1 33.3 37.7 45.6 52.8 61.5 67.8 70.7 70.0 64.6 54.0 44.1 35.9 53.2 364 30.85 96.97 0 61.9 66.9 74.5 80.5 85.8 91.3 95.7 95.9 90.3 81.7 71.1 63.6 79.9 50.6 55.0 62.3 68.7 75.5 81.3 84.6 84.5 79.2 70.3 60.1 52.4 68.7 39.2 43.1 50.1 56.9 65.1 71.2 73.5 73.1 68.0 58.8 49.0 41.1 57.4 1470 29.68 100.02 1 61.7 66.2 73.5 79.9 86.0 91.1 94.2 94.1 89.5 80.5 70.1 63.0 79.2 47.4 51.8 59.3 66.2 74.0 79.7 82.1 81.6 76.9 67.4 56.7 49.1 66.0 33.1 37.3 45.1 52.5 62.0 68.3 69.9 69.0 64.2 54.2 43.3 35.1 52.8 2300 35.92 100.38 0 47.4 53.6 61.7 71.1 78.9 88.1 93.9 92.8 84.5 73.8 59.1 48.5 71.1 33.1 38.4 46.4 55.9 65.3 74.9 79.9 78.7 70.5 58.6 44.6 34.8 56.8 18.8 23.1 31.0 40.7 51.6 61.7 65.9 64.6 56.4 43.4 30.0 21.0 42.4 2875 30.13 104.68 0 66.6 73.4 81.0 88.9 96.1 101.6 99.9 97.3 93.1 85.6 74.2 66.8 85.4 49.1 54.2 60.8 68.0 76.0 83.2 83.8 81.5 77.1 67.8 55.9 49.3 67.2 31.5 35.0 40.5 47.0 55.9 64.7 67.6 65.7 61.1 50.0 37.5 31.8 49.0 1000 29.87 98.20 0 60.4 64.8 72.3 78.8 84.9 90.8 94.7 95.0 89.5 81.0 70.1 62.3 78.7 49.0 53.0 60.3 67.1 74.1 80.0 83.1 83.0 78.0 69.3 59.0 51.3 67.3 37.6 41.2 48.3 55.3 63.3 69.2 71.4 71.0 66.5 57.5 47.9 40.3 55.8 3590 34.98 101.93 0 52.2 57.8 65.7 74.1 81.9 90.1 92.6 90.1 84.5 75.2 61.5 52.7 73.2 38.0 42.9 50.1 58.4 67.2 75.9 79.3 77.3 70.9 60.5 47.4 39.0 58.9 23.7 27.9 34.5 42.7 52.5 61.6 66.0 64.5 57.2 45.7 33.3 25.3 44.6 613 28.48 99.87 1 65.2 70.6 78.8 85.1 90.3 95.3 98.3 97.6 92.4 83.6 73.5 65.9 83.1 52.4 57.2 65.4 72.6 79.1 84.1 86.3 85.7 81.0 72.0 61.5 53.6 70.9 39.6 43.7 52.0 60.0 67.8 72.9 74.2 73.7 69.6 60.3 49.4 41.2 58.7 1780 29.80 100.73 0 61.3 65.7 72.8 80.3 86.1 90.9 93.8 93.6 88.9 79.5 69.2 61.8 78.7 47.1 51.2 58.6 66.7 74.4 79.6 82.4 81.9 77.2 67.2 56.3 48.1 65.9 32.9 36.6 44.4 53.1 62.6 68.3 71.0 70.2 65.4 54.9 43.4 34.3 53.1 340 32.13 94.35 0 56.5 62.0 69.7 76.4 83.1 89.7 93.7 93.7 87.9 78.7 67.1 59.1 76.5 45.2 49.8 57.4 64.0 72.0 78.9 82.6 82.1 76.2 65.9 55.2 47.6 64.7 33.9 37.5 45.0 51.5 60.9 68.0 71.5 70.4 64.4 53.1 43.2 36.1 53.0 2169 29.13 103.52 1 67.7 74.7 83.3 91.0 99.1 103.4 102.3 100.4 95.9 87.8 76.9 68.4 87.6 50.7 57.2 65.5 73.4 82.4 87.6 88.1 86.5 81.7 72.2 60.2 51.9 71.5 33.6 39.6 47.6 55.8 65.6 71.8 73.8 72.5 67.5 56.5 43.4 35.3 55.3 560 28.33 99.63 1 66.6 71.8 80.0 86.4 92.0 96.1 99.2 99.0 94.2 86.1 75.7 67.9 84.6 53.5 57.9 65.8 72.8 80.0 84.5 86.9 86.6 82.2 73.6 63.3 55.0 71.8 40.4 43.9 51.5 59.2 67.9 72.8 74.5 74.1 70.2 61.0 50.8 42.1 59.0 325 31.80 94.17 0 57.1 62.4 69.8 76.4 83.3 89.7 93.9 93.8 88.2 78.8 67.8 59.8 76.8 46.0 50.2 57.3 64.0 72.2 78.9 82.8 82.0 76.3 65.7 55.7 48.3 65.0 34.9 37.9 44.7 51.5 61.0 68.1 71.6 70.2 64.3 52.6 43.5 36.7 53.1 320 31.25 95.97 0 58.4 63.2 70.9 77.5 84.1 90.4 94.7 95.0 89.3 80.2 68.9 60.9 77.8 46.4 50.6 58.0 64.7 72.6 79.3 83.1 82.7 77.0 66.9 56.5 48.7 65.5 34.3 37.9 45.1 51.9 61.1 68.2 71.4 70.3 64.6 53.5 44.1 36.5 53.2 3790 35.68 102.33 0 47.5 52.8 60.9 68.6 77.9 87.3 90.9 88.5 81.1 71.4 57.7 48.6 69.4 33.8 38.4 45.6 53.8 63.6 73.1 77.5 75.6 67.8 56.8 43.8 35.1 55.4 20.0 23.9 30.2 39.0 49.3 58.9 64.1 62.7 54.5 42.2 29.8 21.5 41.3 25 27.58 97.45 1 67.3 70.5 76.5 81.1 85.4 89.9 92.4 92.6 89.8 83.6 75.4 69.0 81.1 56.5 59.9 66.3 71.9 77.4 81.6 83.4 83.4 80.5 73.7 65.3 58.3 71.5 45.6 49.3 56.1 62.7 69.4 73.3 74.3 74.1 71.2 63.8 55.1 47.5 61.9 441 28.93 98.75 1 67.0 71.7 79.1 84.7 89.4 94.0 96.9 97.0 92.6 85.4 75.5 68.2 83.5 54.2 58.2 65.6 71.6 78.1 82.7 84.8 84.6 80.6 72.8 63.3 55.7 71.0 41.3 44.7 52.0 58.5 66.7 71.4 72.6 72.2 68.6 60.2 51.0 43.2 58.5 1951 34.43 100.28 0 51.9 57.5 66.3 75.4 82.8 91.0 95.3 93.6 86.0 75.8 62.6 53.4 74.3 39.4 44.6 52.7 61.5 70.3 78.6 83.1 81.4 73.8 63.0 50.3 41.3 61.7 26.8 31.6 39.1 47.6 57.7 66.1 70.8 69.1 61.5 50.2 37.9 29.2 49.0 5300 29.27 103.30 1 57.6 61.5 68.3 74.8 82.0 85.4 84.2 82.5 78.8 72.8 64.8 58.8 72.6 46.9 50.3 56.2 62.6 70.3 74.2 74.1 72.6 68.8 62.3 54.1 48.3 61.7 36.1 39.1 44.0 50.3 58.5 63.0 63.9 62.6 58.8 51.7 43.4 37.7 50.8 230 28.47 98.25 1 65.2 69.9 77.2 83.3 88.6 94.1 97.4 97.4 93.2 85.4 75.0 67.1 82.8 53.4 57.6 65.1 71.0 77.6 82.8 85.2 85.2 81.3 73.2 63.3 55.5 70.9 41.6 45.3 52.9 58.6 66.6 71.4 73.0 72.9 69.4 61.0 51.5 43.9 59.0 2700 34.93 100.88 0 51.4 56.6 64.8 73.6 81.4 89.4 94.7 92.6 85.4 75.5 62.1 53.0 73.4 36.9 41.7 49.4 58.0 67.0 75.4 80.2 78.3 70.9 59.9 47.3 38.7 58.6 22.4 26.8 33.9 42.4 52.5 61.4 65.6 63.9 56.3 44.3 32.5 24.4 43.9 435 33.62 95.07 0 51.7 57.5 65.7 73.4 80.1 87.5 92.2 92.5 85.8 76.2 63.5 54.4 73.4 40.7 45.9 54.2 62.0 70.5 78.2 82.2 81.7 74.9 64.0 52.3 43.5 62.5 29.7 34.3 42.6 50.5 60.9 68.9 72.2 70.9 63.9 51.8 41.0 32.6 51.6 3396 35.12 101.37 0 48.5 53.4 61.6 69.9 77.8 86.1 90.5 88.6 81.6 71.9 58.5 49.8 69.9 34.9 39.3 46.7 54.8 63.9 72.9 77.4 75.9 68.6 57.9 45.0 36.5 56.2 21.2 25.2 31.7 39.7 49.9 59.6 64.2 63.1 55.6 43.8 31.4 23.2 42.4 783 32.33 97.40 0 57.7 63.4 71.3 78.6 85.2 92.0 97.0 96.9 89.8 80.4 67.7 59.5 78.3 45.9 51.0 58.6 66.0 73.7 80.5 84.5 84.2 77.7 67.8 56.2 47.9 66.2 34.0 38.5 45.9 53.3 62.2 69.0 72.0 71.5 65.6 55.2 44.7 36.3 54.0 196 30.37 95.10 0 60.2 65.0 72.5 78.3 84.8 90.4 93.7 93.9 89.0 80.1 69.3 62.1 78.3 49.3 53.1 60.5 66.6 74.0 79.9 82.7 82.4 77.7 68.1 58.2 51.0 67.0 38.4 41.2 48.4 54.8 63.2 69.4 71.6 70.9 66.3 56.1 47.1 39.9 55.6 355 30.53 95.15 0 60.0 64.4 71.6 77.9 84.6 90.4 93.8 94.1 89.1 80.9 70.2 62.5 78.3 48.8 52.3 59.3 65.8 73.4 79.4 82.3 82.0 77.3 68.1 58.3 50.9 66.5 37.5 40.2 47.0 53.6 62.2 68.4 70.8 69.8 65.5 55.2 46.4 39.2 54.7 1727 31.82 99.42 0 56.6 62.1 69.5 77.5 83.7 89.7 93.7 93.2 87.1 78.2 66.4 58.1 76.3 43.3 48.6 55.9 64.4 71.9 78.3 81.8 81.1 74.8 65.0 53.4 45.1 63.6 30.0 35.0 42.2 51.3 60.1 66.8 69.8 69.0 62.4 51.8 40.4 32.1 50.9 314 30.58 96.37 0 60.6 65.5 72.6 78.8 85.3 91.7 95.6 96.2 90.9 82.0 70.9 62.8 79.4 50.2 54.5 61.6 67.9 75.3 81.6 84.6 84.7 79.7 70.5 60.0 52.2 68.6 39.8 43.4 50.5 56.9 65.3 71.5 73.6 73.2 68.5 59.0 49.1 41.5 57.7 2105 32.38 100.90 0 57.0 63.5 70.9 79.9 87.0 92.5 95.9 94.2 87.6 78.8 66.9 58.7 77.7 42.0 47.5 55.0 63.9 72.9 79.4 82.7 81.3 74.5 64.3 52.0 43.6 63.3 27.0 31.5 39.0 47.9 58.7 66.3 69.5 68.4 61.3 49.7 37.0 28.4 48.7 199 29.72 96.53 1 64.2 68.4 75.9 81.3 87.2 92.7 96.3 97.4 93.2 85.3 74.5 66.5 81.9 50.5 54.3 61.9 68.0 75.3 80.7 83.3 83.3 78.8 69.8 60.1 52.4 68.2 36.8 40.2 47.9 54.7 63.3 68.6 70.2 69.2 64.4 54.2 45.7 38.2 54.5 245 30.33 95.48 0 60.5 64.7 72.5 78.4 85.0 90.7 94.3 94.3 89.2 80.9 70.6 62.5 78.6 50.3 54.0 61.6 67.9 75.1 81.0 83.7 83.4 78.6 69.6 60.0 52.1 68.1 40.0 43.3 50.6 57.4 65.1 71.3 73.1 72.4 67.9 58.2 49.4 41.7 57.5 2570 31.53 101.28 0 57.3 62.9 71.0 79.6 87.3 92.6 95.8 94.4 88.1 79.0 67.1 59.2 77.9 42.3 47.2 54.9 63.4 72.4 78.8 81.6 80.1 73.8 63.8 51.9 44.0 62.9 27.2 31.5 38.7 47.1 57.4 64.9 67.3 65.8 59.4 48.6 36.7 28.8 47.8 1475 34.12 99.75 0 52.9 58.4 68.0 76.6 85.2 93.3 99.0 97.1 89.2 78.2 65.2 55.1 76.5 38.7 43.7 53.0 61.5 71.3 80.0 85.1 83.3 75.1 63.4 50.9 41.2 62.3 24.5 29.0 37.9 46.3 57.3 66.6 71.2 69.5 61.0 48.6 36.5 27.2 48.0 4480 31.78 105.47 0 58.3 64.0 71.4 79.2 87.3 95.1 94.2 91.7 87.0 78.4 66.6 58.6 77.7 42.1 46.4 52.6 59.6 68.6 77.1 78.8 76.7 71.1 61.1 49.3 42.3 60.5 25.8 28.8 33.8 40.0 49.8 59.0 63.4 61.7 55.2 43.7 31.9 25.9 43.3 20 27.68 97.28 1 65.0 68.4 74.4 79.5 85.0 89.8 91.5 91.9 89.2 83.2 74.7 67.4 80.0 57.8 61.3 67.5 73.1 79.4 84.1 85.5 85.7 82.9 76.5 67.7 60.1 73.5 50.5 54.1 60.6 66.7 73.7 78.3 79.4 79.4 76.6 69.8 60.7 52.8 66.9 41 27.77 97.52 1 66.0 69.7 75.8 80.7 85.6 90.2 93.2 93.4 89.9 83.6 74.9 68.0 80.9 56.1 59.5 66.0 71.5 77.5 81.9 83.8 83.9 80.8 73.8 65.1 58.1 71.5 46.2 49.3 56.2 62.3 69.5 73.5 74.4 74.5 71.6 64.0 55.4 48.1 62.1 413 32.10 96.47 0 55.1 60.2 67.8 75.2 82.3 89.5 94.5 94.8 88.6 78.9 66.5 57.7 75.9 44.6 49.1 56.6 63.9 72.0 79.4 83.7 83.6 77.3 67.1 55.4 47.0 65.0 34.0 38.0 45.4 52.6 61.7 69.3 72.9 72.3 66.0 55.3 44.3 36.2 54.0 2630 31.40 102.32 0 60.1 65.6 73.4 81.4 88.6 94.0 95.3 94.1 87.9 79.4 68.4 60.6 79.1 45.4 50.4 58.2 66.8 75.1 81.6 83.6 82.3 75.7 66.3 54.4 46.1 65.5 30.6 35.2 43.0 52.2 61.5 69.1 71.9 70.4 63.5 53.2 40.4 31.6 51.9 347 31.30 95.45 0 57.6 62.5 70.0 76.7 83.3 89.4 93.3 93.9 88.5 79.5 68.2 60.2 76.9 46.8 50.9 58.1 64.9 72.7 79.2 82.5 82.4 77.2 67.4 56.7 49.0 65.7 35.9 39.3 46.1 53.0 62.1 69.0 71.7 70.9 65.9 55.2 45.2 37.7 54.3 3010 33.65 101.25 0 52.9 58.3 66.5 74.8 82.0 88.9 92.5 90.7 83.9 75.4 62.9 54.5 73.6 39.1 43.7 51.3 59.9 68.5 76.1 79.5 78.0 71.3 61.8 49.4 41.1 60.0 25.3 29.0 36.0 44.9 54.9 63.3 66.5 65.2 58.6 48.1 35.8 27.6 46.3 580 28.68 99.83 1 66.6 71.8 79.7 85.0 90.1 94.5 97.1 96.8 92.3 84.5 74.3 67.2 83.3 54.6 59.4 67.1 73.0 79.3 83.7 85.7 85.5 81.4 73.4 63.2 55.7 71.8 42.6 46.9 54.5 60.9 68.4 72.9 74.3 74.2 70.4 62.3 52.1 44.2 60.3 178 29.08 97.32 1 65.6 69.8 76.0 81.3 86.9 92.2 95.1 95.9 91.4 84.6 74.7 67.1 81.7 53.5 57.3 63.7 69.3 76.1 81.4 83.3 83.5 79.1 71.5 62.0 55.0 69.6 41.3 44.8 51.4 57.2 65.3 70.5 71.5 71.0 66.8 58.3 49.3 42.9 57.5 300 32.92 94.72 0 55.9 61.3 69.3 76.4 83.9 90.8 95.0 95.1 88.5 78.7 66.6 58.7 76.7 44.8 49.3 57.1 64.2 72.8 79.8 83.6 83.1 77.0 66.7 55.4 47.8 65.1 33.7 37.3 44.8 52.0 61.6 68.7 72.2 71.1 65.4 54.6 44.1 36.8 53.5 4000 36.02 102.62 0 46.9 52.7 60.2 68.2 76.7 86.6 90.2 88.2 81.5 70.9 57.6 48.7 69.0 31.4 36.6 43.0 51.7 61.0 71.2 74.9 73.3 66.1 54.0 41.3 32.7 53.1 15.9 20.5 25.7 35.2 45.3 55.7 59.6 58.4 50.7 37.1 24.9 16.7 37.1 3990 36.02 102.55 0 47.9 52.7 60.3 68.1 76.6 86.3 90.0 87.7 80.3 70.4 57.5 48.6 68.9 33.5 38.0 45.0 53.2 62.6 72.2 76.4 74.6 66.7 55.6 42.9 34.5 54.6 19.0 23.3 29.7 38.2 48.6 58.1 62.8 61.5 53.1 40.8 28.2 20.4 40.3 560 32.90 97.02 0 54.1 60.1 68.3 75.9 83.2 91.1 95.4 94.8 87.7 77.9 65.1 56.5 75.8 44.1 49.4 57.4 65.0 73.1 80.9 85.0 84.4 77.5 67.2 55.1 46.7 65.5 34.0 38.7 46.4 54.0 63.0 70.7 74.6 74.0 67.2 56.4 45.1 36.8 55.1 440 32.85 96.85 0 55.4 61.0 69.1 76.5 83.8 91.6 96.1 95.8 88.5 78.6 66.0 57.4 76.7 45.9 51.0 58.8 66.3 74.4 82.2 86.5 86.1 78.9 68.4 56.4 48.0 66.9 36.4 41.0 48.5 56.1 64.9 72.7 76.8 76.4 69.2 58.2 46.8 38.6 57.1 70 29.05 96.23 1 62.4 66.0 72.5 78.8 84.5 89.7 92.6 93.2 89.4 82.4 72.1 64.6 79.0 52.2 55.2 62.0 68.6 75.1 80.5 82.5 82.8 79.2 71.3 61.5 54.3 68.8 41.9 44.4 51.4 58.3 65.7 71.3 72.3 72.4 68.9 60.2 50.8 43.9 58.5 400 33.63 94.63 0 53.4 59.0 67.5 75.4 82.0 88.9 93.4 93.6 86.7 77.3 64.7 55.7 74.8 42.5 47.4 55.3 63.2 70.9 78.0 82.2 81.5 74.9 64.8 53.3 45.2 63.3 31.6 35.7 43.1 50.9 59.8 67.0 71.0 69.3 63.0 52.2 41.8 34.6 51.7 3770 31.90 105.22 0 59.3 65.0 72.3 80.0 89.1 97.2 97.4 94.8 88.9 80.4 68.0 59.4 79.3 42.3 47.3 53.6 61.0 70.7 78.9 81.1 78.8 72.3 62.0 49.8 42.1 61.7 25.3 29.5 34.8 42.0 52.2 60.5 64.8 62.8 55.7 43.6 31.5 24.7 44.0 999 29.38 100.93 1 62.8 68.0 76.0 82.7 88.7 93.7 96.2 96.0 90.6 81.7 70.9 63.5 80.9 51.3 56.1 63.8 70.6 77.7 82.9 85.3 85.1 80.0 71.1 60.1 52.4 69.7 39.7 44.1 51.6 58.5 66.7 72.1 74.3 74.1 69.4 60.5 49.2 41.2 58.5 613 33.82 96.57 0 51.0 56.8 65.1 73.2 80.5 88.4 93.6 93.5 85.9 76.1 63.3 54.0 73.5 40.5 45.5 53.7 61.7 70.0 77.9 82.6 81.9 74.8 64.4 52.9 43.7 62.5 29.9 34.2 42.2 50.2 59.4 67.4 71.6 70.2 63.6 52.6 42.5 33.3 51.4 630 33.20 97.10 0 53.3 59.2 67.2 74.4 81.7 89.2 94.1 93.5 86.1 76.3 64.1 56.0 74.6 42.7 48.0 55.9 63.4 71.6 79.1 83.6 82.7 75.6 65.3 53.6 45.4 63.9 32.0 36.8 44.6 52.4 61.4 69.0 73.1 71.9 65.0 54.3 43.0 34.8 53.2 550 28.68 99.18 1 63.8 68.6 76.9 83.7 88.9 93.8 96.8 96.5 91.5 83.3 73.0 65.3 81.8 52.0 56.6 64.6 71.2 77.9 82.6 84.8 84.8 80.5 71.9 61.9 54.0 70.2 40.2 44.6 52.2 58.6 66.9 71.4 72.8 73.1 69.4 60.5 50.7 42.6 58.6 3850 34.60 102.32 0 48.8 54.0 62.4 70.9 79.4 87.7 90.1 87.6 81.3 71.4 58.4 49.5 70.1 34.6 38.9 45.8 54.1 63.6 72.6 75.9 74.0 67.1 56.3 43.6 35.6 55.2 20.4 23.7 29.1 37.3 47.7 57.5 61.7 60.3 52.9 41.1 28.8 21.7 40.2 1120 30.22 97.98 0 60.6 65.3 73.4 79.9 85.2 90.9 94.6 95.6 89.8 81.0 69.6 62.1 79.0 49.0 53.1 60.7 67.4 74.1 79.8 82.8 83.1 77.6 68.9 58.1 50.7 67.1 37.3 40.8 47.9 54.9 62.9 68.7 71.0 70.6 65.4 56.8 46.5 39.3 55.2 1502 32.10 98.33 0 54.5 59.7 68.0 75.8 82.2 88.7 93.9 94.0 87.0 77.3 64.8 56.4 75.2 42.6 47.5 55.2 63.1 70.6 77.5 81.7 81.4 74.8 65.1 53.3 44.9 63.1 30.7 35.2 42.4 50.4 59.0 66.2 69.5 68.8 62.6 52.8 41.7 33.3 51.1 3655 35.87 101.97 0 47.3 52.5 60.4 69.4 78.2 87.6 91.7 89.2 81.7 71.7 57.8 48.6 69.7 34.1 38.5 45.7 54.4 64.0 73.7 78.4 76.5 68.7 57.6 44.2 35.7 56.0 20.8 24.4 30.9 39.4 49.8 59.7 65.0 63.8 55.7 43.4 30.5 22.8 42.2 760 32.87 97.45 0 54.5 60.4 67.8 75.6 82.7 90.7 95.7 95.4 88.3 78.0 65.5 57.1 76.0 43.0 47.9 55.1 63.4 71.5 79.8 84.1 83.8 76.7 66.3 54.3 45.7 64.3 31.4 35.3 42.3 51.1 60.2 68.8 72.4 72.1 65.1 54.6 43.1 34.2 52.6 808 28.72 100.48 1 64.2 69.4 77.9 85.0 90.5 95.2 98.1 97.9 92.6 83.7 73.2 65.1 82.7 52.2 57.0 65.0 72.0 78.9 83.9 86.4 86.0 81.2 72.1 61.5 53.4 70.8 40.1 44.5 52.1 59.0 67.2 72.5 74.7 74.1 69.8 60.4 49.7 41.7 58.8 1433 32.40 98.82 0 54.6 59.9 68.7 76.7 83.9 90.4 94.9 94.7 87.7 78.4 65.8 56.8 76.0 40.7 45.7 54.2 62.4 70.6 77.9 81.6 80.7 73.7 63.4 51.5 42.8 62.1 26.7 31.5 39.6 48.0 57.3 65.3 68.3 66.7 59.6 48.4 37.1 28.8 48.1 5240 31.83 105.97 0 53.0 59.2 66.1 73.4 82.5 91.4 91.4 88.8 83.8 74.8 62.1 54.1 73.4 41.6 46.7 52.7 59.5 68.0 76.3 77.5 75.5 70.9 61.9 50.0 43.0 60.3 30.1 34.1 39.2 45.5 53.4 61.2 63.5 62.2 57.9 49.0 37.9 31.8 47.2 3918 31.82 106.38 0 57.2 63.4 70.2 78.1 86.7 95.3 94.5 92.0 87.1 77.9 65.5 57.4 77.1 45.1 50.5 57.0 64.6 73.7 82.1 83.3 81.1 75.4 64.9 52.7 45.4 64.7 32.9 37.5 43.7 51.1 60.6 68.8 72.0 70.2 63.7 51.8 39.8 33.4 52.1 579 30.35 97.37 0 61.5 66.3 74.1 80.2 85.9 91.7 95.6 95.9 90.6 82.1 71.0 63.3 79.9 50.8 55.0 62.4 68.7 75.6 81.2 84.3 84.3 79.4 70.7 60.3 52.6 68.8 40.0 43.7 50.7 57.2 65.2 70.7 72.9 72.6 68.1 59.2 49.5 41.9 57.6 435 32.87 95.77 0 53.1 58.5 66.8 74.0 80.4 87.3 92.4 93.0 86.5 76.7 64.5 55.5 74.1 42.4 47.1 55.3 62.7 70.3 77.6 81.8 81.4 75.0 64.5 53.2 44.7 63.0 31.6 35.7 43.8 51.3 60.1 67.9 71.1 69.8 63.4 52.2 41.8 33.9 51.9 590 28.05 99.43 1 67.3 71.7 80.6 86.8 92.4 97.0 99.3 99.4 94.1 86.3 76.6 68.3 85.0 53.9 58.3 66.2 72.7 79.5 84.2 85.9 85.9 81.4 73.0 63.3 55.6 71.7 40.5 44.9 51.8 58.6 66.5 71.4 72.4 72.4 68.7 59.7 49.9 42.8 58.3 1245 31.47 98.17 0 56.5 61.2 68.6 75.5 82.0 88.8 93.3 93.5 87.8 78.6 66.6 58.7 75.9 44.5 49.0 56.1 63.3 70.9 78.0 81.9 81.8 75.8 66.5 54.7 46.9 64.1 32.5 36.7 43.6 51.1 59.8 67.2 70.4 70.0 63.8 54.3 42.8 35.0 52.3 432 31.73 96.20 0 58.5 63.3 70.9 77.6 83.8 90.3 95.0 95.1 89.0 79.7 68.2 60.0 77.6 47.5 51.9 59.4 66.2 73.5 79.9 83.6 83.1 77.0 67.6 57.0 49.0 66.3 36.4 40.5 47.9 54.7 63.1 69.5 72.2 71.0 65.0 55.5 45.8 38.0 55.0 320 26.55 99.13 1 68.0 73.3 82.1 87.8 93.2 97.5 99.7 99.5 94.1 86.7 77.4 69.2 85.7 57.0 61.5 69.4 75.3 81.5 85.7 87.1 86.9 82.7 75.2 66.3 58.4 73.9 45.9 49.6 56.7 62.8 69.8 73.8 74.4 74.3 71.2 63.6 55.1 47.6 62.1 120 27.22 98.13 1 67.6 72.0 79.3 85.1 89.9 94.4 97.0 97.0 92.4 85.5 76.5 69.5 83.9 55.8 59.6 66.7 72.8 79.0 83.4 85.1 84.8 81.1 73.6 64.8 57.8 72.0 43.9 47.2 54.1 60.5 68.1 72.3 73.2 72.6 69.7 61.7 53.1 46.1 60.2 470 32.52 96.67 0 55.5 61.1 68.5 76.2 83.3 90.8 95.7 95.9 89.0 79.2 66.4 57.6 76.6 44.4 49.5 56.9 64.4 72.6 79.7 84.0 83.7 77.3 67.2 55.2 46.8 65.1 33.3 37.8 45.3 52.5 61.8 68.6 72.3 71.4 65.5 55.1 43.9 36.0 53.6 520 29.67 97.12 1 61.8 66.0 73.4 79.3 85.2 90.8 94.6 94.9 90.0 81.9 71.1 63.4 79.4 52.1 55.8 63.0 69.1 75.6 81.0 83.8 83.9 79.3 71.2 61.3 53.8 69.2 42.3 45.6 52.5 58.8 65.9 71.1 73.0 72.9 68.6 60.5 51.4 44.1 58.9 400 29.13 98.17 1 62.7 67.3 74.9 80.7 86.5 92.2 95.7 95.9 91.2 83.3 72.9 65.5 80.7 50.6 54.8 62.6 68.9 76.2 81.8 84.6 84.4 79.6 70.9 60.9 53.0 69.0 38.4 42.2 50.3 57.0 65.9 71.4 73.5 72.8 67.9 58.4 48.9 40.4 57.3 3219 33.97 101.33 0 50.1 55.5 64.0 72.9 81.1 88.8 92.3 90.2 83.0 73.6 60.3 51.5 71.9 36.7 41.4 49.0 58.0 67.2 75.7 79.3 77.4 70.2 59.8 47.1 38.5 58.4 23.2 27.2 33.9 43.1 53.2 62.5 66.3 64.6 57.4 46.0 33.8 25.5 44.7 2769 36.43 100.13 0 45.5 51.5 59.3 69.0 77.0 86.1 91.4 90.3 82.2 71.5 57.1 47.4 69.0 32.9 38.1 45.8 55.2 64.3 73.8 78.7 77.7 69.3 58.0 44.5 35.4 56.1 20.2 24.6 32.2 41.3 51.6 61.5 66.0 65.0 56.4 44.4 31.8 23.3 43.2 4880 30.67 103.88 0 61.1 65.8 71.8 79.3 85.8 91.2 89.5 87.5 83.8 78.4 68.5 62.4 77.1 44.8 48.6 54.0 61.1 68.8 74.9 75.3 73.4 68.9 61.3 51.5 45.8 60.7 28.4 31.3 36.2 42.9 51.7 58.5 61.1 59.3 54.0 44.1 34.5 29.1 44.3 3905 31.18 105.73 0 59.8 65.8 72.4 80.1 88.9 96.0 94.7 91.8 87.8 80.4 68.7 59.8 78.9 42.0 46.9 53.6 60.8 70.3 79.0 80.1 77.8 72.3 62.6 50.0 42.3 61.5 24.2 27.9 34.8 41.5 51.6 61.9 65.4 63.7 56.8 44.7 31.2 24.8 44.0 3000 30.90 102.92 0 60.9 66.5 74.0 82.1 89.4 95.0 95.8 94.5 88.8 81.1 70.5 62.3 80.1 46.2 50.9 58.2 66.0 74.4 81.0 82.5 81.0 75.5 66.4 55.6 47.8 65.5 31.4 35.3 42.3 49.9 59.3 66.9 69.1 67.5 62.1 51.7 40.6 33.2 50.8 320 28.47 98.82 1 66.3 71.4 78.5 85.4 90.3 95.6 98.9 98.4 93.5 85.5 75.5 68.1 84.0 52.7 57.2 64.5 71.2 78.1 83.3 85.7 85.4 80.7 72.2 62.0 54.4 70.6 39.1 42.9 50.4 56.9 65.8 70.9 72.5 72.3 67.9 58.8 48.5 40.6 57.2 469 31.03 96.48 0 59.5 64.1 71.7 77.9 84.2 90.4 95.1 95.5 89.3 80.5 69.2 61.5 78.2 48.9 53.2 60.4 66.9 74.1 80.2 83.7 83.5 77.9 68.8 58.4 50.9 67.2 38.2 42.3 49.1 55.9 64.0 69.9 72.2 71.5 66.5 57.1 47.5 40.2 56.2 1685 30.23 98.92 0 61.2 65.8 72.9 79.4 84.5 89.7 93.1 93.2 88.1 80.0 69.1 62.2 78.3 48.7 52.6 59.8 66.5 73.4 79.0 81.7 81.2 76.2 67.8 57.2 50.0 66.2 36.1 39.3 46.6 53.5 62.2 68.2 70.2 69.2 64.3 55.5 45.3 37.7 54.0 8 28.98 95.38 1 62.6 65.4 71.5 76.5 82.6 87.8 90.2 90.2 86.7 80.2 72.0 65.0 77.6 54.0 56.7 63.1 69.0 75.9 81.5 83.7 83.4 79.5 71.9 63.1 56.2 69.8 45.4 47.9 54.7 61.4 69.2 75.1 77.2 76.5 72.2 63.5 54.1 47.4 62.1 510 27.90 98.62 1 67.4 71.3 78.7 85.1 90.2 94.8 97.3 97.5 92.4 85.4 76.4 68.2 83.7 55.0 58.6 66.0 72.4 78.6 83.2 85.1 85.1 80.7 73.4 63.7 56.3 71.5 42.5 45.8 53.2 59.6 66.9 71.5 72.9 72.6 68.9 61.3 51.0 44.4 59.2 4010 34.65 102.72 0 49.9 55.1 62.9 70.7 79.0 87.5 89.8 87.8 81.5 72.2 59.3 50.8 70.5 35.8 40.3 47.3 55.2 64.4 73.3 76.4 74.6 67.9 57.5 45.1 37.0 56.2 21.7 25.4 31.7 39.7 49.8 59.1 63.0 61.4 54.3 42.7 30.9 23.1 41.9 2530 32.77 101.47 0 57.0 62.7 71.3 79.5 86.4 92.1 94.6 93.0 86.4 78.1 66.2 58.5 77.2 43.4 48.3 56.3 64.4 72.4 78.9 81.7 80.2 73.6 64.7 52.7 45.1 63.5 29.8 33.8 41.2 49.2 58.4 65.7 68.8 67.4 60.8 51.2 39.1 31.6 49.8 780 33.63 97.15 0 51.8 57.3 66.2 74.3 81.4 89.4 94.7 94.4 86.8 77.0 64.1 54.8 74.4 40.1 45.3 53.9 62.2 70.3 78.6 83.4 82.8 75.2 64.5 52.4 43.1 62.7 28.3 33.2 41.5 50.1 59.1 67.8 72.0 71.1 63.6 52.0 40.6 31.4 50.9 870 33.65 97.07 0 51.3 57.9 66.0 74.0 80.5 87.7 94.0 94.4 86.5 76.6 63.1 53.9 73.8 40.7 46.5 53.9 62.2 70.0 77.8 83.2 83.1 75.6 65.3 52.4 43.5 62.9 30.0 35.0 41.7 50.4 59.5 67.8 72.3 71.8 64.7 53.9 41.7 33.0 51.8 10 29.33 94.78 1 61.9 64.4 70.0 75.2 81.4 86.6 88.7 89.3 86.5 79.7 71.3 64.3 76.6 55.8 58.0 64.1 70.0 76.9 82.2 84.3 84.4 81.1 74.1 65.4 58.1 71.2 49.7 51.5 58.2 64.7 72.3 77.8 79.8 79.5 75.6 68.4 59.4 51.8 65.7 2640 31.87 101.50 0 56.4 62.1 70.8 78.7 86.2 91.6 94.0 92.6 86.2 77.7 66.2 58.2 76.7 41.6 46.6 54.4 62.6 71.5 78.2 81.0 79.7 73.3 63.7 51.5 43.5 62.3 26.7 31.1 37.9 46.4 56.7 64.8 68.0 66.7 60.3 49.6 36.8 28.7 47.8 760 31.38 97.72 0 61.2 66.1 73.8 80.1 85.7 91.7 96.4 96.4 90.5 81.9 70.6 62.7 79.8 47.4 52.0 59.8 66.5 73.8 79.9 83.5 82.8 77.0 67.8 57.0 49.0 66.4 33.5 37.9 45.7 52.9 61.9 68.0 70.5 69.2 63.4 53.6 43.3 35.2 52.9 840 30.68 97.72 0 59.2 63.6 71.4 78.3 84.7 90.6 95.7 95.9 89.6 80.7 68.9 60.8 78.3 47.2 51.3 59.1 66.5 73.8 80.0 83.8 83.6 77.9 68.5 57.7 49.5 66.6 35.1 38.9 46.8 54.6 62.8 69.3 71.8 71.3 66.2 56.3 46.5 38.1 54.8 390 32.75 95.05 0 55.0 60.6 68.2 75.2 82.0 89.0 93.4 93.7 87.5 77.9 66.1 57.8 75.5 43.2 48.0 55.4 62.4 70.6 78.0 82.0 81.3 74.9 64.4 53.8 45.9 63.3 31.4 35.3 42.5 49.5 59.2 66.9 70.5 68.9 62.3 50.9 41.5 33.9 51.1 655 32.23 97.78 0 58.2 64.0 72.3 79.6 86.0 92.5 97.3 97.0 89.5 80.5 68.5 59.9 78.8 43.6 48.9 57.1 64.7 72.4 79.6 83.4 82.4 75.6 65.7 54.2 45.5 64.4 28.9 33.7 41.9 49.7 58.7 66.6 69.5 67.7 61.7 50.9 39.9 31.1 50.0 1500 31.45 98.58 0 58.6 63.0 70.7 77.3 82.8 88.1 92.0 91.5 86.5 78.7 67.7 60.0 76.4 46.9 51.3 58.7 65.7 72.5 78.3 81.6 81.2 76.0 67.6 56.7 48.5 65.4 35.2 39.5 46.6 54.0 62.1 68.4 71.1 70.8 65.5 56.5 45.6 37.0 54.4 142 28.67 97.40 1 68.1 71.9 78.2 83.0 87.8 92.6 95.5 96.1 92.4 85.7 76.3 69.7 83.1 55.7 59.1 65.7 71.1 77.5 82.2 84.3 84.5 80.7 73.1 64.1 57.4 71.3 43.3 46.2 53.1 59.1 67.2 71.7 73.1 72.8 68.9 60.4 51.9 45.1 59.4 380 29.53 97.45 1 60.7 65.0 72.3 78.5 84.5 90.2 93.9 93.9 89.0 81.1 70.7 62.9 78.6 49.7 53.6 61.1 67.3 74.7 80.5 83.5 83.2 78.4 69.5 59.4 51.7 67.7 38.7 42.2 49.9 56.1 64.9 70.8 73.0 72.4 67.7 57.9 48.1 40.4 56.8 1050 33.10 98.58 0 55.0 60.6 69.4 77.3 84.2 91.2 96.6 96.2 88.9 79.3 66.4 57.3 76.9 41.1 46.5 55.1 63.1 71.8 79.5 84.1 83.1 75.4 64.4 52.4 43.2 63.3 27.1 32.3 40.8 48.9 59.4 67.7 71.5 70.0 61.8 49.5 38.3 29.0 49.7 2440 31.30 102.83 0 60.8 67.1 75.4 83.6 91.0 96.7 98.0 96.1 90.0 81.7 70.3 61.6 81.0 43.8 49.2 57.3 65.7 74.5 82.0 84.0 82.3 75.9 65.9 53.6 44.9 64.9 26.7 31.2 39.2 47.7 57.9 67.2 70.0 68.5 61.8 50.0 36.8 28.1 48.8 565 30.70 97.33 0 58.3 62.7 70.2 77.5 84.0 90.2 94.5 94.8 89.5 80.1 68.4 60.3 77.5 47.1 51.1 59.1 66.3 73.7 79.9 83.3 83.3 78.1 68.4 57.5 49.3 66.4 35.8 39.5 47.9 55.0 63.4 69.5 72.1 71.8 66.6 56.6 46.5 38.2 55.2 585 32.95 97.05 0 54.0 59.7 67.8 75.2 82.5 90.3 95.5 95.3 88.3 78.5 65.6 56.8 75.8 42.4 47.6 55.6 63.3 71.6 79.4 84.0 83.4 76.5 65.9 54.2 45.4 64.1 30.8 35.5 43.4 51.3 60.6 68.4 72.5 71.5 64.7 53.3 42.7 33.9 52.4 545 33.17 96.10 0 52.1 57.7 65.8 73.5 80.6 88.6 93.3 93.4 86.4 76.5 63.7 54.7 73.9 41.7 46.5 54.2 61.9 70.3 78.3 82.7 82.3 75.6 64.9 53.1 44.4 63.0 31.2 35.2 42.5 50.3 59.9 67.9 72.1 71.2 64.7 53.3 42.5 34.1 52.1 350 31.07 95.13 0 60.8 65.8 73.2 79.2 85.6 91.2 94.8 95.0 89.8 81.8 70.8 62.7 79.2 49.0 53.3 60.0 66.3 73.7 79.9 83.1 82.6 77.4 68.2 58.0 50.4 66.8 37.1 40.8 46.7 53.4 61.8 68.5 71.4 70.2 64.9 54.5 45.2 38.0 54.4 3170 36.25 101.40 0 46.4 52.2 60.7 69.5 77.5 87.7 92.2 90.1 82.6 72.2 57.2 47.4 69.6 32.3 37.2 45.3 54.6 63.8 73.9 78.3 76.6 68.7 56.9 43.0 33.9 55.4 18.2 22.1 29.9 39.6 50.0 60.0 64.4 63.0 54.7 41.5 28.8 20.3 41.0 1740 33.62 100.32 0 53.7 59.3 67.9 77.4 85.0 92.1 96.7 95.0 87.4 78.0 64.6 55.1 76.0 38.8 44.0 52.0 61.0 70.1 78.0 82.3 80.8 73.3 62.6 49.6 40.4 61.1 23.9 28.7 36.1 44.6 55.2 63.8 67.9 66.5 59.1 47.2 34.6 25.7 46.1 275 29.47 96.95 1 63.5 67.7 74.5 80.1 85.8 90.8 94.4 94.9 90.5 83.0 72.8 65.3 80.3 52.7 56.4 63.4 69.2 76.0 81.1 83.7 83.7 79.6 71.5 61.9 54.5 69.5 41.8 45.0 52.2 58.3 66.2 71.4 72.9 72.5 68.6 60.0 50.9 43.7 58.6 1260 31.72 98.15 0 56.7 61.7 69.3 76.1 82.8 89.5 94.3 93.6 86.8 78.1 66.7 58.6 76.2 45.1 49.8 57.0 64.0 71.8 78.8 82.8 81.9 75.4 66.3 55.0 47.2 64.6 33.4 37.8 44.6 51.8 60.7 68.0 71.3 70.2 64.0 54.4 43.3 35.7 52.9 38 26.20 97.67 1 68.8 72.7 79.6 83.9 88.6 92.5 94.5 94.9 91.2 85.2 77.4 70.4 83.3 58.6 62.1 68.8 73.7 79.3 83.0 84.4 84.5 81.3 74.8 67.2 60.4 73.2 48.4 51.4 57.9 63.5 70.0 73.5 74.3 74.1 71.4 64.3 57.0 50.3 63.0 3640 34.37 102.08 0 50.4 56.2 63.9 72.2 80.0 87.8 90.4 88.1 82.1 73.3 60.2 51.7 71.4 35.4 40.1 47.3 55.9 65.0 73.5 76.6 74.5 68.1 58.0 45.3 37.3 56.4 20.3 24.0 30.6 39.6 50.0 59.2 62.7 60.9 54.1 42.6 30.4 22.8 41.4 1600 33.15 99.75 0 54.1 59.5 68.6 77.6 85.3 91.7 96.1 95.0 87.6 78.0 64.9 56.1 76.2 41.5 46.6 54.9 63.8 72.7 80.0 84.4 83.3 75.8 65.4 52.8 43.9 63.8 28.8 33.6 41.1 50.0 60.0 68.3 72.7 71.5 64.0 52.7 40.7 31.6 51.3 580 27.32 98.68 1 68.0 72.5 80.1 85.7 91.0 95.3 97.5 97.7 92.9 85.8 76.9 69.2 84.4 55.9 60.0 67.6 73.6 79.7 83.9 85.4 85.3 81.3 73.6 64.8 57.3 72.4 43.8 47.5 55.1 61.4 68.4 72.4 73.2 72.9 69.6 61.3 52.7 45.3 60.3 420 32.18 94.80 0 55.6 61.0 68.5 75.5 82.3 89.1 93.1 93.3 87.1 77.9 66.6 58.4 75.7 44.4 48.8 55.9 62.8 70.9 78.0 81.9 81.4 75.3 65.1 54.5 46.8 63.8 33.1 36.6 43.2 50.1 59.4 66.9 70.6 69.5 63.4 52.2 42.4 35.1 51.9 930 33.82 98.20 0 51.1 56.8 65.6 73.9 81.4 89.0 95.0 94.4 86.5 76.6 63.5 54.2 74.0 39.0 44.2 52.7 61.1 69.7 77.7 82.9 81.9 74.3 63.5 51.1 42.1 61.7 26.8 31.6 39.8 48.2 58.0 66.4 70.7 69.4 62.1 50.4 38.6 29.9 49.3 3820 34.82 102.40 0 49.8 55.1 63.6 72.0 80.2 88.9 91.6 89.3 82.6 72.9 59.7 50.6 71.4 35.5 39.9 47.3 55.7 65.0 74.0 77.6 75.7 68.5 57.7 44.9 36.6 56.5 21.1 24.6 30.9 39.4 49.7 59.1 63.5 62.1 54.3 42.5 30.1 22.6 41.7 1025 31.98 98.03 0 56.9 61.7 68.7 76.3 82.2 89.1 93.8 93.9 87.3 78.0 66.3 58.4 76.1 43.5 47.9 55.2 63.3 70.9 78.5 82.1 81.8 75.1 65.1 53.6 45.4 63.5 30.1 34.1 41.6 50.3 59.6 67.8 70.4 69.6 62.8 52.2 40.8 32.3 51.0 550 32.02 97.12 0 57.4 62.9 70.9 77.5 83.9 90.6 95.2 95.3 89.2 80.0 68.0 59.6 77.5 46.3 51.4 59.1 65.9 73.4 80.2 84.1 84.0 77.9 68.3 56.9 48.6 66.3 35.2 39.8 47.2 54.2 62.9 69.7 72.9 72.6 66.5 56.5 45.8 37.6 55.1 920 29.37 99.17 1 62.4 67.3 74.7 80.9 86.5 91.9 94.8 94.9 90.0 81.5 70.9 63.9 80.0 50.3 54.9 62.2 68.7 75.7 81.0 83.1 82.9 78.6 70.0 59.3 52.0 68.2 38.1 42.4 49.6 56.4 64.8 70.0 71.3 70.9 67.1 58.5 47.7 40.1 56.4 1942 31.85 99.57 0 55.9 61.2 69.3 77.2 84.0 89.8 93.7 93.1 86.9 78.2 65.9 57.8 76.1 42.5 47.5 55.4 63.4 71.1 77.7 81.2 80.5 74.0 64.6 52.9 44.5 62.9 29.1 33.7 41.4 49.5 58.2 65.5 68.7 67.8 61.0 50.9 39.8 31.2 49.7 95 30.00 95.37 0 62.3 66.5 73.3 79.1 85.5 90.7 93.6 93.5 89.3 82.0 72.0 64.6 79.4 51.8 55.4 62.3 68.5 75.8 81.3 83.6 83.3 78.9 70.4 60.9 53.7 68.8 41.2 44.3 51.3 57.9 66.1 71.8 73.5 73.0 68.4 58.8 49.8 42.8 58.2 44 29.65 95.28 1 63.3 67.1 73.6 79.4 85.9 91.0 93.6 93.4 89.3 82.0 72.5 65.4 79.7 54.3 57.7 64.2 70.0 77.0 82.3 84.5 84.4 80.5 72.2 63.0 56.1 70.5 45.2 48.2 54.8 60.6 68.1 73.5 75.3 75.3 71.6 62.3 53.4 46.7 61.3 58 29.92 95.15 0 62.6 66.3 72.8 78.5 85.2 90.8 93.9 94.2 89.9 81.4 72.1 64.8 79.4 51.3 54.3 61.2 67.5 74.8 80.2 82.8 82.8 78.9 69.5 60.5 53.1 68.1 39.9 42.3 49.6 56.5 64.3 69.6 71.6 71.4 67.9 57.6 48.9 41.4 56.8 1630 29.98 101.18 0 62.0 67.4 76.0 82.3 88.7 93.3 95.5 94.9 89.8 81.2 70.5 62.8 80.4 47.9 52.2 60.8 68.1 76.0 81.7 84.0 83.4 78.1 68.7 57.5 49.0 67.3 33.7 37.0 45.5 53.8 63.3 70.0 72.4 71.9 66.3 56.2 44.4 35.2 54.1 494 30.72 95.55 0 57.9 62.8 70.6 77.5 84.4 90.3 93.8 93.5 88.0 79.3 68.5 60.3 77.2 48.5 52.7 60.2 66.9 74.2 80.2 83.2 82.8 77.6 68.8 58.7 50.8 67.1 39.0 42.6 49.7 56.3 64.0 70.1 72.6 72.1 67.2 58.2 48.9 41.2 56.8 1100 33.23 98.15 0 53.0 58.7 66.5 74.6 81.8 89.4 94.4 93.9 86.2 76.4 63.9 55.7 74.5 41.4 46.5 54.2 62.7 70.8 78.9 83.4 82.6 75.2 64.9 52.6 44.1 63.1 29.7 34.2 41.9 50.8 59.8 68.4 72.3 71.3 64.2 53.3 41.2 32.4 51.6 560 31.97 95.27 0 57.5 62.4 69.9 76.9 83.3 89.7 94.0 93.8 87.9 79.1 67.6 59.6 76.8 46.2 50.4 57.6 65.2 72.9 79.4 83.1 82.4 76.8 67.3 56.0 48.6 65.5 34.8 38.4 45.2 53.4 62.5 69.0 72.2 71.0 65.6 55.4 44.4 37.6 54.1 2010 33.25 100.57 0 53.8 59.2 67.9 77.0 84.4 91.3 95.7 93.8 86.4 77.1 64.4 55.6 75.6 39.4 44.4 52.3 61.4 70.3 78.2 82.4 80.8 73.3 62.9 50.1 41.3 61.4 24.9 29.5 36.6 45.7 56.2 65.1 69.1 67.7 60.2 48.7 35.7 27.0 47.2 199 32.77 94.33 0 54.7 60.0 68.3 75.3 81.9 88.4 93.1 93.1 87.1 77.6 65.7 57.1 75.2 43.1 47.7 56.1 62.9 71.2 78.2 82.0 81.4 74.9 63.8 53.5 45.7 63.4 31.4 35.4 43.8 50.4 60.5 67.9 70.8 69.6 62.7 50.0 41.2 34.2 51.5 510 31.35 96.15 0 59.1 63.7 71.8 77.6 84.0 89.7 93.6 95.0 88.9 80.1 68.8 60.8 77.8 48.6 52.7 60.3 66.5 73.6 79.6 82.9 83.2 77.6 68.7 58.3 50.6 66.9 38.1 41.7 48.7 55.3 63.2 69.4 72.1 71.4 66.3 57.3 47.8 40.4 56.0 1232 30.28 98.42 0 61.3 65.5 73.0 80.0 86.0 91.9 96.0 96.0 90.6 81.7 70.6 62.9 79.6 47.0 51.3 58.7 65.7 73.2 79.6 83.0 82.8 77.5 68.0 57.4 49.3 66.1 32.7 37.1 44.4 51.4 60.4 67.2 70.0 69.5 64.4 54.3 44.1 35.7 52.6 1747 30.45 99.80 0 61.0 65.8 73.1 79.5 85.9 91.6 94.8 94.4 88.8 80.2 69.2 62.1 78.9 45.2 50.0 57.5 65.0 72.8 79.1 81.6 80.8 75.4 65.8 54.2 46.8 64.5 29.3 34.1 41.8 50.5 59.6 66.5 68.4 67.1 61.9 51.3 39.2 31.4 50.1 450 28.90 97.88 1 63.2 67.5 74.5 80.4 86.3 92.0 94.9 95.2 90.2 82.8 72.5 65.3 80.4 52.0 55.7 62.7 68.9 75.9 81.3 83.6 83.6 79.2 71.3 61.3 54.0 69.1 40.7 43.9 50.9 57.4 65.5 70.5 72.3 72.0 68.1 59.8 50.1 42.7 57.8 420 32.57 96.27 0 54.0 59.4 67.0 74.3 81.5 89.2 94.6 95.1 88.4 78.4 65.6 56.6 75.3 43.2 48.1 55.7 63.0 71.3 78.9 83.5 83.3 76.7 66.0 54.3 45.6 64.1 32.3 36.7 44.4 51.6 61.1 68.6 72.3 71.4 65.0 53.6 42.9 34.6 52.9 4860 31.00 104.12 0 55.5 60.8 67.9 75.9 83.4 90.1 89.2 86.3 81.4 74.9 65.0 57.7 74.0 43.2 47.2 53.4 60.9 69.0 75.7 76.5 74.0 69.2 61.8 51.5 44.4 60.6 30.9 33.5 38.8 45.9 54.6 61.2 63.7 61.7 57.0 48.6 37.9 31.0 47.1 1782 30.07 99.12 0 58.3 62.7 70.0 76.7 82.3 88.1 91.6 91.9 86.5 77.8 67.1 59.9 76.1 45.3 49.7 57.3 64.4 71.7 77.7 80.5 80.1 74.9 65.6 55.1 47.3 64.1 32.3 36.6 44.5 52.1 61.1 67.3 69.3 68.3 63.3 53.3 43.0 34.7 52.2 910 31.07 97.73 0 58.0 62.8 69.9 78.0 84.1 91.0 95.3 95.7 89.2 80.2 68.1 60.2 77.7 46.0 50.4 57.6 65.5 72.8 79.9 83.5 83.5 77.3 68.0 56.2 48.2 65.7 34.0 37.9 45.3 52.9 61.5 68.8 71.7 71.3 65.4 55.7 44.2 36.1 53.7 66 27.52 97.87 1 68.3 71.7 78.1 83.5 87.8 92.6 95.5 95.6 91.9 85.3 76.5 70.2 83.1 55.9 59.4 65.9 72.0 77.6 82.3 84.3 84.4 81.0 73.5 64.7 58.0 71.6 43.4 47.1 53.6 60.4 67.4 71.9 73.1 73.2 70.0 61.7 52.8 45.7 60.0 56 27.50 97.82 1 67.6 71.8 78.5 83.4 88.3 92.7 95.1 95.1 91.2 85.1 76.4 69.1 82.9 57.1 60.8 67.6 73.1 79.2 83.5 85.2 85.1 81.5 74.6 65.8 58.6 72.7 46.5 49.7 56.7 62.8 70.1 74.3 75.3 75.1 71.7 64.0 55.1 48.1 62.5 357 29.92 96.88 0 62.6 67.1 74.4 80.5 86.3 91.7 95.9 96.0 90.6 82.8 71.8 64.3 80.3 52.0 55.8 62.9 69.1 76.0 81.6 84.5 84.4 79.4 71.2 61.1 53.6 69.3 41.4 44.5 51.4 57.7 65.7 71.4 73.1 72.8 68.1 59.5 50.4 42.9 58.2 759 28.98 99.87 1 64.1 69.7 77.7 84.6 89.7 94.7 97.8 97.8 92.5 84.0 73.6 65.8 82.7 51.4 56.3 64.2 71.2 77.8 83.1 85.5 85.3 80.6 71.5 61.5 53.1 70.1 38.7 42.9 50.6 57.7 65.8 71.4 73.1 72.7 68.7 59.0 49.3 40.4 57.5 3800 31.97 106.60 0 59.6 65.8 73.2 80.7 89.0 97.2 97.2 94.3 89.6 80.5 68.0 59.1 79.5 44.7 49.7 56.1 63.0 71.6 80.4 82.7 80.5 75.3 64.8 52.5 44.6 63.8 29.7 33.6 38.9 45.3 54.2 63.6 68.1 66.7 61.0 49.1 37.0 30.0 48.1 2440 29.27 103.80 1 69.2 76.1 83.7 91.2 97.6 101.7 100.6 98.5 94.7 87.3 76.9 69.4 87.2 52.1 58.0 65.0 72.6 80.6 87.0 87.1 85.4 81.2 71.7 59.8 52.7 71.1 34.9 39.8 46.2 54.0 63.5 72.3 73.5 72.2 67.6 56.0 42.7 35.9 54.9 2100 32.33 100.92 0 54.9 60.4 68.4 76.5 84.1 90.1 93.3 92.2 85.6 77.0 65.2 56.4 75.3 42.1 47.3 55.3 63.4 72.3 79.0 82.2 81.2 74.5 64.8 53.0 44.0 63.3 29.3 34.1 42.1 50.2 60.4 67.9 71.1 70.2 63.3 52.6 40.8 31.6 51.1 414 32.82 95.53 0 49.6 54.7 62.7 70.3 78.0 85.8 89.9 90.4 83.8 74.0 61.1 52.3 71.1 40.4 44.9 52.9 60.3 69.0 76.6 80.6 80.0 73.7 63.0 51.5 43.0 61.3 31.1 35.1 43.0 50.3 59.9 67.3 71.3 69.6 63.5 51.9 41.9 33.7 51.6 1167 33.75 99.15 0 51.7 57.5 66.6 76.0 84.2 92.1 97.5 96.1 87.8 77.4 63.6 53.8 75.4 39.9 45.2 53.7 63.0 71.8 80.0 84.9 83.7 75.8 65.1 52.2 42.6 63.2 28.1 32.9 40.8 49.9 59.3 67.8 72.3 71.3 63.8 52.7 40.7 31.4 50.9 2965 32.72 101.95 0 54.2 59.9 68.1 76.1 84.2 90.6 92.9 91.3 84.8 76.5 64.6 56.1 74.9 40.1 45.0 52.2 60.2 69.5 76.8 79.7 78.2 71.9 62.3 50.2 42.1 60.7 26.0 30.0 36.2 44.3 54.8 63.0 66.4 65.0 59.0 48.0 35.7 28.0 46.4 1032 31.07 98.18 0 57.8 62.4 70.1 77.2 83.1 89.5 94.1 94.1 88.2 79.2 67.7 59.5 76.9 44.1 48.5 56.3 63.9 71.9 78.8 82.4 81.8 75.7 65.7 54.4 46.1 64.1 30.4 34.6 42.5 50.5 60.6 68.1 70.7 69.4 63.2 52.1 41.0 32.6 51.3 1290 29.80 101.57 0 61.8 67.2 75.8 84.0 90.6 95.3 97.6 97.2 91.8 81.9 70.5 62.6 81.4 47.4 52.7 61.7 70.2 78.3 83.8 86.1 85.7 79.9 69.5 57.5 48.6 68.5 32.9 38.1 47.5 56.4 65.9 72.3 74.6 74.1 67.9 57.0 44.4 34.5 55.5 430 27.57 99.50 1 67.5 73.0 81.8 89.4 95.2 99.7 101.6 100.8 95.0 86.8 76.7 68.6 86.3 55.6 60.6 68.9 76.0 82.6 86.9 88.5 87.9 83.2 75.1 65.1 57.0 74.0 43.7 48.2 56.0 62.6 70.0 74.1 75.4 75.0 71.3 63.3 53.4 45.3 61.5 510 33.03 96.48 0 53.4 58.9 66.9 74.5 81.9 89.6 94.2 94.5 88.0 78.2 65.2 56.3 75.1 42.1 47.3 55.2 62.9 71.0 78.5 82.8 82.6 76.2 65.7 53.8 45.1 63.6 30.8 35.6 43.4 51.2 60.0 67.4 71.3 70.7 64.3 53.1 42.4 33.9 52.0 3550 33.57 102.38 0 53.4 59.1 67.2 75.5 83.9 91.2 92.7 90.4 84.0 75.7 63.2 54.9 74.3 38.6 43.2 50.2 58.8 68.1 76.2 78.6 76.8 70.3 60.3 48.1 40.2 59.1 23.7 27.2 33.1 42.0 52.3 61.1 64.5 63.1 56.5 44.8 32.9 25.4 43.9 465 30.42 97.02 0 59.4 63.6 70.9 77.2 83.5 89.7 93.6 94.0 89.0 80.5 69.6 61.7 77.7 48.4 52.4 59.8 66.1 73.6 79.9 83.1 83.1 78.1 69.0 58.8 50.7 66.9 37.3 41.1 48.6 55.0 63.6 70.0 72.5 72.1 67.2 57.4 47.9 39.6 56.0 35 30.07 94.80 0 61.1 65.0 71.8 77.4 83.9 89.1 92.2 92.8 88.5 81.0 70.8 63.3 78.1 50.7 54.3 60.6 66.8 74.1 79.7 82.5 82.6 77.9 69.0 59.6 52.8 67.6 40.3 43.5 49.3 56.1 64.2 70.3 72.7 72.3 67.3 56.9 48.4 42.2 57.0 2450 36.23 100.27 0 47.3 53.3 61.7 71.0 78.9 88.2 94.2 92.8 84.7 73.8 58.9 49.2 71.2 31.8 36.9 45.4 55.0 64.5 74.3 79.7 78.2 69.7 57.6 43.5 34.1 55.9 16.2 20.4 29.1 39.0 50.0 60.3 65.1 63.6 54.6 41.4 28.1 18.9 40.6 3505 33.93 102.35 0 53.0 58.5 66.6 74.4 82.7 90.1 92.0 89.5 83.9 75.3 62.7 54.3 73.6 37.9 42.5 49.5 57.7 67.2 75.4 78.2 76.1 69.7 59.6 47.5 39.4 58.4 22.7 26.4 32.3 40.9 51.6 60.7 64.4 62.7 55.4 43.9 32.3 24.5 43.2 178 30.73 94.93 0 59.3 63.9 71.3 77.6 84.3 90.4 94.1 94.2 88.7 80.2 69.6 61.8 78.0 47.6 51.2 58.4 64.9 72.8 79.1 82.3 81.8 76.6 67.0 57.3 49.6 65.7 35.8 38.4 45.5 52.2 61.3 67.8 70.5 69.4 64.4 53.7 45.0 37.4 53.5 1020 30.75 98.65 0 59.6 64.3 71.9 78.8 84.9 91.2 96.0 95.6 89.7 80.6 69.0 61.2 78.6 46.0 50.3 58.1 65.4 73.3 80.0 83.7 83.0 76.9 67.2 55.9 47.8 65.6 32.3 36.3 44.3 51.9 61.7 68.8 71.3 70.4 64.1 53.8 42.8 34.3 52.7 330 32.47 94.73 0 57.1 62.6 70.0 77.2 84.0 90.5 94.5 94.5 89.0 79.6 67.9 59.4 77.2 45.4 49.8 57.1 64.2 72.6 79.5 83.4 82.6 76.8 66.2 55.5 47.5 65.1 33.7 37.0 44.1 51.2 61.1 68.5 72.3 70.7 64.6 52.8 43.1 35.5 52.9 407 32.35 94.65 0 55.6 61.0 68.7 75.6 82.7 89.5 93.4 93.0 86.3 77.2 65.6 58.1 75.6 46.8 51.2 58.6 65.4 73.2 79.9 83.5 82.8 76.6 67.0 56.3 49.0 65.9 37.9 41.3 48.5 55.1 63.7 70.3 73.6 72.5 66.9 56.7 46.9 39.9 56.1 302 31.13 95.45 0 58.3 63.2 71.0 77.6 84.4 90.6 94.5 95.1 89.7 80.5 68.9 60.6 77.9 47.1 51.0 58.4 65.4 73.1 79.4 82.9 82.7 77.5 67.4 56.8 49.1 65.9 35.9 38.7 45.8 53.1 61.8 68.2 71.2 70.3 65.2 54.2 44.6 37.5 53.9 3254 33.67 101.82 0 51.9 57.8 66.2 74.7 82.8 90.0 91.9 90.0 83.4 74.4 61.6 53.2 73.2 38.1 43.3 51.2 60.0 69.2 77.1 79.8 78.0 70.9 60.7 48.1 39.7 59.7 24.4 28.9 36.2 45.4 55.6 64.1 67.7 66.0 58.4 47.0 34.5 26.1 46.2 288 31.23 94.75 0 59.2 64.5 71.8 78.1 84.4 90.0 93.5 93.6 88.5 80.1 69.2 61.3 77.9 48.6 52.9 59.8 66.2 73.7 79.7 82.6 82.2 77.3 67.7 57.7 50.3 66.6 37.9 41.2 47.8 54.2 63.0 69.4 71.7 70.8 66.0 55.3 46.1 39.2 55.2 400 29.68 97.65 1 61.5 66.0 73.6 79.8 85.8 91.8 95.8 96.5 91.3 82.9 71.7 63.6 80.0 49.2 53.4 61.0 67.2 74.7 80.9 83.8 83.7 78.6 69.7 59.2 51.3 67.7 36.9 40.7 48.3 54.5 63.5 70.0 71.8 70.8 65.9 56.4 46.6 39.0 55.4 722 29.23 98.85 1 63.7 68.5 75.4 81.0 85.5 90.5 93.8 94.2 89.7 82.2 71.5 64.6 80.1 52.0 56.3 63.4 69.5 75.8 80.8 83.1 83.0 78.8 70.9 60.6 53.5 69.0 40.3 44.1 51.3 57.9 66.0 71.0 72.4 71.8 67.9 59.5 49.7 42.3 57.9 252 30.95 95.92 0 60.2 64.8 72.2 78.8 85.8 91.8 96.0 96.5 90.8 81.8 70.1 62.3 79.3 48.0 52.0 59.0 66.2 74.2 80.4 83.6 83.4 78.0 68.4 57.4 50.0 66.7 35.8 39.1 45.8 53.5 62.5 68.9 71.2 70.2 65.1 54.9 44.6 37.7 54.1 4055 30.22 103.23 0 62.3 65.9 72.4 79.4 86.1 91.0 90.8 89.8 85.0 79.1 70.3 64.2 78.0 44.9 48.1 54.9 61.9 69.9 75.5 76.6 75.8 70.8 62.9 53.0 46.4 61.7 27.4 30.3 37.3 44.4 53.6 60.0 62.4 61.7 56.6 46.6 35.7 28.6 45.4 4760 30.30 104.02 0 59.1 63.8 70.4 77.5 85.0 90.7 88.9 87.3 83.0 76.7 66.9 59.8 75.8 41.5 45.2 51.4 58.6 67.3 74.0 74.5 73.1 68.1 59.9 49.3 42.3 58.8 23.9 26.6 32.4 39.6 49.6 57.2 60.0 58.8 53.2 43.0 31.7 24.7 41.7 388 31.33 96.85 0 60.6 65.7 72.8 78.5 84.2 90.5 95.0 95.7 90.4 81.9 70.1 62.2 79.0 48.8 53.4 60.6 67.1 74.3 80.7 84.2 84.2 79.0 69.7 58.7 50.7 67.6 37.0 41.1 48.4 55.7 64.4 70.9 73.4 72.7 67.5 57.4 47.2 39.1 56.2 352 32.53 94.35 0 54.2 59.7 67.5 74.8 81.6 88.5 92.4 92.5 86.3 76.6 65.1 56.7 74.7 43.8 48.5 56.3 63.2 71.1 78.2 81.9 81.5 75.4 64.3 54.1 46.2 63.7 33.4 37.3 45.0 51.6 60.5 67.8 71.3 70.5 64.4 52.0 43.1 35.7 52.7 1430 30.75 99.23 0 60.0 64.5 72.6 79.7 85.2 91.2 94.9 94.4 89.0 80.1 69.5 61.4 78.5 45.4 49.5 57.3 65.1 72.3 78.9 82.0 81.1 75.8 66.0 55.6 47.4 64.7 30.8 34.4 41.9 50.4 59.4 66.5 69.1 67.8 62.6 51.9 41.7 33.4 50.8 2290 34.02 100.83 0 53.1 58.2 66.6 75.4 82.6 90.2 94.8 92.7 85.3 76.2 63.5 54.8 74.5 40.2 44.9 52.5 61.2 69.6 77.8 82.2 80.5 73.0 63.2 50.8 42.3 61.5 27.3 31.6 38.4 47.0 56.5 65.4 69.6 68.2 60.7 50.1 38.0 29.7 48.5 10 28.68 95.97 1 62.3 64.6 70.0 76.1 81.9 87.2 89.6 90.7 87.9 81.6 72.4 65.4 77.5 53.3 56.0 61.9 69.0 75.7 81.3 83.4 83.5 80.0 72.7 63.1 56.1 69.7 44.3 47.3 53.8 61.9 69.5 75.3 77.2 76.3 72.1 63.8 53.8 46.8 61.8 138 28.03 97.87 1 65.3 69.4 76.1 81.9 86.9 91.9 94.9 95.2 90.9 84.1 74.6 67.7 81.6 54.7 58.3 65.1 71.4 77.4 82.1 84.0 84.3 80.7 73.2 64.1 56.9 71.0 44.1 47.2 54.0 60.8 67.9 72.3 73.0 73.3 70.5 62.2 53.5 46.1 60.4 100 26.20 98.25 1 69.1 73.1 80.6 85.2 89.2 93.6 95.5 96.2 92.3 86.3 78.0 70.6 84.1 58.7 62.3 69.3 74.5 79.8 83.8 85.1 85.7 82.2 75.6 67.5 60.2 73.7 48.2 51.5 58.0 63.8 70.3 73.9 74.7 75.1 72.1 64.9 56.9 49.7 63.3 100 26.18 98.23 1 69.9 74.1 81.4 85.9 90.0 94.0 96.1 96.4 92.3 86.3 78.1 71.4 84.7 60.1 63.8 70.8 75.8 80.9 84.5 85.9 86.1 82.7 76.4 68.4 61.6 74.8 50.3 53.5 60.2 65.7 71.8 74.9 75.7 75.8 73.1 66.4 58.6 51.8 64.8 2450 31.13 102.20 0 60.7 66.1 74.0 81.7 89.1 94.2 95.6 94.3 88.5 80.1 69.1 61.6 79.6 46.9 51.9 59.3 67.2 75.3 81.6 83.8 82.6 76.8 67.7 56.0 48.2 66.4 33.1 37.6 44.5 52.6 61.4 69.0 72.0 70.9 65.1 55.3 42.8 34.7 53.3 220 26.48 98.38 1 68.8 73.4 81.1 86.2 90.4 95.1 97.7 98.4 93.8 86.8 78.1 70.4 85.0 57.9 61.9 69.1 74.7 80.1 84.1 85.7 85.8 82.1 75.2 67.0 59.6 73.6 46.9 50.3 57.1 63.2 69.7 73.0 73.7 73.2 70.4 63.5 55.8 48.7 62.1 1705 29.78 99.28 0 61.0 66.1 73.1 79.7 85.2 90.8 93.9 94.3 89.3 80.3 70.0 62.6 78.9 47.2 51.3 58.6 65.5 73.0 79.0 81.4 81.3 76.7 67.3 57.0 49.2 65.6 33.3 36.4 44.1 51.2 60.8 67.1 68.9 68.3 64.0 54.3 43.9 35.7 52.3 723 31.43 97.40 0 56.0 61.1 68.9 76.5 83.5 90.4 95.5 95.4 88.8 79.0 66.6 58.2 76.7 45.0 49.7 57.3 64.9 72.7 79.8 83.9 83.7 77.3 67.3 55.9 47.4 65.4 33.9 38.2 45.7 53.2 61.9 69.2 72.3 72.0 65.8 55.6 45.1 36.6 54.1 595 33.17 96.62 0 52.5 58.1 65.6 73.3 80.2 87.7 92.7 92.6 85.4 75.7 63.2 54.8 73.5 41.8 46.5 53.9 62.3 70.5 78.1 82.4 81.6 74.8 64.4 52.8 44.5 62.8 31.1 34.9 42.2 51.2 60.8 68.5 72.0 70.6 64.2 53.0 42.4 34.1 52.1 2860 35.23 100.60 0 49.9 56.1 65.2 74.1 80.8 87.7 92.0 90.4 84.2 74.4 60.6 51.4 72.2 37.6 42.7 50.8 59.4 67.5 75.3 79.5 78.2 71.5 61.1 48.2 39.5 59.3 25.3 29.3 36.4 44.7 54.2 62.8 67.0 66.0 58.7 47.8 35.7 27.6 46.3 2090 34.73 100.53 0 52.0 57.6 65.9 75.0 82.6 90.7 95.7 94.0 86.3 76.3 62.8 53.6 74.4 38.8 43.6 51.2 60.0 69.2 77.7 82.6 81.0 73.4 62.5 49.5 40.8 60.9 25.5 29.6 36.4 45.0 55.7 64.6 69.5 68.0 60.5 48.7 36.2 28.0 47.3 1951 30.92 99.78 0 60.4 65.6 73.3 80.8 86.6 91.3 94.8 93.9 88.4 80.0 68.6 61.4 78.8 45.6 50.2 57.9 65.3 73.0 78.6 81.4 80.4 74.7 65.5 54.4 46.9 64.5 30.7 34.7 42.5 49.7 59.3 65.8 68.0 66.8 61.0 51.0 40.2 32.3 50.2 535 31.68 96.48 0 57.5 62.7 70.4 77.6 84.3 91.3 95.8 96.8 90.7 80.9 68.7 59.9 78.1 45.6 50.3 57.9 65.2 72.7 79.7 83.7 83.6 77.7 67.5 56.5 48.0 65.7 33.7 37.9 45.3 52.8 61.1 68.1 71.5 70.3 64.6 54.1 44.3 36.0 53.3 2755 35.70 100.63 0 46.6 51.9 60.0 69.6 77.8 86.7 92.4 90.7 82.6 71.7 57.6 48.4 69.7 33.6 38.3 46.3 55.4 64.7 74.2 79.4 77.8 69.6 57.7 44.4 35.6 56.4 20.6 24.6 32.5 41.1 51.6 61.6 66.3 64.9 56.5 43.6 31.1 22.7 43.1 2862 31.95 102.18 0 56.8 63.0 70.9 78.8 86.8 92.7 94.3 92.8 86.1 77.4 65.8 58.4 77.0 43.2 48.6 55.9 63.7 72.8 79.6 81.7 80.4 73.9 64.4 52.3 44.8 63.4 29.6 34.1 40.8 48.6 58.8 66.4 69.1 67.9 61.6 51.3 38.8 31.2 49.9 2740 32.02 102.03 0 59.5 66.0 73.6 81.9 89.0 94.4 95.6 93.9 88.2 80.1 67.9 61.0 79.3 44.5 49.8 57.3 65.1 73.6 79.8 81.8 80.5 74.5 65.4 53.2 45.9 64.3 29.5 33.6 40.9 48.3 58.2 65.2 68.0 67.0 60.7 50.7 38.5 30.8 49.3 385 32.72 95.37 0 54.3 60.0 67.5 74.8 81.9 88.7 93.1 93.5 87.3 77.7 65.4 56.9 75.1 42.8 47.5 54.9 62.3 71.2 78.3 82.0 81.3 75.0 64.6 53.4 45.3 63.2 31.2 35.0 42.3 49.8 60.4 67.9 70.8 69.0 62.7 51.4 41.4 33.7 51.3 930 32.78 98.07 0 58.2 63.7 72.5 79.6 86.1 92.8 97.3 96.6 89.7 80.5 67.8 59.6 78.7 45.8 50.9 59.3 66.4 74.1 80.8 84.8 84.2 77.5 67.9 56.1 47.6 66.3 33.4 38.0 46.1 53.1 62.0 68.7 72.2 71.7 65.3 55.3 44.3 35.6 53.8 133 26.22 98.40 1 70.0 74.3 82.2 87.3 91.6 95.7 97.7 98.2 93.9 87.2 78.8 71.4 85.7 58.8 62.6 69.8 75.4 81.1 84.7 86.3 86.4 82.8 75.8 67.5 60.0 74.3 47.5 50.8 57.4 63.5 70.5 73.7 74.8 74.5 71.7 64.3 56.2 48.6 62.8 2660 31.58 102.88 0 60.1 66.7 75.5 83.6 91.5 97.6 98.6 96.7 90.0 81.9 69.4 61.0 81.1 43.3 49.1 57.2 65.1 74.2 81.5 83.3 81.9 75.1 65.4 52.8 44.6 64.5 26.5 31.4 38.8 46.6 56.9 65.4 68.0 67.1 60.1 48.8 36.2 28.1 47.8 3760 33.72 102.77 0 52.5 57.8 65.7 73.7 82.2 89.9 91.4 89.0 82.9 74.3 62.1 53.7 72.9 37.8 42.2 49.5 57.6 67.1 75.3 77.8 75.7 69.2 59.3 47.4 39.2 58.2 23.1 26.5 33.2 41.4 52.0 60.7 64.2 62.3 55.5 44.3 32.7 24.7 43.4 6790 30.67 104.52 0 55.0 58.8 65.2 72.3 80.0 86.0 84.5 82.1 77.8 71.8 62.4 55.8 71.0 43.7 46.8 52.1 58.7 66.5 72.2 71.8 70.1 66.3 60.0 50.9 44.8 58.7 32.4 34.7 39.0 45.0 53.0 58.4 59.0 58.1 54.8 48.2 39.4 33.7 46.3 425 33.17 95.00 0 54.2 59.6 67.6 75.3 82.4 89.9 94.2 94.6 88.0 78.4 65.6 57.0 75.6 41.8 46.2 54.2 61.8 70.4 78.3 82.2 81.6 74.8 63.7 52.7 44.5 62.7 29.3 32.7 40.7 48.3 58.3 66.6 70.1 68.5 61.6 49.0 39.7 32.0 49.7 1005 33.65 97.38 0 53.4 59.3 66.8 74.3 81.3 88.4 92.8 92.8 86.3 76.5 64.5 56.1 74.4 42.8 48.0 55.5 63.0 71.0 78.4 82.5 81.9 75.3 64.9 53.9 45.7 63.6 32.2 36.7 44.2 51.6 60.7 68.3 72.2 70.9 64.2 53.3 43.2 35.3 52.7 3825 34.23 102.73 0 51.7 57.2 65.1 73.2 81.8 89.8 91.9 89.6 83.2 74.0 61.3 52.8 72.6 36.0 40.6 47.5 55.9 65.3 74.1 77.2 75.3 68.4 57.4 45.0 37.1 56.7 20.2 23.9 29.9 38.6 48.7 58.4 62.4 60.9 53.5 40.8 28.6 21.4 40.6 3740 33.95 102.78 0 53.4 58.8 66.3 74.1 82.9 91.0 93.0 91.1 84.5 75.6 63.2 54.7 74.1 37.3 41.8 48.6 56.9 66.5 75.3 77.8 76.1 69.2 58.9 46.9 38.4 57.8 21.2 24.8 30.9 39.6 50.1 59.5 62.5 61.0 53.9 42.1 30.5 22.1 41.5 1480 33.45 99.62 0 54.8 60.3 68.6 77.7 84.9 92.2 96.5 95.3 87.8 78.3 65.9 56.5 76.6 41.5 46.3 54.3 63.6 72.1 80.1 83.9 82.7 75.2 64.8 52.5 43.7 63.4 28.1 32.3 39.9 49.4 59.3 68.0 71.2 70.0 62.5 51.2 39.1 30.9 50.2 435 31.62 94.65 0 56.5 61.8 69.4 76.3 83.3 89.6 93.5 93.9 88.1 78.9 67.5 59.3 76.5 46.5 50.8 58.5 65.4 73.8 80.3 83.9 83.6 77.7 67.3 56.4 48.8 66.1 36.4 39.7 47.5 54.5 64.2 71.0 74.3 73.2 67.3 55.6 45.2 38.2 55.6 454 31.95 96.70 0 56.6 62.1 69.9 77.4 84.6 91.7 96.6 96.9 90.7 81.0 68.1 59.2 77.9 44.2 49.2 57.1 64.6 72.7 79.8 83.8 83.6 77.2 66.9 55.5 46.7 65.1 31.7 36.3 44.3 51.7 60.8 67.8 71.0 70.3 63.6 52.7 42.8 34.1 52.3 710 29.73 98.12 1 61.7 66.6 74.1 79.9 85.7 91.2 94.7 95.3 90.3 81.9 71.2 63.6 79.7 48.6 52.8 60.2 66.4 73.9 79.8 82.7 82.6 77.8 68.6 58.5 50.8 66.9 35.5 38.9 46.3 52.8 62.1 68.3 70.6 69.9 65.2 55.3 45.8 37.9 54.1 72 29.27 95.90 1 63.2 66.6 72.9 78.5 84.7 90.0 92.9 93.3 89.8 83.0 73.4 65.6 79.5 52.5 55.9 62.4 68.3 75.1 80.5 82.7 82.6 78.9 71.0 62.3 54.7 68.9 41.7 45.1 51.9 58.1 65.5 70.9 72.4 71.9 67.9 58.9 51.2 43.8 58.3 400 29.27 97.75 1 62.2 66.1 73.0 79.4 85.2 90.7 94.0 94.7 89.9 81.9 71.3 63.9 79.4 50.5 54.2 61.2 68.0 74.9 80.3 83.0 83.2 78.7 70.1 60.0 52.6 68.1 38.8 42.3 49.4 56.6 64.5 69.9 71.9 71.6 67.5 58.2 48.6 41.3 56.7 1964 31.47 100.48 0 57.9 63.2 71.4 79.2 86.2 91.3 94.9 94.1 87.7 79.0 67.3 59.4 77.6 43.6 48.7 56.5 64.5 72.7 78.9 82.4 81.2 74.4 65.0 53.3 45.4 63.9 29.3 34.2 41.6 49.7 59.1 66.4 69.8 68.3 61.1 50.9 39.2 31.3 50.1 1195 33.37 98.77 0 55.9 62.0 70.7 78.6 85.3 91.9 96.7 96.5 89.0 79.3 66.3 57.7 77.5 43.2 48.4 56.5 64.4 72.4 79.9 84.3 83.7 76.4 66.2 53.8 45.2 64.5 30.4 34.8 42.3 50.2 59.4 67.9 71.8 70.9 63.8 53.1 41.2 32.6 51.5 3610 34.18 102.13 0 50.8 55.9 64.0 72.0 80.2 87.8 90.1 87.9 81.9 73.3 60.5 52.1 71.4 36.3 40.6 48.2 56.6 65.8 73.9 76.8 74.8 68.3 58.2 46.1 37.8 57.0 21.8 25.3 32.3 41.2 51.4 60.0 63.4 61.7 54.6 43.1 31.6 23.4 42.5 10 30.08 93.73 0 60.1 63.9 70.6 76.7 83.6 88.5 90.9 91.5 87.4 79.6 70.3 62.6 77.1 50.3 53.4 60.1 66.5 74.1 79.5 81.6 81.6 77.2 68.4 59.3 52.2 67.0 40.5 42.9 49.5 56.2 64.5 70.4 72.3 71.7 66.9 57.1 48.3 41.8 56.8 18 30.23 93.73 0 59.8 63.8 70.7 76.6 83.0 88.2 90.8 90.6 86.9 79.7 69.4 62.5 76.8 49.8 53.4 60.2 66.2 73.6 79.1 81.6 81.2 76.9 68.0 58.6 52.1 66.7 39.8 43.0 49.6 55.8 64.2 70.0 72.3 71.7 66.9 56.2 47.8 41.6 56.6 2340 30.68 101.20 0 58.9 63.9 71.9 79.3 85.9 90.3 93.0 92.3 86.7 78.0 67.0 59.7 77.2 43.3 48.0 55.9 63.9 72.3 78.0 80.5 79.6 73.8 64.0 52.7 44.5 63.0 27.7 32.0 39.8 48.5 58.7 65.7 68.0 66.9 60.8 50.0 38.3 29.3 48.8 1900 34.02 100.30 0 52.8 58.3 67.4 76.4 83.8 91.5 96.8 95.1 87.0 77.1 63.9 54.4 75.4 39.5 44.5 52.6 61.4 70.1 78.4 83.1 81.6 73.8 63.1 50.5 41.5 61.7 26.2 30.7 37.8 46.3 56.4 65.2 69.3 68.1 60.5 49.0 37.0 28.5 47.9 1625 31.50 99.92 0 61.3 66.7 74.8 82.8 89.2 93.9 97.4 96.5 89.9 81.8 70.0 62.4 80.6 46.6 51.6 59.4 67.2 75.1 80.9 84.1 83.2 76.6 67.5 55.9 47.9 66.3 31.9 36.4 44.0 51.6 61.0 67.8 70.7 69.8 63.2 53.1 41.8 33.4 52.1 12 28.73 96.25 1 61.8 64.5 70.3 76.2 82.5 87.6 89.7 90.2 87.2 80.6 71.5 64.3 77.2 52.9 55.8 62.1 68.5 75.7 81.1 83.4 83.0 79.0 71.3 62.2 55.1 69.2 44.0 47.0 53.8 60.7 68.8 74.6 77.0 75.8 70.8 62.0 52.9 45.9 61.1 465 31.78 95.60 0 58.3 63.4 71.5 77.7 83.8 89.7 93.9 94.4 88.6 79.9 68.1 60.1 77.5 47.9 52.4 60.0 66.2 73.2 79.3 82.9 82.7 77.1 67.7 57.4 49.7 66.4 37.4 41.3 48.4 54.7 62.6 68.9 71.8 71.0 65.5 55.5 46.7 39.2 55.3 3150 35.57 100.97 0 47.9 53.0 61.1 70.2 78.3 87.1 92.0 89.9 82.2 72.0 58.1 49.2 70.1 34.9 39.5 46.9 55.8 65.0 74.1 79.1 77.4 69.6 58.6 45.3 36.7 56.9 21.9 26.0 32.6 41.3 51.6 61.1 66.1 64.9 57.0 45.1 32.4 24.2 43.7 1689 30.17 101.55 0 61.8 67.0 75.3 82.4 89.5 93.6 95.9 95.4 90.2 81.1 69.7 62.5 80.4 46.1 50.9 59.7 67.6 76.4 81.9 84.3 83.5 77.4 67.7 55.5 47.0 66.5 30.4 34.8 44.1 52.8 63.3 70.2 72.7 71.5 64.5 54.3 41.3 31.5 52.6 1665 30.27 101.45 0 59.5 64.9 72.7 80.2 87.1 91.1 93.6 93.2 87.9 79.0 67.8 60.3 78.1 45.5 50.5 58.6 66.5 74.8 80.4 82.9 82.3 76.6 67.0 55.1 47.1 65.6 31.5 36.1 44.4 52.8 62.4 69.6 72.2 71.3 65.3 55.0 42.4 33.9 53.1 3532 35.42 101.37 0 47.5 52.9 61.7 70.5 78.4 86.9 90.8 88.8 81.8 71.4 57.5 47.9 69.7 33.4 38.0 45.6 54.5 63.4 72.4 76.6 75.2 67.9 56.7 43.5 34.6 55.2 19.3 23.1 29.4 38.4 48.3 57.8 62.4 61.5 54.0 42.0 29.5 21.2 40.6 3740 29.33 103.20 1 62.8 68.1 76.0 83.4 90.7 95.0 94.1 92.4 88.3 80.6 71.0 63.3 80.5 49.0 53.6 60.8 67.9 75.8 80.6 81.2 79.7 75.2 66.8 57.3 50.0 66.5 35.2 39.0 45.5 52.3 60.8 66.2 68.3 67.0 62.0 53.0 43.6 36.6 52.5 542 33.67 95.57 0 51.2 57.4 65.7 74.0 81.3 89.4 94.3 94.5 87.1 76.7 63.1 54.0 74.1 40.6 46.0 54.4 62.3 70.6 78.7 83.1 82.6 75.2 64.3 52.3 43.5 62.8 29.9 34.5 43.0 50.6 59.9 67.9 71.9 70.6 63.3 51.9 41.4 32.9 51.5 635 28.88 99.08 1 65.0 70.1 78.3 84.0 89.3 94.2 97.5 97.7 92.9 84.9 74.3 66.3 82.9 51.5 56.1 63.9 69.9 76.4 81.4 84.0 83.9 79.7 71.1 60.9 53.1 69.3 37.9 42.0 49.5 55.7 63.5 68.5 70.4 70.0 66.4 57.3 47.4 39.9 55.7 2610 31.42 103.50 0 59.9 66.4 75.0 83.1 91.2 97.8 98.5 96.6 90.2 81.6 69.7 61.2 80.9 44.0 49.1 56.4 64.6 73.8 81.6 83.7 82.1 75.3 65.0 52.7 44.9 64.4 28.1 31.7 37.7 46.1 56.3 65.3 68.8 67.5 60.4 48.4 35.6 28.6 47.9 2940 31.73 102.58 0 58.7 64.3 72.5 80.4 88.6 94.2 96.0 95.0 88.5 80.1 68.7 59.9 78.9 43.7 48.8 56.2 64.5 73.5 80.4 82.8 81.7 75.1 65.6 53.8 45.1 64.3 28.7 33.3 39.9 48.6 58.3 66.5 69.6 68.3 61.7 51.0 38.9 30.2 49.6 2942 36.38 100.82 0 45.1 50.8 58.8 68.2 76.0 85.7 91.4 89.4 81.7 71.5 56.7 46.8 68.5 31.8 36.8 44.5 53.4 62.8 72.6 78.1 76.5 68.4 57.1 43.1 33.9 54.9 18.4 22.8 30.2 38.6 49.6 59.4 64.8 63.5 55.0 42.7 29.4 21.0 41.3 2865 29.67 103.17 1 64.7 70.1 78.1 85.8 92.9 97.2 96.7 95.1 90.2 82.9 72.9 65.1 82.6 48.7 53.5 61.1 69.2 77.6 83.2 84.3 83.0 77.6 68.2 57.1 49.9 67.8 32.7 36.9 44.1 52.6 62.2 69.1 71.9 70.8 64.9 53.5 41.3 34.6 52.9 105 29.23 96.18 1 62.0 66.1 73.3 79.6 85.7 91.3 94.3 94.8 90.0 82.4 72.5 64.5 79.7 51.9 55.3 62.4 68.9 76.0 81.1 83.6 83.2 78.7 70.3 61.4 53.8 68.9 41.8 44.5 51.4 58.1 66.3 70.9 72.8 71.6 67.3 58.2 50.3 43.1 58.0 690 33.38 96.97 0 52.9 58.9 67.4 75.3 83.2 90.8 96.6 96.2 88.8 78.4 64.9 56.1 75.8 41.5 46.6 54.5 62.6 71.6 79.8 85.0 84.3 76.8 66.0 53.0 44.3 63.8 30.0 34.2 41.5 49.9 59.9 68.7 73.4 72.3 64.8 53.6 41.0 32.5 51.8 5600 31.88 104.82 0 52.1 55.9 62.2 69.4 77.3 85.3 85.1 83.1 77.6 70.3 59.5 53.3 69.3 41.4 45.1 50.0 57.6 65.7 73.2 73.7 72.1 67.0 59.3 48.9 42.0 58.0 30.6 34.2 37.8 45.7 54.1 61.0 62.3 61.1 56.4 48.3 38.3 30.6 46.7 3675 33.18 102.83 0 53.1 59.5 67.2 75.1 83.4 90.4 91.7 89.9 83.9 75.7 63.2 55.3 74.0 39.1 44.4 50.9 59.0 68.2 75.8 78.2 76.6 70.4 60.4 48.1 40.8 59.3 25.1 29.2 34.6 42.9 52.9 61.2 64.6 63.3 56.8 45.0 32.9 26.3 44.6 3370 34.18 101.70 0 49.0 54.5 62.7 71.3 79.9 87.8 91.0 88.6 82.2 73.1 59.7 50.6 70.9 36.7 41.6 49.1 57.9 67.4 75.7 79.0 76.8 69.9 59.7 47.0 38.4 58.3 24.4 28.6 35.4 44.4 54.8 63.5 66.9 65.0 57.6 46.2 34.2 26.1 45.6 20 28.65 96.55 1 64.6 68.1 74.2 79.2 84.6 89.6 91.8 91.8 89.0 82.6 73.9 67.0 79.7 55.2 58.5 64.9 70.4 77.1 82.4 84.7 84.4 80.3 73.1 64.3 57.3 71.1 45.7 48.8 55.6 61.6 69.5 75.1 77.5 76.9 71.6 63.6 54.7 47.6 62.4 12 27.83 97.05 1 62.5 65.3 72.2 77.6 83.8 88.6 89.9 90.3 88.1 82.2 73.8 66.1 78.4 56.1 58.7 66.1 71.8 78.3 83.2 84.4 85.0 82.6 76.4 67.5 59.3 72.5 49.7 52.1 59.9 65.9 72.7 77.7 78.9 79.6 77.0 70.5 61.1 52.5 66.5 16 29.95 94.02 0 61.5 65.3 72.0 77.8 84.3 89.4 91.6 91.7 88.0 80.5 70.9 63.9 78.1 52.2 55.6 62.2 68.2 75.4 80.9 82.7 82.5 78.7 70.1 60.9 54.2 68.6 42.9 45.9 52.4 58.6 66.4 72.3 73.8 73.2 69.4 59.6 50.8 44.5 59.2 17 26.07 97.22 1 67.4 70.0 75.0 79.0 83.7 87.7 89.2 89.3 87.3 83.1 76.4 69.0 79.8 59.7 62.4 68.3 73.1 78.5 82.2 83.4 83.4 81.2 76.4 69.5 61.5 73.3 52.0 54.8 61.6 67.2 73.2 76.7 77.5 77.4 75.1 69.7 62.5 54.0 66.8 9 26.55 97.43 1 64.8 67.9 73.7 77.8 82.4 86.9 88.7 88.7 86.3 81.0 73.9 67.0 78.3 56.8 60.3 67.0 72.0 77.5 81.5 83.0 82.8 79.8 74.0 66.7 59.1 71.7 48.8 52.6 60.2 66.1 72.6 76.0 77.3 76.9 73.2 67.0 59.4 51.1 65.1 5 28.43 96.43 1 60.6 63.7 69.6 75.1 80.7 86.0 88.2 89.4 86.5 81.1 71.9 64.1 76.4 54.3 57.4 64.1 70.0 76.4 81.7 83.9 84.1 80.9 74.1 65.0 57.0 70.7 47.9 51.1 58.6 64.8 72.1 77.4 79.5 78.8 75.3 67.0 58.1 49.8 65.0 2620 33.18 101.38 0 54.2 60.1 68.4 76.8 84.2 90.8 94.0 92.3 85.3 77.0 64.7 56.1 75.3 41.0 45.8 53.3 61.7 70.4 78.1 81.8 80.4 73.3 63.8 51.3 43.1 62.0 27.8 31.5 38.2 46.6 56.5 65.3 69.6 68.4 61.2 50.5 37.9 30.1 48.6 480 29.03 98.58 1 63.7 68.2 75.9 82.1 87.2 92.5 95.9 96.1 91.9 83.7 73.6 65.5 81.4 51.4 55.2 62.9 69.4 76.3 81.3 84.3 84.2 80.2 71.4 61.4 53.2 69.3 39.0 42.1 49.9 56.6 65.3 70.1 72.6 72.3 68.4 59.0 49.2 40.9 57.1 2052 29.92 99.77 0 59.8 63.8 70.8 77.0 82.4 88.0 91.0 90.9 86.1 77.4 67.1 60.3 76.2 45.3 49.1 56.7 63.9 71.3 77.2 79.6 79.0 73.8 64.2 53.9 46.3 63.4 30.7 34.4 42.6 50.7 60.1 66.3 68.2 67.1 61.4 50.9 40.6 32.3 50.4 2560 29.55 104.35 1 69.1 75.4 83.1 90.0 97.0 102.1 100.8 99.0 94.8 87.1 76.6 69.0 87.0 51.8 57.4 64.4 71.8 80.1 86.9 87.3 85.7 80.8 71.7 59.8 52.4 70.8 34.5 39.3 45.7 53.6 63.2 71.6 73.7 72.3 66.8 56.2 43.0 35.7 54.6 1221 31.97 98.50 0 57.1 62.1 70.2 77.5 84.1 90.9 95.5 95.3 88.8 80.0 67.8 59.5 77.4 43.9 48.7 56.8 64.4 72.3 79.3 83.0 82.4 75.9 66.3 54.9 46.4 64.5 30.6 35.2 43.3 51.2 60.4 67.7 70.4 69.4 63.0 52.5 42.0 33.3 51.6 1591 32.37 99.18 0 55.3 60.8 68.5 76.7 83.8 90.7 94.9 94.4 87.2 77.9 65.6 56.8 76.1 43.2 48.4 55.7 64.3 72.2 79.4 83.3 82.7 75.7 66.1 54.1 45.3 64.2 31.1 36.0 42.8 51.9 60.5 68.1 71.6 70.9 64.1 54.2 42.6 33.8 52.3 1495 34.25 99.68 0 52.1 57.4 66.3 75.3 83.4 91.7 96.5 94.4 86.4 76.8 63.5 54.5 74.9 38.4 43.6 52.3 61.2 70.5 79.3 83.9 82.1 74.0 62.8 50.1 40.8 61.6 24.6 29.7 38.3 47.0 57.6 66.9 71.3 69.7 61.5 48.8 36.6 27.1 48.3 31 26.48 97.82 1 68.6 72.6 79.6 84.4 88.4 92.4 95.3 95.5 91.2 85.4 77.3 70.1 83.4 58.1 61.4 68.3 73.6 78.9 82.7 84.5 84.7 81.1 74.6 66.6 59.5 72.8 47.5 50.2 56.9 62.7 69.4 72.9 73.7 73.8 70.9 63.7 55.8 48.9 62.2 2800 31.90 103.93 0 61.8 67.9 76.1 84.0 91.5 98.5 98.4 96.4 90.3 82.1 70.7 62.7 81.7 45.6 50.6 57.9 65.8 74.4 82.0 83.7 81.9 75.5 65.9 54.2 46.5 65.3 29.4 33.2 39.7 47.6 57.3 65.4 68.9 67.4 60.7 49.7 37.6 30.3 48.9 520 29.97 97.45 0 60.2 64.7 72.5 79.4 85.3 91.3 95.3 95.8 90.4 81.7 70.4 62.4 79.1 47.5 51.6 59.5 66.5 73.9 80.0 82.9 82.8 77.3 68.4 57.8 49.7 66.5 34.7 38.5 46.4 53.6 62.5 68.6 70.5 69.7 64.2 55.1 45.2 37.0 53.8 49 28.30 97.28 1 67.7 71.4 77.1 81.0 86.3 91.4 94.2 94.4 91.1 84.2 75.2 68.7 81.9 56.1 59.3 65.7 70.5 77.0 81.8 83.9 83.7 80.2 72.5 63.9 57.3 71.0 44.5 47.2 54.2 59.9 67.6 72.1 73.5 72.9 69.2 60.7 52.5 45.9 60.0 54 28.38 97.28 1 66.1 69.4 76.3 80.8 85.9 90.8 94.3 94.6 90.7 84.3 75.2 68.0 81.4 55.0 58.4 65.2 70.5 76.7 81.5 83.7 83.7 80.1 72.5 64.0 56.6 70.7 43.9 47.4 54.1 60.2 67.4 72.2 73.0 72.8 69.4 60.6 52.7 45.1 59.9 172 26.38 98.82 1 69.4 74.2 82.5 88.3 92.3 96.7 99.1 99.3 94.1 86.8 78.1 70.5 85.9 57.0 61.2 69.0 75.4 81.0 85.1 86.7 86.7 82.4 74.7 66.0 58.3 73.6 44.5 48.1 55.5 62.4 69.7 73.4 74.3 74.1 70.6 62.5 53.9 46.1 61.3 1633 32.08 98.97 0 55.1 60.3 68.7 76.9 83.8 89.8 94.1 93.7 87.1 78.1 66.0 57.4 75.9 42.4 47.3 55.1 63.2 71.5 78.2 81.9 81.3 74.8 65.0 53.4 44.8 63.2 29.7 34.3 41.5 49.5 59.2 66.6 69.7 68.8 62.4 51.9 40.7 32.2 50.5 1780 31.90 100.48 0 57.4 63.0 71.2 79.8 86.9 92.7 96.4 95.3 88.6 79.5 67.4 59.0 78.1 43.2 48.2 56.2 64.7 73.6 80.6 84.2 83.1 76.1 65.9 53.7 45.1 64.6 29.0 33.4 41.1 49.6 60.2 68.4 72.0 70.8 63.6 52.2 39.9 31.1 50.9 85 27.78 97.67 1 65.9 70.0 77.0 82.4 86.8 92.0 95.0 95.1 91.4 84.3 75.7 68.0 82.0 55.5 59.1 66.3 72.3 78.0 82.8 84.9 85.1 81.5 74.0 65.4 57.6 71.9 45.1 48.2 55.6 62.1 69.2 73.5 74.8 75.0 71.5 63.7 55.0 47.2 61.7 9 28.03 97.05 1 63.0 65.5 71.2 76.8 82.5 87.8 90.1 90.3 88.1 81.6 72.7 65.6 77.9 54.0 57.0 63.4 70.1 76.7 82.0 83.8 83.8 80.7 73.5 63.9 56.4 70.4 44.9 48.4 55.6 63.3 70.9 76.2 77.5 77.2 73.2 65.3 55.1 47.1 62.9 2400 30.02 100.22 0 58.9 63.9 70.4 77.9 83.9 88.3 91.6 91.3 86.3 77.7 66.7 59.7 76.4 46.6 50.9 57.3 64.9 72.0 77.0 79.9 79.5 74.8 66.1 55.3 47.8 64.3 34.3 37.9 44.2 51.9 60.0 65.7 68.1 67.6 63.3 54.4 43.8 35.8 52.3 2380 32.45 100.53 0 54.9 61.4 69.4 78.0 84.7 90.5 93.8 92.4 85.1 76.3 64.8 56.2 75.6 41.9 47.0 54.2 63.3 71.6 78.5 81.8 80.6 73.5 63.9 52.2 43.6 62.7 28.9 32.6 38.9 48.5 58.4 66.5 69.8 68.7 61.8 51.4 39.6 30.9 49.7 1935 32.85 100.47 0 55.4 61.4 69.1 77.5 84.4 90.8 94.2 92.9 85.8 76.7 64.8 56.3 75.8 41.3 46.2 53.4 62.2 70.7 77.9 81.7 80.6 73.6 63.3 51.3 42.9 62.1 27.2 31.0 37.7 46.8 57.0 64.9 69.1 68.2 61.4 49.8 37.7 29.4 48.4 720 31.82 95.15 0 55.5 60.8 68.5 75.2 81.9 88.4 92.8 93.1 87.5 77.9 66.5 58.1 75.5 46.2 50.6 58.0 64.7 72.3 78.9 82.6 82.5 77.1 67.5 57.0 48.8 65.5 36.8 40.4 47.4 54.2 62.6 69.3 72.4 71.8 66.6 57.0 47.4 39.5 55.5 189 31.07 94.10 0 57.5 62.5 70.2 76.9 84.5 91.0 94.5 94.6 89.3 79.7 68.1 60.3 77.4 46.4 50.5 58.3 64.8 73.1 79.5 82.3 81.8 77.0 66.7 56.6 49.0 65.5 35.2 38.4 46.3 52.6 61.6 67.9 70.1 69.0 64.6 53.6 45.0 37.6 53.5 1916 31.35 100.50 0 57.9 63.5 71.1 79.0 85.6 90.8 94.4 93.1 86.6 77.8 66.5 59.3 77.1 44.9 49.7 57.2 65.0 73.1 79.2 82.4 81.3 74.8 65.4 54.0 46.4 64.5 31.8 36.0 43.3 51.0 60.6 67.6 70.4 69.4 63.0 53.0 41.4 33.5 51.8 809 29.53 98.47 1 62.1 67.1 74.3 80.4 86.0 91.4 94.6 94.7 90.0 82.0 71.4 64.0 79.8 50.3 54.7 62.1 68.6 75.8 81.5 84.3 84.2 79.4 70.7 60.0 52.4 68.7 38.6 42.4 49.9 56.9 65.5 71.6 74.0 73.6 68.8 59.4 48.6 40.8 57.5 612 29.87 97.92 0 61.1 65.8 73.4 79.6 85.7 91.5 95.1 95.4 90.7 82.3 71.3 63.3 79.6 49.9 53.9 61.6 68.2 75.6 81.5 84.4 84.4 79.7 70.5 59.9 52.1 68.5 38.6 42.0 49.7 56.8 65.5 71.5 73.7 73.4 68.6 58.7 48.5 40.8 57.3 1195 31.18 98.72 0 58.7 63.3 71.3 78.7 85.1 91.4 95.8 95.2 89.3 80.5 68.7 60.5 78.2 46.1 50.8 58.7 66.0 73.7 80.0 83.6 82.7 77.0 67.4 56.3 47.9 65.9 33.4 38.2 46.0 53.3 62.2 68.6 71.4 70.1 64.7 54.3 43.9 35.2 53.4 2855 30.15 102.40 0 60.1 64.5 72.3 79.8 86.4 90.5 91.9 91.1 86.1 77.5 68.1 61.0 77.4 45.3 49.6 57.4 65.2 73.3 78.7 80.4 79.5 74.0 64.2 53.9 46.6 64.0 30.5 34.6 42.4 50.6 60.1 66.8 68.9 67.9 61.9 50.9 39.7 32.1 50.5 50 26.27 97.87 1 69.1 73.7 81.0 84.9 89.4 93.5 96.0 95.8 91.6 86.3 78.8 71.2 84.3 58.3 62.5 69.4 74.2 79.8 83.8 85.3 85.1 81.3 74.9 67.7 60.3 73.6 47.5 51.2 57.8 63.4 70.2 74.0 74.6 74.3 71.0 63.5 56.6 49.3 62.8 194 29.78 96.13 0 62.0 66.1 73.0 79.3 85.8 91.4 94.9 95.1 90.1 82.7 71.6 64.4 79.7 51.4 54.9 61.8 68.1 75.3 81.0 83.6 83.5 78.9 70.6 60.5 53.3 68.6 40.7 43.7 50.5 56.9 64.7 70.5 72.2 71.9 67.6 58.5 49.3 42.2 57.4 940 29.45 98.70 1 61.4 66.3 74.2 80.3 86.1 91.2 94.6 94.6 90.0 81.8 70.7 63.4 79.6 51.0 55.3 62.7 68.8 75.5 80.9 83.5 83.6 79.2 71.1 60.3 52.9 68.7 40.5 44.2 51.2 57.2 64.8 70.6 72.4 72.5 68.4 60.4 49.8 42.3 57.9 3340 32.72 102.55 0 55.0 60.9 69.1 77.6 85.6 92.3 94.1 92.1 85.8 77.3 65.0 56.6 76.0 40.9 45.7 52.7 61.1 70.3 78.0 80.6 78.8 72.4 62.4 50.2 42.3 61.3 26.7 30.4 36.3 44.6 54.9 63.6 67.0 65.5 58.9 47.4 35.3 28.0 46.6 1287 33.60 99.27 0 52.7 58.1 67.1 75.8 83.6 91.1 96.5 95.6 87.4 77.4 64.0 55.0 75.4 40.2 45.2 53.7 62.2 71.1 79.3 84.2 83.2 75.2 64.4 51.4 42.5 62.7 27.7 32.2 40.2 48.6 58.6 67.4 71.8 70.7 62.9 51.4 38.8 29.9 50.0 2360 35.22 100.25 0 48.4 54.1 62.4 71.6 79.2 87.6 93.3 91.5 83.6 73.0 59.4 50.1 71.2 35.7 40.8 48.5 57.8 66.7 75.6 80.8 79.2 71.2 59.9 46.8 37.8 58.4 22.9 27.4 34.5 44.0 54.2 63.5 68.2 66.9 58.8 46.7 34.2 25.5 45.6 2170 30.68 101.83 0 61.7 67.1 75.7 83.1 89.7 94.0 95.9 95.1 89.3 80.4 69.6 62.2 80.3 46.0 50.9 59.4 66.6 75.2 81.4 83.6 82.5 76.2 66.1 54.7 46.8 65.8 30.3 34.7 43.1 50.1 60.6 68.7 71.2 69.9 63.0 51.7 39.7 31.4 51.2 760 33.70 96.63 0 50.8 56.5 64.9 72.8 79.9 87.7 92.7 92.3 85.1 75.2 62.4 53.3 72.8 41.5 46.7 54.8 62.5 70.3 78.2 82.8 82.2 75.1 64.8 52.9 44.0 63.0 32.2 36.9 44.7 52.2 60.7 68.7 72.9 72.0 65.1 54.3 43.3 34.6 53.1 4535 31.18 105.32 0 57.2 62.8 69.5 77.2 85.5 93.0 92.0 89.8 85.0 77.2 66.3 57.9 76.1 41.2 45.8 51.8 59.0 68.4 76.4 77.5 75.6 70.0 60.5 49.3 41.6 59.8 25.1 28.7 34.0 40.7 51.2 59.8 62.9 61.4 54.9 43.7 32.2 25.3 43.3 3280 34.47 101.30 0 49.9 55.0 62.9 71.4 79.0 87.2 90.9 88.8 82.2 73.1 60.0 51.4 71.0 35.8 40.5 47.6 55.9 65.1 74.0 78.1 76.2 69.1 58.7 45.7 37.5 57.0 21.6 26.0 32.3 40.4 51.1 60.8 65.2 63.6 55.9 44.2 31.3 23.6 43.0 51 28.03 97.50 1 64.0 67.5 74.0 79.0 83.9 89.0 91.7 92.5 89.0 82.4 73.1 66.3 79.4 54.1 57.4 64.3 69.8 76.0 81.4 83.4 83.5 79.6 72.2 63.1 56.0 70.1 44.2 47.3 54.5 60.6 68.0 73.7 75.0 74.4 70.2 61.9 53.1 45.7 60.7 340 30.02 97.15 0 61.3 65.4 73.0 79.7 85.2 91.5 95.4 96.3 90.8 82.1 71.0 63.1 79.6 49.0 52.8 60.4 67.6 74.7 81.0 83.9 83.9 78.6 69.5 59.0 51.0 67.6 36.7 40.1 47.8 55.4 64.2 70.4 72.3 71.4 66.3 56.8 47.0 38.9 55.6 2335 32.72 100.92 0 54.8 60.3 69.0 77.4 85.0 91.2 94.6 92.8 86.1 77.4 65.0 56.6 75.9 40.8 45.7 53.6 62.1 71.1 78.4 81.8 80.2 73.4 63.5 51.0 42.5 62.0 26.7 31.1 38.2 46.7 57.2 65.5 68.9 67.6 60.7 49.6 36.9 28.4 48.1 263 30.33 96.53 0 60.8 65.0 72.3 79.2 86.1 92.7 96.7 96.9 91.5 82.4 71.0 63.3 79.8 48.6 52.7 60.2 67.5 75.2 81.8 85.0 84.7 79.1 69.5 59.0 51.0 67.9 36.4 40.3 48.1 55.7 64.2 70.8 73.3 72.4 66.7 56.6 46.9 38.6 55.8 2138 30.58 100.65 0 58.9 64.2 71.3 79.4 86.5 91.4 94.7 93.8 87.6 78.3 67.3 59.4 77.7 43.1 48.3 55.5 64.4 72.8 78.8 81.4 80.4 74.2 64.2 53.4 44.6 63.4 27.2 32.3 39.6 49.3 59.1 66.2 68.0 66.9 60.7 50.1 39.4 29.7 49.0 3094 36.18 101.18 0 52.7 58.5 66.9 75.4 82.6 91.4 95.5 93.6 87.1 77.4 63.3 53.8 74.9 37.6 42.5 50.3 58.8 67.4 76.4 80.7 79.2 72.0 61.3 47.9 39.1 59.4 22.4 26.5 33.6 42.2 52.1 61.4 65.9 64.7 56.9 45.1 32.5 24.4 44.0 2297 33.48 100.88 0 53.7 58.9 67.4 76.6 84.1 91.7 95.4 93.6 85.8 76.9 64.5 55.2 75.3 39.6 44.2 51.7 60.5 69.4 77.5 81.2 79.9 72.4 62.2 49.8 41.2 60.8 25.5 29.4 36.0 44.3 54.6 63.2 67.0 66.1 58.9 47.5 35.0 27.1 46.2 1640 32.93 99.80 0 55.0 60.4 69.6 78.2 86.0 93.0 96.9 95.9 88.3 78.7 65.7 56.7 77.0 41.4 46.6 54.7 63.7 72.4 80.1 84.0 83.0 75.6 65.5 52.5 43.3 63.6 27.7 32.8 39.7 49.2 58.8 67.1 71.1 70.0 62.9 52.2 39.2 29.9 50.1 1309 32.25 98.20 0 55.0 59.8 67.7 75.3 81.8 88.8 93.6 93.4 86.5 77.6 65.5 57.1 75.2 42.5 47.4 55.0 63.2 70.9 78.2 81.9 81.4 74.8 64.9 53.2 45.1 63.2 30.0 35.0 42.3 51.0 60.0 67.5 70.1 69.3 63.0 52.2 40.9 33.0 51.2 2265 31.83 100.98 0 57.4 63.0 71.3 79.9 86.6 91.8 94.7 93.8 87.2 79.0 67.5 59.5 77.6 42.4 47.6 55.5 64.5 72.8 79.2 81.9 81.0 74.3 64.4 52.8 44.3 63.4 27.4 32.2 39.6 49.0 58.9 66.5 69.1 68.1 61.4 49.7 38.1 29.0 49.1 706 31.03 97.53 0 58.7 63.8 71.5 78.5 84.9 91.4 96.0 96.0 90.0 80.8 69.1 61.1 78.5 46.6 51.3 58.9 66.1 73.7 80.3 84.0 83.7 78.0 68.3 57.3 49.2 66.5 34.4 38.7 46.3 53.7 62.5 69.2 72.0 71.3 65.9 55.8 45.5 37.3 54.4 3691 36.35 102.08 0 46.7 52.2 60.0 68.7 76.8 86.4 91.1 89.0 81.7 71.4 57.7 48.0 69.1 32.6 37.4 44.4 52.9 62.0 71.9 76.8 75.1 67.2 55.9 42.8 34.3 54.4 18.5 22.6 28.7 37.0 47.2 57.3 62.4 61.2 52.7 40.3 27.9 20.6 39.7 82 29.62 95.63 1 61.9 65.7 72.5 79.1 85.6 90.7 93.7 93.6 89.1 81.7 71.9 64.3 79.2 51.8 55.1 62.0 68.7 76.0 81.5 84.1 83.8 79.3 70.8 61.4 53.8 69.0 41.6 44.5 51.4 58.2 66.4 72.2 74.4 74.0 69.4 59.9 50.9 43.2 58.8 495 33.15 95.63 0 53.9 59.2 66.8 74.6 82.0 89.8 94.8 95.6 89.0 78.9 65.8 56.8 75.6 42.5 47.5 55.2 62.7 71.1 78.8 83.2 83.0 76.2 65.5 54.0 45.4 63.8 31.1 35.7 43.6 50.7 60.1 67.8 71.6 70.4 63.4 52.1 42.2 33.9 51.9 3120 33.17 101.80 0 52.7 58.6 66.8 75.2 82.9 89.8 92.2 90.5 84.0 75.5 62.9 54.9 73.8 38.9 43.8 50.8 59.4 68.4 76.1 79.2 77.6 71.0 61.3 48.8 41.2 59.7 25.1 29.0 34.7 43.5 53.9 62.3 66.1 64.6 58.0 47.0 34.6 27.4 45.5 565 30.57 97.42 0 59.2 64.0 72.3 78.9 85.3 91.3 95.3 95.7 90.2 81.0 69.2 61.1 78.6 47.5 51.8 59.6 66.3 73.9 80.2 83.6 83.5 78.0 68.6 57.4 49.5 66.7 35.8 39.5 46.9 53.6 62.5 69.0 71.9 71.3 65.8 56.2 45.5 37.8 54.7 635 31.08 97.32 0 57.2 61.9 69.6 77.0 83.5 90.2 95.0 95.2 89.3 79.7 67.9 59.2 77.1 46.1 50.5 58.0 65.5 73.1 79.9 83.7 83.7 77.8 67.9 56.6 48.4 65.9 34.9 39.0 46.3 53.9 62.7 69.5 72.4 72.2 66.2 56.1 45.3 37.6 54.7 390 33.42 94.08 0 52.5 58.3 66.5 74.6 81.6 88.9 93.1 93.1 86.3 76.5 63.9 55.1 74.2 41.6 46.3 54.2 62.3 71.0 78.6 82.6 81.8 75.0 64.1 52.5 44.3 62.9 30.7 34.3 41.8 50.0 60.4 68.3 72.0 70.5 63.6 51.7 41.1 33.5 51.5 72 29.48 95.63 1 62.4 66.1 73.0 79.3 85.7 91.0 93.7 93.9 89.7 82.3 72.6 65.0 79.6 52.8 56.0 62.9 68.9 75.9 81.4 83.8 83.7 79.5 71.2 62.5 55.1 69.5 43.2 45.8 52.7 58.5 66.0 71.8 73.8 73.4 69.3 60.1 52.3 45.2 59.3 1370 33.18 99.18 0 54.7 60.1 68.6 76.7 84.5 91.7 96.8 96.0 88.6 78.7 65.8 57.0 76.6 41.4 46.1 54.4 62.3 71.1 79.1 83.7 82.7 75.4 64.9 52.6 44.0 63.1 28.1 32.1 40.1 47.9 57.7 66.5 70.5 69.4 62.1 51.0 39.3 30.9 49.6 345 28.42 98.53 1 66.2 71.3 79.3 85.4 90.8 95.7 98.7 98.6 93.6 85.6 75.3 67.7 84.0 53.2 57.7 65.4 71.6 78.4 83.2 85.5 85.1 80.6 72.3 62.7 55.0 70.9 40.1 44.1 51.5 57.8 66.0 70.7 72.2 71.5 67.6 59.0 50.1 42.2 57.7 190 31.18 93.57 0 57.4 61.4 69.0 76.0 84.1 90.4 93.9 93.5 88.4 79.5 68.5 60.6 76.9 46.4 49.7 57.3 63.9 72.3 78.9 82.0 81.4 76.4 66.3 56.3 49.0 65.0 35.3 38.0 45.5 51.8 60.5 67.3 70.1 69.2 64.3 53.1 44.1 37.3 53.0 3525 31.40 106.05 0 59.5 66.2 73.1 81.0 89.1 96.4 95.3 92.4 88.1 80.0 67.8 59.6 79.0 43.3 49.1 55.2 62.5 70.4 78.6 80.2 78.1 72.9 62.5 50.2 43.3 62.2 27.0 31.9 37.3 43.9 51.7 60.7 65.1 63.7 57.7 45.0 32.6 26.9 45.3 214 30.80 94.18 0 59.2 63.9 70.7 76.9 83.6 89.2 92.1 92.3 87.6 79.0 68.8 61.6 77.1 48.8 52.6 59.7 65.9 73.5 79.3 81.9 81.7 77.2 67.6 58.3 51.0 66.5 38.3 41.3 48.7 54.9 63.3 69.3 71.6 71.0 66.8 56.1 47.7 40.3 55.8 1571 33.75 99.87 0 54.2 59.6 68.6 77.8 85.8 93.6 98.5 96.5 88.7 78.8 65.2 56.1 77.0 40.7 45.5 53.8 63.0 71.9 80.3 84.9 83.1 75.5 64.8 51.8 42.9 63.2 27.1 31.4 38.9 48.2 57.9 67.0 71.3 69.6 62.2 50.8 38.3 29.6 49.4 3470 34.53 101.77 0 50.4 55.3 63.2 71.6 79.5 87.9 91.1 89.2 83.1 73.9 60.6 51.6 71.5 36.3 40.6 47.6 56.0 65.1 74.1 77.8 76.1 69.5 59.0 46.1 37.7 57.2 22.2 25.8 32.0 40.4 50.7 60.2 64.4 63.0 55.8 44.1 31.6 23.8 42.8 2330 34.40 100.90 0 52.5 58.8 66.7 75.7 83.0 90.6 94.9 93.0 85.8 76.4 63.3 53.8 74.5 38.1 43.5 50.8 60.2 68.9 77.0 81.3 79.5 72.2 61.7 49.1 39.9 60.2 23.7 28.1 34.8 44.7 54.7 63.3 67.7 66.0 58.5 46.9 34.8 26.0 45.8 550 32.30 95.30 0 57.2 63.5 72.0 78.3 83.9 90.0 93.6 94.0 88.1 78.5 66.6 58.4 77.0 47.5 52.4 60.3 66.6 73.3 79.9 83.4 83.3 77.4 67.4 57.5 49.1 66.5 37.7 41.2 48.6 54.8 62.7 69.8 73.1 72.5 66.7 56.3 48.3 39.8 56.0 912 29.22 99.77 1 63.9 69.1 76.0 82.7 87.9 92.7 95.9 95.9 91.5 82.9 72.4 65.4 81.4 50.6 55.4 62.4 70.0 76.7 81.7 83.9 83.6 79.5 70.6 60.0 52.7 68.9 37.2 41.7 48.8 57.2 65.5 70.7 71.8 71.2 67.4 58.2 47.6 39.9 56.4 920 29.18 99.83 1 64.0 68.5 76.5 82.4 89.4 94.3 97.3 96.9 92.0 83.5 72.5 64.7 81.8 50.3 54.9 62.8 69.4 76.8 82.0 84.3 84.0 79.3 70.5 59.7 51.6 68.8 36.5 41.3 49.0 56.3 64.2 69.7 71.2 71.0 66.6 57.4 46.8 38.5 55.7 4430 30.58 104.50 0 60.1 65.6 72.1 80.0 87.4 93.9 91.9 90.2 86.4 78.9 67.9 60.6 77.9 43.4 48.0 54.1 61.6 69.7 77.2 77.2 75.6 71.3 62.5 51.3 44.4 61.4 26.7 30.4 36.0 43.1 52.0 60.4 62.4 60.9 56.1 46.0 34.6 28.2 44.7 3955 31.05 104.83 0 57.6 63.1 69.9 77.4 85.4 92.5 91.7 89.6 84.5 76.9 66.1 58.0 76.1 42.7 47.3 53.7 60.8 69.6 77.5 78.3 76.5 70.8 61.8 50.8 43.2 61.1 27.8 31.4 37.5 44.1 53.8 62.4 64.8 63.4 57.1 46.7 35.4 28.4 46.1 1227 34.15 99.33 0 52.1 58.3 67.0 75.4 83.9 92.0 97.2 95.6 87.1 77.2 63.6 54.3 75.3 38.9 44.5 52.9 61.7 71.3 79.8 84.5 83.0 74.9 63.8 50.8 41.3 62.3 25.7 30.7 38.8 48.0 58.7 67.5 71.8 70.4 62.6 50.4 38.0 28.3 49.2 115 28.87 96.93 1 62.8 66.6 73.4 79.2 85.1 90.3 93.4 93.7 89.9 83.0 73.0 65.2 79.6 53.2 56.7 63.7 69.7 76.6 81.8 84.2 84.2 80.1 72.3 62.7 55.2 70.0 43.6 46.7 53.9 60.1 68.1 73.3 75.0 74.6 70.3 61.6 52.3 45.2 60.4 495 31.60 97.22 0 56.9 62.3 70.0 77.6 84.2 91.4 95.9 95.9 89.7 79.5 67.5 59.4 77.5 45.1 49.9 57.8 65.5 73.5 80.7 84.9 84.4 78.0 67.5 56.1 47.7 65.9 33.3 37.5 45.5 53.4 62.7 70.0 73.9 72.9 66.2 55.4 44.7 36.0 54.3 500 31.62 97.23 0 57.0 62.3 70.2 77.6 84.8 92.0 96.7 96.9 90.1 80.4 67.8 59.1 77.9 46.1 50.8 58.5 65.9 74.1 81.3 85.4 85.2 78.6 68.6 56.8 48.3 66.6 35.1 39.3 46.8 54.2 63.3 70.6 74.1 73.5 67.0 56.7 45.8 37.5 55.3 215 30.33 96.15 0 59.9 64.1 71.8 78.4 85.4 91.5 95.6 96.1 90.4 81.9 70.7 62.4 79.0 49.1 53.1 60.7 67.2 74.9 81.0 83.9 83.9 78.5 69.2 59.4 51.3 67.7 38.2 42.0 49.5 55.9 64.3 70.4 72.1 71.6 66.6 56.5 48.0 40.1 56.3 2120 31.67 100.73 0 58.1 63.6 71.9 79.6 86.4 91.0 94.6 93.4 87.2 78.9 67.5 59.4 77.6 43.0 47.5 55.6 63.4 71.8 78.1 81.5 80.2 73.7 64.1 52.1 44.3 62.9 27.8 31.3 39.2 47.1 57.2 65.1 68.4 66.9 60.1 49.2 36.7 29.2 48.2 630 32.42 96.85 0 56.9 62.7 70.6 77.5 84.3 91.5 96.0 95.8 89.3 80.1 67.4 58.9 77.6 46.0 51.1 58.8 65.8 73.5 80.5 84.6 84.1 77.8 68.2 56.6 48.2 66.3 35.0 39.4 46.9 54.1 62.6 69.5 73.2 72.4 66.2 56.2 45.7 37.5 54.9 955 32.75 97.77 0 54.2 59.5 67.8 75.8 82.7 90.1 95.2 95.2 88.0 78.1 65.6 56.9 75.8 41.6 46.7 54.6 62.7 71.1 78.8 83.3 82.7 75.4 64.8 53.0 44.3 63.3 29.0 33.9 41.3 49.6 59.5 67.4 71.3 70.1 62.8 51.4 40.4 31.7 50.7 50 28.10 97.42 1 64.6 68.8 74.2 79.7 84.5 89.7 92.4 93.2 89.7 83.5 74.5 67.0 80.2 54.0 58.2 64.4 70.3 76.4 81.3 83.5 83.8 80.0 72.5 63.9 56.2 70.4 43.4 47.5 54.5 60.9 68.2 72.9 74.5 74.3 70.3 61.4 53.2 45.4 60.5 2040 34.83 100.22 0 54.2 59.6 69.4 78.3 85.3 93.0 97.9 96.0 88.7 78.4 64.6 55.4 76.7 40.6 45.4 54.0 62.4 71.0 79.1 83.8 82.1 74.7 64.1 51.1 42.5 62.6 27.0 31.2 38.6 46.4 56.7 65.1 69.6 68.1 60.6 49.7 37.6 29.5 48.3 75 26.15 97.97 1 69.4 73.3 80.1 84.8 89.3 93.1 95.4 95.8 91.9 86.1 78.3 71.3 84.1 58.6 62.1 68.8 74.2 79.5 83.1 84.5 84.7 81.4 74.9 67.4 60.5 73.3 47.7 50.9 57.5 63.6 69.6 73.1 73.6 73.5 70.8 63.7 56.4 49.6 62.5 574 31.85 97.37 0 56.3 61.5 69.4 76.8 83.9 91.2 96.2 96.2 89.6 79.8 67.3 58.8 77.3 44.5 49.2 57.2 64.7 72.9 80.0 83.9 83.6 77.5 67.1 55.8 47.2 65.3 32.7 36.8 45.0 52.6 61.9 68.8 71.6 70.9 65.3 54.4 44.2 35.6 53.3 1030 33.98 98.50 0 52.1 58.1 67.2 75.5 83.5 91.7 97.2 95.8 87.5 77.1 63.7 54.5 75.3 40.5 45.7 54.2 62.4 71.4 79.7 84.8 83.5 75.6 64.7 51.9 42.9 63.1 28.9 33.4 41.1 49.3 59.3 67.8 72.4 71.3 63.7 52.4 40.1 31.3 50.9 522 32.70 96.02 0 52.3 57.8 65.7 73.5 80.9 88.3 93.3 93.8 86.9 76.8 64.1 55.1 74.0 41.9 46.8 54.5 61.9 70.2 77.6 81.9 81.7 75.2 64.8 53.0 44.5 62.8 31.4 35.8 43.2 50.2 59.5 66.8 70.4 69.6 63.4 52.8 41.8 33.9 51.6 2807 31.78 103.20 0 58.9 65.3 72.9 81.3 89.1 95.5 96.1 94.5 88.1 79.9 68.1 60.2 79.2 43.4 48.9 56.4 64.7 73.7 81.1 83.0 81.5 74.9 64.9 52.4 44.4 64.1 27.8 32.4 39.8 48.0 58.2 66.7 69.9 68.5 61.6 49.8 36.7 28.5 49.0 1862 31.97 99.97 0 58.4 63.6 72.4 80.7 87.2 92.3 95.6 94.7 88.5 79.9 67.4 59.8 78.4 45.0 49.7 57.9 65.6 73.8 79.9 83.1 82.2 75.9 66.9 54.7 46.7 65.1 31.5 35.8 43.3 50.4 60.3 67.4 70.5 69.6 63.3 53.8 41.9 33.5 51.8 282 33.30 94.17 0 53.0 59.3 67.1 74.7 82.0 89.6 93.9 93.6 86.6 76.4 64.3 55.7 74.7 42.0 47.1 55.3 62.7 70.7 78.3 82.3 81.2 74.2 63.0 52.5 44.6 62.8 30.9 34.9 43.5 50.6 59.4 66.9 70.6 68.8 61.8 49.5 40.7 33.5 50.9 325 29.27 97.12 1 62.2 66.2 73.1 79.5 85.5 90.9 94.2 94.9 90.6 82.8 71.9 64.5 79.7 50.9 54.5 61.6 68.1 74.9 80.4 82.6 82.8 78.7 70.5 60.4 53.0 68.2 39.5 42.8 50.1 56.7 64.3 69.8 71.0 70.7 66.8 58.1 48.9 41.5 56.7 3670 31.70 106.32 0 60.5 66.3 73.7 81.4 89.9 98.8 98.7 95.7 90.5 81.4 69.5 60.5 80.6 44.9 50.0 56.9 64.2 73.0 81.8 83.6 81.3 75.4 64.9 52.9 44.7 64.5 29.2 33.6 40.0 46.9 56.0 64.7 68.5 66.8 60.3 48.3 36.3 28.8 48.3 320 26.88 99.30 1 67.0 72.4 81.2 87.6 92.8 96.4 98.0 98.0 92.9 85.4 76.3 67.9 84.7 56.2 60.8 68.8 75.9 81.9 85.6 87.0 87.0 82.6 75.1 65.8 57.7 73.7 45.4 49.2 56.4 64.2 71.0 74.8 76.0 75.9 72.3 64.7 55.3 47.4 62.7 LaplacesDemon/data/demonchoice.txt0000644000176200001440000001466615144316355016734 0ustar liggesusersChoice HH.Income Vehicle.Age Stop.Signs.Arterial Stop.Signs.Two.Lane Stop.Signs.Freeway Distance.Arterial Distance.Two.Lane Distance.Freeway 2 4 8 14 7 7 4.8094038 4.411727 6.1142808 2 1 1 14 7 7 4.8094038 4.411727 6.1142808 2 2 5 14 7 7 4.8094038 4.411727 6.1142808 2 4 3 14 7 7 4.8094038 4.411727 6.1142808 2 4 3 14 7 7 4.8094038 4.411727 6.1142808 2 3 5 14 7 7 4.8094038 4.411727 6.1142808 2 1 6 14 7 7 4.8094038 4.411727 6.1142808 1 1 0 14 7 7 4.8094038 4.411727 6.1142808 2 1 2 14 7 7 4.8094038 6.7170097 6.1142808 3 2 3 23 10 5 8.5189827 4.411727 7.1146865 2 3 6 14 7 7 4.8094038 4.411727 6.1142808 2 2 4 14 7 7 4.8094038 4.411727 6.1142808 2 2 1 14 7 7 4.8094038 6.7170097 6.1142808 3 2 1 23 10 5 8.5189827 2.9080116 7.1146865 2 2 1 14 11 7 5.2132943 4.411727 7.7174154 2 1 7 14 7 7 4.8094038 7.0152673 6.1142808 1 2 1 13 13 12 5.9154424 7.0152673 8.7178211 1 2 15 13 13 12 5.9154424 4.411727 8.7178211 2 3 6 14 7 7 4.8094038 4.411727 6.1142808 2 2 7 14 7 7 4.8094038 4.411727 6.1142808 3 2 0 14 7 7 4.8094038 4.411727 6.1142808 2 1 1 14 7 7 4.8094038 5.0082422 6.1142808 2 4 1 17 8 8 4.5111462 4.411727 6.7170097 2 1 6 14 7 7 4.8094038 5.0082422 6.1142808 2 2 8 17 8 8 4.5111462 4.411727 6.7170097 1 2 1 14 7 7 4.8094038 4.411727 6.1142808 2 3 0 14 7 7 4.8094038 4.411727 6.1142808 2 3 0 14 7 7 4.8094038 5.0082422 6.1142808 2 1 15 17 8 8 4.5111462 4.411727 6.7170097 2 2 6 14 7 7 4.8094038 4.411727 6.1142808 2 1 7 14 7 7 4.8094038 6.7170097 6.1142808 1 2 1 23 10 5 8.5189827 4.411727 7.1146865 2 1 4 14 7 7 4.8094038 4.411727 6.1142808 1 3 4 14 7 7 4.8094038 7.0152673 6.1142808 1 1 0 13 13 12 5.9154424 4.411727 8.7178211 2 4 2 14 7 7 4.8094038 4.411727 6.1142808 2 3 0 14 7 7 4.8094038 4.411727 6.1142808 2 2 2 14 7 7 4.8094038 5.0082422 6.1142808 2 2 5 17 8 8 4.5111462 4.411727 6.7170097 2 1 5 14 7 7 4.8094038 4.411727 6.1142808 2 3 4 14 7 7 4.8094038 4.411727 6.1142808 2 1 5 14 7 7 4.8094038 4.411727 6.1142808 1 1 6 14 7 7 4.8094038 4.411727 6.1142808 1 2 7 14 7 7 4.8094038 4.411727 6.1142808 2 2 0 14 7 7 4.8094038 3.7095789 6.1142808 2 2 2 15 3 1 6.2137 5.0082422 4.6105654 2 1 5 17 8 8 4.5111462 6.7170097 6.7170097 3 3 5 23 10 5 8.5189827 6.7170097 7.1146865 2 3 0 23 10 5 8.5189827 4.411727 7.1146865 2 2 2 14 7 7 4.8094038 4.411727 6.1142808 2 2 6 14 7 7 4.8094038 6.7170097 6.1142808 2 2 3 23 10 5 8.5189827 5.0082422 7.1146865 1 4 2 17 8 8 4.5111462 4.411727 6.7170097 1 4 1 14 7 7 4.8094038 4.411727 6.1142808 2 1 2 14 7 7 4.8094038 4.411727 6.1142808 1 1 8 14 7 7 4.8094038 4.3123078 6.1142808 1 2 4 13 7 6 4.3123078 4.3123078 5.7103903 2 4 13 13 7 6 4.3123078 4.3123078 5.7103903 2 1 4 13 7 6 4.3123078 4.908823 5.7103903 1 1 1 16 8 7 4.1072557 4.3123078 6.2137 2 3 6 13 7 6 4.3123078 4.3123078 5.7103903 1 3 3 13 7 6 4.3123078 4.3123078 5.7103903 2 1 8 13 7 6 4.3123078 6.6175905 5.7103903 3 1 5 22 10 4 8.015673 4.908823 6.6175905 1 1 1 16 8 7 4.1072557 4.3123078 6.2137 1 1 4 13 7 6 4.3123078 4.908823 5.7103903 1 1 0 16 8 7 4.1072557 4.3123078 6.2137 1 3 2 13 7 6 4.3123078 4.3123078 5.7103903 2 2 1 13 7 6 4.3123078 4.3123078 5.7103903 2 3 3 13 7 6 4.3123078 4.3123078 5.7103903 1 4 2 13 7 6 4.3123078 8.015673 5.7103903 2 1 7 18 10 2 7.6179962 4.3123078 8.3201443 3 4 5 13 7 6 4.3123078 8.015673 5.7103903 3 4 1 18 10 2 7.6179962 4.3123078 8.3201443 1 2 3 13 7 6 4.2066749 4.3123078 5.7103903 2 3 3 13 7 6 4.3123078 4.3123078 5.7103903 2 4 1 13 7 6 4.3123078 6.9158481 5.7103903 2 2 3 12 13 11 5.4121327 4.3123078 8.2207251 1 2 3 13 7 6 4.2066749 4.3123078 5.7103903 2 2 8 13 7 6 4.3123078 4.908823 5.7103903 1 2 1 16 8 7 4.1072557 4.908823 6.2137 3 1 21 16 8 7 4.2066749 4.908823 6.2137 3 2 15 16 8 7 4.2066749 4.3123078 6.2137 2 1 11 13 7 6 4.3123078 4.3123078 5.7103903 2 1 1 13 7 6 4.3123078 4.3123078 5.7103903 2 1 5 13 7 6 4.3123078 3.6101597 5.7103903 2 1 2 13 7 6 5.1138751 3.6101597 6.5119576 2 2 0 13 7 6 5.1138751 5.8098095 6.5119576 2 2 3 22 10 4 8.9166595 3.6101597 7.518577 2 3 1 13 7 6 5.1138751 3.6101597 6.5119576 2 1 2 13 7 6 5.1138751 4.2066749 6.5119576 2 1 0 16 8 7 4.908823 3.6101597 7.1146865 2 2 1 13 7 6 5.1138751 5.8098095 6.5119576 3 2 13 22 10 4 8.9166595 3.6101597 7.518577 2 3 0 13 7 6 5.1138751 3.6101597 6.5119576 2 2 1 13 7 6 5.1138751 4.2066749 6.5119576 2 1 4 16 8 7 4.908823 3.6101597 7.1146865 2 1 4 13 7 6 5.1138751 3.6101597 6.5119576 2 2 6 13 7 6 5.1138751 3.6101597 6.5119576 2 3 3 13 7 6 5.1138751 4.2066749 6.5119576 2 1 16 16 8 7 4.908823 3.6101597 7.1146865 2 1 6 13 7 6 5.1138751 3.6101597 6.5119576 2 1 6 13 7 6 5.1138751 5.8098095 6.5119576 2 4 3 22 10 4 8.9166595 3.6101597 7.518577 2 1 2 13 7 6 5.1138751 3.6101597 6.5119576 2 2 5 13 7 6 5.1138751 4.2066749 6.5119576 2 1 2 16 8 7 4.908823 3.6101597 7.1146865 2 2 1 13 7 6 5.1138751 3.6101597 6.5119576 1 2 6 13 7 6 5.1138751 3.6101597 6.5119576 2 1 1 13 7 6 5.1138751 3.6101597 6.5119576 2 1 13 13 7 6 5.1138751 5.8098095 6.5119576 2 2 2 22 10 4 8.9166595 5.8098095 7.518577 2 1 1 22 10 4 8.9166595 4.2066749 7.518577 3 2 4 16 8 7 4.908823 5.8098095 7.1146865 2 1 5 22 10 4 8.9166595 3.6101597 7.518577 2 1 2 13 7 6 5.1138751 3.6101597 6.5119576 1 1 2 13 7 6 5.1138751 3.6101597 6.5119576 2 1 0 13 7 6 5.1138751 4.2066749 6.5119576 2 1 4 16 8 7 4.908823 4.2066749 7.1146865 2 2 0 16 8 7 4.908823 5.8098095 7.1146865 2 3 19 22 10 4 8.9166595 3.6101597 7.518577 2 1 4 13 7 6 5.1138751 4.2066749 6.5119576 2 2 2 16 8 7 4.908823 5.8098095 7.1146865 2 1 4 22 10 4 8.9166595 3.6101597 7.518577 2 2 0 13 7 6 5.1138751 3.6101597 6.5119576 2 1 4 13 7 6 5.1138751 4.2066749 6.5119576 2 1 16 16 8 7 4.908823 5.3127135 7.1146865 1 2 2 17 8 8 5.1138751 7.0152673 7.3135249 3 2 4 23 10 5 9.1217116 5.3127135 7.4191578 1 4 3 17 8 8 5.0082422 5.3127135 7.3135249 2 2 1 17 8 8 5.1138751 5.3127135 7.3135249 1 3 4 17 8 8 5.0082422 4.7099846 7.3135249 1 2 4 14 7 7 5.1138751 5.3127135 6.4125384 1 3 5 17 8 8 5.1138751 4.7099846 7.3135249 2 1 2 14 7 7 5.1138751 4.7099846 6.4125384 2 4 5 14 7 7 5.1138751 8.4195635 6.4125384 3 2 6 19 10 3 8.3201443 4.7099846 9.0222924 2 3 4 14 7 7 5.1138751 4.7099846 6.4125384 2 2 3 14 7 7 5.1138751 7.0152673 6.4125384 3 1 2 23 10 5 9.1217116 5.3127135 7.4191578 2 3 2 17 8 8 5.1138751 4.7099846 7.3135249 2 1 14 14 7 7 5.1138751 3.2062692 6.4125384 2 3 6 14 11 7 5.4121327 5.3127135 8.015673 1 4 1 17 8 8 5.1138751 4.7099846 7.3135249 2 2 1 14 7 7 5.1138751 5.3127135 6.4125384 2 2 1 17 8 8 5.1138751 5.3127135 7.3135249 2 3 6 17 8 8 5.1138751 7.3135249 7.3135249 1 3 1 13 13 12 6.2137 4.7099846 9.0222924 2 1 10 14 7 7 5.1138751 4.7099846 6.4125384 3 3 3 14 7 7 5.1138751 5.3127135 6.4125384 1 3 2 17 8 8 5.1138751 0 7.3135249 LaplacesDemon/data/demonsnacks.txt0000755000176200001440000000443415144316355016757 0ustar liggesusersServing.Size Calories Total.Fat Saturated.Fat Cholesterol Sodium Total.Carbohydrate Dietary.Fiber Sugars Protein Apple 125 65 0 0 0 1 17 3 13 0 Apricots.Dried 250 213 0 0 0 10 55 7 49 3 Banana.Chips 85 441 29 25 0 5 50 7 30 2 Banana 225 200 1 0 0 2 51 6 28 2 Beef.Jerky 20 82 5 2 10 443 2 0 2 7 Beer.Light 29 9 0 0 0 1 0 0 0 0 Bit.O.Honey 40 150 3 2 0 118 32 0 19 1 Carrots.Baby 15 5 0 0 0 12 1 0 1 0 Cherries 155 77 0 0 0 5 19 2 13 2 Cranberries.Dried 40 123 1 0 0 1 33 2 26 0 Dates 24 66 0 0 0 0 18 2 16 0 Fritolay 28 137 6 1 0 92 19 2 2 2 Granola.Bar 24 116 6 1 0 68 15 1 0 2 Grapes 92 62 0 0 0 2 16 1 15 1 Jellybeans 11 41 0 0 0 5 10 0 8 0 Mangos 165 107 0 0 0 3 28 3 24 1 M&Ms 208 1023 44 27 29 127 148 6 132 9 Marshmallows 50 159 0 0 0 40 41 0 29 1 Nuts.Mixed 142 876 80 12 0 595 30 13 6 24 Nuts.Pistachio 123 702 57 7 0 12 34 13 10 26 Oatmeal.Quaker 40 133 1 0 0 1 29 5 0 5 Oranges 185 85 0 0 0 0 21 4 17 1 Pickles.Dill 143 17 0 0 0 1251 4 2 2 1 Popcorn.Microwave 28 120 3 0 0 137 21 4 0 4 Potato.Chips 198 1026 56 7 0 1220 125 10 2 12 Pretzels 143 483 4 1 4 2008 99 2 0 12 Pumpkin.Seeds.Salted 64 285 12 2 0 368 34 0 0 12 Rolo 48 228 10 7 6 90 33 0 31 2 Salmon.Atlantic.Wild 154 280 13 2 109 86 0 0 0 39 Snickers 15 71 4 1 2 37 9 0 8 1 Strawberries 152 49 0 0 0 2 12 3 7 1 Sunflower.Seeds.Salted 128 745 64 7 0 525 31 12 3 25 Tortilla.Chips 28 137 7 1 0 118 18 1 0 2 Trail.Mix.Regular 150 693 44 8 0 343 67 0 0 21 Trail.Mix.Tropical 140 570 24 12 0 14 92 0 0 9 Turkey.Breast 45 42 0 0 19 540 1 0 0 9 Scooby.Snacks 312 1566 78 59 22 618 203 3 151 15 Twix 58 311 19 9 3 131 31 2 21 5 Twizzlers 71 249 2 0 0 204 57 0 28 2 LaplacesDemon/data/demonfx.txt0000755000176200001440000130610215144316355016110 0ustar liggesusersEURUSD.Close EURUSD.High EURUSD.Low USDJPY.Close USDJPY.High USDJPY.Low USDCHF.Close USDCHF.High USDCHF.Low GBPUSD.Close GBPUSD.High GBPUSD.Low USDCAD.Close USDCAD.High USDCAD.Low EURGBP.Close EURGBP.High EURGBP.Low EURJPY.Close EURJPY.High EURJPY.Low EURCHF.Close EURCHF.High EURCHF.Low AUDUSD.Close AUDUSD.High AUDUSD.Low GBPJPY.Close GBPJPY.High GBPJPY.Low CHFJPY.Close CHFJPY.High CHFJPY.Low GBPCHF.Close GBPCHF.High GBPCHF.Low NZDUSD.Close NZDUSD.High NZDUSD.Low 2010-01-01 1.4318 1.4318 1.4318 93.08 93.08 93.08 1.0348 1.0348 1.0348 1.6166 1.6166 1.6166 1.0482 1.0482 1.0482 0.8857 0.8857 0.8857 133.29 133.29 133.29 1.482 1.482 1.482 0.8991 0.8991 0.8991 150.51 150.51 150.51 89.9 89.9 89.9 1.673 1.673 1.673 0.7264 0.7264 0.7264 2010-01-04 1.4411 1.4455 1.4258 92.54 93.21 92.2 1.0298 1.0419 1.0264 1.6099 1.624 1.606 1.0412 1.0517 1.0353 0.895 0.8967 0.8856 133.39 133.8 132.39 1.4839 1.4896 1.4803 0.9124 0.9136 0.894 149.01 150.71 148.68 89.87 90.04 89.28 1.6577 1.6781 1.6552 0.7336 0.7352 0.72 2010-01-05 1.4366 1.4483 1.4347 91.65 92.55 91.26 1.0334 1.036 1.0254 1.5993 1.6153 1.5967 1.0387 1.0425 1.0338 0.8981 0.9015 0.8945 131.68 133.47 131.47 1.4847 1.4878 1.4825 0.9115 0.9173 0.9092 146.61 149.15 146.16 88.69 89.88 88.44 1.6529 1.6596 1.6468 0.734 0.739 0.7318 2010-01-06 1.4412 1.4434 1.4285 92.32 92.74 91.53 1.0275 1.038 1.025 1.6023 1.6064 1.5939 1.0314 1.0409 1.0314 0.8994 0.9012 0.8926 133.08 133.5 131.26 1.4808 1.4857 1.4793 0.9201 0.9217 0.91 147.94 148.47 146.03 89.86 90.12 88.46 1.6462 1.6633 1.6424 0.7377 0.7386 0.7304 2010-01-07 1.4319 1.4446 1.4299 93.27 93.4 92.11 1.0335 1.0371 1.0245 1.5936 1.6058 1.5897 1.0348 1.0373 1.0293 0.8984 0.9026 0.898 133.56 133.67 132.41 1.48 1.4842 1.4769 0.917 0.9266 0.916 148.63 148.75 147.09 90.23 90.34 89.45 1.6472 1.6503 1.6406 0.7317 0.7427 0.7315 2010-01-08 1.4411 1.4439 1.4264 92.59 93.76 92.3 1.0238 1.0384 1.0218 1.6029 1.611 1.5917 1.0306 1.0384 1.0296 0.8991 0.9007 0.8922 133.44 134.13 132.43 1.4755 1.4858 1.4744 0.9242 0.9253 0.9122 148.39 149.71 147.99 90.41 90.61 89.43 1.641 1.6609 1.6376 0.7366 0.7379 0.7286 2010-01-11 1.4526 1.4557 1.4409 92.06 92.66 91.82 1.0151 1.0242 1.0133 1.6108 1.6193 1.605 1.0329 1.0343 1.0254 0.9014 0.9027 0.8973 133.72 134.38 133.42 1.4751 1.4793 1.4726 0.9315 0.9325 0.9277 148.27 149.6 148.1 90.66 91.04 90.38 1.6356 1.6461 1.6319 0.7432 0.7436 0.7383 2010-01-12 1.4487 1.4548 1.4454 90.95 92.43 90.74 1.0182 1.0209 1.0145 1.6162 1.6194 1.6064 1.04 1.0414 1.0314 0.896 0.9027 0.8957 131.76 133.8 131.64 1.4755 1.4772 1.4736 0.9197 0.9306 0.9169 147 148.64 146.64 89.3 90.7 89.2 1.6458 1.6472 1.6355 0.7381 0.7431 0.7365 2010-01-13 1.4506 1.4582 1.4456 91.45 91.56 90.91 1.0181 1.0218 1.0139 1.6283 1.6306 1.6138 1.0302 1.041 1.029 0.8908 0.8968 0.8893 132.68 133.21 131.54 1.4777 1.48 1.4746 0.924 0.9267 0.9186 148.93 149.06 146.74 89.78 90.03 89.19 1.6586 1.6615 1.645 0.7397 0.7425 0.7371 2010-01-14 1.4496 1.4555 1.4447 91.11 92.04 90.85 1.0184 1.0233 1.0161 1.6323 1.6347 1.625 1.023 1.0322 1.0226 0.8879 0.8936 0.8866 132.07 133.62 131.7 1.4765 1.4811 1.4754 0.9312 0.933 0.9217 148.7 150 148.41 89.44 90.31 89.07 1.6625 1.6679 1.6553 0.7424 0.7441 0.739 2010-01-15 1.4375 1.4511 1.4338 90.81 91.32 90.61 1.0269 1.0287 1.0178 1.6258 1.6353 1.6212 1.0295 1.0314 1.0233 0.884 0.888 0.881 130.55 132.4 130.32 1.4764 1.4784 1.4741 0.9229 0.9319 0.9214 147.63 149.22 147.2 88.41 89.65 88.21 1.6693 1.6756 1.6626 0.738 0.743 0.736 2010-01-18 1.4386 1.4401 1.4336 90.76 91.05 90.63 1.0245 1.0291 1.0235 1.6326 1.6378 1.6252 1.0253 1.0313 1.0249 0.881 0.8833 0.8783 130.57 130.95 130.1 1.4739 1.4778 1.4732 0.9264 0.9279 0.9172 148.16 148.9 147.56 88.58 88.76 88.22 1.6725 1.6791 1.671 0.739 0.7402 0.7331 2010-01-19 1.4304 1.4413 1.4253 91.07 91.26 90.32 1.0311 1.0356 1.0231 1.6372 1.6457 1.6313 1.0302 1.0348 1.0251 0.8733 0.8811 0.8713 130.3 130.72 129.66 1.4748 1.4782 1.4732 0.9245 0.9281 0.9176 149.17 149.47 148.02 88.33 88.63 87.81 1.6883 1.6941 1.6735 0.739 0.7408 0.7336 2010-01-20 1.4102 1.4296 1.4081 91.23 91.46 90.8 1.0439 1.0462 1.0315 1.6287 1.6371 1.6244 1.0475 1.049 1.0305 0.8657 0.8738 0.8649 128.66 130.35 128.42 1.4722 1.4772 1.4723 0.9086 0.9242 0.9072 148.6 149.25 147.59 87.38 88.34 86.99 1.7006 1.7036 1.6882 0.72 0.7363 0.7187 2010-01-21 1.4098 1.4143 1.4028 90.36 91.87 90.12 1.0416 1.0495 1.0405 1.6208 1.6311 1.6126 1.0502 1.0524 1.044 0.8696 0.8724 0.8655 127.4 129.51 127.06 1.4689 1.4759 1.4676 0.9035 0.9146 0.9017 146.43 149.09 146.12 86.71 87.97 86.43 1.6891 1.7017 1.6869 0.7124 0.7233 0.7114 2010-01-22 1.414 1.4181 1.4068 89.87 90.56 89.79 1.0411 1.0445 1.0376 1.611 1.6284 1.6079 1.058 1.0602 1.0466 0.8776 0.8785 0.8688 127.09 128.18 126.58 1.4724 1.4747 1.4671 0.9013 0.9092 0.8984 144.8 147.21 144.67 86.31 87.16 86.22 1.6773 1.6929 1.675 0.7104 0.7178 0.7093 2010-01-25 1.4153 1.4197 1.4129 90.21 90.34 89.82 1.0392 1.0426 1.0367 1.6232 1.626 1.6092 1.0576 1.0612 1.0534 0.8719 0.8797 0.8704 127.7 128.14 127.09 1.4713 1.4744 1.4708 0.9046 0.9092 0.9015 146.46 146.73 144.72 86.8 87.05 86.29 1.687 1.6901 1.6735 0.7142 0.717 0.7114 2010-01-26 1.4076 1.4179 1.4043 89.66 90.55 89.35 1.0458 1.0491 1.038 1.614 1.6268 1.6094 1.0619 1.0692 1.0547 0.8718 0.8753 0.8668 126.23 128.36 125.69 1.4725 1.4741 1.4701 0.8984 0.9084 0.8939 144.75 147.29 144.11 85.71 87.21 85.31 1.6886 1.6975 1.6809 0.7074 0.717 0.7023 2010-01-27 1.4018 1.4096 1.3994 89.96 90.08 89.15 1.0499 1.0526 1.0447 1.6158 1.6244 1.6109 1.0645 1.0688 1.061 0.8672 0.8731 0.8658 126.11 126.4 125.25 1.472 1.4744 1.4708 0.8935 0.9045 0.8912 145.34 145.71 143.66 85.65 85.82 85.09 1.6968 1.7006 1.686 0.7047 0.7106 0.7031 2010-01-28 1.3971 1.4052 1.3938 89.85 90.55 89.65 1.0515 1.0554 1.0478 1.6128 1.6276 1.6114 1.0656 1.0667 1.0558 0.8663 0.8676 0.8602 125.55 127.08 125.12 1.4694 1.4742 1.469 0.8945 0.9047 0.8931 144.93 147.21 144.67 85.42 86.3 85.1 1.6961 1.7114 1.6948 0.7047 0.7137 0.7039 2010-01-29 1.3867 1.3989 1.3863 90.27 90.92 89.59 1.0604 1.0641 1.0483 1.6 1.6179 1.5987 1.0685 1.0695 1.0624 0.8664 0.8693 0.863 125.2 126.68 124.82 1.4705 1.4762 1.4635 0.8856 0.8961 0.8849 144.46 146.26 144.3 85.12 86.38 85.03 1.6966 1.7029 1.6872 0.7016 0.7088 0.7017 2010-02-01 1.3926 1.3935 1.3854 90.64 90.94 89.81 1.0567 1.0625 1.0565 1.5959 1.5978 1.5851 1.0622 1.072 1.0622 0.8725 0.8769 0.8684 126.24 126.52 124.52 1.4718 1.4737 1.47 0.8909 0.8915 0.8787 144.68 144.86 143.06 85.79 85.92 84.71 1.6865 1.6957 1.679 0.7085 0.7094 0.6995 2010-02-02 1.3963 1.3974 1.3887 90.34 90.91 90.27 1.0547 1.0607 1.0542 1.5978 1.5995 1.5904 1.0581 1.064 1.0567 0.8735 0.8763 0.8707 126.16 126.68 125.84 1.4731 1.4744 1.4694 0.8865 0.8927 0.878 144.35 145.19 143.89 85.62 86.03 85.45 1.6858 1.6901 1.6805 0.7122 0.7127 0.7039 2010-02-03 1.3903 1.4026 1.3891 90.94 91.28 90.09 1.0586 1.06 1.0497 1.5904 1.6069 1.5888 1.0614 1.063 1.0547 0.874 0.877 0.8711 126.41 126.97 125.99 1.4716 1.4754 1.4713 0.8834 0.8915 0.8815 144.61 145.28 144.25 85.89 86.2 85.49 1.6837 1.6929 1.6807 0.7082 0.7152 0.7069 2010-02-04 1.3738 1.3903 1.3729 88.9 91.07 88.58 1.0657 1.0674 1.0578 1.575 1.5918 1.5733 1.0722 1.0752 1.0598 0.872 0.8759 0.8713 122.13 126.46 121.62 1.4643 1.4723 1.4641 0.8648 0.883 0.8608 140.03 144.78 139.39 83.38 85.99 83 1.6789 1.6868 1.6757 0.6874 0.7027 0.6848 2010-02-05 1.3652 1.3746 1.3586 89.33 89.89 88.84 1.0735 1.0794 1.0647 1.5623 1.5775 1.556 1.0713 1.078 1.0647 0.8737 0.8756 0.8688 121.98 123.32 120.72 1.4659 1.4809 1.4563 0.8657 0.8717 0.8578 139.58 141.42 138.29 83.2 84.22 82.35 1.6775 1.701 1.6755 0.6866 0.6931 0.6808 2010-02-08 1.3659 1.3714 1.3622 89.28 89.56 89.15 1.0724 1.0772 1.0685 1.5604 1.566 1.5536 1.0744 1.0746 1.0658 0.8754 0.8802 0.873 121.98 122.78 121.57 1.4649 1.4692 1.4645 0.8644 0.8708 0.8641 139.3 139.93 138.65 83.25 83.67 82.87 1.6733 1.6809 1.6682 0.683 0.6921 0.6829 2010-02-09 1.378 1.3839 1.3644 89.63 89.8 89.17 1.0648 1.0747 1.0609 1.5697 1.5747 1.5563 1.0675 1.0775 1.0647 0.8777 0.8818 0.8753 123.46 124.18 121.66 1.4672 1.4707 1.4638 0.8774 0.8797 0.8617 140.68 141.25 138.82 84.17 84.57 83.03 1.6714 1.6755 1.6636 0.6948 0.6967 0.6819 2010-02-10 1.3732 1.3815 1.3678 89.93 90.06 89.25 1.0679 1.072 1.0618 1.5583 1.5765 1.5572 1.0625 1.0707 1.0599 0.8811 0.882 0.8744 123.52 124.28 122.69 1.4669 1.4692 1.4645 0.8751 0.8796 0.8708 140.16 141.43 139.46 84.2 84.59 83.7 1.6644 1.6788 1.6625 0.6928 0.6968 0.6895 2010-02-11 1.3681 1.3801 1.3596 89.73 90.14 89.58 1.0707 1.0783 1.0627 1.5694 1.5718 1.5559 1.0508 1.0631 1.0482 0.8716 0.8844 0.8701 122.75 124.15 122.07 1.4655 1.4679 1.4646 0.8906 0.892 0.875 140.78 141.02 139.65 83.76 84.65 83.26 1.6804 1.6845 1.659 0.7005 0.7022 0.6915 2010-02-12 1.3609 1.3696 1.3533 90 90.43 89.6 1.077 1.0829 1.0698 1.567 1.5741 1.5582 1.0513 1.0578 1.049 0.8684 0.8726 0.8656 122.5 123.09 121.39 1.4659 1.4697 1.4626 0.8864 0.8915 0.8784 141.02 141.89 139.82 83.56 84.03 82.86 1.6876 1.6954 1.6782 0.6955 0.6994 0.6898 2010-02-15 1.3597 1.3634 1.358 89.96 90.23 89.92 1.0776 1.0803 1.0752 1.5662 1.572 1.5613 1.0489 1.0532 1.0465 0.8676 0.8703 0.867 122.31 122.87 122.25 1.4651 1.468 1.4624 0.8891 0.8909 0.8848 140.86 141.39 140.74 83.47 83.81 83.38 1.6871 1.691 1.6845 0.6978 0.6989 0.6956 2010-02-16 1.3765 1.3779 1.3589 90.13 90.51 89.72 1.0659 1.0789 1.0654 1.5786 1.5796 1.5629 1.0431 1.0499 1.0411 0.8717 0.8745 0.8678 124.09 124.48 122.32 1.4676 1.4687 1.4637 0.9015 0.9027 0.8878 142.32 142.59 140.77 84.53 84.77 83.42 1.6832 1.6892 1.6783 0.7068 0.7079 0.6966 2010-02-17 1.3607 1.3789 1.3587 91.19 91.26 90.12 1.0776 1.0798 1.0648 1.5678 1.5816 1.5668 1.0453 1.047 1.0413 0.8676 0.8741 0.867 124.1 124.85 123.42 1.4667 1.4695 1.4667 0.8999 0.9037 0.8973 142.96 143.6 142.12 84.61 85.05 84.1 1.6896 1.6931 1.6803 0.7034 0.7079 0.7019 2010-02-18 1.3612 1.3653 1.354 91.23 91.48 90.59 1.0772 1.0826 1.0751 1.5618 1.5687 1.5558 1.0413 1.0497 1.0399 0.8715 0.8723 0.8662 124.22 124.46 122.77 1.4667 1.4686 1.4642 0.9021 0.9026 0.8939 142.51 143.05 141 84.67 84.84 83.8 1.6827 1.692 1.681 0.7058 0.7061 0.6987 2010-02-19 1.359 1.3607 1.3444 91.6 92.14 91.6 1.0769 1.0898 1.0763 1.5454 1.5549 1.535 1.0404 1.053 1.0389 0.8792 0.8798 0.8702 124.52 124.8 123.56 1.4641 1.4676 1.464 0.8982 0.8989 0.8879 141.6 142.67 140.93 85.04 85.22 84.34 1.6649 1.6842 1.6647 0.6983 0.6999 0.6931 2010-02-22 1.3597 1.3653 1.3574 91.1 91.9 91.02 1.076 1.0788 1.074 1.548 1.5519 1.5434 1.0427 1.044 1.0372 0.8781 0.8817 0.8762 123.85 125.25 123.65 1.4632 1.4665 1.4631 0.8993 0.9024 0.8974 141.03 142.18 140.83 84.65 85.46 84.45 1.666 1.6717 1.6614 0.7005 0.7037 0.6994 2010-02-23 1.35 1.3691 1.3497 90.16 91.29 89.93 1.0842 1.0848 1.0716 1.5407 1.5575 1.5395 1.0566 1.0578 1.0382 0.8761 0.8836 0.8751 121.75 124.55 121.59 1.4638 1.4684 1.4621 0.8884 0.9071 0.8879 138.94 141.67 138.76 83.17 84.92 83.03 1.6706 1.6737 1.6591 0.6906 0.7058 0.6896 2010-02-24 1.3532 1.3626 1.3503 90.2 90.37 89.78 1.0807 1.0843 1.074 1.5395 1.5476 1.5387 1.054 1.0592 1.0512 0.879 0.8813 0.8751 122.06 122.61 121.62 1.4629 1.4654 1.4627 0.893 0.8955 0.8858 138.84 139.59 138.4 83.42 83.75 83.09 1.6642 1.673 1.661 0.6928 0.6952 0.6871 2010-02-25 1.3558 1.3571 1.3452 89.07 90.32 88.81 1.0794 1.0878 1.0786 1.527 1.542 1.5191 1.0586 1.0679 1.0517 0.8876 0.8893 0.8773 120.75 122.3 119.66 1.4635 1.4646 1.4621 0.8885 0.8952 0.8802 136 139.23 134.99 82.5 83.55 81.8 1.6478 1.6684 1.6461 0.6906 0.6945 0.6848 2010-02-26 1.3613 1.3683 1.3531 88.91 89.5 88.75 1.0745 1.0816 1.0696 1.5246 1.5318 1.5151 1.0516 1.0618 1.0516 0.8927 0.8974 0.8869 121.05 121.65 120.52 1.4628 1.4646 1.4619 0.8962 0.898 0.8864 135.59 136.68 134.68 82.75 83.14 82.35 1.638 1.6501 1.6317 0.6985 0.7019 0.6907 2010-03-01 1.3558 1.3656 1.3461 89.07 89.48 88.83 1.079 1.087 1.072 1.4988 1.5203 1.4784 1.0415 1.0573 1.0411 0.9045 0.915 0.8968 120.77 121.91 120.09 1.4635 1.465 1.4621 0.9004 0.9015 0.8936 133.5 135.5 132.07 82.51 83.27 82.08 1.6178 1.6311 1.5989 0.6988 0.7016 0.6933 2010-03-02 1.3608 1.3622 1.3435 88.68 89.39 88.56 1.0748 1.0889 1.0747 1.4961 1.4999 1.4856 1.0364 1.0442 1.0311 0.9095 0.9102 0.902 120.71 121.33 119.78 1.4631 1.4652 1.4614 0.9033 0.9059 0.896 132.71 133.75 132.51 82.48 82.93 81.89 1.6088 1.6228 1.6077 0.6959 0.7004 0.6926 2010-03-03 1.3701 1.3736 1.3594 88.4 88.99 88.33 1.0671 1.0763 1.0648 1.5104 1.513 1.496 1.0309 1.0365 1.0274 0.9069 0.9102 0.9051 121.14 121.74 120.62 1.4626 1.4643 1.4611 0.9054 0.9085 0.9009 133.55 134.01 132.78 82.82 83.18 82.45 1.6124 1.6165 1.6074 0.6932 0.6986 0.6895 2010-03-04 1.3587 1.3712 1.3552 89.05 89.25 88.15 1.0763 1.0795 1.067 1.5035 1.5136 1.5006 1.0309 1.0339 1.0272 0.9036 0.9084 0.9017 121.05 121.81 120.31 1.4626 1.4641 1.462 0.901 0.9062 0.898 133.94 134.81 132.6 82.74 83.23 82.24 1.618 1.6225 1.6103 0.6862 0.6956 0.6853 2010-03-05 1.3624 1.3629 1.3529 90.33 90.58 88.99 1.0738 1.0809 1.0735 1.5146 1.5166 1.4994 1.0293 1.0331 1.0261 0.8993 0.9048 0.8982 123.05 123.32 120.9 1.4632 1.4649 1.4616 0.9083 0.9092 0.8986 136.82 137.05 133.81 84.1 84.29 82.65 1.6262 1.6292 1.6167 0.6973 0.6973 0.6856 2010-03-08 1.363 1.3704 1.3606 90.3 90.68 90.16 1.0738 1.0748 1.0676 1.506 1.5195 1.5032 1.0278 1.0293 1.0253 0.9049 0.9073 0.8997 123.09 123.89 122.83 1.4629 1.4644 1.4621 0.9091 0.9133 0.9077 135.98 137.37 135.69 84.11 84.68 83.98 1.6166 1.6266 1.6125 0.6999 0.7036 0.6949 2010-03-09 1.3599 1.3635 1.3537 89.97 90.33 89.63 1.0749 1.0806 1.0727 1.4992 1.5067 1.4938 1.026 1.032 1.0237 0.9068 0.9097 0.9047 122.35 123.14 121.47 1.4619 1.4638 1.4618 0.9135 0.9147 0.9056 134.91 136.07 133.97 83.68 84.17 83.05 1.6115 1.6173 1.6079 0.7025 0.7036 0.6963 2010-03-10 1.3641 1.3679 1.3546 90.52 90.82 89.85 1.0709 1.0794 1.0687 1.496 1.5016 1.4874 1.0261 1.0291 1.0219 0.9118 0.9134 0.9062 123.48 124.01 121.9 1.4608 1.4634 1.4607 0.9141 0.9193 0.9127 135.38 135.89 133.93 84.51 84.83 83.36 1.6021 1.6136 1.6005 0.7019 0.7097 0.7014 2010-03-11 1.3677 1.3687 1.362 90.54 90.71 90.22 1.0686 1.0731 1.068 1.5058 1.5066 1.4948 1.0234 1.0321 1.0231 0.9082 0.9121 0.9064 123.87 123.9 123.03 1.4617 1.4631 1.4597 0.915 0.9169 0.9113 136.35 136.49 134.93 84.73 84.83 84.22 1.6093 1.612 1.6017 0.7004 0.7025 0.6966 2010-03-12 1.3758 1.3796 1.367 90.45 91.08 90.18 1.058 1.0696 1.0578 1.5181 1.5217 1.5028 1.0179 1.0251 1.0157 0.9061 0.9111 0.9045 124.47 125.2 123.7 1.4563 1.4625 1.4563 0.9156 0.9194 0.9141 137.32 138.07 136.12 85.44 85.84 84.6 1.6069 1.612 1.6037 0.701 0.7049 0.6986 2010-03-15 1.3671 1.3776 1.3641 90.51 90.8 90.36 1.0621 1.0642 1.0578 1.505 1.5207 1.5021 1.0194 1.0232 1.0165 0.9083 0.9128 0.9047 123.76 124.96 123.31 1.4523 1.4582 1.4508 0.9142 0.9179 0.9096 136.23 137.94 135.84 85.19 85.74 84.97 1.5986 1.6094 1.5918 0.7016 0.7054 0.6988 2010-03-16 1.3778 1.3783 1.3657 90.24 90.73 89.99 1.0535 1.0625 1.0535 1.5257 1.5259 1.4979 1.0139 1.0202 1.0137 0.903 0.9121 0.9012 124.33 124.6 123.24 1.4516 1.4537 1.4503 0.919 0.9192 0.912 137.65 137.88 135.22 85.63 85.8 84.9 1.6071 1.6096 1.5909 0.7097 0.7103 0.7012 2010-03-17 1.3738 1.3817 1.3727 90.25 90.71 90.04 1.0543 1.0566 1.0508 1.5323 1.538 1.521 1.0099 1.0146 1.0072 0.8963 0.9066 0.8953 123.98 125.06 123.93 1.4484 1.4536 1.4475 0.9227 0.9251 0.9175 138.28 139.32 137.13 85.59 86.14 85.42 1.6152 1.6209 1.6023 0.714 0.7178 0.7105 2010-03-18 1.3612 1.3742 1.3587 90.29 90.8 89.77 1.0571 1.0646 1.0525 1.5246 1.5328 1.5218 1.013 1.0143 1.0091 0.8927 0.8973 0.8917 122.87 124.27 122.66 1.4392 1.4488 1.4356 0.9214 0.9242 0.9181 137.6 138.58 137.06 85.38 85.88 84.78 1.6118 1.6219 1.6081 0.7151 0.7174 0.712 2010-03-19 1.3531 1.3626 1.3502 90.52 90.71 90.34 1.0601 1.0634 1.054 1.5014 1.5255 1.499 1.0168 1.0187 1.0063 0.9012 0.9019 0.8922 122.52 123.34 122.26 1.4349 1.4407 1.4318 0.9154 0.9224 0.913 135.9 138.08 135.66 85.37 85.85 85.1 1.5918 1.6134 1.5905 0.708 0.7158 0.7066 2010-03-22 1.3549 1.3568 1.3464 90.13 90.77 89.84 1.0582 1.0661 1.0564 1.5093 1.5098 1.4934 1.019 1.0243 1.0149 0.8977 0.9045 0.8971 122.13 122.62 121.08 1.4339 1.4376 1.4308 0.9175 0.9181 0.9086 136.03 136.17 134.58 85.16 85.58 84.36 1.5972 1.5989 1.5853 0.7066 0.7072 0.7003 2010-03-23 1.35 1.3569 1.3477 90.41 90.47 90.07 1.0567 1.0638 1.0548 1.5044 1.5112 1.4974 1.0154 1.0228 1.0153 0.8971 0.9018 0.8966 122.07 122.6 121.77 1.4272 1.4371 1.4263 0.919 0.9198 0.9137 136.01 136.52 135.27 85.53 85.63 84.9 1.5901 1.6019 1.5869 0.7072 0.7079 0.7031 2010-03-24 1.3331 1.3501 1.3321 92.13 92.23 90.36 1.0722 1.0732 1.0561 1.4889 1.5041 1.4871 1.0233 1.0281 1.0159 0.8953 0.8981 0.8908 122.82 123.06 121.43 1.4297 1.4306 1.4231 0.9089 0.9196 0.9075 137.15 137.45 135.52 85.89 86.25 85.15 1.5965 1.6028 1.5868 0.7026 0.7063 0.6997 2010-03-25 1.328 1.3386 1.3269 92.69 92.95 91.77 1.0736 1.0751 1.0675 1.4815 1.4987 1.48 1.0245 1.0253 1.0172 0.8962 0.8994 0.8898 123.12 123.94 122.29 1.426 1.4298 1.4254 0.9073 0.9141 0.9072 137.34 138.11 136.68 86.33 86.73 85.69 1.5907 1.6044 1.5893 0.7026 0.7102 0.7017 2010-03-26 1.3423 1.3425 1.3268 92.48 92.89 92.31 1.065 1.0745 1.0638 1.4899 1.4923 1.4808 1.0264 1.0302 1.0207 0.9006 0.9025 0.8957 124.13 124.19 122.98 1.4297 1.4314 1.4256 0.904 0.9116 0.9002 137.8 138.04 137.09 86.82 86.99 86.22 1.5864 1.5956 1.583 0.7038 0.7092 0.7017 2010-03-29 1.3477 1.3506 1.342 92.46 92.78 92.36 1.0623 1.069 1.0593 1.498 1.5019 1.4894 1.0205 1.0271 1.0177 0.8995 0.9021 0.8972 124.64 125.08 124.1 1.4318 1.4356 1.4282 0.9175 0.9176 0.9035 138.5 139.11 137.71 87.03 87.44 86.67 1.5911 1.5959 1.5839 0.7094 0.7116 0.7037 2010-03-30 1.3413 1.3539 1.3396 92.82 93.02 92.13 1.0663 1.0681 1.0587 1.5066 1.5125 1.4975 1.019 1.0223 1.0159 0.8902 0.9 0.888 124.51 125.44 124.19 1.4305 1.4343 1.43 0.9182 0.9215 0.916 139.82 140.54 138.06 87.02 87.52 86.7 1.6064 1.6115 1.5912 0.709 0.7132 0.7083 2010-03-31 1.351 1.3548 1.3385 93.5 93.63 92.76 1.0538 1.0683 1.049 1.5177 1.5203 1.5044 1.0152 1.02 1.0131 0.8901 0.8945 0.8871 126.33 126.54 124.45 1.4238 1.4321 1.4209 0.9173 0.9206 0.9132 141.88 142.02 139.8 88.71 89.04 86.99 1.5995 1.6123 1.593 0.7099 0.7115 0.7072 2010-04-01 1.3585 1.3587 1.3458 93.84 94.04 93.29 1.0537 1.0609 1.0437 1.5287 1.5303 1.5174 1.0079 1.0161 1.0068 0.8886 0.8903 0.8842 127.51 127.54 125.97 1.4318 1.4412 1.4142 0.9199 0.9218 0.9152 143.48 143.67 141.78 89.03 89.99 88.48 1.6108 1.6218 1.5951 0.7071 0.7111 0.7036 2010-04-02 1.3485 1.3591 1.3483 94.63 94.69 93.66 1.0635 1.0639 1.054 1.5192 1.5296 1.5183 1.0096 1.0129 1.0084 0.8875 0.8898 0.8873 127.63 127.9 126.91 1.4346 1.435 1.4311 0.9187 0.9214 0.9184 143.77 143.95 142.86 88.94 89.23 88.67 1.616 1.6165 1.6098 0.7057 0.7083 0.7053 2010-04-05 1.3479 1.3538 1.3461 94.33 94.76 94.09 1.0623 1.0644 1.0584 1.5279 1.5319 1.5222 1.003 1.0088 1.0012 0.882 0.8861 0.8815 127.14 127.82 126.95 1.4321 1.4336 1.4313 0.9206 0.9221 0.9189 144.13 144.72 143.79 88.78 89.25 88.64 1.6234 1.6249 1.6162 0.7027 0.7072 0.7022 2010-04-06 1.3402 1.3496 1.3356 93.73 94.37 93.67 1.0684 1.0722 1.0616 1.527 1.5306 1.5131 1.0008 1.0047 0.9989 0.8772 0.8859 0.8766 125.64 127.35 125.38 1.4321 1.433 1.4316 0.9279 0.9288 0.9166 143.14 144.41 142.09 87.71 88.89 87.55 1.632 1.6338 1.6165 0.7062 0.7073 0.6965 2010-04-07 1.3351 1.3408 1.3327 93.25 94.26 93.16 1.073 1.0745 1.0681 1.5245 1.5286 1.514 1.0047 1.0057 0.9979 0.8756 0.8819 0.8752 124.49 126.15 124.49 1.4331 1.4351 1.4317 0.9269 0.9297 0.9249 142.12 143.83 141.81 86.86 88.08 86.85 1.6365 1.6379 1.6241 0.7068 0.7094 0.7028 2010-04-08 1.3348 1.3366 1.3282 93.35 93.48 92.84 1.0735 1.0786 1.0716 1.5265 1.5278 1.5143 1.0027 1.0104 1.002 0.8742 0.8784 0.8738 124.6 124.84 123.45 1.433 1.4342 1.4317 0.9278 0.9291 0.9225 142.52 142.81 140.99 86.93 87.1 86.19 1.6387 1.6404 1.6308 0.7061 0.7074 0.7008 2010-04-09 1.3492 1.3494 1.3341 93.16 93.78 93.12 1.0655 1.0765 1.0656 1.5367 1.5391 1.5269 1.0036 1.0083 0.9992 0.8777 0.8782 0.8707 125.72 125.8 124.71 1.438 1.4396 1.4327 0.9324 0.9344 0.9267 143.19 144.32 142.63 87.42 87.72 86.93 1.6376 1.6514 1.6371 0.7151 0.7174 0.7068 2010-04-12 1.3579 1.3691 1.3565 93.23 93.62 92.99 1.0598 1.0616 1.0552 1.5362 1.5485 1.5354 1.0035 1.0088 1.0012 0.8838 0.8849 0.8805 126.62 127.44 126.59 1.4394 1.4467 1.4379 0.9276 0.9382 0.9253 143.23 144.51 143.2 87.95 88.35 87.86 1.6284 1.6392 1.6271 0.7121 0.7194 0.7112 2010-04-13 1.3589 1.3626 1.3546 93.13 93.42 92.58 1.055 1.0602 1.054 1.5369 1.5449 1.5338 1.0015 1.0065 1.0008 0.8841 0.8862 0.8805 126.57 127.08 125.72 1.4339 1.4409 1.4328 0.9274 0.9291 0.9224 143.16 143.76 142.09 88.25 88.38 87.42 1.6213 1.6331 1.6206 0.7106 0.7146 0.7098 2010-04-14 1.3654 1.3678 1.3597 93.2 93.71 92.83 1.0518 1.056 1.0503 1.5465 1.549 1.5373 0.9988 1.002 0.9954 0.8828 0.8864 0.8807 127.23 127.68 126.82 1.4362 1.4387 1.4337 0.935 0.936 0.9274 144.1 144.63 143.26 88.59 88.88 88.35 1.6262 1.63 1.6187 0.7138 0.7153 0.7076 2010-04-15 1.3574 1.3666 1.352 93.02 93.53 92.87 1.056 1.0611 1.0508 1.5493 1.5523 1.5387 1.0031 1.0035 0.9959 0.8758 0.8831 0.875 126.26 127.66 125.84 1.4336 1.4367 1.4329 0.9335 0.9364 0.9311 144.15 145.04 143.28 88.07 88.95 87.74 1.6366 1.6392 1.626 0.7111 0.7161 0.7104 2010-04-16 1.3504 1.3581 1.3473 92.13 93.14 91.91 1.0605 1.0634 1.056 1.5389 1.548 1.5362 1.0134 1.0164 0.9999 0.8774 0.8801 0.8745 124.41 126.42 123.89 1.4325 1.4347 1.432 0.9252 0.9345 0.923 141.78 144.09 141.37 86.84 88.14 86.47 1.6323 1.6391 1.6288 0.709 0.7156 0.7066 2010-04-19 1.3486 1.3497 1.3415 92.39 92.46 91.61 1.063 1.0691 1.0617 1.5336 1.534 1.5191 1.0144 1.0215 1.0138 0.8791 0.8843 0.8788 124.58 124.65 123.18 1.4336 1.4362 1.4323 0.9228 0.9244 0.9158 141.65 141.75 139.43 86.9 86.94 85.92 1.6299 1.6322 1.6211 0.7098 0.7109 0.7055 2010-04-20 1.3444 1.3522 1.3429 93.14 93.4 92.4 1.0676 1.0689 1.0603 1.5369 1.5432 1.529 0.9989 1.0164 0.9972 0.8745 0.8803 0.8741 125.23 125.61 124.49 1.4357 1.4361 1.4325 0.9315 0.9324 0.9242 143.15 143.53 141.56 87.2 87.61 86.84 1.6411 1.6425 1.6289 0.7105 0.7144 0.7078 2010-04-21 1.3395 1.3447 1.3359 93.16 93.44 92.94 1.0696 1.0724 1.066 1.5407 1.5439 1.5333 0.9997 1.0013 0.9931 0.8691 0.8747 0.8683 124.8 125.52 124.29 1.4333 1.4357 1.4295 0.9277 0.9338 0.926 143.54 144.16 142.66 87.05 87.58 86.75 1.6483 1.65 1.64 0.7099 0.7132 0.7077 2010-04-22 1.3311 1.3421 1.326 93.51 93.54 92.74 1.0761 1.0803 1.0673 1.5382 1.5473 1.5343 0.9994 1.0039 0.996 0.8652 0.8697 0.8632 124.48 125.17 123.33 1.4331 1.4346 1.4311 0.9283 0.9304 0.9228 143.84 144.17 142.46 86.85 87.35 86.05 1.6558 1.6601 1.6474 0.711 0.714 0.7071 2010-04-23 1.3371 1.34 1.3202 94.06 94.32 93.32 1.073 1.085 1.0717 1.5369 1.5398 1.5296 0.9991 1.0065 0.9969 0.8698 0.8719 0.8608 125.77 126.06 123.42 1.4352 1.4362 1.4314 0.9263 0.9271 0.9172 144.57 144.78 143.12 87.62 87.81 86.15 1.6492 1.6642 1.6458 0.7161 0.7167 0.7086 2010-04-26 1.3363 1.3397 1.3291 93.97 94.35 93.94 1.0735 1.0787 1.0713 1.5455 1.5498 1.5374 1.0011 1.0023 0.9969 0.8645 0.8692 0.86 125.63 126.29 125.05 1.4355 1.4366 1.4333 0.9269 0.9312 0.9258 145.22 145.96 144.52 87.5 87.99 87.22 1.66 1.6672 1.6499 0.7226 0.7255 0.7167 2010-04-27 1.3174 1.3413 1.3163 93.04 94.02 92.82 1.0877 1.0878 1.07 1.5241 1.5482 1.5242 1.0179 1.0181 0.9993 0.8643 0.8698 0.864 122.57 125.96 122.6 1.4328 1.4381 1.433 0.9135 0.9286 0.9136 141.81 145.39 141.63 85.53 87.77 85.55 1.6574 1.6593 1.6508 0.71 0.7234 0.7099 2010-04-28 1.3196 1.3268 1.3116 94.13 94.32 93 1.0857 1.0924 1.0814 1.5183 1.5288 1.5126 1.0093 1.0197 1.0075 0.869 0.8709 0.863 124.22 124.95 122.46 1.4328 1.4377 1.4284 0.9246 0.9265 0.9143 142.9 143.51 141.75 86.68 87.07 85.47 1.6485 1.6604 1.6455 0.7197 0.7216 0.711 2010-04-29 1.3241 1.328 1.3185 94.07 94.26 93.86 1.0828 1.087 1.0808 1.5339 1.5344 1.5144 1.005 1.0113 1.0015 0.8631 0.8733 0.8631 124.57 124.91 123.76 1.4338 1.4357 1.4328 0.9283 0.9294 0.9224 144.25 144.41 142.23 86.84 87.07 86.37 1.6607 1.6617 1.6425 0.7237 0.7243 0.7153 2010-04-30 1.3314 1.3342 1.3226 93.92 94.6 93.88 1.076 1.0846 1.0748 1.529 1.539 1.5253 1.0158 1.0178 1.0017 0.8703 0.873 0.8624 125.07 125.98 124.39 1.4327 1.4359 1.4321 0.9251 0.9324 0.9247 143.66 145.21 143.29 87.29 87.85 86.71 1.6456 1.664 1.6428 0.7268 0.7325 0.7235 2010-05-03 1.3196 1.336 1.3155 94.59 94.8 93.85 1.0854 1.0888 1.0747 1.5244 1.5319 1.5212 1.0106 1.0187 1.0103 0.8655 0.8709 0.864 124.83 125.4 124.01 1.4322 1.4343 1.4318 0.9265 0.9275 0.9228 144.19 144.63 143.01 87.13 87.46 86.58 1.6545 1.6578 1.6461 0.7314 0.7323 0.7269 2010-05-04 1.3007 1.3213 1.2994 94.41 94.98 94.33 1.1012 1.1024 1.084 1.5156 1.5267 1.5092 1.0239 1.0255 1.0105 0.858 0.8671 0.8565 122.82 125.45 122.64 1.4325 1.4338 1.4318 0.9096 0.9272 0.9086 143.08 144.9 142.63 85.72 87.59 85.61 1.6689 1.6722 1.652 0.7199 0.7312 0.719 2010-05-05 1.2818 1.2996 1.2805 93.67 94.98 93.54 1.1175 1.1187 1.1024 1.5091 1.5172 1.5068 1.0302 1.0353 1.0233 0.8491 0.8578 0.8485 120.11 123.37 119.96 1.4326 1.4337 1.4314 0.9045 0.9117 0.9021 141.33 144.03 141.24 83.82 86.11 83.74 1.6864 1.6883 1.6701 0.7162 0.7219 0.7143 2010-05-06 1.2614 1.2856 1.251 90 93.98 88.03 1.1114 1.1245 1.1018 1.4816 1.5148 1.4715 1.0534 1.074 1.0284 0.851 0.8542 0.8426 113.54 120.71 110.5 1.4023 1.4346 1.3991 0.8841 0.9093 0.8716 133.31 142.29 130.03 80.9 84.93 78.96 1.6474 1.692 1.6441 0.7099 0.7276 0.7013 2010-05-07 1.2732 1.2797 1.2587 91.37 93.11 90.03 1.1077 1.1176 1.1053 1.4815 1.4935 1.4478 1.043 1.0571 1.0341 0.8592 0.8805 0.8443 116.35 118.57 113.66 1.4106 1.4188 1.4052 0.8871 0.8938 0.8805 135.38 138.19 133.17 82.46 83.81 80.85 1.6416 1.6657 1.6095 0.7134 0.7167 0.704 2010-05-10 1.2775 1.3093 1.276 93.2 93.54 91.79 1.1108 1.1116 1.0924 1.4855 1.5053 1.4764 1.0252 1.0391 1.0211 0.86 0.8751 0.8546 119.11 122.3 118.12 1.4194 1.4332 1.4175 0.9012 0.9078 0.8924 138.47 140.56 135.84 83.9 85.41 83.14 1.6497 1.6635 1.6285 0.7206 0.7295 0.7127 2010-05-11 1.2691 1.2802 1.2667 92.75 93.4 92.22 1.1088 1.1132 1.1037 1.4948 1.5005 1.4721 1.0212 1.0287 1.0151 0.8488 0.8617 0.8476 117.69 119.41 116.92 1.4076 1.4194 1.4028 0.8972 0.9035 0.8933 138.64 139.67 135.92 83.6 84.23 82.99 1.6576 1.6624 1.6358 0.7172 0.7224 0.7162 2010-05-12 1.2626 1.2739 1.2606 93.16 93.28 92.45 1.1108 1.1138 1.106 1.4825 1.5044 1.482 1.0191 1.0246 1.0154 0.8514 0.8545 0.8446 117.62 118.43 116.59 1.4026 1.4116 1.4014 0.8929 0.898 0.889 138.13 139.83 137.44 83.85 84.12 83.04 1.647 1.6693 1.642 0.7126 0.7199 0.7107 2010-05-13 1.2545 1.2684 1.2537 92.71 93.64 92.6 1.1164 1.1172 1.1078 1.4627 1.4916 1.4616 1.0198 1.0208 1.011 0.8573 0.8594 0.8499 116.31 118.69 116.27 1.4005 1.4071 1.3999 0.896 0.9026 0.8943 135.64 139.5 135.55 83.05 84.37 83.01 1.6328 1.6546 1.6302 0.7147 0.7191 0.7138 2010-05-14 1.238 1.2575 1.2359 92.25 93.09 91.81 1.1312 1.1332 1.1152 1.4536 1.4638 1.4497 1.0318 1.0377 1.0212 0.8516 0.862 0.8502 114.23 117.01 113.51 1.4007 1.4032 1.3998 0.8852 0.8973 0.8854 134.13 136.05 133.24 81.55 83.39 81.05 1.6441 1.6472 1.626 0.7062 0.7153 0.7063 2010-05-17 1.2386 1.2414 1.2237 92.51 92.69 91.77 1.1306 1.1445 1.1297 1.4471 1.4546 1.4253 1.0331 1.0437 1.0318 0.8556 0.8597 0.8501 114.6 114.9 112.49 1.4008 1.403 1.3995 0.8756 0.8861 0.8687 133.86 134.34 131.13 81.78 81.93 80.34 1.6367 1.6477 1.6294 0.696 0.7074 0.6918 2010-05-18 1.221 1.2444 1.2162 92.36 92.96 92.12 1.1467 1.1513 1.1269 1.4333 1.452 1.4307 1.0366 1.041 1.0245 0.8518 0.8606 0.8498 112.77 115.49 112.08 1.4 1.405 1.3996 0.8651 0.8789 0.8627 132.36 134.81 131.87 80.52 82.36 80.05 1.6437 1.6476 1.6297 0.6945 0.7039 0.6923 2010-05-19 1.2386 1.2398 1.2146 91.63 92.15 90.97 1.1509 1.1584 1.1423 1.4417 1.4443 1.424 1.0433 1.0536 1.0387 0.8588 0.8605 0.8463 113.48 113.74 110.88 1.4259 1.431 1.3957 0.8461 0.8637 0.8358 132.07 132.34 129.79 79.59 80.38 78.56 1.659 1.6655 1.6347 0.6767 0.6904 0.6661 2010-05-20 1.2523 1.2598 1.2298 89.76 91.88 89 1.1494 1.1574 1.1453 1.4409 1.4461 1.4232 1.0651 1.0719 1.0419 0.869 0.8716 0.8565 112.39 114.08 109.52 1.4393 1.4457 1.4139 0.8252 0.8498 0.8153 129.3 132.73 126.78 78.08 79.79 77.09 1.6554 1.6655 1.6386 0.6701 0.6876 0.6622 2010-05-21 1.2575 1.2672 1.2464 90.03 90.47 89.09 1.1485 1.158 1.1451 1.4486 1.4496 1.4318 1.0593 1.0748 1.0552 0.868 0.8775 0.8648 113.22 114.4 111.05 1.4445 1.4603 1.4351 0.8313 0.8366 0.8077 130.42 130.81 127.82 78.36 78.8 77.36 1.664 1.666 1.6467 0.6779 0.6817 0.6642 2010-05-24 1.2384 1.2559 1.2346 90.39 90.61 89.75 1.1587 1.161 1.1492 1.4435 1.4528 1.4353 1.06 1.0659 1.0534 0.8579 0.8674 0.8579 111.99 113.25 111.24 1.4352 1.4441 1.4312 0.8296 0.8357 0.8186 130.47 131.39 129.15 78.02 78.55 77.56 1.6722 1.6772 1.6618 0.6719 0.6786 0.67 2010-05-25 1.2332 1.2353 1.2176 90.06 90.31 89.28 1.1571 1.1697 1.1568 1.4395 1.4413 1.4262 1.0712 1.0851 1.0623 0.8566 0.8588 0.8511 111.08 111.5 108.85 1.427 1.4332 1.4209 0.8234 0.8249 0.8068 129.66 130.07 127.67 77.81 77.91 76.41 1.6658 1.6759 1.6592 0.6675 0.6725 0.6563 2010-05-26 1.2191 1.2375 1.2178 90 90.67 89.83 1.1601 1.1623 1.1516 1.4403 1.4442 1.4333 1.0668 1.0746 1.0581 0.8461 0.8575 0.8454 109.73 111.81 109.43 1.4144 1.4293 1.4133 0.8245 0.8388 0.8189 129.56 130.57 129.1 77.57 78.48 77.43 1.6703 1.6748 1.6588 0.6632 0.6742 0.6608 2010-05-27 1.2345 1.2394 1.2155 90.86 91 89.86 1.1528 1.1655 1.1487 1.4574 1.4607 1.437 1.0516 1.0713 1.0487 0.8471 0.851 0.8421 112.2 112.76 109.22 1.4238 1.4275 1.4109 0.8485 0.8507 0.8213 132.41 132.85 129.15 78.81 79.18 77.39 1.6806 1.6832 1.6652 0.6818 0.6848 0.663 2010-05-28 1.2276 1.2452 1.2271 90.85 91.41 90.61 1.1585 1.1593 1.1481 1.4458 1.461 1.4435 1.0506 1.054 1.0444 0.8488 0.8547 0.8445 111.51 113.68 111.38 1.4223 1.4307 1.4209 0.8459 0.8551 0.843 131.39 133.23 130.92 78.36 79.46 78.22 1.6758 1.6837 1.669 0.6785 0.6861 0.6757 2010-05-31 1.23 1.2334 1.2267 91.08 91.61 90.93 1.1547 1.1591 1.1533 1.4538 1.4548 1.4429 1.0456 1.0551 1.0415 0.8458 0.8524 0.8444 112.03 112.91 111.6 1.4203 1.4257 1.417 0.8436 0.8515 0.8383 132.38 132.94 131.38 78.86 79.31 78.46 1.6788 1.6814 1.67 0.679 0.6846 0.6702 2010-06-01 1.2235 1.2353 1.2112 91.04 91.45 90.55 1.157 1.173 1.1471 1.4649 1.4723 1.444 1.0539 1.0562 1.0422 0.835 0.8476 0.8324 111.38 112.82 109.78 1.4161 1.422 1.4138 0.833 0.8476 0.8283 133.33 134.47 130.83 78.63 79.63 77.49 1.6951 1.705 1.671 0.6761 0.6839 0.6703 2010-06-02 1.2243 1.2275 1.2176 92.13 92.36 90.98 1.1541 1.1602 1.1529 1.465 1.4769 1.4555 1.0388 1.0573 1.0371 0.8356 0.8379 0.828 112.79 113.06 111.03 1.4133 1.4164 1.4118 0.8412 0.8412 0.8277 134.96 135.4 133.16 79.78 79.9 78.56 1.6908 1.7074 1.6866 0.6812 0.6817 0.6721 2010-06-03 1.2163 1.2326 1.2153 92.57 92.8 92.05 1.1564 1.1602 1.1537 1.4614 1.4743 1.4587 1.0408 1.0573 1.0334 0.8322 0.838 0.832 112.62 114.16 112.14 1.4068 1.4177 1.4053 0.8425 0.8522 0.8317 135.31 136.43 134.59 80.02 80.64 78.56 1.6899 1.6994 1.6845 0.6832 0.6899 0.6721 2010-06-04 1.1963 1.2215 1.1956 91.59 92.89 91.43 1.162 1.1631 1.1437 1.4466 1.4681 1.4456 1.0609 1.0624 1.0368 0.8269 0.8334 0.825 109.57 113.37 109.42 1.3904 1.4091 1.3866 0.8228 0.8477 0.8214 132.47 136.26 132.19 78.81 80.93 78.71 1.6808 1.6926 1.6734 0.6694 0.6864 0.6683 2010-06-07 1.192 1.1991 1.1878 91.63 92.08 90.99 1.163 1.1672 1.1585 1.4467 1.4562 1.439 1.0599 1.0678 1.0515 0.8239 0.8301 0.8209 109.22 110.29 108.09 1.3866 1.3942 1.3851 0.8108 0.8227 0.8097 132.56 133.84 131.13 78.74 79.34 78 1.6822 1.6915 1.6758 0.6586 0.6711 0.6585 2010-06-08 1.1943 1.2008 1.1901 91.4 91.93 90.85 1.1531 1.1641 1.1487 1.4426 1.4529 1.4347 1.048 1.0612 1.0472 0.8278 0.8337 0.8231 109.15 110.05 108.36 1.3775 1.3911 1.3744 0.8272 0.8284 0.809 131.83 133.39 130.46 79.22 79.53 78.28 1.6638 1.6894 1.6533 0.6677 0.6683 0.6576 2010-06-09 1.1979 1.2075 1.1925 91.06 91.67 91.07 1.1479 1.1555 1.1417 1.4526 1.4607 1.4398 1.044 1.0517 1.0365 0.8245 0.8287 0.8244 109.1 110.58 108.88 1.3755 1.3807 1.3737 0.8274 0.8358 0.8196 132.3 133.78 131.44 79.29 80.18 79.01 1.6673 1.6716 1.6626 0.6655 0.6748 0.6615 2010-06-10 1.2117 1.2143 1.1958 91.26 91.48 90.86 1.143 1.1504 1.14 1.4704 1.4717 1.4511 1.0313 1.0451 1.0288 0.8237 0.8282 0.8223 110.58 110.79 108.99 1.3851 1.3858 1.3749 0.8485 0.85 0.8269 134.2 134.26 132.27 79.82 80.11 79.19 1.6807 1.6841 1.6657 0.6864 0.6867 0.6699 2010-06-11 1.2091 1.2152 1.2046 91.71 91.78 91.2 1.1501 1.1546 1.1406 1.4532 1.4758 1.4505 1.0346 1.039 1.0298 0.8319 0.8324 0.8212 110.88 111.39 110.31 1.3912 1.3949 1.3814 0.8503 0.8504 0.8424 133.26 135.14 132.72 79.7 80.31 79.34 1.6721 1.6859 1.6691 0.6896 0.6906 0.6805 2010-06-14 1.2225 1.2298 1.2118 91.44 92.11 91.43 1.1422 1.1488 1.1348 1.4746 1.4808 1.4553 1.0325 1.0349 1.0225 0.8291 0.836 0.8285 111.8 112.88 111.12 1.3967 1.3984 1.3873 0.8587 0.8666 0.8511 134.81 135.89 133.45 80.03 81 79.81 1.6842 1.6866 1.6683 0.6957 0.702 0.6905 2010-06-15 1.2337 1.2349 1.2167 91.42 91.69 91.09 1.1321 1.1481 1.1295 1.4807 1.4836 1.4684 1.0259 1.036 1.0241 0.8331 0.8337 0.8262 112.79 113.05 110.88 1.397 1.4041 1.3912 0.8651 0.8652 0.8507 135.35 135.67 133.96 80.72 81.01 79.43 1.6768 1.6921 1.6736 0.6979 0.6985 0.6889 2010-06-16 1.2303 1.2355 1.2255 91.39 91.82 91.1 1.1299 1.1339 1.1251 1.4782 1.4855 1.4752 1.0242 1.0323 1.0224 0.8321 0.8339 0.8286 112.46 113.33 111.73 1.3902 1.3972 1.3863 0.8636 0.8674 0.8582 135.12 135.97 134.56 80.86 81.31 80.52 1.6699 1.6789 1.6683 0.6978 0.7003 0.6932 2010-06-17 1.2385 1.2412 1.2243 90.97 91.44 90.52 1.1117 1.1329 1.1096 1.4819 1.4838 1.4646 1.0269 1.0337 1.0225 0.8355 0.8384 0.8339 112.65 113.21 111.66 1.3772 1.3923 1.374 0.8673 0.8686 0.8584 134.82 135.49 133.57 81.79 82.08 80.53 1.648 1.6666 1.6432 0.7031 0.7035 0.695 2010-06-18 1.2384 1.2416 1.2351 90.67 90.96 90.42 1.1082 1.1132 1.1066 1.4826 1.4866 1.4768 1.0215 1.0312 1.0215 0.8358 0.8373 0.8323 112.36 112.8 111.86 1.3729 1.3786 1.3713 0.872 0.873 0.8649 134.37 135.19 133.9 81.81 81.94 81.4 1.6424 1.6386 1.6424 0.7065 0.7073 0.7014 2010-06-21 1.2304 1.2486 1.2304 90.96 91.48 90.3 1.1137 1.1137 1.101 1.4739 1.4936 1.4741 1.0257 1.026 1.0139 0.8347 0.8381 0.8328 111.96 113.41 111.87 1.3704 1.3761 1.3687 0.8753 0.8859 0.8754 134.07 136.03 134.01 81.65 82.53 81.65 1.6414 1.651 1.6372 0.7069 0.7152 0.7072 2010-06-22 1.2271 1.2353 1.2251 90.34 91.1 90.35 1.1068 1.1121 1.1037 1.4811 1.4859 1.4689 1.0284 1.0295 1.0182 0.8284 0.8368 0.8274 110.86 112.46 110.89 1.3586 1.3703 1.3584 0.8724 0.8832 0.8722 133.81 134.76 133.13 81.58 82.2 81.51 1.6397 1.6441 1.6301 0.7047 0.7119 0.7044 2010-06-23 1.2321 1.2343 1.221 89.94 90.58 89.74 1.1042 1.1138 1.1022 1.4953 1.4973 1.4804 1.0368 1.0459 1.0274 0.8235 0.8287 0.8202 110.81 111.38 109.93 1.3605 1.3616 1.3548 0.8744 0.878 0.8662 134.46 134.97 133.73 81.43 81.89 80.83 1.6511 1.658 1.6399 0.7139 0.7162 0.7028 2010-06-24 1.2329 1.2387 1.2263 89.48 89.98 89.23 1.102 1.1068 1.0988 1.4924 1.501 1.4926 1.0432 1.0469 1.0375 0.8259 0.8274 0.8181 110.31 111 109.56 1.3587 1.3629 1.3551 0.8669 0.8771 0.8642 133.52 134.87 133.5 81.17 81.49 80.78 1.645 1.6582 1.6441 0.7089 0.7142 0.7038 2010-06-25 1.2378 1.2395 1.2253 89.25 89.77 89.23 1.0924 1.1046 1.0925 1.5039 1.5043 1.4857 1.0367 1.0442 1.0341 0.823 0.8272 0.8203 110.5 110.89 109.59 1.3523 1.3601 1.346 0.8744 0.876 0.8596 134.27 134.52 133.15 81.66 81.87 81.15 1.6423 1.6488 1.6375 0.7138 0.7157 0.6997 2010-06-28 1.2279 1.2397 1.2266 89.39 89.47 89.07 1.0868 1.0941 1.0818 1.5111 1.5128 1.502 1.0348 1.0371 1.032 0.8124 0.8237 0.8122 109.75 110.8 109.61 1.3342 1.3544 1.3329 0.8731 0.8776 0.8708 135.05 135.24 134.22 82.22 82.53 81.64 1.642 1.6469 1.6298 0.7086 0.7148 0.7062 2010-06-29 1.2188 1.229 1.2152 88.46 89.42 88.29 1.0803 1.0903 1.0803 1.5062 1.5119 1.5014 1.0566 1.0574 1.0344 0.8089 0.8136 0.8068 107.83 109.86 107.33 1.3169 1.3362 1.3169 0.8481 0.8721 0.8473 133.25 135.13 132.85 81.86 82.25 81.24 1.6276 1.6438 1.6273 0.692 0.7085 0.6911 2010-06-30 1.2229 1.2304 1.2167 88.36 88.76 88.37 1.0775 1.0854 1.0754 1.4938 1.5073 1.4936 1.0645 1.0646 1.0467 0.8186 0.8227 0.809 108.07 109.12 107.7 1.3177 1.3288 1.3177 0.8408 0.8566 0.841 131.99 133.6 132.03 81.96 82.3 81.67 1.6096 1.6331 1.6099 0.6856 0.6954 0.6857 2010-07-01 1.2522 1.2539 1.2194 87.55 88.56 86.97 1.0585 1.0788 1.0581 1.518 1.519 1.4875 1.0586 1.0674 1.0578 0.8247 0.8256 0.8167 109.63 109.81 107.52 1.3258 1.3401 1.3074 0.8431 0.8448 0.8317 132.87 133.03 131.33 82.66 82.75 81.25 1.6069 1.6295 1.595 0.6897 0.6914 0.6796 2010-07-02 1.2547 1.2613 1.2483 87.73 88.21 87.34 1.0646 1.0697 1.0588 1.5194 1.5229 1.5152 1.063 1.0668 1.0558 0.8257 0.8299 0.8219 110.08 110.74 109.58 1.3362 1.3437 1.322 0.8431 0.851 0.8403 133.28 133.86 132.75 82.38 83.14 82 1.6181 1.6251 1.6056 0.6883 0.697 0.6874 2010-07-05 1.2533 1.2563 1.2509 87.75 88 87.64 1.0646 1.0674 1.0619 1.5129 1.5199 1.5091 1.0647 1.0676 1.0576 0.828 0.8298 0.8253 110.02 110.42 109.73 1.335 1.3367 1.3308 0.8384 0.8468 0.8372 132.74 133.66 132.41 82.42 82.79 82.21 1.6112 1.6184 1.6057 0.687 0.6941 0.6856 2010-07-06 1.2614 1.2662 1.2481 87.46 87.99 87.36 1.0594 1.0666 1.0561 1.5133 1.5227 1.5084 1.0557 1.0677 1.0487 0.8333 0.8342 0.8266 110.35 110.85 109.15 1.3363 1.3418 1.3283 0.8491 0.8559 0.8318 132.38 133.68 131.9 82.51 83.08 82.01 1.6025 1.6174 1.6034 0.6916 0.6974 0.6828 2010-07-07 1.2634 1.2664 1.2554 87.73 87.74 87.02 1.052 1.0637 1.051 1.5193 1.5219 1.508 1.0486 1.0606 1.0476 0.8316 0.8339 0.8292 110.84 110.88 109.32 1.3291 1.339 1.3265 0.8646 0.8664 0.8451 133.29 133.32 131.24 83.34 83.41 81.9 1.5983 1.6086 1.5973 0.7038 0.7051 0.6887 2010-07-08 1.2693 1.27 1.2622 88.36 88.64 87.68 1.0487 1.0564 1.0483 1.5158 1.5241 1.5103 1.0436 1.0484 1.038 0.8374 0.8381 0.831 112.16 112.52 110.75 1.3317 1.3357 1.326 0.8759 0.8791 0.8623 133.96 134.58 133.07 84.23 84.35 83.33 1.5896 1.6036 1.5883 0.7086 0.7103 0.7025 2010-07-09 1.2639 1.2722 1.2608 88.64 88.71 88.38 1.0554 1.0597 1.0491 1.5064 1.5204 1.5052 1.033 1.0454 1.0297 0.8387 0.8398 0.8333 112.04 112.67 111.53 1.3342 1.3397 1.331 0.8763 0.878 0.8728 133.51 134.64 133.25 83.96 84.49 83.48 1.59 1.6058 1.5891 0.7104 0.7114 0.7064 2010-07-12 1.2589 1.2647 1.255 88.6 89.15 88.4 1.0597 1.0675 1.0549 1.5029 1.5086 1.495 1.0373 1.0386 1.0301 0.8375 0.8417 0.8341 111.52 112.39 111.14 1.3342 1.341 1.3305 0.8745 0.8776 0.8703 133.16 133.99 132.59 83.58 84.42 82.99 1.5928 1.6052 1.5835 0.7099 0.7108 0.7059 2010-07-13 1.2717 1.2737 1.2523 88.43 88.86 88.04 1.0547 1.0645 1.0515 1.5166 1.5191 1.4966 1.0322 1.0385 1.0278 0.8382 0.8392 0.8316 112.47 112.52 110.69 1.341 1.3414 1.3312 0.8816 0.8829 0.8683 134.1 134.25 132.48 83.82 83.98 83.12 1.5991 1.6055 1.5908 0.7191 0.7207 0.7078 2010-07-14 1.2737 1.2778 1.2683 88.25 89.11 88.08 1.053 1.0617 1.0531 1.5255 1.5296 1.5175 1.0341 1.037 1.0288 0.8347 0.8384 0.832 112.43 113.29 112.05 1.3415 1.349 1.3409 0.8825 0.8871 0.8787 134.64 135.81 134.32 83.79 84.41 83.46 1.6063 1.6169 1.6001 0.7224 0.7255 0.7161 2010-07-15 1.2914 1.2919 1.2709 87.55 88.43 87.24 1.0418 1.0548 1.0401 1.544 1.5445 1.5238 1.0369 1.0442 1.0283 0.8362 0.8402 0.8325 113.06 113.43 111.82 1.3454 1.3472 1.338 0.8832 0.8847 0.8728 135.21 135.58 134.02 83.99 84.35 83.46 1.6085 1.611 1.5986 0.7291 0.7297 0.7176 2010-07-16 1.2925 1.3007 1.2891 86.57 87.5 86.27 1.0521 1.0542 1.04 1.5299 1.5449 1.5279 1.054 1.0558 1.0382 0.8446 0.8462 0.8365 111.89 113.35 111.56 1.3598 1.3625 1.3457 0.8688 0.8844 0.8683 132.46 135.07 132.04 82.26 83.97 82.04 1.6096 1.6133 1.6004 0.7106 0.7281 0.71 2010-07-19 1.2945 1.2991 1.2872 86.82 87.21 86.49 1.0552 1.056 1.0451 1.5227 1.5352 1.5204 1.055 1.058 1.05 0.8496 0.8532 0.8424 112.4 113.05 111.45 1.3665 1.3673 1.351 0.87 0.8719 0.8635 132.24 133.43 131.82 82.23 83.11 82.22 1.6079 1.6108 1.599 0.7068 0.7112 0.7031 2010-07-20 1.2889 1.3028 1.284 87.37 87.48 86.7 1.0524 1.0556 1.0453 1.5283 1.5309 1.5154 1.0452 1.0586 1.0435 0.8433 0.8534 0.8434 112.63 113.33 111.48 1.3566 1.3681 1.3502 0.8827 0.8838 0.8669 133.5 133.64 131.52 83 83.5 82.21 1.608 1.6091 1.5923 0.7157 0.7162 0.7047 2010-07-21 1.2766 1.2913 1.2733 87.03 87.47 86.88 1.05 1.0543 1.0486 1.5166 1.5334 1.5126 1.0473 1.0501 1.0352 0.8414 0.848 0.8376 111.11 112.83 110.79 1.3405 1.3579 1.3396 0.8781 0.8859 0.8764 132.02 133.72 131.62 82.88 83.22 82.53 1.5923 1.6112 1.5921 0.713 0.7195 0.7122 2010-07-22 1.2889 1.2929 1.2739 86.89 87.22 86.35 1.0425 1.0512 1.0394 1.5269 1.5296 1.5152 1.0392 1.0503 1.0355 0.844 0.8466 0.8388 112 112.75 110.03 1.3438 1.3464 1.3344 0.8922 0.8953 0.8739 132.66 133.31 130.87 83.32 83.78 82.24 1.592 1.5958 1.5854 0.7239 0.7272 0.7099 2010-07-23 1.2909 1.2967 1.2794 87.3 87.52 86.75 1.0534 1.0563 1.0408 1.5419 1.5449 1.5255 1.0365 1.0434 1.0347 0.8371 0.8453 0.8319 112.73 113 111.62 1.3601 1.3609 1.342 0.8961 0.897 0.8897 134.62 135.01 132.47 82.88 83.71 82.69 1.6239 1.6271 1.5917 0.7259 0.7291 0.7227 2010-07-26 1.2995 1.3005 1.2878 86.88 87.71 86.83 1.0477 1.0556 1.0462 1.5481 1.552 1.5411 1.032 1.0385 1.0303 0.8392 0.8397 0.8323 112.92 113.46 112.22 1.3624 1.3632 1.3549 0.9031 0.9035 0.893 134.51 135.56 134.42 82.87 83.41 82.54 1.6227 1.6346 1.619 0.734 0.7353 0.7248 2010-07-27 1.3002 1.3045 1.2953 87.88 87.96 86.84 1.0598 1.064 1.0482 1.5587 1.5591 1.5444 1.0361 1.0395 1.0254 0.8338 0.8416 0.8334 114.3 114.33 112.81 1.3779 1.3797 1.3617 0.902 0.9068 0.9001 137.01 137.08 134.48 82.93 83.02 82.36 1.652 1.6538 1.6232 0.7324 0.7395 0.7315 2010-07-28 1.2979 1.3041 1.2968 87.43 88.11 87.27 1.0571 1.0622 1.0538 1.5576 1.5638 1.5548 1.0385 1.0389 1.0298 0.8328 0.8367 0.8314 113.49 114.74 113.24 1.3721 1.3817 1.3717 0.8921 0.9025 0.8909 136.18 137.54 135.93 82.69 83.24 82.53 1.6463 1.656 1.6458 0.7282 0.7338 0.7258 2010-07-29 1.3085 1.3106 1.2979 86.83 87.51 86.58 1.0407 1.0579 1.0375 1.5618 1.5662 1.5581 1.0353 1.0392 1.0299 0.8378 0.8395 0.8326 113.63 114.21 113.2 1.3621 1.3756 1.3582 0.9007 0.9042 0.8908 135.62 136.87 135.01 83.38 83.96 82.45 1.6254 1.6503 1.6192 0.7239 0.7286 0.7207 2010-07-30 1.3054 1.3093 1.2981 86.43 86.93 85.95 1.0401 1.0465 1.0364 1.5702 1.5722 1.5553 1.0267 1.0375 1.0264 0.831 0.838 0.8304 112.81 113.7 112.04 1.3578 1.3634 1.351 0.9057 0.9066 0.8967 135.7 136.07 134.22 83.03 83.46 82.65 1.6331 1.6392 1.6182 0.7259 0.7267 0.7193 2010-08-02 1.3167 1.3195 1.3055 86.46 86.88 86.33 1.0394 1.0477 1.0349 1.5888 1.5908 1.5698 1.023 1.0298 1.0205 0.8285 0.8325 0.8255 113.86 114.19 112.74 1.3687 1.3702 1.3583 0.9127 0.9147 0.9046 137.4 137.66 135.55 83.15 83.44 82.81 1.6516 1.6567 1.6331 0.7325 0.7342 0.7264 2010-08-03 1.3229 1.3261 1.3147 85.82 86.66 85.69 1.0388 1.0414 1.0348 1.5942 1.5968 1.5863 1.0237 1.0273 1.022 0.8296 0.8316 0.8271 113.56 114.14 113.13 1.3749 1.3756 1.3662 0.9127 0.9149 0.9072 136.82 137.76 136.36 82.57 83.37 82.5 1.6568 1.6582 1.6471 0.7345 0.7355 0.73 2010-08-04 1.316 1.3239 1.3132 86.24 86.41 85.33 1.0523 1.0557 1.038 1.5893 1.5967 1.5859 1.0174 1.027 1.0164 0.8279 0.8308 0.8274 113.53 113.74 112.73 1.3856 1.3869 1.373 0.9169 0.9182 0.9095 137.05 137.33 135.87 81.92 82.62 81.69 1.6731 1.6749 1.6552 0.735 0.7356 0.73 2010-08-05 1.3178 1.3234 1.312 85.77 86.49 85.72 1.046 1.0542 1.0412 1.5882 1.5929 1.5822 1.0168 1.0187 1.0107 0.8297 0.8324 0.8273 113.03 113.94 112.77 1.3789 1.388 1.3754 0.9147 0.9173 0.9117 136.18 137.57 135.8 81.92 82.53 81.68 1.6621 1.6765 1.6569 0.7281 0.7356 0.7248 2010-08-06 1.3288 1.3333 1.3158 85.38 86.22 85.03 1.0376 1.0508 1.0334 1.596 1.6002 1.5841 1.0273 1.0306 1.0146 0.8321 0.8338 0.8288 113.45 113.73 112.6 1.3787 1.3846 1.3745 0.9187 0.9221 0.9136 136.27 137.12 135.51 82.27 82.43 81.53 1.6559 1.6694 1.6514 0.7323 0.7344 0.7273 2010-08-09 1.3223 1.3307 1.3217 85.84 85.96 85.31 1.0487 1.0498 1.036 1.5903 1.5997 1.5895 1.0268 1.0299 1.0256 0.8313 0.8337 0.8292 113.52 113.99 113.3 1.3867 1.3882 1.3757 0.9163 0.9205 0.9154 136.53 137.08 136.25 81.84 82.51 81.8 1.6675 1.6711 1.6547 0.7282 0.7343 0.7268 2010-08-10 1.3191 1.3234 1.3075 85.34 86.24 85.19 1.0477 1.0618 1.0463 1.5856 1.591 1.5712 1.0313 1.0388 1.027 0.8316 0.8362 0.8299 112.57 113.79 112.31 1.3821 1.3924 1.3796 0.914 0.9166 0.906 135.31 136.82 134.9 81.4 82.04 81.03 1.6609 1.6693 1.6584 0.724 0.7291 0.7169 2010-08-11 1.2884 1.319 1.2864 85.33 85.49 84.75 1.0577 1.0604 1.047 1.5682 1.5866 1.563 1.0449 1.0475 1.0304 0.8213 0.8322 0.8213 109.94 112.67 109.67 1.363 1.3824 1.3598 0.8981 0.9134 0.8982 133.8 135.52 132.85 80.64 81.58 80.32 1.6588 1.6679 1.6479 0.7161 0.7246 0.7147 2010-08-12 1.2828 1.2932 1.2782 85.88 86.03 84.94 1.0498 1.0616 1.0466 1.5575 1.5716 1.5563 1.0425 1.0494 1.0421 0.8234 0.8266 0.8204 110.16 110.9 109.23 1.3468 1.3668 1.3461 0.8954 0.9008 0.8916 133.75 134.75 133.02 81.76 82.08 80.23 1.6351 1.6629 1.6307 0.7087 0.716 0.7067 2010-08-13 1.2753 1.2906 1.2753 86.28 86.39 85.58 1.052 1.0551 1.0482 1.5591 1.568 1.5572 1.0408 1.0439 1.0351 0.8178 0.8259 0.8174 110.02 111.12 109.56 1.342 1.354 1.3422 0.8929 0.9035 0.8928 134.53 134.87 133.4 81.98 82.17 81.27 1.6405 1.6479 1.6352 0.7055 0.7183 0.7054 2010-08-16 1.2816 1.2871 1.2735 85.32 86.28 85.22 1.0399 1.0534 1.0352 1.5646 1.5707 1.5537 1.044 1.0464 1.0371 0.8188 0.8228 0.8179 109.33 110.31 109.18 1.3328 1.3451 1.3273 0.8973 0.8997 0.8861 133.46 134.58 133.2 82 82.65 81.5 1.627 1.6406 1.6145 0.7075 0.7105 0.7 2010-08-17 1.288 1.2915 1.2805 85.47 85.7 85.13 1.0429 1.0447 1.0363 1.5576 1.5697 1.5554 1.0331 1.0438 1.0309 0.8267 0.8284 0.8184 110.11 110.51 109.1 1.3442 1.346 1.3301 0.9058 0.9082 0.8947 133.15 133.98 133.1 81.89 82.27 81.73 1.6256 1.6355 1.622 0.7125 0.7149 0.7042 2010-08-18 1.286 1.2923 1.2824 85.43 85.69 85.2 1.0413 1.0453 1.0386 1.56 1.5688 1.55 1.028 1.034 1.0271 0.8243 0.8282 0.8222 109.9 110.37 109.6 1.3394 1.345 1.336 0.8993 0.9058 0.8973 133.3 133.75 132.47 82.03 82.17 81.75 1.6251 1.6334 1.6137 0.7148 0.7192 0.7103 2010-08-19 1.2819 1.2902 1.2773 85.32 85.91 84.9 1.0313 1.0465 1.0259 1.5597 1.5672 1.5504 1.0386 1.0415 1.0246 0.8218 0.825 0.8193 109.38 110.17 109.21 1.3227 1.3406 1.3206 0.8918 0.9018 0.8906 133.09 134.05 132.82 82.71 82.85 81.85 1.6084 1.628 1.6045 0.7071 0.7156 0.7058 2010-08-20 1.2708 1.2832 1.2664 85.68 85.85 85.2 1.0352 1.0394 1.0289 1.553 1.5597 1.5464 1.0486 1.0513 1.0383 0.8183 0.8248 0.8172 108.89 109.59 108.25 1.3157 1.3239 1.314 0.8924 0.8932 0.8843 133.06 133.38 132 82.75 82.99 82.31 1.6072 1.6116 1.6016 0.7065 0.7082 0.7005 2010-08-23 1.2665 1.2731 1.2647 85.19 85.68 85.09 1.0407 1.0408 1.0304 1.5519 1.562 1.5502 1.0522 1.0529 1.0445 0.8158 0.818 0.8141 107.9 108.9 107.73 1.3179 1.3193 1.3106 0.8916 0.8982 0.8865 132.24 133.42 132.05 81.84 82.87 81.83 1.6149 1.6167 1.6055 0.7068 0.7124 0.7042 2010-08-24 1.2674 1.2718 1.2587 84.17 85.2 83.61 1.0304 1.0452 1.0288 1.543 1.5513 1.5373 1.0597 1.0663 1.0517 0.8209 0.8221 0.815 106.68 107.85 105.44 1.306 1.3181 1.3048 0.8841 0.8908 0.8798 129.88 132.14 128.8 81.67 81.97 80.34 1.5898 1.6153 1.5901 0.705 0.7078 0.7008 2010-08-25 1.2653 1.2725 1.2607 84.79 84.83 84.08 1.0302 1.0329 1.025 1.5446 1.547 1.539 1.0592 1.0667 1.0575 0.819 0.8239 0.8178 107.26 107.64 106.24 1.3041 1.3085 1.2973 0.8832 0.8895 0.8772 130.93 131.07 129.6 82.22 82.46 81.52 1.5916 1.5929 1.5831 0.6984 0.7063 0.6949 2010-08-26 1.2735 1.2764 1.2651 84.45 84.9 84.33 1.0232 1.032 1.0224 1.5539 1.5597 1.5468 1.0553 1.0602 1.0522 0.8194 0.8198 0.8155 107.56 108.02 107.08 1.3031 1.3142 1.3011 0.8885 0.8916 0.8833 131.19 132.04 130.86 82.53 82.71 82.05 1.5894 1.607 1.5895 0.7041 0.7088 0.6985 2010-08-27 1.2738 1.2778 1.2677 85.33 85.49 84.28 1.029 1.03 1.0222 1.5517 1.5539 1.5445 1.0517 1.0648 1.0507 0.8207 0.8233 0.8178 108.71 108.94 107.01 1.3111 1.312 1.2995 0.8992 0.8998 0.8846 132.41 132.61 130.47 82.88 83.14 82.16 1.5975 1.5983 1.5836 0.7117 0.7129 0.7019 2010-08-30 1.2662 1.2769 1.266 84.63 85.92 84.56 1.0258 1.0315 1.0237 1.5459 1.558 1.5457 1.0597 1.0599 1.0474 0.8188 0.8218 0.8162 107.17 109.6 107.12 1.2997 1.3147 1.2983 0.893 0.903 0.8927 130.82 133.67 130.83 82.43 83.38 82.17 1.5866 1.6034 1.5839 0.7085 0.7135 0.7081 2010-08-31 1.2684 1.2743 1.2626 83.96 84.66 83.83 1.0142 1.0263 1.0136 1.535 1.5477 1.5329 1.0655 1.0672 1.0576 0.8262 0.8288 0.8172 106.5 107.76 106.2 1.2866 1.3 1.2853 0.8905 0.8956 0.8862 128.87 130.96 128.69 82.75 83.19 82.11 1.5565 1.5875 1.5554 0.697 0.705 0.6966 2010-09-01 1.2802 1.2855 1.2664 84.47 84.66 83.69 1.0157 1.0185 1.0066 1.5453 1.5491 1.5337 1.0512 1.0656 1.0486 0.8284 0.8328 0.8249 108.15 108.6 106.6 1.3009 1.3043 1.2869 0.9092 0.9098 0.8913 130.54 130.94 128.81 83.1 83.85 82.65 1.5697 1.5736 1.5518 0.7115 0.7131 0.6989 2010-09-02 1.2815 1.2848 1.2777 84.25 84.55 84.01 1.0133 1.0186 1.0096 1.5392 1.5455 1.5351 1.0529 1.0556 1.0473 0.8325 0.8349 0.8282 107.97 108.31 107.46 1.2988 1.3038 1.2944 0.9118 0.912 0.9055 129.69 130.59 129.2 83.11 83.42 82.59 1.5595 1.5724 1.5535 0.7147 0.7178 0.7099 2010-09-03 1.2891 1.2897 1.281 84.4 85.22 84.18 1.0164 1.0238 1.0118 1.5456 1.5466 1.5391 1.0392 1.0569 1.0386 0.8336 0.8349 0.8299 108.77 109.56 107.94 1.3106 1.3163 1.2976 0.9161 0.9175 0.9068 130.4 131.68 129.7 82.97 83.41 82.88 1.5717 1.5812 1.5578 0.7205 0.7218 0.7133 2010-09-06 1.2872 1.2918 1.2866 84.2 84.49 84.05 1.0125 1.0183 1.0109 1.5402 1.5489 1.5347 1.0344 1.0403 1.0338 0.8356 0.8391 0.833 108.37 108.94 108.29 1.3038 1.3132 1.302 0.917 0.9182 0.9147 129.66 130.66 129.27 83.11 83.29 82.71 1.5596 1.5755 1.5569 0.7225 0.7257 0.7184 2010-09-07 1.2698 1.2876 1.2683 83.78 84.26 83.52 1.0098 1.0148 1.008 1.5373 1.5424 1.5297 1.0462 1.0477 1.0351 0.8258 0.8364 0.8257 106.4 108.37 106.29 1.2822 1.3026 1.2813 0.9121 0.9177 0.9093 128.79 129.6 127.93 82.95 83.39 82.63 1.5519 1.5594 1.5427 0.7202 0.7239 0.7188 2010-09-08 1.2712 1.2763 1.266 83.92 84.04 83.35 1.0119 1.0139 1.0063 1.5467 1.5533 1.5346 1.0368 1.0509 1.0346 0.8218 0.8272 0.8202 106.66 107.11 105.79 1.2863 1.292 1.2765 0.917 0.9194 0.9099 129.77 130.32 128.08 82.91 83.21 82.5 1.565 1.5692 1.5504 0.7217 0.7239 0.7161 2010-09-09 1.2703 1.2767 1.2665 83.89 84.02 83.5 1.015 1.0169 1.01 1.5442 1.5477 1.5376 1.0331 1.0394 1.0302 0.8225 0.8268 0.8211 106.59 106.96 105.97 1.2897 1.2932 1.2821 0.9243 0.9277 0.9172 129.57 129.97 128.57 82.63 83.06 82.28 1.5675 1.5704 1.5556 0.7256 0.7287 0.7203 2010-09-10 1.2707 1.2747 1.2645 84.18 84.38 83.76 1.0195 1.0277 1.0137 1.5351 1.5466 1.5346 1.0353 1.0374 1.0289 0.8276 0.8288 0.8214 106.95 107.38 106.27 1.2954 1.3072 1.2866 0.9264 0.9268 0.9206 129.22 130.05 129.03 82.53 82.84 81.87 1.5649 1.5855 1.5613 0.7277 0.73 0.7229 2010-09-13 1.2872 1.2892 1.2706 83.62 84.36 83.51 1.0076 1.0205 1.0072 1.5417 1.5488 1.5356 1.0265 1.0345 1.0266 0.8348 0.8358 0.8273 107.63 107.97 107 1.2971 1.3039 1.2947 0.9353 0.9362 0.929 128.92 130.11 128.8 82.96 83.29 82.56 1.5531 1.5742 1.5528 0.7341 0.7345 0.7285 2010-09-14 1.3011 1.3033 1.283 83.09 83.75 82.93 0.995 1.0097 0.9934 1.5562 1.5586 1.5348 1.0255 1.0305 1.0216 0.836 0.8387 0.8329 108.11 108.26 106.78 1.2947 1.2999 1.2874 0.9422 0.9458 0.9314 129.32 129.44 127.68 83.48 83.62 82.59 1.5481 1.5571 1.5381 0.7363 0.7395 0.7269 2010-09-15 1.3012 1.3036 1.2956 85.59 85.77 82.88 1.0035 1.0051 0.995 1.5617 1.5651 1.545 1.0262 1.0319 1.0252 0.833 0.8399 0.8313 111.35 111.67 107.75 1.3057 1.307 1.2932 0.9388 0.9428 0.9344 133.66 134.06 128.58 85.26 85.52 83.27 1.5667 1.5709 1.5438 0.7316 0.7356 0.73 2010-09-16 1.3083 1.3117 1.2977 85.81 85.84 85.23 1.0142 1.017 0.9998 1.5631 1.5649 1.554 1.0261 1.029 1.0239 0.8367 0.8402 0.831 112.2 112.39 110.67 1.3272 1.33 1.2992 0.9363 0.9395 0.9332 134.1 134.26 133.01 84.54 85.62 84.2 1.5856 1.5879 1.5585 0.7237 0.7285 0.7217 2010-09-17 1.3042 1.3159 1.3019 85.76 85.92 85.6 1.0095 1.0183 1.007 1.5626 1.5728 1.5598 1.0307 1.035 1.0213 0.8344 0.8381 0.8329 111.88 112.98 111.6 1.3167 1.3391 1.3141 0.9365 0.9468 0.9352 134.05 135.03 133.71 84.93 85.06 84.21 1.5772 1.6003 1.577 0.726 0.7332 0.724 2010-09-20 1.3064 1.312 1.3028 85.75 85.8 85.52 1.005 1.0121 1.0031 1.555 1.5685 1.5538 1.0284 1.0346 1.0261 0.84 0.841 0.8334 112.02 112.36 111.68 1.3132 1.3231 1.3115 0.9472 0.9494 0.9364 133.3 134.44 133.25 85.28 85.42 84.66 1.5631 1.5856 1.5615 0.7289 0.7321 0.7254 2010-09-21 1.3242 1.3281 1.3059 85.13 85.77 84.99 0.9967 1.0074 0.9964 1.5615 1.5643 1.5504 1.0265 1.033 1.0218 0.8478 0.8492 0.839 112.72 112.91 111.49 1.3202 1.324 1.3116 0.9527 0.9564 0.9443 132.9 133.42 132.37 85.36 85.44 84.82 1.5563 1.5697 1.5536 0.7319 0.7352 0.726 2010-09-22 1.3393 1.344 1.3248 84.51 85.18 84.28 0.9859 0.9985 0.9837 1.5668 1.5715 1.5604 1.0293 1.0358 1.0192 0.8547 0.8578 0.8463 113.19 113.58 112.57 1.3211 1.3276 1.3183 0.955 0.9599 0.951 132.4 133.39 131.76 85.67 85.85 85.02 1.545 1.5641 1.5401 0.7374 0.7417 0.7321 2010-09-23 1.3314 1.3413 1.3305 84.33 84.67 84.27 0.9856 0.9905 0.9807 1.5679 1.5741 1.5613 1.0336 1.0379 1.0279 0.8488 0.8564 0.8472 112.26 113.43 112.19 1.3124 1.3246 1.3102 0.9491 0.9576 0.9468 132.2 132.77 131.85 85.53 85.95 85.33 1.5455 1.551 1.5394 0.7295 0.7382 0.7266 2010-09-24 1.3484 1.3492 1.3287 84.31 85.38 84.12 0.985 0.9879 0.978 1.5822 1.5843 1.5643 1.0265 1.0354 1.0226 0.8521 0.8545 0.8484 113.68 113.77 112.34 1.3285 1.3289 1.3075 0.9588 0.9615 0.9464 133.38 133.74 132.32 85.55 86.48 85.54 1.5583 1.5607 1.537 0.734 0.736 0.7274 2010-09-27 1.3472 1.3506 1.3426 84.2 84.39 84.12 0.9842 0.987 0.9818 1.5852 1.5867 1.5788 1.0276 1.0293 1.0223 0.8496 0.8522 0.8494 113.41 113.75 113.08 1.3262 1.3296 1.3235 0.9621 0.9644 0.9575 133.45 133.68 132.94 85.51 85.78 85.25 1.5605 1.5632 1.5552 0.7348 0.7368 0.7326 2010-09-28 1.3583 1.3595 1.3382 83.91 84.34 83.7 0.9765 0.9877 0.974 1.5798 1.5895 1.572 1.0302 1.0361 1.0286 0.8596 0.8604 0.8467 113.98 114 112.69 1.3266 1.3294 1.3167 0.9678 0.9686 0.9561 132.59 133.76 131.98 85.9 86.05 85.2 1.5428 1.5661 1.5388 0.7392 0.7404 0.7306 2010-09-29 1.3627 1.3647 1.3567 83.65 84.07 83.51 0.9764 0.9814 0.9735 1.5781 1.5874 1.5764 1.0337 1.0341 1.0241 0.8634 0.8643 0.8571 113.99 114.16 113.51 1.3308 1.3348 1.324 0.9682 0.9731 0.9659 132.01 132.92 131.86 85.64 86.09 85.29 1.541 1.5514 1.5395 0.7365 0.7407 0.7358 2010-09-30 1.3632 1.3683 1.356 83.51 83.81 83.17 0.9823 0.9839 0.9709 1.5707 1.5922 1.567 1.0285 1.0346 1.0231 0.8676 0.8685 0.8562 113.83 114.22 113 1.339 1.34 1.3266 0.9664 0.9733 0.9625 131.13 132.73 130.88 85 85.81 84.86 1.543 1.552 1.536 0.7342 0.7409 0.7307 2010-10-01 1.3778 1.3783 1.362 83.28 83.58 83.16 0.9748 0.9843 0.9749 1.5834 1.5871 1.5705 1.0195 1.0313 1.0188 0.87 0.8705 0.8659 114.75 114.86 113.78 1.3431 1.3464 1.336 0.9726 0.975 0.9637 131.86 132.09 131.15 85.4 85.47 84.87 1.5432 1.5521 1.5395 0.7442 0.7462 0.7331 2010-10-04 1.3683 1.3808 1.3667 83.4 83.86 83.19 0.9721 0.9789 0.9705 1.5829 1.587 1.575 1.0223 1.0244 1.0179 0.8643 0.8726 0.8631 114.13 115.27 113.77 1.3303 1.3465 1.3295 0.9669 0.9727 0.9652 132.02 132.38 131.18 85.76 85.8 85.12 1.5387 1.5468 1.5338 0.7407 0.7442 0.7396 2010-10-05 1.383 1.3859 1.3639 83.2 83.98 82.97 0.9672 0.9737 0.9646 1.5887 1.593 1.5774 1.0169 1.0272 1.0154 0.8703 0.8715 0.8627 115.07 115.35 113.9 1.3377 1.3393 1.3265 0.9715 0.9725 0.9542 132.17 133.02 131.91 85.99 86.39 85.79 1.5357 1.5406 1.5308 0.7488 0.7497 0.7363 2010-10-06 1.3935 1.3947 1.38 82.9 83.26 82.77 0.9607 0.9686 0.96 1.5885 1.5938 1.5833 1.0103 1.0166 1.0063 0.8772 0.8773 0.869 115.52 115.65 114.69 1.339 1.3418 1.3323 0.9773 0.9791 0.9694 131.68 132.44 131.46 86.25 86.36 85.78 1.526 1.5428 1.5257 0.7521 0.7548 0.746 2010-10-07 1.3917 1.4028 1.3858 82.37 83.02 82.12 0.9667 0.9701 0.9556 1.5869 1.6017 1.5829 1.018 1.0212 1.0077 0.8768 0.8804 0.8732 114.64 115.66 114.25 1.3457 1.3487 1.3364 0.9813 0.992 0.9758 130.67 131.88 130.49 85.17 86.28 84.97 1.534 1.5434 1.5191 0.7493 0.7592 0.7469 2010-10-08 1.3922 1.3983 1.3835 82.07 82.57 81.74 0.9634 0.9697 0.9593 1.5951 1.5965 1.5824 1.011 1.0227 1.0109 0.8728 0.8803 0.8711 114.26 114.94 113.65 1.3415 1.3496 1.3364 0.9861 0.9872 0.9711 130.91 131 130.06 85.17 85.57 84.76 1.5367 1.5382 1.5271 0.7545 0.7551 0.7428 2010-10-11 1.3875 1.4011 1.3867 82.09 82.19 81.4 0.9647 0.9663 0.9589 1.5871 1.5962 1.587 1.0143 1.015 1.0089 0.8741 0.878 0.8728 113.91 114.75 113.85 1.3382 1.3493 1.3376 0.9838 0.9906 0.9822 130.28 131.03 129.93 85.12 85.5 84.85 1.5302 1.538 1.5299 0.7508 0.7577 0.7509 2010-10-12 1.3914 1.3932 1.3774 81.83 82.34 81.66 0.9566 0.973 0.9558 1.5793 1.5916 1.576 1.0104 1.0183 1.0089 0.881 0.8821 0.8696 113.86 114.14 112.86 1.3313 1.3417 1.3266 0.9863 0.9877 0.9768 129.24 130.71 129 85.49 85.54 84.27 1.5112 1.5421 1.5097 0.7548 0.7559 0.748 2010-10-13 1.3962 1.4001 1.3913 81.76 82 81.73 0.9589 0.964 0.9546 1.5895 1.5909 1.5775 1.0039 1.0105 1.0012 0.8783 0.8839 0.8776 114.15 114.69 113.83 1.3394 1.342 1.332 0.9903 0.9936 0.9834 129.92 130.16 129.03 85.21 85.8 84.94 1.5241 1.5269 1.5098 0.7606 0.7634 0.755 2010-10-14 1.4076 1.4121 1.3956 81.5 81.72 80.9 0.9525 0.9587 0.9466 1.6009 1.6066 1.589 1.0055 1.0074 0.9978 0.8793 0.8821 0.877 114.72 114.78 113.99 1.3407 1.3439 1.3336 0.9943 0.9993 0.9897 130.47 130.52 129.7 85.56 85.76 85.21 1.5249 1.5278 1.5165 0.7577 0.7643 0.7556 2010-10-15 1.3969 1.4157 1.3938 81.45 81.62 80.9 0.9594 0.9601 0.9486 1.5984 1.6104 1.5975 1.0127 1.0138 1.0013 0.8737 0.8802 0.8721 113.75 114.7 113.56 1.3402 1.3481 1.3366 0.9878 1.0003 0.9864 130.18 130.72 130.04 84.86 85.52 84.84 1.5332 1.5374 1.5253 0.7533 0.7618 0.7535 2010-10-18 1.3986 1.3998 1.3832 81.16 81.47 81.13 0.9565 0.9652 0.9543 1.5934 1.6003 1.5838 1.0144 1.0228 1.0119 0.8779 0.8795 0.8705 113.56 113.81 112.41 1.3384 1.3403 1.3308 0.9933 0.9944 0.9802 129.33 130.21 128.72 84.82 85.06 84.15 1.5238 1.5356 1.5168 0.7593 0.7595 0.7502 2010-10-19 1.3728 1.4003 1.3721 81.54 81.92 81.15 0.9705 0.9757 0.9577 1.5699 1.594 1.568 1.0318 1.0373 1.0164 0.8745 0.8825 0.8764 111.94 113.65 111.82 1.3324 1.3454 1.3306 0.9684 0.996 0.9663 128.01 129.42 127.79 84.02 84.98 83.81 1.5236 1.5342 1.5151 0.7445 0.7599 0.7424 2010-10-20 1.3956 1.3991 1.3699 81.14 81.66 80.85 0.9624 0.9719 0.9574 1.5833 1.5878 1.5655 1.022 1.0348 1.0207 0.8811 0.8822 0.8743 113.24 113.37 111.57 1.3432 1.3443 1.3311 0.9865 0.9889 0.9665 128.46 128.77 127.44 84.29 84.59 83.82 1.5238 1.527 1.5129 0.7543 0.7569 0.743 2010-10-21 1.3923 1.405 1.3874 81.32 81.82 80.93 0.9675 0.9681 0.961 1.5704 1.5848 1.5688 1.0264 1.0303 1.0169 0.8864 0.8909 0.8776 113.24 113.92 112.83 1.3471 1.3532 1.3396 0.9784 0.9893 0.9745 127.7 129.22 127.52 84.02 84.63 83.87 1.5193 1.5295 1.5143 0.7467 0.7538 0.7438 2010-10-22 1.3934 1.3973 1.3858 81.35 81.5 81 0.9783 0.9805 0.9662 1.5678 1.575 1.5657 1.0272 1.0302 1.0223 0.8887 0.8896 0.8847 113.34 113.57 112.61 1.3633 1.365 1.346 0.9811 0.9855 0.976 127.53 127.89 127.13 83.11 84.13 83.09 1.5339 1.5365 1.5201 0.7464 0.7508 0.744 2010-10-25 1.3979 1.408 1.3935 80.78 81.45 80.42 0.9703 0.9783 0.9664 1.5741 1.5772 1.5667 1.0192 1.0268 1.0155 0.8879 0.8941 0.8864 112.92 113.78 112.56 1.3565 1.367 1.3547 0.9909 0.9975 0.9825 127.16 127.74 126.47 83.21 83.5 82.9 1.5271 1.5348 1.5225 0.7529 0.7563 0.747 2010-10-26 1.3848 1.3982 1.3826 81.44 81.65 80.62 0.9856 0.9881 0.9703 1.5841 1.5896 1.5692 1.0235 1.0265 1.0175 0.8741 0.8879 0.8729 112.83 113.26 112.45 1.3651 1.3686 1.3542 0.9841 0.9927 0.9815 129.06 129.16 126.85 82.61 83.52 82.4 1.5614 1.5646 1.5265 0.7486 0.7541 0.7473 2010-10-27 1.3764 1.3877 1.3735 81.69 81.98 81.32 0.9901 0.9929 0.9839 1.5763 1.5864 1.5732 1.0287 1.0339 1.0226 0.8729 0.8753 0.8713 112.41 113.2 112.24 1.3635 1.3699 1.3608 0.9711 0.9864 0.9653 128.74 129.59 128.55 82.45 83.04 82.27 1.5612 1.569 1.5566 0.7435 0.7499 0.7407 2010-10-28 1.3931 1.3945 1.3759 80.99 81.77 80.87 0.9821 0.9906 0.9805 1.594 1.5976 1.5763 1.0203 1.0286 1.0182 0.8738 0.8771 0.8705 112.85 112.97 112.22 1.3694 1.3705 1.3614 0.9782 0.9819 0.972 129.1 129.37 128.12 82.41 82.65 82.15 1.5662 1.5737 1.5544 0.7539 0.7555 0.7461 2010-10-29 1.3908 1.3951 1.3806 80.47 81.07 80.46 0.9841 0.991 0.9826 1.6032 1.6035 1.5878 1.0192 1.0247 1.0169 0.8676 0.8741 0.867 111.93 112.97 111.54 1.3689 1.3737 1.3645 0.9795 0.9822 0.968 128.97 129.29 128.01 81.76 82.4 81.45 1.5775 1.5795 1.5665 0.7622 0.7649 0.7522 2010-11-01 1.3879 1.4011 1.3863 80.58 81.6 80.25 0.9925 0.9973 0.9814 1.6031 1.6089 1.6009 1.0175 1.0202 1.0128 0.8657 0.8723 0.8652 111.85 113.59 111.81 1.3784 1.3837 1.3713 0.9846 0.9914 0.9827 129.2 130.55 128.83 81.14 82.35 80.98 1.592 1.5967 1.5757 0.7649 0.7693 0.7637 2010-11-02 1.4027 1.4058 1.3882 80.68 80.96 80.49 0.9793 0.9932 0.9759 1.6022 1.608 1.5962 1.0092 1.0156 1.0082 0.8755 0.877 0.8655 113.17 113.48 111.84 1.3737 1.3821 1.3688 0.9993 1.0023 0.9861 129.27 129.66 128.99 82.39 82.7 81.14 1.569 1.5938 1.5631 0.7712 0.7741 0.764 2010-11-03 1.4132 1.4182 1.3992 81.11 81.58 80.58 0.9711 0.9823 0.9688 1.6094 1.6173 1.6008 1.005 1.0155 1.0044 0.8781 0.8786 0.8697 114.62 114.89 112.84 1.3724 1.3772 1.3704 1.006 1.0063 0.9893 130.54 131.25 129.06 83.52 83.7 82.14 1.529 1.5833 1.567 0.7793 0.7805 0.7705 2010-11-04 1.4206 1.4282 1.4103 80.65 81.21 80.58 0.9689 0.9737 0.9569 1.6291 1.6299 1.6087 1.0025 1.0119 1.001 0.872 0.8817 0.8715 114.57 115.41 114.05 1.3622 1.3804 1.3586 1.0161 1.0176 1.0023 131.39 131.52 130.15 84.11 84.27 82.98 1.5621 1.575 1.5565 0.7957 0.7976 0.7831 2010-11-05 1.4035 1.4247 1.4024 81.32 81.47 80.63 0.9616 0.9642 0.9548 1.6187 1.6292 1.6168 1.0003 1.008 0.9992 0.8671 0.8777 0.8653 114.13 115.03 113.86 1.3496 1.3637 1.3439 1.0151 1.0183 1.0086 131.63 132.02 130.53 84.57 84.94 84.12 1.5565 1.5629 1.5461 0.7972 0.7974 0.7885 2010-11-08 1.3918 1.4084 1.3888 81.15 81.43 81.01 0.9661 0.9683 0.9578 1.6132 1.6211 1.6108 1.003 1.0056 0.9996 0.8625 0.8692 0.8608 112.96 114.28 112.65 1.3448 1.3529 1.3407 1.0138 1.0165 1.0082 130.92 131.61 130.57 83.99 84.86 83.75 1.5578 1.5616 1.5507 0.7877 0.7941 0.7843 2010-11-09 1.3775 1.3973 1.3752 81.92 81.96 80.53 0.9688 0.9696 0.9588 1.5973 1.6183 1.5954 1.008 1.0093 0.9978 0.8621 0.8645 0.8588 112.84 113.08 111.74 1.3342 1.3452 1.3326 1.0025 1.0176 1.0002 130.87 131.07 129.86 84.54 84.58 83.57 1.5472 1.5607 1.5422 0.7766 0.7915 0.7763 2010-11-10 1.378 1.3826 1.3671 82.26 82.79 81.56 0.9709 0.9765 0.9674 1.6121 1.6136 1.5962 1.0002 1.0091 0.9994 0.8546 0.8638 0.8526 113.35 113.79 112.25 1.3381 1.3428 1.3274 1.0053 1.0073 0.9976 132.61 133.04 130.4 84.68 85.04 84.04 1.565 1.5698 1.546 0.7836 0.785 0.774 2010-11-11 1.3658 1.382 1.3638 82.44 82.6 82.05 0.9749 0.9786 0.9672 1.6106 1.6177 1.6082 1.0032 1.0072 0.9976 0.8479 0.8556 0.8457 112.61 113.53 112.53 1.3319 1.3397 1.3257 0.9977 1.0086 0.9958 132.79 133.24 132.3 84.51 84.99 84.31 1.5703 1.5783 1.5608 0.7798 0.7872 0.7775 2010-11-12 1.3699 1.3777 1.3575 82.43 82.65 81.66 0.9803 0.9808 0.9725 1.6139 1.6183 1.5988 1.009 1.0145 1.0027 0.8486 0.856 0.845 112.91 113.4 111.06 1.3433 1.3437 1.3229 0.9866 1.0002 0.9826 132.98 133.57 131 84.02 84.63 83.73 1.5824 1.5831 1.5569 0.7746 0.781 0.7702 2010-11-15 1.3564 1.375 1.3564 83.22 83.24 82.41 0.9853 0.9871 0.9764 1.6045 1.6153 1.6042 1.009 1.0139 1.0056 0.8455 0.8514 0.8455 112.9 113.62 112.61 1.337 1.3472 1.3365 0.9842 0.9919 0.9813 133.55 133.77 132.93 84.4 84.66 84.03 1.5814 1.5869 1.5737 0.7717 0.7779 0.7685 2010-11-16 1.3488 1.3656 1.3447 83.3 83.59 82.41 0.996 0.998 0.9783 1.5883 1.6084 1.584 1.022 1.0254 1.007 0.8492 0.8525 0.8455 11236 113.44 112.25 1.3434 1.3442 1.337 0.9767 0.9893 0.9725 132.3 133.77 132.14 83.63 84.63 83.57 1.5818 1.5828 1.5722 0.7675 0.7756 0.7653 2010-11-17 1.3518 1.3565 1.346 83.31 83.54 83.04 0.9926 0.9976 0.9884 1.5893 1.5948 1.5856 1.0241 1.0258 1.0181 0.8502 0.8514 0.8475 112.62 112.78 112.35 1.3417 1.3467 1.3387 0.9781 0.9834 0.9727 132.39 132.96 132.24 83.89 84.09 83.59 1.5774 1.5862 1.574 0.7687 0.7727 0.7634 2010-11-18 1.363 1.3667 1.3526 83.5 83.78 83.1 0.9963 0.9999 0.9854 1.6036 1.6055 1.589 1.0212 1.0248 1.0155 0.8497 0.8554 0.8488 113.81 114.09 112.5 1.3583 1.3597 1.3408 0.9881 0.9905 0.9788 133.9 134.21 132.26 83.76 84.53 83.74 1.5977 1.6006 1.5725 0.7768 0.7784 0.7698 2010-11-19 1.3685 1.3731 1.3609 83.46 83.64 83.15 0.9928 0.9998 0.9877 1.5986 1.6094 1.5938 1.0174 1.0233 1.0157 0.8558 0.8569 0.8497 114.21 114.31 113.54 1.359 1.3673 1.3541 0.9857 0.9911 0.9816 133.43 134.2 133.07 84.01 84.25 83.42 1.5872 1.5991 1.5876 0.7793 0.78 0.7748 2010-11-22 1.3624 1.3786 1.3577 83.28 83.56 83.24 0.9898 0.9942 0.9876 1.5961 1.6084 1.59 1.0176 1.0216 1.0114 0.8536 0.8595 0.8523 113.46 114.97 113.26 1.3485 1.3659 1.3457 0.9889 0.9954 0.9825 132.92 134.19 132.64 84.14 84.52 84 1.5798 1.5925 1.5748 0.7741 0.7835 0.7697 2010-11-23 1.3375 1.3633 1.3362 83.14 83.85 82.8 0.9965 0.9974 0.9849 1.5774 1.5964 1.576 1.0233 1.0264 1.0168 0.8477 0.8541 0.8446 111.19 113.68 110.77 1.3329 1.349 1.3293 0.9726 0.9889 0.971 131.15 133.37 130.87 83.4 84.75 83.11 1.5719 1.5798 1.5692 0.7581 0.773 0.7582 2010-11-24 1.3324 1.3421 1.3284 83.58 83.66 82.95 0.9962 0.9989 0.9898 1.5768 1.5835 1.5743 1.0117 1.0247 1.0092 0.845 0.85 0.8428 111.38 111.78 110.32 1.3276 1.3347 1.3242 0.9807 0.9851 0.972 131.79 132 130.88 83.86 84.13 83.15 1.5706 1.5763 1.5635 0.7605 0.7643 0.7584 2010-11-25 1.3376 1.3386 1.3287 83.59 83.69 83.41 0.9994 1.0021 0.9945 1.5766 1.5793 1.5727 1.0083 1.0123 1.0065 0.8481 0.8486 0.8434 111.82 111.92 111.03 1.3372 1.3376 1.3261 0.9808 0.9849 0.9763 131.78 132.03 131.39 83.58 84 83.46 1.5754 1.5793 1.5695 0.7612 0.7627 0.7561 2010-11-26 1.3236 1.3365 1.3199 84.06 84.18 83.58 1.0016 1.0053 0.9986 1.5618 1.577 1.5591 1.0196 1.0245 1.0087 0.8475 0.8485 0.842 111.3 111.82 110.55 1.3258 1.3375 1.3234 0.9646 0.9816 0.9614 131.31 132.11 131.02 83.92 83.98 83.43 1.564 1.5781 1.5631 0.7503 0.762 0.7481 2010-11-29 1.3123 1.3302 1.3065 84.22 84.4 83.83 0.9996 1.0045 0.9982 1.5575 1.5646 1.5528 1.0175 1.0257 1.0168 0.8425 0.8522 0.8409 110.53 111.73 110.26 1.3118 1.3324 1.3102 0.9629 0.9698 0.9567 131.16 131.37 130.89 84.22 84.35 83.75 1.5569 1.5658 1.5543 0.7469 0.7536 0.7431 2010-11-30 1.2998 1.3149 1.2968 83.66 84.3 83.43 1.003 1.0033 0.9928 1.5568 1.5595 1.5486 1.0256 1.0286 1.0173 0.8348 0.8447 0.8349 108.75 110.68 108.35 1.3037 1.3132 1.2936 0.9605 0.966 0.9545 130.25 131.26 129.36 83.37 84.53 83.32 1.5613 1.5625 1.5452 0.7444 0.7469 0.7399 2010-12-01 1.3135 1.318 1.2972 84.17 84.39 83.39 1.0027 1.0066 0.9988 1.5628 1.5647 1.5549 1.0164 1.027 1.0141 0.8406 0.8441 0.8334 110.57 110.76 108.43 1.3174 1.319 1.3013 0.9691 0.9698 0.954 131.53 131.6 129.95 83.93 84.12 83.13 1.5667 1.5735 1.5595 0.7497 0.751 0.7404 2010-12-02 1.3223 1.3247 1.3059 83.87 84.36 83.5 0.9925 1.0055 0.9889 1.5599 1.5666 1.5512 1.0037 1.0189 1.0028 0.8477 0.8492 0.8391 110.92 111.2 109.98 1.3126 1.3206 1.3071 0.9756 0.9778 0.9628 130.82 131.75 130.21 84.47 84.61 83.66 1.5479 1.5702 1.5422 0.754 0.7564 0.7456 2010-12-03 1.3408 1.3414 1.3194 82.65 83.89 82.54 0.974 0.995 0.9742 1.5784 1.5786 1.5582 1.0036 1.008 1.0002 0.8493 0.8525 0.8446 110.83 111.2 109.88 1.3061 1.317 1.3045 0.9931 0.9937 0.9741 130.48 131.06 129.54 84.83 84.94 83.77 1.5372 1.5563 1.532 0.766 0.7662 0.7547 2010-12-06 1.3323 1.3421 1.3245 82.62 82.98 82.57 0.9812 0.9874 0.9724 1.5724 1.5774 1.5656 1.0044 1.0083 1.0024 0.847 0.8509 0.8453 110.08 111.08 109.65 1.3075 1.3118 1.3003 0.99 0.9926 0.985 129.9 130.61 129.56 84.16 85.16 83.78 1.5427 1.5478 1.5322 0.7614 0.7652 0.7588 2010-12-07 1.3274 1.34 1.3269 83.49 83.66 82.35 0.9871 0.9884 0.9756 1.5764 1.5821 1.5705 1.0106 1.0113 1.0011 0.8419 0.8481 0.8419 110.82 111.12 109.59 1.3103 1.3124 1.3037 0.9844 0.9965 0.9837 131.61 131.8 129.58 84.54 84.83 83.96 1.5558 1.5573 1.5406 0.7585 0.7666 0.7572 2010-12-08 1.3258 1.328 1.3181 84.02 84.3 83.47 0.9866 0.9915 0.985 1.5803 1.5835 1.5669 1.0114 1.0141 1.0063 0.839 0.8428 0.8363 111.41 111.48 110.52 1.3083 1.3105 1.3022 0.9791 0.9855 0.9753 132.79 133.01 131.37 85.14 85.29 84.5 1.5588 1.5622 1.5472 0.7453 0.7577 0.7437 2010-12-09 1.3239 1.3322 1.3166 83.68 84.11 83.52 0.9832 0.9895 0.981 1.5764 1.584 1.5712 1.0101 1.0126 1.0066 0.8397 0.8416 0.836 110.79 111.65 110.55 1.3017 1.3097 1.298 0.9843 0.9884 0.9778 131.91 132.91 131.76 85.07 85.37 84.95 1.5496 1.5593 1.5475 0.7488 0.7514 0.7453 2010-12-10 1.3226 1.3282 1.3179 83.89 84.01 83.46 0.9807 0.9841 0.9795 1.5813 1.5861 1.575 1.0091 1.0114 1.0082 0.8364 0.8405 0.8356 110.96 111.13 110.48 1.2975 1.3032 1.2959 0.9849 0.9896 0.9829 132.64 132.67 131.97 85.5 85.64 85 1.5507 1.556 1.5477 0.7478 0.7529 0.7472 2010-12-13 1.3389 1.3433 1.3183 83.39 84.36 83.11 0.968 0.9855 0.9651 1.5856 1.5896 1.5721 1.008 1.0108 1.0028 0.8444 0.8457 0.8346 111.67 112.07 110.66 1.2963 1.3006 1.291 0.995 0.9984 0.9834 132.24 133.05 131.83 86.11 86.55 85.35 1.5352 1.5559 1.53 0.7544 0.7575 0.7462 2010-12-14 1.3384 1.3498 1.3364 83.66 83.77 82.85 0.9593 0.9689 0.9563 1.5779 1.591 1.574 1.0066 1.0109 1.0029 0.8479 0.8509 0.8433 111.95 112.22 111.54 1.2842 1.3004 1.2831 0.9977 1.0027 0.9944 132.01 132.64 131.31 87.15 87.26 86.1 1.5137 1.5383 1.5111 0.7517 0.7575 0.7494 2010-12-15 1.3221 1.3382 1.3211 84.3 84.51 83.61 0.9673 0.9695 0.9575 1.5543 1.5783 1.5532 1.0035 1.0095 1.0001 0.8506 0.8549 0.8451 111.45 112.1 111.45 1.2794 1.285 1.2761 0.9854 0.9993 0.9842 131.03 132.29 130.79 87.09 87.57 86.96 1.5036 1.517 1.4982 0.738 0.7522 0.7383 2010-12-16 1.3224 1.3265 1.3182 84.03 84.44 83.97 0.9649 0.9733 0.9647 1.5621 1.5629 1.5542 1.0059 1.0074 1.0031 0.8464 0.8511 0.8457 111.16 111.61 111.07 1.2764 1.2869 1.2741 0.9876 0.9905 0.9832 131.28 131.64 130.9 87.06 87.3 86.54 1.5077 1.5171 1.503 0.7376 0.7406 0.7345 2010-12-17 1.3181 1.3358 1.3134 83.92 84.21 83.7 0.9698 0.9719 0.956 1.5518 1.5646 1.5455 1.013 1.0143 1.0039 0.8493 0.8551 0.8467 110.64 111.94 110.41 1.2789 1.2792 1.2721 0.9884 0.9926 0.9841 130.19 131.4 130.03 86.48 87.76 86.52 1.5051 1.5085 1.4917 0.737 0.7425 0.7351 2010-12-20 1.312 1.3187 1.3096 83.74 84.11 83.64 0.9648 0.972 0.9632 1.5513 1.5576 1.5478 1.0169 1.0208 1.01 0.8457 0.8501 0.8447 109.88 110.79 109.57 1.2663 1.2784 1.2635 0.9936 0.9949 0.9864 129.88 130.48 129.58 86.76 86.9 86.48 1.4965 1.5065 1.4944 0.7419 0.7436 0.7342 2010-12-21 1.3092 1.3202 1.3074 83.74 83.9 83.51 0.9588 0.9657 0.9562 1.546 1.5567 1.5437 1.0179 1.0206 1.0149 0.8466 0.8519 0.8448 109.64 110.48 109.64 1.2558 1.2713 1.2546 0.9962 0.9995 0.9919 129.4 130.32 129.27 87.28 87.46 86.76 1.4824 1.4989 1.4811 0.7427 0.7484 0.7398 2010-12-22 1.3092 1.3181 1.3078 83.56 83.85 83.43 0.9521 0.959 0.9504 1.5381 1.5493 1.5358 1.0139 1.0178 1.0112 0.851 0.8523 0.8462 109.4 110.11 109.21 1.2467 1.2584 1.2441 1 1.0011 0.9952 128.49 129.71 128.36 87.71 87.93 87.24 1.4645 1.4833 1.4626 0.7417 0.7451 0.7405 2010-12-23 1.3115 1.3153 1.3056 82.91 83.57 82.86 0.9588 0.9662 0.9499 1.5426 1.5437 1.5375 1.0091 1.0165 1.0058 0.8499 0.8526 0.8468 108.76 109.6 108.46 1.2577 1.2648 1.2459 1.0044 1.0066 0.9985 127.9 128.74 127.48 86.43 87.84 85.95 1.479 1.4876 1.4621 0.7474 0.75 0.7397 2010-12-24 1.3115 1.3148 1.3095 82.89 83.15 82.87 0.9619 0.9634 0.9554 1.5441 1.5475 1.5418 1.0062 1.0115 1.005 0.8491 0.8512 0.848 108.7 109.05 108.58 1.2619 1.2657 1.2545 1.0042 1.0049 1.0022 127.98 128.43 127.86 86.07 86.88 86.07 1.485 1.4885 1.4747 0.7486 0.749 0.7459 2010-12-27 1.3156 1.317 1.3073 82.82 82.97 82.66 0.9601 0.9645 0.9575 1.5415 1.5456 1.5371 1.0068 1.011 1.002 0.8533 0.8559 0.8479 108.97 109.07 108.43 1.2631 1.2698 1.2548 1.0033 1.0058 0.9989 127.67 128.01 127.41 86.23 87.84 85.89 1.4794 1.4893 1.4781 0.7493 0.7505 0.7459 2010-12-28 1.3114 1.3274 1.3094 82.42 82.84 81.82 0.9521 0.9605 0.9439 1.5381 1.5511 1.5346 0.9997 1.0071 0.9976 0.8526 0.8592 0.8525 108.09 109.52 107.63 1.2486 1.2666 1.2452 1.0093 1.0154 1.004 126.76 128.03 126.14 86.53 87.12 86.14 1.4643 1.4821 1.4566 0.7566 0.7584 0.7494 2010-12-29 1.3231 1.3238 1.3085 81.61 82.45 81.62 0.9455 0.9532 0.9457 1.5504 1.5518 1.5352 1.0003 1.0054 0.9972 0.8532 0.8554 0.8504 108 108.12 107.62 1.251 1.2543 1.2457 1.0179 1.0183 1.009 126.54 126.8 126.14 86.3 86.62 86.11 1.4655 1.4716 1.4607 0.767 0.7675 0.7544 2010-12-30 1.3279 1.3314 1.3213 81.53 81.85 81.3 0.9358 0.9462 0.9352 1.5413 1.5535 1.5368 0.9994 1.0022 0.9973 0.8614 0.8634 0.8518 108.28 108.92 107.6 1.2433 1.2511 1.2407 1.0157 1.0197 1.012 125.66 126.7 125.53 87.05 87.29 86.19 1.4426 1.4665 1.4402 0.7705 0.7725 0.7665 2010-12-31 1.3366 1.3424 1.3285 81.18 81.54 80.95 0.934 0.9396 0.9302 1.5602 1.5664 1.5426 0.9957 1.0006 0.9926 0.8567 0.8647 0.8533 108.53 108.91 108.3 1.2484 1.257 1.2423 1.0219 1.0253 1.0153 126.66 127.02 125.72 86.81 87.23 86.61 1.4569 1.4635 1.442 0.7795 0.7813 0.7705 2011-01-03 1.3351 1.3394 1.3251 81.72 81.74 80.99 0.9336 0.9382 0.9322 1.5477 1.5584 1.5435 0.9937 0.9949 0.9888 0.8625 0.8647 0.8542 109.12 109.25 107.8 1.2472 1.2502 1.2415 1.0161 1.0223 1.0162 126.46 126.57 125.79 87.49 87.52 86.74 1.4448 1.456 1.4442 0.773 0.7784 0.7731 2011-01-04 1.3298 1.3433 1.3292 82.01 82.27 81.62 0.9486 0.9516 0.9329 1.5586 1.5645 1.5456 0.9986 1.0033 0.9916 0.8531 0.8637 0.8526 109.07 110.24 108.63 1.2616 1.2683 1.2458 1.0047 1.0171 1.003 127.82 128.59 126.38 86.41 87.77 86.2 1.4783 1.4828 1.4452 0.7669 0.7741 0.7642 2011-01-05 1.3149 1.3325 1.3127 83.28 83.37 81.89 0.966 0.9684 0.947 1.5507 1.5627 1.5453 0.9962 1.0022 0.9933 0.8481 0.8542 0.8472 109.51 109.76 108.49 1.2705 1.2725 1.2572 0.9989 1.0075 0.9961 129.12 129.14 127.48 86.18 86.69 85.92 1.4974 1.4993 1.4755 0.7573 0.768 0.7577 2011-01-06 1.3014 1.317 1.2998 83.29 83.39 82.89 0.9651 0.9707 0.9611 1.5469 1.5561 1.545 0.9963 0.9993 0.9921 0.8412 0.8487 0.8402 108.43 109.65 108.12 1.2559 1.2723 1.2524 0.9937 1.0014 0.9934 128.88 129.29 128.45 86.29 86.39 85.68 1.493 1.5054 1.4896 0.7569 0.7603 0.7555 2011-01-07 1.2924 1.302 1.2907 83.03 83.67 82.86 0.9668 0.969 0.9608 1.5556 1.5578 1.541 0.991 1.0003 0.9899 0.8306 0.8426 0.8302 107.29 108.78 106.96 1.2499 1.2562 1.2451 0.9964 0.9994 0.9909 129.12 129.43 128.31 85.81 87.03 85.84 1.504 1.5046 1.4843 0.7617 0.7637 0.7554 2011-01-10 1.295 1.2964 1.2875 82.73 83.28 82.68 0.9675 0.9726 0.9633 1.5574 1.5602 1.5476 0.993 0.9983 0.9913 0.8315 0.8339 0.8286 107.14 107.68 106.81 1.253 1.2563 1.2432 0.996 0.9982 0.9884 128.84 129.34 128.33 85.47 86.36 85.15 1.5064 1.5106 1.493 0.7632 0.7647 0.7574 2011-01-11 1.2977 1.2992 1.2905 83.23 83.54 82.69 0.9736 0.9785 0.9662 1.5615 1.5639 1.5514 0.99 0.9949 0.9892 0.8309 0.8342 0.8294 107.99 108.3 107.06 1.2635 1.267 1.2518 0.987 0.9956 0.9821 129.97 130.41 128.76 85.44 85.91 85.24 1.5203 1.5254 1.5043 0.7602 0.7638 0.7562 2011-01-12 1.313 1.3144 1.2962 82.95 83.47 82.82 0.9668 0.9758 0.9664 1.5767 1.578 1.5582 0.9865 0.9912 0.9848 0.8326 0.8338 0.8299 108.9 109.03 107.86 1.2695 1.2735 1.2582 0.9952 0.9965 0.9806 130.76 131.15 129.64 85.75 85.95 85.11 1.5241 1.5303 1.5127 0.7623 0.7626 0.7564 2011-01-13 1.3349 1.3384 1.3089 82.78 83.16 82.55 0.9646 0.9766 0.9614 1.5829 1.5883 1.572 0.9897 0.9909 0.9856 0.843 0.8442 0.8313 110.5 110.68 108.71 1.2875 1.2887 1.2687 0.9957 1.0019 0.9918 131.03 131.41 130.52 85.79 86.04 85.08 1.5266 1.5371 1.5222 0.7684 0.7703 0.7612 2011-01-14 1.3368 1.3456 1.3315 82.96 83.07 82.41 0.9646 0.9687 0.9607 1.5862 1.5888 1.5816 0.9891 0.9976 0.9886 0.8426 0.8499 0.839 110.9 110.94 110.08 1.2896 1.2958 1.2851 0.9888 0.9993 0.9857 131.6 131.89 130.49 85.97 86.1 85.43 1.5299 1.5352 1.5204 0.7668 0.7725 0.7637 2011-01-17 1.3294 1.3387 1.3247 82.71 83.49 82.36 0.9647 0.9678 0.9624 1.5891 1.5954 1.5837 0.9868 0.9901 0.9856 0.8364 0.8436 0.8346 109.95 110.97 109.58 1.2828 1.2896 1.2808 0.9938 0.9967 0.9865 131.41 132.59 131 85.63 86.46 85.32 1.5331 1.54 1.527 0.772 0.7746 0.7673 2011-01-18 1.3382 1.3465 1.3253 82.62 82.82 82.34 0.9638 0.9661 0.9553 1.5956 1.6059 1.5879 0.9923 0.9935 0.9832 0.8386 0.8407 0.8334 110.56 111.14 109.59 1.2897 1.2927 1.2776 0.9983 1.0006 0.9899 131.84 132.51 131.31 85.7 86.34 85.6 1.5373 1.5428 1.5248 0.7706 0.7741 0.7694 2011-01-19 1.3465 1.3538 1.3369 82.06 82.69 81.86 0.9548 0.965 0.9523 1.5986 1.6037 1.5947 0.9955 0.9965 0.9889 0.842 0.8454 0.8378 110.5 111.06 110.34 1.2858 1.2994 1.2847 0.9992 1.0076 0.9964 131.18 132.17 130.85 85.91 85.97 85.31 1.5267 1.5419 1.5232 0.7683 0.7786 0.7686 2011-01-20 1.347 1.3522 1.3397 82.99 83.12 81.99 0.9678 0.9686 0.9529 1.5902 1.6009 1.5841 0.9975 1.003 0.9951 0.8467 0.8481 0.8414 111.78 111.91 110.31 1.303 1.3043 1.2816 0.9871 1.0008 0.9833 131.96 132.12 130.7 85.76 86.31 85.69 1.5379 1.5401 1.5193 0.7578 0.7691 0.7534 2011-01-21 1.3615 1.3626 1.345 82.57 83.09 82.54 0.9584 0.969 0.9574 1.6007 1.6017 1.5868 0.9942 0.9988 0.9908 0.8504 0.8528 0.8461 112.41 112.49 111.64 1.3049 1.3073 1.2978 0.9901 0.9918 0.9841 132.17 132.36 131.5 86.12 86.36 85.62 1.5341 1.5406 1.5277 0.7584 0.7593 0.7528 2011-01-24 1.3641 1.3686 1.354 82.51 82.94 82.31 0.949 0.9632 0.9473 1.5994 1.6013 1.5922 0.9946 0.9981 0.9918 0.8529 0.8553 0.8493 112.56 112.9 112.24 1.2949 1.312 1.2932 0.9976 1.0022 0.9865 131.95 132.38 131.72 86.89 87.09 85.84 1.5176 1.5407 1.5149 0.7627 0.7657 0.757 2011-01-25 1.3683 1.3703 1.3573 82.26 82.66 81.99 0.9422 0.9523 0.9406 1.5816 1.6017 1.5753 0.9975 1.0004 0.991 0.8648 0.8667 0.8527 112.52 112.79 111.84 1.2888 1.2986 1.2827 0.9962 0.9995 0.989 130.1 132.02 129.67 87.27 87.49 86.6 1.4899 1.5182 1.4863 0.7676 0.7677 0.7623 2011-01-26 1.369 1.3721 1.3645 82.31 82.6 81.99 0.9433 0.9465 0.9401 1.5895 1.591 1.5771 0.9951 0.9981 0.9938 0.8612 0.8673 0.8597 112.68 112.93 112.14 1.2916 1.2969 1.2873 0.9974 1.0001 0.9931 130.78 131.07 129.53 87.22 87.43 86.79 1.499 1.5023 1.4871 0.7708 0.772 0.7649 2011-01-27 1.3737 1.3759 1.3638 82.86 83.2 82.03 0.9455 0.9481 0.939 1.5927 1.599 1.5881 0.9932 0.9985 0.9926 0.8623 0.8631 0.858 113.83 114.02 112.46 1.299 1.3003 1.2887 0.9922 1.0001 0.9878 131.98 132.68 130.6 87.62 88.13 87.05 1.506 1.5105 1.4963 0.7723 0.7751 0.7673 2011-01-28 1.3606 1.3746 1.3584 82.1 82.93 81.99 0.9419 0.947 0.9388 1.5865 1.5966 1.5826 1.0014 1.0017 0.9933 0.8577 0.8653 0.8573 111.74 113.91 111.52 1.2822 1.2989 1.2779 0.9923 0.9985 0.9885 130.26 132.11 129.82 87.11 87.82 86.93 1.4943 1.5071 1.489 0.7717 0.7793 0.7707 2011-01-31 1.3693 1.3739 1.3571 82.03 82.26 81.91 0.9433 0.9448 0.937 1.6016 1.6049 1.5822 1.0015 1.0057 0.9963 0.8548 0.862 0.8531 112.35 112.7 111.43 1.2919 1.2929 1.278 0.997 0.9991 0.9868 131.4 131.6 129.88 86.94 88.16 86.84 1.5109 1.5134 1.4901 0.7712 0.7746 0.7686 2011-02-01 1.3831 1.3836 1.3687 81.38 82.14 81.32 0.935 0.9456 0.9338 1.615 1.6157 1.6011 0.9902 1.0012 0.99 0.8564 0.857 0.851 112.58 112.7 111.88 1.2933 1.2996 1.2908 1.0113 1.0151 0.9964 131.44 131.97 130.94 87.04 87.15 86.54 1.51 1.5217 1.5075 0.7805 0.782 0.7714 2011-02-02 1.3807 1.3861 1.3768 81.52 81.85 81.32 0.9403 0.9442 0.9329 1.6185 1.6229 1.6129 0.9881 0.9915 0.986 0.8529 0.8578 0.8514 112.55 112.91 112.21 1.2984 1.3014 1.2873 1.0082 1.0133 1.0056 131.97 132.32 131.3 86.7 87.35 86.56 1.5219 1.5257 1.5085 0.7778 0.783 0.7778 2011-02-03 1.3632 1.3825 1.361 81.62 82.06 81.41 0.9456 0.9525 0.9397 1.6145 1.6277 1.6123 0.9905 0.9921 0.9857 0.8443 0.8532 0.8438 111.26 112.86 111.06 1.2891 1.3037 1.287 1.0158 1.0162 1.0084 131.76 132.93 131.49 86.3 86.86 86.1 1.5265 1.5374 1.5211 0.7739 0.7749 0.7691 2011-02-04 1.3588 1.3678 1.3544 82.19 82.46 81.13 0.9542 0.9594 0.9454 1.6096 1.6172 1.6037 0.9879 0.9933 0.9832 0.8439 0.8482 0.8424 111.66 112.07 110.64 1.2969 1.3007 1.2882 1.0138 1.0199 1.0113 132.3 132.75 130.83 86.09 86.39 85.41 1.5365 1.541 1.5256 0.7684 0.7747 0.7668 2011-02-07 1.3586 1.3626 1.3509 82.31 82.46 82.17 0.9551 0.9597 0.9532 1.6113 1.6185 1.6091 0.99 0.9906 0.9851 0.843 0.8448 0.8389 111.85 112.19 111.24 1.2984 1.3045 1.2933 1.0136 1.0163 1.0107 132.62 133.25 132.28 86.14 86.25 85.83 1.5397 1.5498 1.5361 0.7696 0.7726 0.7679 2011-02-08 1.3635 1.3689 1.3573 82.36 82.42 81.78 0.9626 0.9643 0.9525 1.6071 1.6162 1.6029 0.9951 0.9977 0.9868 0.8483 0.8509 0.842 112.28 112.31 111.6 1.3127 1.3144 1.2976 1.0146 1.0191 1.0116 132.35 132.9 131.59 85.52 86.29 85.35 1.5474 1.5492 1.5332 0.7735 0.7796 0.7696 2011-02-09 1.3721 1.3744 1.3609 82.39 82.66 82.21 0.9579 0.966 0.9554 1.6093 1.6124 1.6034 0.9942 0.9956 0.9915 0.8524 0.8531 0.847 113.06 113.21 112.08 1.3145 1.3188 1.3122 1.0106 1.0151 1.0089 132.59 133 132.13 85.99 86.12 85.26 1.5419 1.5535 1.5397 0.771 0.7755 0.7703 2011-02-10 1.3595 1.3735 1.3577 83.28 83.36 82.33 0.9697 0.9702 0.9573 1.6092 1.6137 1.6011 0.9957 0.9986 0.9931 0.8448 0.8528 0.8443 113.22 113.4 112.6 1.3183 1.3195 1.3085 1.0045 1.0138 1.0008 134.02 134.24 132.39 85.88 86.13 85.67 1.5604 1.5616 1.5411 0.7634 0.7722 0.7624 2011-02-11 1.355 1.3621 1.3498 83.44 83.67 83.21 0.9725 0.9775 0.9681 1.6012 1.6111 1.5965 0.9869 0.9986 0.9865 0.846 0.8477 0.8423 113.07 113.45 112.79 1.3181 1.3204 1.3128 1.0019 1.0045 0.9962 133.6 134.22 133.27 85.78 86.2 85.51 1.5573 1.562 1.5525 0.7599 0.7643 0.7554 2011-02-14 1.3483 1.3559 1.3429 83.31 83.57 83.11 0.97 0.9747 0.9693 1.6029 1.6078 1.5983 0.9885 0.9901 0.9848 0.841 0.8461 0.8399 112.33 112.98 112.06 1.308 1.3202 1.3051 1.0022 1.0075 0.9983 133.54 133.77 133.2 85.87 85.98 85.39 1.5549 1.5653 1.5504 0.7557 0.76 0.7546 2011-02-15 1.3483 1.3552 1.3461 83.85 83.91 83.2 0.9668 0.9729 0.9653 1.6123 1.617 1.6009 0.9891 0.9899 0.985 0.8362 0.8448 0.8356 113.05 113.4 112.32 1.3039 1.314 1.3037 0.9943 1.0057 0.9946 135.2 135.46 133.53 86.68 86.78 85.85 1.5591 1.5692 1.5518 0.7503 0.7587 0.7507 2011-02-16 1.3561 1.3589 1.3462 83.58 83.98 83.51 0.9589 0.9738 0.9555 1.6095 1.6185 1.5988 0.9847 0.9904 0.9846 0.8424 0.8451 0.8362 113.37 113.66 112.91 1.3009 1.313 1.2975 1.0038 1.0055 0.996 134.54 135.47 134.21 87.14 87.45 86.22 1.5438 1.561 1.5382 0.755 0.7565 0.7508 2011-02-17 1.3604 1.3619 1.3537 83.29 83.73 83.16 0.9494 0.9601 0.9479 1.6169 1.6186 1.6077 0.9844 0.9859 0.9817 0.8413 0.8444 0.84 113.33 113.69 113.05 1.2919 1.303 1.2901 1.0116 1.013 1.0019 134.7 134.99 134.37 87.71 87.78 87.07 1.5354 1.5464 1.5325 0.7583 0.7605 0.7538 2011-02-18 1.3686 1.3715 1.3546 83.1 83.53 83.04 0.946 0.9538 0.9438 1.6236 1.6262 1.6149 0.9862 0.9874 0.9818 0.8426 0.8436 0.8357 113.75 113.92 112.95 1.2952 1.299 1.2895 1.0136 1.0157 1.009 134.93 135.51 134.47 87.84 88.01 87.47 1.5361 1.5462 1.5341 0.7618 0.7655 0.7585 2011-02-21 1.3675 1.3717 1.3644 83.1 83.26 83.02 0.9464 0.9489 0.9423 1.6215 1.626 1.6202 0.9827 0.9871 0.9818 0.843 0.8445 0.841 113.64 113.99 113.56 1.295 1.2979 1.2923 1.0094 1.0151 1.0069 134.73 135.17 134.72 87.74 88.1 87.63 1.5352 1.5399 1.5333 0.763 0.7661 0.7601 2011-02-22 1.3655 1.3703 1.3524 82.74 83.5 82.56 0.9384 0.9505 0.9362 1.6134 1.6227 1.6099 0.9906 0.9917 0.9821 0.8462 0.8477 0.8384 112.98 114.2 112.24 1.2821 1.2963 1.2793 0.9975 1.0095 0.9963 133.5 135.42 133.27 88.13 88.62 87.49 1.5142 1.5376 1.5118 0.7459 0.7642 0.7443 2011-02-23 1.3749 1.3787 1.3645 82.52 82.88 82.29 0.9332 0.9392 0.9303 1.6207 1.627 1.6132 0.9885 0.9958 0.9855 0.8482 0.8496 0.843 113.46 113.82 112.98 1.2831 1.2883 1.2809 1.0024 1.0058 0.9978 133.73 134.64 133.4 88.41 88.65 88.05 1.5127 1.5259 1.5093 0.7462 0.7513 0.7424 2011-02-24 1.3799 1.382 1.3701 81.9 82.51 81.6 0.9262 0.9334 0.923 1.6131 1.6254 1.6083 0.9828 0.9901 0.9812 0.8554 0.8566 0.847 113.04 113.51 112.21 1.2786 1.2831 1.2707 1.0096 1.0124 0.9991 132.15 133.86 131.52 88.41 88.7 88.12 1.4949 1.5132 1.4894 0.7474 0.7508 0.7427 2011-02-25 1.3744 1.3837 1.3721 81.67 82.05 81.63 0.9279 0.9318 0.9237 1.6102 1.6161 1.6029 0.979 0.9832 0.9775 0.8535 0.8592 0.8532 112.24 113.44 112.23 1.2755 1.2842 1.2754 1.0168 1.0176 1.0081 131.47 132.46 131.13 87.99 88.69 87.78 1.4941 1.4989 1.4901 0.7503 0.7527 0.7463 2011-02-28 1.3801 1.3855 1.3709 81.75 81.98 81.59 0.9288 0.9305 0.9255 1.626 1.6275 1.607 0.9717 0.9789 0.9706 0.8488 0.8555 0.8481 112.86 113.35 111.98 1.2821 1.2861 1.2727 1.0182 1.0192 1.0118 132.94 133.32 131.31 88.01 88.3 87.92 1.5102 1.5123 1.491 0.7518 0.7552 0.7487 2011-03-01 1.3771 1.3854 1.3761 81.9 82.23 81.71 0.9295 0.9321 0.927 1.6258 1.6329 1.6249 0.9744 0.9754 0.9681 0.847 0.8504 0.8461 112.82 113.72 112.79 1.2804 1.2892 1.2801 1.0133 1.0201 1.0122 133.17 134.13 132.97 88.09 88.4 88.02 1.5113 1.5198 1.5102 0.7479 0.7534 0.7473 2011-03-02 1.3866 1.3889 1.3741 81.87 82.11 81.55 0.9236 0.929 0.9197 1.6329 1.6343 1.6214 0.9722 0.9775 0.9704 0.8491 0.8504 0.8464 113.53 113.53 112.55 1.2808 1.2823 1.2756 1.0167 1.0181 1.0083 133.65 133.76 132.85 88.61 88.7 88.11 1.5085 1.5117 1.5028 0.7434 0.7479 0.7377 2011-03-03 1.396 1.3971 1.383 82.34 82.51 81.69 0.9319 0.9327 0.9229 1.6271 1.6333 1.6251 0.9718 0.9752 0.9711 0.8578 0.8581 0.8479 114.95 115.01 113.1 1.3008 1.3013 1.279 1.0158 1.0189 1.0123 134.01 134.18 132.94 88.37 88.64 88.16 1.5162 1.5182 1.5038 0.7412 0.7494 0.7385 2011-03-04 1.3983 1.4006 1.3936 82.34 83 82.19 0.9256 0.9328 0.922 1.6268 1.6305 1.6233 0.972 0.9743 0.9696 0.8593 0.8607 0.8566 115.13 116.03 114.88 1.295 1.3024 1.2917 1.013 1.0147 1.0073 133.94 135.12 133.67 88.9 89.29 88.3 1.5065 1.5189 1.5025 0.7373 0.7409 0.7334 2011-03-07 1.3973 1.4037 1.3951 82.3 82.4 81.93 0.9263 0.9275 0.9233 1.62 1.6342 1.6181 0.9721 0.9743 0.9697 0.8623 0.8635 0.8572 114.97 115.32 114.56 1.2943 1.2988 1.2915 1.0115 1.0185 1.0089 133.3 134.09 132.95 88.81 89.01 88.63 1.501 1.5119 1.4983 0.7366 0.7402 0.7346 2011-03-08 1.39 1.3993 1.386 82.66 82.85 82.19 0.9356 0.9363 0.9256 1.6152 1.6209 1.6123 0.9715 0.9747 0.9704 0.8604 0.8637 0.859 114.89 115.21 114.55 1.3005 1.3041 1.2935 1.0097 1.0134 1.0051 133.48 133.79 133.14 88.33 88.86 88.19 1.5112 1.514 1.5003 0.7392 0.7417 0.7358 2011-03-09 1.3902 1.3942 1.3853 82.73 82.94 82.54 0.9296 0.9369 0.9264 1.6203 1.6243 1.6137 0.9683 0.9714 0.9664 0.858 0.8607 0.8565 115.04 115.27 114.76 1.2927 1.3015 1.2895 1.0095 1.0132 1.0058 134.05 134.82 133.59 88.98 89.19 88.38 1.5063 1.5176 1.5008 0.7364 0.7416 0.735 2011-03-10 1.3784 1.3925 1.3773 82.94 83.17 82.67 0.9325 0.9362 0.9277 1.6045 1.6216 1.6036 0.9755 0.9766 0.968 0.859 0.8608 0.8535 114.35 115.27 114.22 1.2853 1.2943 1.2833 0.9994 1.0117 0.9988 133.09 134.35 132.95 88.94 89.15 88.72 1.4959 1.5125 1.4937 0.7342 0.7378 0.7318 2011-03-11 1.3903 1.3914 1.375 81.88 83.29 81.64 0.9296 0.9358 0.9264 1.6071 1.608 1.5975 0.9718 0.9801 0.9709 0.8644 0.8656 0.8591 113.76 115 112.94 1.2915 1.2926 1.2825 1.015 1.0158 0.9966 131.59 133.73 130.89 88.07 89.3 87.8 1.4939 1.4995 1.4857 0.7431 0.7455 0.7322 2011-03-14 1.3997 1.4003 1.3902 81.69 82.43 80.68 0.9237 0.9316 0.9225 1.6179 1.6198 1.6025 0.9723 0.9764 0.9707 0.865 0.8692 0.8636 114.34 114.81 112.59 1.2938 1.2984 1.2911 1.0105 1.0128 1.0045 132.15 132.35 129.94 88.39 88.64 86.85 1.4951 1.4978 1.4882 0.7408 0.7416 0.7358 2011-03-15 1.3993 1.4013 1.3852 80.86 82.03 80.59 0.9171 0.9251 0.9137 1.6071 1.6184 1.598 0.9824 0.9973 0.9731 0.8706 0.8708 0.8627 113.17 114.64 111.98 1.2836 1.2943 1.2739 0.9913 1.0106 0.9813 129.95 132.54 129.2 88.17 88.77 87.69 1.4739 1.4963 1.4689 0.7327 0.7403 0.7263 2011-03-16 1.3897 1.4 1.3863 79.83 81.17 79.74 0.9082 0.9197 0.9069 1.602 1.6131 1.5984 0.9914 0.9967 0.9804 0.8672 0.8707 0.8664 110.94 113.49 110.8 1.2624 1.2855 1.2586 0.9819 0.9962 0.976 127.86 130.53 127.7 87.86 88.33 87.83 1.4551 1.4808 1.4517 0.7284 0.7358 0.7247 2011-03-17 1.4017 1.4052 1.3868 78.95 79.74 76.25 0.8988 0.9059 0.8967 1.6132 1.6169 1.5981 0.9861 0.9939 0.9832 0.8687 0.8714 0.8669 110.68 111.27 107.58 1.2603 1.2676 1.2485 0.9803 0.9873 0.9704 127.39 128.02 123.48 87.79 88.18 85.88 1.4505 1.4585 1.4355 0.7183 0.7249 0.7113 2011-03-18 1.4165 1.4184 1.3978 80.87 81.98 78.99 0.9022 0.909 0.8976 1.6223 1.6254 1.6059 0.9853 0.9865 0.9801 0.8731 0.8761 0.8678 114.58 115.5 110.77 1.2782 1.2804 1.2585 0.996 0.9978 0.9779 131.2 132.48 127.54 89.62 90.66 87.93 1.4636 1.4676 1.4488 0.7311 0.7321 0.7176 2011-03-21 1.422 1.424 1.4137 81.04 81.33 80.72 0.9051 0.9075 0.9009 1.6309 1.6328 1.6202 0.9791 0.9852 0.9745 0.8718 0.8743 0.8696 115.24 115.42 114.48 1.2873 1.2884 1.2784 1.0048 1.007 0.995 132.17 132.36 130.98 89.51 89.85 89.4 1.4763 1.4773 1.4632 0.734 0.736 0.7288 2011-03-22 1.4202 1.4249 1.4172 80.91 81.3 80.82 0.9028 0.9058 0.9008 1.6383 1.6401 1.629 0.9792 0.9809 0.9742 0.8666 0.873 0.8658 114.91 115.56 114.81 1.2823 1.289 1.281 1.0111 1.0128 1.0035 132.56 132.99 131.8 89.59 89.91 89.43 1.4792 1.483 1.4696 0.7409 0.745 0.7334 2011-03-23 1.4126 1.4216 1.4098 80.89 81.07 80.68 0.9082 0.9087 0.8976 1.6252 1.6382 1.6217 0.9801 0.9843 0.9787 0.8691 0.8725 0.8654 114.29 115.04 114.04 1.283 1.2836 1.2734 1.0152 1.0156 1.0062 131.45 132.7 131.17 89.07 90.01 88.96 1.4757 1.4804 1.4629 0.7426 0.7433 0.7371 2011-03-24 1.4168 1.422 1.4049 80.97 81.05 80.74 0.9085 0.9123 0.9026 1.6106 1.6267 1.6089 0.9767 0.9824 0.9727 0.8796 0.8809 0.8664 114.72 114.96 113.56 1.2874 1.2882 1.279 1.0217 1.0228 1.0106 130.37 131.7 130.26 89.08 89.58 88.59 1.4632 1.4797 1.4589 0.7494 0.752 0.7417 2011-03-25 1.4068 1.4193 1.4052 81.4 81.49 80.87 0.9206 0.9214 0.907 1.6021 1.6142 1.6005 0.9815 0.9826 0.9739 0.8779 0.8813 0.8773 114.54 115.23 114.5 1.2953 1.2955 1.2858 1.0252 1.0294 1.0184 130.41 131.06 130.22 88.41 89.25 88.41 1.4752 1.4755 1.4621 0.7525 0.7575 0.7478 2011-03-28 1.4091 1.4115 1.4019 81.71 81.84 81.33 0.9172 0.9233 0.9149 1.5997 1.6037 1.5934 0.9764 0.9822 0.9739 0.8806 0.882 0.8762 115.13 115.32 114.24 1.2924 1.298 1.2883 1.0265 1.0314 1.0232 130.71 131.06 130.26 89.07 89.24 88.32 1.4672 1.4778 1.4641 0.7529 0.7554 0.7485 2011-03-29 1.4095 1.4149 1.4045 82.42 82.51 81.51 0.9206 0.9225 0.9137 1.5996 1.6042 1.5941 0.9746 0.9785 0.9741 0.8812 0.8836 0.8799 116.19 116.27 114.83 1.2984 1.2992 1.2891 1.029 1.0293 1.0202 131.87 131.93 130.35 89.48 89.54 89.03 1.4728 1.4748 1.4639 0.7567 0.7576 0.7489 2011-03-30 1.4132 1.4147 1.4049 82.9 83.19 82.35 0.9184 0.9274 0.9172 1.6078 1.6082 1.5977 0.971 0.9752 0.9683 0.8788 0.8819 0.8753 117.16 117.28 116.24 1.2981 1.3039 1.2962 1.0328 1.0337 1.0268 133.29 133.65 131.86 90.25 90.27 89.44 1.4766 1.4875 1.4732 0.7623 0.7637 0.7543 2011-03-31 1.4197 1.4233 1.4113 83.04 83.21 82.54 0.9162 0.9196 0.9122 1.606 1.6151 1.6015 0.9693 0.9728 0.9681 0.8838 0.8853 0.8777 117.91 117.99 116.75 1.3007 1.3025 1.2933 1.0353 1.0372 1.0308 133.35 133.85 132.52 90.64 90.7 90 1.4714 1.4808 1.4627 0.7634 0.7648 0.7578 2011-04-01 1.4224 1.4245 1.4059 84.11 84.72 83.14 0.9243 0.934 0.9177 1.6113 1.6132 1.597 0.9646 0.9704 0.9622 0.8827 0.8844 0.8801 119.63 119.81 117.84 1.3148 1.3169 1.3011 1.0375 1.0389 1.0311 135.49 135.82 133.38 90.98 91.08 90.53 1.4892 1.4947 1.4727 0.7668 0.7682 0.7576 2011-04-04 1.4216 1.4268 1.419 84.01 84.38 83.82 0.9231 0.9264 0.9187 1.6122 1.6177 1.6104 0.9672 0.9686 0.9613 0.8816 0.884 0.8792 119.46 120.04 119.2 1.3127 1.3192 1.3083 1.0362 1.0416 1.0333 135.44 136.28 135.22 90.99 91.29 90.81 1.4885 1.4952 1.4835 0.7675 0.7704 0.7654 2011-04-05 1.4222 1.4245 1.4149 84.82 84.9 84.04 0.925 0.9272 0.9199 1.6286 1.6296 1.609 0.9635 0.9692 0.9623 0.8733 0.8819 0.8714 120.64 120.74 119.33 1.316 1.3167 1.3056 1.033 1.0371 1.0285 138.1 138.23 135.63 91.66 91.73 91.08 1.5064 1.5081 1.4853 0.7675 0.7723 0.7667 2011-04-06 1.4334 1.435 1.4208 85.43 85.52 84.81 0.9185 0.929 0.9128 1.6332 1.6363 1.6255 0.9598 0.964 0.9565 0.8776 0.8797 0.8719 122.45 122.63 120.83 1.317 1.3235 1.3067 1.0442 1.045 1.0313 139.51 139.68 138.14 92.97 93.29 91.8 1.5003 1.5173 1.4894 0.7796 0.7806 0.7665 2011-04-07 1.4307 1.4344 1.424 84.87 85.54 84.57 0.9157 0.9202 0.9148 1.632 1.6342 1.6261 0.9587 0.9624 0.9566 0.8766 0.8792 0.8733 121.42 122.67 120.77 1.3104 1.3172 1.307 1.0453 1.0508 1.041 138.5 139.7 137.91 92.64 93.13 92.37 1.4948 1.5005 1.4921 0.7782 0.7806 0.7734 2011-04-08 1.4439 1.4444 1.4289 84.88 85.4 84.65 0.9098 0.9171 0.9088 1.6351 1.6427 1.6312 0.957 0.9594 0.9522 0.8828 0.8842 0.8759 122.58 123.09 121.36 1.3137 1.3192 1.3097 1.0526 1.0551 1.045 138.82 140.02 138.49 93.3 93.55 92.63 1.4876 1.5031 1.4867 0.7805 0.7833 0.7759 2011-04-11 1.4433 1.4483 1.4416 84.62 85.18 84.49 0.906 0.9108 0.9042 1.6349 1.6426 1.6311 0.9561 0.9577 0.954 0.8825 0.8859 0.8792 122.12 123.33 122.01 1.3083 1.3171 1.3069 1.0495 1.058 1.0482 138.33 139.63 138.04 93.33 93.66 92.99 1.4816 1.4954 1.4802 0.779 0.7846 0.7779 2011-04-12 1.4478 1.4519 1.4374 83.67 84.81 83.44 0.8963 0.9079 0.8937 1.6252 1.6353 1.6225 0.9622 0.9656 0.9553 0.8907 0.8916 0.8823 121.15 122.44 120.16 1.2981 1.3102 1.2962 1.0455 1.0523 1.0387 135.99 138.64 135.83 93.3 93.98 92.51 1.4568 1.4834 1.4545 0.7832 0.7884 0.7743 2011-04-13 1.4445 1.452 1.441 83.8 84.26 83.48 0.8959 0.8991 0.8924 1.6268 1.6308 1.6236 0.9629 0.9654 0.9582 0.8879 0.8923 0.8871 121.03 122.19 120.77 1.2946 1.3044 1.2919 1.0504 1.0538 1.0426 136.31 137.21 135.74 93.48 93.91 93.15 1.458 1.463 1.4544 0.7887 0.7929 0.782 2011-04-14 1.4491 1.4515 1.4362 83.4 83.96 82.94 0.8915 0.8969 0.8892 1.6345 1.6383 1.6252 0.9599 0.9669 0.9591 0.8863 0.888 0.8809 120.86 121.36 119.27 1.2926 1.2957 1.2845 1.0545 1.0549 1.0455 136.28 136.75 135.32 93.5 94.03 92.78 1.4574 1.4617 1.454 0.7934 0.7956 0.786 2011-04-15 1.4421 1.4504 1.4389 83.09 83.78 82.94 0.8929 0.8958 0.8913 1.6293 1.6373 1.6291 0.9608 0.9649 0.9588 0.885 0.8867 0.8814 119.82 121.48 119.69 1.2876 1.295 1.2865 1.0554 1.0578 1.0509 135.37 137.04 135.41 93.04 93.9 92.86 1.4544 1.463 1.4551 0.7983 0.7996 0.7922 2011-04-18 1.4236 1.442 1.4155 82.63 83.26 82.16 0.8964 0.8999 0.8902 1.6261 1.6328 1.6165 0.9637 0.9721 0.9587 0.8754 0.8838 0.8751 117.65 120.05 116.5 1.2761 1.2892 1.2728 1.0509 1.0572 1.0452 134.37 135.86 133.01 92.17 93.29 91.43 1.4574 1.4622 1.4519 0.7903 0.7992 0.7838 2011-04-19 1.4338 1.4352 1.4202 82.48 82.76 82.3 0.8994 0.901 0.8942 1.6312 1.6335 1.6229 0.9562 0.9666 0.9544 0.8787 0.8794 0.8744 118.25 118.39 117.1 1.2893 1.2917 1.273 1.0517 1.053 1.0441 134.54 134.83 133.8 91.69 92.31 91.5 1.4672 1.4708 1.454 0.7872 0.7901 0.7818 2011-04-20 1.451 1.4546 1.4325 82.35 83.09 82.25 0.8887 0.9003 0.8874 1.6402 1.6425 1.6306 0.953 0.9563 0.9493 0.8846 0.8878 0.8781 119.51 120.4 118.29 1.2892 1.298 1.2889 1.0676 1.0691 1.0516 135.07 135.8 134.7 92.68 92.98 91.7 1.4572 1.4697 1.4562 0.7943 0.8008 0.7875 2011-04-21 1.4543 1.4649 1.4503 81.83 82.57 81.6 0.8852 0.8896 0.8776 1.6521 1.6599 1.6384 0.9534 0.9537 0.9451 0.8802 0.8879 0.8783 119.03 120.27 118.66 1.2876 1.2965 1.2799 1.0745 1.0773 1.0674 135.2 135.96 134.73 92.42 93.17 92.33 1.4628 1.464 1.4548 0.8016 0.8037 0.795 2011-04-22 1.4547 1.4588 1.4532 81.91 82.1 81.64 0.8852 0.8877 0.8839 1.6519 1.6568 1.65 0.9541 0.9543 0.9517 0.8805 0.8835 0.8802 119.18 119.71 118.83 1.2885 1.2927 1.2868 1.0739 1.0755 1.0718 135.26 135.77 134.81 92.51 92.65 92.12 1.4616 1.4681 1.4609 0.8012 0.8036 0.7999 2011-04-25 1.458 1.4627 1.4522 81.7 82.42 81.68 0.8806 0.8873 0.8769 1.6497 1.6551 1.6465 0.9545 0.956 0.95 0.8837 0.8852 0.8808 119.13 120.02 119.14 1.2841 1.2913 1.2824 1.0721 1.0774 1.068 134.78 135.93 134.83 92.74 93.39 92.39 1.4525 1.464 1.4507 0.8001 0.8036 0.797 2011-04-26 1.464 1.4657 1.4492 81.54 81.97 81.48 0.8762 0.8853 0.8743 1.6476 1.6532 1.6429 0.9522 0.9561 0.9492 0.8882 0.8903 0.8809 119.38 119.9 118.52 1.2832 1.2879 1.2798 1.0778 1.0792 1.0673 134.37 135.16 134.27 93.03 93.48 92.31 1.4441 1.4566 1.4426 0.8061 0.807 0.7971 2011-04-27 1.4789 1.4791 1.463 82.04 82.77 81.24 0.8737 0.8832 0.8666 1.6628 1.6634 1.6433 0.9504 0.9575 0.9484 0.8891 0.8926 0.8848 121.3 121.36 119.47 1.2924 1.2937 1.2751 1.0874 1.0878 1.0773 136.38 136.7 134.14 93.85 93.99 93.31 1.4531 1.4598 1.4311 0.8082 0.8106 0.7999 2011-04-28 1.4822 1.4881 1.4767 81.51 82.27 81.36 0.8729 0.876 0.8686 1.6646 1.6745 1.6619 0.9506 0.952 0.9462 0.8902 0.8917 0.887 120.8 121.84 120.42 1.2942 1.2966 1.2911 1.0921 1.0947 1.0848 135.7 137.05 135.56 93.34 94.17 93.17 1.4534 1.4584 1.4505 0.8012 0.8083 0.7967 2011-04-29 1.4826 1.4878 1.4802 81.05 81.65 81.02 0.8649 0.8747 0.8622 1.6712 1.6721 1.6622 0.9451 0.9548 0.9445 0.8871 0.8937 0.8871 120.18 121.14 120.18 1.2825 1.296 1.2816 1.0965 1.0977 1.0878 135.43 136.01 135.17 93.66 94.03 93.23 1.4454 1.4552 1.4405 0.8097 0.8108 0.7999 2011-05-02 1.4825 1.4902 1.476 81.26 81.69 80.97 0.8652 0.8703 0.8621 1.6651 1.6737 1.6642 0.951 0.9512 0.9443 0.8903 0.8921 0.8855 120.45 121.07 120.1 1.2828 1.2944 1.2801 1.0937 1.1011 1.0919 135.24 136.11 135.31 93.9 94.1 93.39 1.4406 1.4558 1.4408 0.8055 0.8119 0.8028 2011-05-03 1.4824 1.489 1.4751 80.97 81.27 80.66 0.8617 0.8673 0.8591 1.6472 1.666 1.6462 0.9526 0.9541 0.9454 0.8999 0.9006 0.8883 120.04 120.59 119.24 1.2775 1.2839 1.2766 1.0858 1.0952 1.0834 133.4 135.38 132.97 93.95 94.19 93.14 1.4195 1.4426 1.4186 0.7986 0.8062 0.7966 2011-05-04 1.483 1.4939 1.4773 80.56 81.2 80.41 0.8609 0.8647 0.855 1.6499 1.6574 1.6451 0.9582 0.9603 0.95 0.8987 0.9028 0.8978 119.48 120.87 119.28 1.2776 1.283 1.2731 1.0745 1.0876 1.0736 132.88 134.24 132.79 93.51 94.42 93.53 1.4212 1.4267 1.4158 0.7904 0.7996 0.7862 2011-05-05 1.4529 1.4899 1.4508 80.14 80.69 79.55 0.8704 0.8711 0.8552 1.6383 1.6543 1.6357 0.9679 0.9711 0.9564 0.8869 0.9041 0.8864 116.45 119.77 116.15 1.2649 1.2791 1.2631 1.0567 1.077 1.0532 131.29 133.2 130.93 92.05 93.85 91.92 1.4259 1.4306 1.4109 0.7831 0.794 0.781 2011-05-06 1.4346 1.4587 1.4314 80.62 80.93 80.16 0.8772 0.8797 0.8673 1.6389 1.6463 1.6352 0.9665 0.9702 0.9569 0.8751 0.8899 0.8749 115.65 117.57 115.22 1.2588 1.2749 1.2582 1.0693 1.0802 1.0579 132.11 132.84 131.36 91.86 92.77 91.44 1.4375 1.4409 1.4237 0.7904 0.7973 0.7842 2011-05-09 1.435 1.4441 1.4253 80.23 80.84 80.19 0.8716 0.8788 0.8712 1.6391 1.6406 1.6269 0.963 0.9696 0.96 0.8753 0.8818 0.8742 115.12 116.47 115 1.2508 1.263 1.2485 1.0789 1.079 1.0698 131.51 132.41 131.25 92.03 92.36 91.79 1.4286 1.4372 1.4268 0.7943 0.7948 0.7883 2011-05-10 1.4402 1.4411 1.4267 80.78 80.87 80.13 0.88 0.8823 0.8705 1.6357 1.642 1.6314 0.9576 0.9653 0.9573 0.8803 0.8807 0.872 116.34 116.39 114.81 1.2678 1.2688 1.249 1.0836 1.085 1.0732 132.12 132.51 131.49 91.75 92.26 91.52 1.4399 1.4407 1.429 0.795 0.7961 0.7884 2011-05-11 1.4195 1.4423 1.417 80.97 81.32 80.59 0.8873 0.8885 0.878 1.6341 1.6517 1.632 0.9603 0.9638 0.9509 0.8684 0.8809 0.8678 114.96 116.88 114.58 1.2598 1.2699 1.2591 1.069 1.0888 1.0661 132.3 134.05 131.84 91.23 92.23 90.96 1.4503 1.4552 1.4373 0.7879 0.7973 0.7866 2011-05-12 1.424 1.4276 1.4121 80.86 81.34 80.68 0.884 0.8904 0.8822 1.6279 1.6381 1.6233 0.9626 0.9694 0.9596 0.8745 0.8753 0.8674 115.15 115.62 114.2 1.2588 1.262 1.2548 1.0668 1.0713 1.0563 131.64 133.19 131.25 91.45 91.8 90.91 1.4391 1.452 1.4377 0.7953 0.7991 0.7837 2011-05-13 1.4106 1.4339 1.4064 80.79 81.09 80.33 0.8924 0.8946 0.8796 1.6184 1.6308 1.6146 0.9692 0.9743 0.9601 0.8715 0.88 0.8705 113.97 115.54 113.51 1.2592 1.2694 1.2577 1.0574 1.0716 1.0517 130.74 132.02 130.3 90.48 91.68 90.16 1.4443 1.4465 1.4341 0.7871 0.7964 0.7832 2011-05-16 1.4184 1.4244 1.4046 80.75 81.05 80.62 0.8831 0.8938 0.8796 1.6207 1.6254 1.6158 0.9736 0.977 0.968 0.8749 0.8771 0.8689 114.52 115.23 113.43 1.253 1.2611 1.2522 1.0589 1.0642 1.0509 130.85 131.49 130.42 91.39 91.9 90.24 1.4312 1.4466 1.4288 0.7818 0.787 0.7751 2011-05-17 1.4227 1.4236 1.4118 81.36 81.77 80.71 0.8804 0.8883 0.88 1.6248 1.6303 1.6173 0.9727 0.9792 0.9715 0.8754 0.8758 0.8683 115.75 116.23 114.27 1.2531 1.2596 1.2507 1.0617 1.0623 1.0502 132.17 133.17 130.86 92.36 92.53 91.29 1.431 1.4467 1.4306 0.7838 0.7845 0.776 2011-05-18 1.4233 1.4287 1.4193 81.65 81.74 80.9 0.8814 0.8848 0.878 1.616 1.6289 1.6104 0.971 0.9759 0.9699 0.8808 0.8841 0.8758 116.22 116.4 115.24 1.2547 1.2581 1.2521 1.0617 1.0665 1.0566 131.93 132.53 130.79 92.6 92.79 91.86 1.4244 1.4346 1.4177 0.7881 0.7911 0.7831 2011-05-19 1.4308 1.4325 1.4204 81.51 82.23 81.46 0.8806 0.8879 0.8762 1.6221 1.6221 1.6128 0.9685 0.9713 0.9651 0.8821 0.8845 0.8792 116.64 117.23 116.21 1.2601 1.2642 1.2536 1.0667 1.0681 1.0591 132.2 132.97 131.85 92.54 93.03 92.45 1.4283 1.4358 1.4189 0.7899 0.7936 0.7856 2011-05-20 1.4176 1.4345 1.4137 81.61 81.86 81.46 0.8777 0.8855 0.8745 1.6261 1.6303 1.6165 0.9719 0.9771 0.9638 0.8718 0.884 0.8716 115.74 117.16 115.52 1.2445 1.2644 1.2403 1.0682 1.071 1.0605 132.71 132.97 132.14 92.98 93.31 92.28 1.4274 1.4364 1.4185 0.7974 0.7999 0.7902 2011-05-23 1.4049 1.4143 1.3968 81.95 82.03 81.3 0.883 0.885 0.8755 1.6106 1.6233 1.6086 0.9774 0.981 0.9733 0.8721 0.873 0.8664 115.13 115.59 113.87 1.2406 1.2425 1.2323 1.0508 1.0649 1.0475 131.95 132.92 131.29 92.79 93.46 92.11 1.4219 1.4286 1.4201 0.7913 0.7949 0.7854 2011-05-24 1.4113 1.4132 1.4 81.93 82.21 81.57 0.8789 0.8892 0.8779 1.6194 1.6208 1.6059 0.9768 0.9792 0.9751 0.8714 0.8751 0.8705 115.65 116.18 114.71 1.2405 1.2468 1.2381 1.0564 1.0582 1.0475 132.65 133.13 131.45 93.22 93.55 92.15 1.4228 1.4294 1.4191 0.7983 0.8015 0.7878 2011-05-25 1.4093 1.4118 1.4011 81.97 82.17 81.75 0.8722 0.8816 0.8706 1.6283 1.6294 1.613 0.9768 0.9816 0.974 0.8654 0.8716 0.8632 115.49 115.77 114.7 1.2288 1.2416 1.227 1.0541 1.056 1.0437 133.47 133.7 132.11 93.96 94.1 92.86 1.4202 1.4259 1.4169 0.7994 0.8012 0.7897 2011-05-26 1.4132 1.4206 1.4065 81.35 82.16 81.13 0.866 0.8734 0.8646 1.639 1.6396 1.627 0.9784 0.9815 0.9753 0.8622 0.8711 0.861 114.98 116.38 114.46 1.224 1.2365 1.2201 1.0631 1.0642 1.0505 133.33 133.8 132.66 93.95 94.21 93.6 1.4195 1.424 1.4147 0.8109 0.8123 0.7961 2011-05-27 1.4292 1.4302 1.4123 80.85 81.39 80.69 0.8521 0.8662 0.8508 1.6479 1.6509 1.6378 0.9775 0.9796 0.975 0.8671 0.8693 0.8622 115.56 116 114.68 1.2183 1.2253 1.215 1.0676 1.0718 1.0604 133.25 133.64 132.73 94.84 95 93.68 1.4047 1.4195 1.4033 0.8156 0.8197 0.8064 2011-05-30 1.4278 1.4312 1.4254 80.94 80.98 80.72 0.852 0.8531 0.8488 1.6466 1.6512 1.6448 0.977 0.9787 0.9747 0.8672 0.8682 0.8657 115.57 115.67 115.21 1.2174 1.2184 1.2131 1.068 1.0715 1.0667 133.26 133.48 132.99 94.9 95.21 94.8 1.4036 1.4052 1.3983 0.8151 0.8216 0.8148 2011-05-31 1.4386 1.4424 1.4282 81.44 81.77 80.69 0.8524 0.855 0.8463 1.645 1.6546 1.6423 0.9685 0.9769 0.9652 0.8744 0.8751 0.867 117.19 117.79 115.63 1.2267 1.2317 1.2159 1.0668 1.0756 1.0637 134 135.12 133.33 95.51 96.1 94.97 1.4026 1.412 1.3991 0.8236 0.8262 0.8158 2011-06-01 1.4345 1.4458 1.4339 80.95 81.52 80.66 0.8427 0.8546 0.8379 1.6342 1.6495 1.6334 0.9757 0.976 0.9664 0.8777 0.8809 0.8743 116.12 117.7 116.08 1.2087 1.2323 1.2087 1.062 1.0753 1.0619 132.29 134.36 132.17 96.04 96.35 95.16 1.3771 1.4066 1.3746 0.8168 0.8257 0.8163 2011-06-02 1.4484 1.4513 1.4321 80.88 81.32 80.56 0.8418 0.8455 0.84 1.6359 1.6418 1.6304 0.9757 0.9809 0.9745 0.885 0.8863 0.8771 117.16 117.34 115.85 1.2198 1.2229 1.2069 1.0676 1.0689 1.0585 132.3 132.85 131.81 96.02 96.36 95.68 1.3778 1.3839 1.3734 0.8165 0.818 0.8105 2011-06-03 1.4625 1.4642 1.4451 80.23 81.01 80.03 0.835 0.845 0.8331 1.6435 1.6438 1.6284 0.9772 0.9851 0.9742 0.8899 0.8923 0.8847 117.36 117.59 115.94 1.2219 1.2255 1.2109 1.0727 1.0773 1.0593 131.9 132.59 130.69 96.04 96.45 95.35 1.3731 1.3811 1.3619 0.8163 0.8193 0.8065 2011-06-06 1.4568 1.4658 1.4555 80.09 80.38 79.95 0.8366 0.8386 0.8325 1.6346 1.6459 1.6339 0.9801 0.9816 0.9765 0.891 0.8938 0.8893 116.69 117.7 116.58 1.2186 1.2261 1.2188 1.0711 1.0767 1.0689 130.93 132.27 130.83 95.71 96.37 95.53 1.3676 1.3753 1.3673 0.8138 0.8181 0.8115 2011-06-07 1.4685 1.4696 1.4561 79.99 80.33 79.98 0.8357 0.8394 0.8322 1.6442 1.647 1.6322 0.9741 0.9809 0.9728 0.8932 0.8946 0.8907 117.52 117.89 116.77 1.2282 1.2317 1.2168 1.0722 1.0748 1.0668 131.57 132.08 130.9 95.67 96.33 95.55 1.375 1.3802 1.3641 0.8209 0.823 0.8133 2011-06-08 1.4573 1.4693 1.4564 79.88 80.26 79.67 0.8363 0.8381 0.8343 1.6396 1.6446 1.6346 0.9796 0.982 0.9735 0.8888 0.8975 0.8886 116.42 117.85 116.3 1.2187 1.23 1.2178 1.0615 1.0723 1.0584 130.98 131.94 130.5 95.5 95.92 95.26 1.3711 1.3771 1.3666 0.8146 0.8213 0.8138 2011-06-09 1.4517 1.4651 1.4476 80.27 80.42 79.81 0.8406 0.8444 0.8352 1.637 1.6466 1.6356 0.9726 0.9812 0.9721 0.8865 0.8918 0.8847 116.52 117.45 115.94 1.2207 1.2304 1.2192 1.0636 1.0662 1.056 131.4 131.96 130.94 95.44 96.01 94.95 1.3764 1.3822 1.3708 0.8274 0.83 0.8171 2011-06-10 1.4337 1.455 1.432 80.27 80.46 79.95 0.8423 0.8432 0.8393 1.6231 1.6382 1.6217 0.9775 0.9796 0.9708 0.8834 0.8919 0.8829 115.12 116.87 114.96 1.208 1.2231 1.2059 1.0552 1.0652 1.0524 130.31 131.66 129.82 95.28 95.61 94.89 1.3675 1.3781 1.3646 0.8205 0.8279 0.8202 2011-06-13 1.4411 1.443 1.4319 80.17 80.69 80.08 0.8368 0.8467 0.835 1.638 1.6384 1.6214 0.9761 0.9798 0.9748 0.8796 0.8843 0.8798 115.56 115.77 115.03 1.2065 1.2137 1.2005 1.0602 1.0637 1.0518 131.32 131.45 130.3 95.75 96.14 95.09 1.3707 1.374 1.3618 0.8155 0.8218 0.8107 2011-06-14 1.4449 1.4498 1.4376 80.43 80.63 80.07 0.8452 0.8456 0.8345 1.6369 1.6441 1.6354 0.9689 0.9771 0.9671 0.8826 0.8843 0.8785 116.24 116.7 115.28 1.221 1.2254 1.2015 1.0672 1.0715 1.0564 131.68 132.34 131.08 95.16 96.22 95.17 1.3834 1.3866 1.3669 0.8174 0.8214 0.8134 2011-06-15 1.4173 1.4454 1.4154 80.96 81.06 80.35 0.8529 0.8551 0.844 1.6169 1.6384 1.6166 0.9787 0.9828 0.9667 0.8762 0.8827 0.875 114.74 116.53 114.57 1.2089 1.2244 1.2083 1.0558 1.0713 1.0531 130.9 132.05 130.7 94.88 95.4 94.68 1.3793 1.392 1.3782 0.8047 0.8205 0.8028 2011-06-16 1.4176 1.4201 1.4071 80.66 81.03 80.46 0.8493 0.8549 0.8474 1.6138 1.6227 1.6076 0.9835 0.9898 0.9769 0.8783 0.879 0.8723 114.33 115.08 113.51 1.204 1.2126 1.1947 1.0533 1.0591 1.0473 130.16 131.39 129.77 94.94 95.22 94.51 1.3706 1.3845 1.3648 0.8023 0.8072 0.7968 2011-06-17 1.4289 1.4339 1.4124 80.05 80.68 80 0.8488 0.851 0.8438 1.6165 1.6195 1.6092 0.9808 0.9868 0.9772 0.8837 0.8856 0.8769 114.36 114.81 113.73 1.2126 1.2146 1.1986 1.06 1.0634 1.0501 129.35 130.5 129.38 94.29 95.16 94.3 1.3718 1.3747 1.3645 0.812 0.8137 0.8011 2011-06-20 1.43 1.4327 1.4189 80.23 80.36 80 0.8466 0.8518 0.8403 1.6199 1.6235 1.6107 0.98 0.9849 0.9777 0.8826 0.8843 0.8791 114.74 114.99 113.6 1.2105 1.2142 1.2019 1.0564 1.0617 1.0492 129.98 130.23 128.94 94.77 95.41 94.14 1.3711 1.3743 1.3627 0.8083 0.8118 0.8035 2011-06-21 1.4406 1.4422 1.4304 80.15 80.34 80.02 0.8408 0.846 0.8396 1.6239 1.6253 1.6165 0.9725 0.9805 0.9708 0.887 0.888 0.8827 115.45 115.55 114.67 1.2112 1.2148 1.2071 1.0598 1.0619 1.0528 130.16 130.37 129.68 95.31 95.37 94.85 1.3654 1.371 1.364 0.8112 0.8146 0.8076 2011-06-22 1.4355 1.4441 1.4343 80.32 80.38 79.98 0.8391 0.8432 0.8337 1.6068 1.6261 1.6067 0.9727 0.9753 0.9697 0.8934 0.8953 0.8848 115.31 115.82 115.16 1.2048 1.2149 1.2028 1.0573 1.065 1.0563 129.06 130.53 128.98 95.66 95.99 95.12 1.3483 1.3697 1.346 0.8143 0.8193 0.8101 2011-06-23 1.4237 1.4338 1.4125 80.56 80.79 80.27 0.838 0.8438 0.8361 1.5991 1.607 1.5937 0.9791 0.9823 0.971 0.8902 0.8932 0.885 114.71 115.39 113.85 1.1931 1.2071 1.1848 1.0508 1.0571 1.0451 128.81 129.31 128.5 96.12 96.29 95.43 1.3397 1.3524 1.3359 0.8128 0.8177 0.8078 2011-06-24 1.417 1.4309 1.4139 80.45 80.6 80.11 0.8374 0.8394 0.8336 1.5969 1.6046 1.5949 0.9873 0.9886 0.9767 0.8874 0.8928 0.886 114.02 114.89 113.77 1.1869 1.1964 1.1845 1.0496 1.06 1.0482 128.5 129.03 128.26 96.05 96.23 95.75 1.3373 1.3438 1.3356 0.8098 0.8172 0.809 2011-06-27 1.428 1.4293 1.4101 80.88 80.98 80.35 0.8358 0.8384 0.8314 1.598 1.6011 1.5912 0.9866 0.9913 0.9855 0.8936 0.8943 0.8859 115.5 115.6 113.86 1.1938 1.1958 1.1818 1.0437 1.0487 1.0386 129.24 129.55 128.32 96.74 97.24 96.29 1.3358 1.3378 1.3293 0.8054 0.8081 0.7998 2011-06-28 1.4354 1.4397 1.4234 81.14 81.26 80.63 0.8324 0.8357 0.8271 1.5985 1.6044 1.591 0.9826 0.9885 0.9814 0.8977 0.8984 0.8928 116.46 116.67 115.13 1.1946 1.1959 1.1865 1.0533 1.0543 1.0431 129.68 129.95 128.67 97.46 97.63 96.68 1.3301 1.3357 1.3264 0.8114 0.8124 0.8022 2011-06-29 1.4428 1.4447 1.4325 80.85 81.18 80.54 0.8349 0.8368 0.8295 1.6059 1.6074 1.5968 0.9706 0.9825 0.9685 0.8985 0.9014 0.8945 116.65 117.16 115.9 1.2047 1.2062 1.1926 1.0673 1.0679 1.0515 129.84 130.08 129.12 96.82 97.67 96.56 1.3404 1.3424 1.3268 0.8233 0.8235 0.8096 2011-06-30 1.4514 1.4538 1.4424 80.52 80.87 80.23 0.8401 0.8463 0.8303 1.6058 1.6117 1.5971 0.964 0.97 0.9622 0.9038 0.9068 0.8984 116.88 117.19 116.13 1.2199 1.2246 1.2034 1.0725 1.0749 1.0663 129.31 129.85 128.42 95.79 96.96 95.52 1.3495 1.3547 1.3322 0.8279 0.8318 0.8241 2011-07-01 1.4521 1.4551 1.4434 80.83 81.14 80.51 0.8483 0.8525 0.8399 1.6072 1.6095 1.5987 0.959 0.965 0.9583 0.9035 0.9083 0.9016 117.41 117.46 116.76 1.2318 1.2322 1.2186 1.0779 1.079 1.0669 129.93 130.07 129.06 95.29 96.02 95.09 1.3632 1.3654 1.3484 0.8279 0.8293 0.8236 2011-07-04 1.4529 1.4577 1.4489 80.78 80.9 80.52 0.8476 0.8503 0.846 1.6088 1.614 1.6051 0.96 0.9617 0.9576 0.903 0.9069 0.9002 117.41 117.75 117 1.232 1.2349 1.2305 1.0732 1.0785 1.0708 129.93 130.14 129.65 95.23 95.44 94.84 1.3634 1.3701 1.36 0.8291 0.8309 0.8261 2011-07-05 1.4421 1.4553 1.4395 81.03 81.19 80.69 0.8407 0.8506 0.8383 1.6057 1.6128 1.5989 0.9625 0.9636 0.959 0.8979 0.9049 0.8972 116.89 117.61 116.7 1.2127 1.2339 1.2099 1.0689 1.0746 1.0659 130.15 130.84 129.74 96.37 96.6 95.22 1.3501 1.3652 1.3479 0.8254 0.8325 0.8247 2011-07-06 1.43 1.4466 1.4283 80.94 81.12 80.75 0.8397 0.8442 0.836 1.5989 1.609 1.5946 0.9654 0.9694 0.961 0.8941 0.9018 0.8941 115.75 117.05 115.54 1.2013 1.2172 1.1968 1.0678 1.0733 1.065 129.42 130.29 128.99 96.35 96.64 95.9 1.3427 1.3518 1.3361 0.8252 0.83 0.8233 2011-07-07 1.4351 1.4374 1.4219 81.2 81.41 80.77 0.8443 0.8495 0.8377 1.5963 1.6017 1.5945 0.9586 0.9666 0.9565 0.8987 0.8996 0.8904 116.54 116.8 115.54 1.2121 1.2144 1.1976 1.0771 1.0776 1.0682 129.64 130.13 129.11 96.14 96.59 95.8 1.348 1.3567 1.3388 0.8325 0.8329 0.8249 2011-07-08 1.4249 1.4368 1.4204 80.64 81.48 80.48 0.8371 0.8519 0.8357 1.6039 1.6077 1.593 0.9607 0.9665 0.9569 0.8882 0.9001 0.8865 114.91 116.81 114.66 1.1929 1.217 1.1907 1.0747 1.0788 1.0699 129.34 130.02 128.88 96.3 96.45 95.49 1.3426 1.3584 1.3402 0.8363 0.8366 0.8284 2011-07-11 1.4017 1.4227 1.3984 80.29 80.83 80.07 0.8354 0.8387 0.8326 1.5902 1.6041 1.588 0.9688 0.9695 0.9612 0.8813 0.8891 0.8796 112.54 114.76 112.36 1.171 1.1919 1.1671 1.0639 1.0732 1.0627 127.67 129.42 127.45 96.08 96.59 95.93 1.3287 1.3439 1.3254 0.8278 0.8359 0.827 2011-07-12 1.3968 1.4062 1.3835 79.41 80.38 79.16 0.8308 0.8397 0.8278 1.5912 1.5948 1.578 0.9655 0.9778 0.9622 0.8778 0.8839 0.8749 110.92 112.95 109.59 1.1604 1.1751 1.1554 1.0591 1.0664 1.0521 126.35 127.86 125.14 95.57 96.12 94.83 1.3218 1.3324 1.3156 0.8186 0.8302 0.8106 2011-07-13 1.4139 1.4192 1.3949 78.94 79.58 78.86 0.8177 0.833 0.8172 1.6104 1.612 1.5909 0.9597 0.9667 0.9575 0.8777 0.8848 0.8763 111.65 112.07 110.51 1.1564 1.1721 1.1565 1.073 1.0778 1.0571 127.13 127.38 126.06 96.54 96.56 95.29 1.3167 1.3275 1.3164 0.8348 0.8385 0.8156 2011-07-14 1.4131 1.4281 1.4113 79.15 79.57 78.45 0.8168 0.8199 0.8082 1.6134 1.6191 1.6092 0.9605 0.9616 0.9545 0.8759 0.8832 0.8755 111.89 112.9 111.66 1.1545 1.1648 1.1501 1.071 1.0785 1.069 127.74 128.17 126.85 96.91 97.69 96.57 1.3178 1.3215 1.3077 0.8405 0.8505 0.8385 2011-07-15 1.4145 1.4199 1.409 79.06 79.27 78.87 0.8127 0.8191 0.8118 1.613 1.6174 1.6075 0.9542 0.9624 0.9517 0.8767 0.8795 0.8745 111.85 112.34 111.36 1.1497 1.1597 1.1499 1.065 1.0745 1.0617 127.52 128.03 127.2 97.25 97.27 96.63 1.311 1.3202 1.311 0.8463 0.8468 0.8375 2011-07-18 1.4102 1.4133 1.4009 79.02 79.17 78.91 0.8178 0.8193 0.809 1.6038 1.6131 1.6003 0.9592 0.9635 0.9534 0.8792 0.8795 0.8705 111.45 111.85 110.65 1.1532 1.1537 1.1405 1.0596 1.0653 1.0556 126.76 127.66 126.67 96.62 97.7 96.5 1.3116 1.3166 1.3049 0.8437 0.849 0.8404 2011-07-19 1.4134 1.4217 1.4067 79.19 79.28 78.79 0.8242 0.8277 0.8149 1.6116 1.6176 1.604 0.9507 0.9601 0.9479 0.8769 0.8808 0.8757 111.94 112.31 111.17 1.1653 1.1688 1.1517 1.0719 1.074 1.0596 127.65 127.74 126.84 96.05 96.91 95.77 1.3286 1.3337 1.3106 0.8555 0.8572 0.8426 2011-07-20 1.4227 1.424 1.413 78.75 79.31 78.69 0.8196 0.8254 0.8174 1.6163 1.6167 1.6067 0.9471 0.9512 0.9454 0.8801 0.8829 0.877 112.04 112.34 111.67 1.1657 1.1692 1.1608 1.0741 1.076 1.0705 127.29 127.84 126.72 96.1 96.36 95.77 1.3239 1.3303 1.3202 0.8563 0.8567 0.8521 2011-07-21 1.4375 1.4417 1.4137 78.48 79.03 78.31 0.8166 0.8237 0.8155 1.6297 1.6323 1.612 0.9451 0.9493 0.942 0.8821 0.8838 0.8762 112.81 113.14 111.48 1.1743 1.18 1.1613 1.0832 1.0856 1.069 127.89 128.2 127.03 96.06 96.21 95.67 1.331 1.3374 1.3236 0.8622 0.8642 0.8534 2011-07-22 1.4361 1.4437 1.4322 78.39 78.72 78.25 0.8176 0.8246 0.815 1.6299 1.6327 1.6263 0.9488 0.9529 0.9424 0.881 0.8854 0.8799 112.63 113.56 112.27 1.1744 1.1889 1.1696 1.0853 1.0874 1.0815 127.82 128.41 127.5 95.89 96.26 95.39 1.3326 1.3439 1.328 0.8642 0.8673 0.8578 2011-07-25 1.4373 1.4406 1.4323 78.28 78.55 78.02 0.8049 0.8154 0.8017 1.6296 1.6331 1.626 0.9453 0.9525 0.943 0.8817 0.8844 0.8798 112.51 112.99 112.01 1.1575 1.1714 1.1519 1.0843 1.0876 1.0791 127.57 128.05 127.11 97.19 97.46 96.16 1.3124 1.3284 1.306 0.8647 0.8676 0.8607 2011-07-26 1.451 1.4526 1.4355 77.93 78.59 77.81 0.801 0.8071 0.7997 1.6411 1.6428 1.6264 0.9428 0.9474 0.9403 0.8839 0.8883 0.8817 113.05 113.41 112.25 1.1622 1.1661 1.1546 1.0951 1.0969 1.0817 127.9 128.17 127.07 97.26 97.8 97.05 1.3147 1.3186 1.3072 0.8712 0.8742 0.8606 2011-07-27 1.4366 1.4536 1.4338 78.01 78.17 77.54 0.8018 0.8046 0.7989 1.6331 1.6439 1.631 0.9489 0.9506 0.9407 0.8797 0.8847 0.8773 112.09 113.22 111.95 1.1523 1.1649 1.1502 1.1018 1.108 1.0938 127.36 128.12 127.2 97.23 97.38 96.87 1.31 1.3193 1.3075 0.8696 0.8765 0.8676 2011-07-28 1.4306 1.44 1.4251 77.76 78.02 77.6 0.8021 0.805 0.7987 1.6339 1.6364 1.6293 0.9512 0.9516 0.9455 0.8753 0.8805 0.8736 111.25 112.09 110.82 1.1469 1.1535 1.1421 1.0983 1.1075 1.0977 127.06 127.4 126.72 97 97.32 96.72 1.3098 1.3152 1.3042 0.869 0.8754 0.8678 2011-07-29 1.4379 1.4413 1.4228 76.96 77.86 76.93 0.7882 0.8035 0.785 1.6427 1.647 1.6259 0.9551 0.9589 0.9483 0.8751 0.8784 0.8735 110.69 111.55 110.38 1.1328 1.1496 1.1301 1.0988 1.1016 1.0906 126.44 127.37 126.12 97.69 98.14 96.65 1.2936 1.3133 1.2902 0.8793 0.8794 0.8619 2011-08-01 1.4265 1.4453 1.4184 77.13 78 76.29 0.7829 0.7951 0.7729 1.6305 1.6475 1.6236 0.9555 0.9604 0.9488 0.8748 0.8804 0.8723 110.04 112.24 108.72 1.1169 1.145 1.1032 1.0969 1.1065 1.0918 125.77 128.49 124.23 98.48 99.02 97.14 1.2766 1.3088 1.2589 0.8764 0.884 0.8729 2011-08-02 1.4216 1.4283 1.4149 77.07 77.79 76.93 0.7647 0.7855 0.7639 1.631 1.6328 1.6222 0.9592 0.9618 0.9545 0.8715 0.8769 0.8699 109.58 110.99 109.21 1.0875 1.1204 1.0848 1.0815 1.1007 1.0793 125.71 126.93 125.34 100.78 100.85 98.53 1.2474 1.2807 1.2441 0.8673 0.8784 0.8657 2011-08-03 1.432 1.4344 1.4142 76.98 77.4 76.77 0.7685 0.7787 0.7623 1.6423 1.643 1.6249 0.9618 0.9647 0.9564 0.8719 0.8758 0.8694 110.23 110.61 109.07 1.1005 1.1147 1.0795 1.075 1.0785 1.0674 126.38 126.62 125.29 100.12 101.22 99.14 1.2617 1.2762 1.2411 0.8615 0.8678 0.857 2011-08-04 1.4132 1.4369 1.411 78.98 80.24 76.96 0.7672 0.78 0.7651 1.6262 1.6439 1.6255 0.9778 0.9791 0.96 0.869 0.875 0.8655 111.62 114.17 110.43 1.0846 1.114 1.0836 1.0491 1.0779 1.049 128.44 130.83 126.57 102.93 103.02 100 1.2475 1.2758 1.2459 0.8392 0.8669 0.8389 2011-08-05 1.4274 1.4297 1.4054 78.42 79.4 78.32 0.7656 0.7738 0.7578 1.6358 1.6396 1.6227 0.9781 0.9853 0.974 0.8725 0.8733 0.8644 111.94 112.32 110.37 1.0929 1.0981 1.0728 1.0466 1.0526 1.0371 128.28 129.03 127.42 102.33 103.88 101.42 1.2519 1.26 1.2384 0.8432 0.8465 0.8269 2011-08-08 1.4206 1.4401 1.4129 77.67 78.41 77.48 0.7549 0.765 0.7482 1.635 1.6471 1.6295 0.9916 0.9928 0.9779 0.8688 0.8749 0.8662 110.37 112.52 109.73 1.0727 1.0991 1.0623 1.0222 1.0437 1.0204 127.02 128.85 126.5 102.83 103.61 101.65 1.2343 1.2574 1.2247 0.8231 0.8421 0.8214 2011-08-09 1.4339 1.4346 1.415 76.83 77.85 76.68 0.718 0.7591 0.7085 1.6282 1.641 1.6174 0.9785 1.0009 0.9779 0.8804 0.8807 0.8679 110.18 110.63 109.12 1.03 1.084 1.0075 1.0332 1.0343 0.9924 125.09 127.03 124.55 106.84 108.41 101.98 1.1682 1.2435 1.1502 0.8352 0.836 0.7959 2011-08-10 1.4189 1.4401 1.416 76.85 77.3 76.33 0.7277 0.7323 0.7178 1.613 1.633 1.6121 0.9925 0.9945 0.9763 0.8796 0.8886 0.8759 109.04 111.25 108.31 1.0327 1.0515 1.0258 1.0231 1.04 1.0165 123.95 126.22 123.31 105.54 107.12 104.6 1.1733 1.192 1.1677 0.812 0.8407 0.8076 2011-08-11 1.424 1.4294 1.4101 76.87 77.22 76.29 0.7622 0.7686 0.7236 1.6232 1.6236 1.6109 0.9859 0.9968 0.9847 0.8772 0.8827 0.8737 109.46 109.75 108.03 1.0858 1.0917 1.0257 1.0353 1.0358 1.0108 124.77 124.79 123.41 100.79 106.17 99.92 1.237 1.2446 1.1685 0.8322 0.8329 0.8068 2011-08-12 1.4248 1.4291 1.4148 76.79 77.02 76.48 0.7765 0.7786 0.7546 1.6276 1.6312 1.6165 0.99 0.9917 0.9831 0.8753 0.8784 0.8732 109.42 109.6 108.52 1.1066 1.1095 1.0687 1.0344 1.0361 1.0242 125 125.19 123.97 98.8 101.59 98.68 1.2635 1.2676 1.2215 0.8321 0.8343 0.8175 2011-08-15 1.4442 1.4476 1.4259 76.8 77.09 76.56 0.7846 0.7997 0.7784 1.6383 1.6409 1.6255 0.9804 0.9906 0.9796 0.8814 0.8832 0.8756 110.93 111.02 109.61 1.1332 1.1457 1.116 1.0498 1.0513 1.0357 125.84 125.92 125.01 97.85 98.52 96.15 1.2852 1.303 1.2742 0.8323 0.839 0.8268 2011-08-16 1.4411 1.4471 1.4352 76.74 76.93 76.62 0.7935 0.795 0.7767 1.6471 1.6476 1.6321 0.9806 0.9871 0.9794 0.8748 0.8824 0.8739 110.6 111.05 110.08 1.1435 1.1482 1.1166 1.048 1.0513 1.0402 126.41 126.43 125.3 96.67 98.83 96.57 1.3067 1.3086 1.2695 0.8374 0.838 0.8267 2011-08-17 1.4439 1.4517 1.4323 76.46 76.83 76.38 0.7887 0.8011 0.7822 1.6549 1.659 1.6353 0.9804 0.9845 0.9771 0.8725 0.8808 0.8699 110.44 110.97 109.79 1.1393 1.1554 1.1221 1.055 1.0601 1.0429 126.57 126.98 125.32 96.9 97.9 95.67 1.3053 1.3215 1.2807 0.8373 0.8424 0.8305 2011-08-18 1.4325 1.4451 1.4269 76.54 76.7 76.42 0.7934 0.7986 0.7856 1.6503 1.6553 1.6419 0.9899 0.9937 0.9796 0.8677 0.8743 0.8676 109.62 110.71 109.25 1.1365 1.151 1.1241 1.0378 1.0557 1.0348 126.3 126.79 125.67 96.4 97.33 95.99 1.3092 1.3202 1.2931 0.8209 0.8378 0.8191 2011-08-19 1.4393 1.4452 1.4257 76.5 76.94 75.93 0.7865 0.7959 0.7805 1.6478 1.6618 1.6442 0.9885 0.9925 0.9823 0.8733 0.8735 0.8652 110.1 110.26 109.03 1.1324 1.139 1.1254 1.0403 1.0481 1.0311 126.06 126.8 125.74 97.17 97.67 96.14 1.2961 1.3119 1.2961 0.8176 0.8288 0.8167 2011-08-22 1.4369 1.4434 1.4345 76.74 77.19 76.53 0.79 0.7906 0.7835 1.6472 1.652 1.6434 0.9891 0.9918 0.9825 0.8723 0.8753 0.8697 110.31 110.9 110.03 1.1353 1.1382 1.1269 1.0424 1.0472 1.0357 126.41 127.32 126.16 97.11 98.04 97.09 1.3012 1.3031 1.2914 0.8259 0.8278 0.8151 2011-08-23 1.4437 1.4499 1.4351 76.67 76.93 76.39 0.7912 0.7919 0.785 1.6505 1.657 1.6452 0.9884 0.9909 0.9846 0.8745 0.8769 0.8701 110.73 111.1 110.09 1.1427 1.1432 1.1318 1.0516 1.0534 1.0382 126.55 126.97 126.17 96.84 97.53 96.83 1.3061 1.307 1.2975 0.8351 0.8366 0.8209 2011-08-24 1.4421 1.4481 1.4377 76.99 77.07 76.42 0.795 0.796 0.7873 1.6381 1.6533 1.6363 0.9868 0.9905 0.9836 0.8801 0.8812 0.8729 111.02 111.15 110.17 1.1466 1.1474 1.1371 1.0468 1.0529 1.0444 126.11 126.75 125.64 96.78 97.17 96.45 1.3019 1.3099 1.2938 0.8282 0.8352 0.8257 2011-08-25 1.4383 1.4474 1.4325 77.52 77.69 76.82 0.7929 0.7989 0.7908 1.6286 1.6397 1.626 0.9868 0.9887 0.9789 0.883 0.8835 0.8796 111.52 111.63 110.63 1.1406 1.1519 1.1401 1.0437 1.0513 1.042 126.28 126.54 125.77 97.7 97.78 96.62 1.2917 1.3052 1.2912 0.8277 0.8328 0.825 2011-08-26 1.4496 1.4501 1.4328 76.68 77.46 76.5 0.807 0.8157 0.7892 1.6349 1.6362 1.6207 0.9829 0.9923 0.9826 0.8867 0.8867 0.8831 111.15 111.56 110.09 1.1698 1.1735 1.1395 1.0578 1.0592 1.0462 125.36 126.19 124.48 95.01 97.64 94.45 1.3194 1.3237 1.2869 0.8398 0.8417 0.8284 2011-08-29 1.4512 1.4548 1.4464 76.82 77.02 76.51 0.816 0.8239 0.8067 1.6404 1.6455 1.6325 0.9775 0.9832 0.9737 0.8844 0.8881 0.8834 111.48 111.93 111.02 1.1844 1.197 1.1692 1.0652 1.066 1.0558 126 126.56 125.25 94.1 95.02 93.47 1.3388 1.3533 1.3187 0.8458 0.8469 0.8376 2011-08-30 1.4462 1.4533 1.4383 76.67 76.98 76.6 0.8193 0.8232 0.8119 1.6316 1.6419 1.6253 0.9772 0.9817 0.9754 0.8861 0.8876 0.8815 110.88 111.8 110.46 1.1852 1.1897 1.1754 1.0715 1.072 1.0617 125.11 126.34 124.66 93.56 94.42 93.23 1.3369 1.3439 1.328 0.8543 0.8558 0.8457 2011-08-31 1.4379 1.4468 1.4358 76.56 76.83 76.4 0.8058 0.8208 0.7992 1.6246 1.6333 1.6237 0.9783 0.9801 0.9721 0.885 0.8884 0.8827 110.11 110.88 109.92 1.1591 1.1849 1.1528 1.0698 1.072 1.0649 124.38 125.31 124.31 94.99 95.72 93.42 1.3094 1.3386 1.3036 0.8532 0.8571 0.8499 2011-09-01 1.427 1.4381 1.4224 76.82 77.24 76.64 0.7942 0.8086 0.7923 1.6174 1.6257 1.613 0.9756 0.9796 0.9733 0.8819 0.8857 0.8798 109.6 110.95 109.54 1.1336 1.1607 1.1322 1.0744 1.0764 1.0659 124.22 125.35 124.15 96.67 96.87 95.02 1.2848 1.313 1.2826 0.8508 0.8537 0.8469 2011-09-02 1.4192 1.4288 1.4182 76.8 76.97 76.54 0.7898 0.7959 0.7708 1.6222 1.6253 1.6171 0.9833 0.9846 0.9753 0.8749 0.8821 0.875 109 109.88 108.86 1.1211 1.1353 1.0997 1.0662 1.0733 1.0623 124.58 124.72 124.18 97.16 99.42 96.59 1.2812 1.2882 1.2524 0.8468 0.8544 0.8433 2011-09-05 1.4092 1.4172 1.4059 76.89 76.97 76.66 0.786 0.7912 0.7818 1.6096 1.6186 1.606 0.991 0.9933 0.985 0.8751 0.8789 0.8738 108.34 108.89 108.14 1.1077 1.1198 1.1016 1.055 1.0612 1.0508 123.75 124.42 123.52 97.77 98.36 97.11 1.2646 1.2794 1.258 0.8318 0.8449 0.8287 2011-09-06 1.3996 1.4275 1.3971 77.66 77.68 76.68 0.8617 0.8626 0.7837 1.594 1.618 1.5923 0.9898 0.9956 0.9862 0.878 0.8847 0.8733 108.7 109.94 107.86 1.2061 1.2167 1.102 1.0506 1.0626 1.0478 123.75 125.07 123.08 90.09 98.04 89.91 1.3731 1.3821 1.2609 0.8218 0.8386 0.8201 2011-09-07 1.409 1.4148 1.3992 77.31 77.71 77.04 0.859 0.8621 0.8536 1.5974 1.6039 1.5919 0.9857 0.9908 0.9846 0.8818 0.883 0.8771 108.93 109.09 108.26 1.2101 1.2109 1.2037 1.0636 1.0648 1.0479 123.47 123.88 123.2 89.97 90.4 89.79 1.3718 1.3757 1.3674 0.8299 0.8325 0.8226 2011-09-08 1.3892 1.4095 1.3873 77.46 77.6 77.11 0.8744 0.8768 0.8571 1.5967 1.6083 1.5912 0.9884 0.9896 0.9826 0.8699 0.8842 0.8693 107.62 109.03 107.55 1.2151 1.218 1.2073 1.0581 1.066 1.0562 123.68 124.38 123.16 88.5 90.12 88.48 1.3962 1.3993 1.3686 0.8324 0.8383 0.8302 2011-09-09 1.3663 1.3936 1.3626 77.45 77.85 77.07 0.8829 0.8863 0.8704 1.5873 1.599 1.5842 0.9961 0.9979 0.9866 0.8603 0.8719 0.8598 105.83 107.99 105.3 1.2065 1.2185 1.2056 1.0453 1.0635 1.0419 122.92 124.24 122.38 87.7 88.98 87.3 1.4018 1.4076 1.3891 0.8213 0.8371 0.8189 2011-09-12 1.3616 1.3692 1.3495 77.34 77.58 76.71 0.884 0.8925 0.8798 1.5827 1.5885 1.5777 0.9948 1.0026 0.9937 0.8602 0.8638 0.8533 105.29 105.6 103.92 1.2036 1.2076 1.2033 1.0309 1.044 1.0252 122.37 123.02 121.31 87.44 87.63 86.16 1.3989 1.4124 1.3954 0.82 0.8239 0.8109 2011-09-13 1.3695 1.3739 1.3556 76.89 77.25 76.78 0.879 0.8879 0.8755 1.5791 1.5869 1.5761 0.9855 0.9976 0.9848 0.8672 0.8684 0.8594 105.28 105.58 104.42 1.2038 1.2053 1.2017 1.0333 1.0375 1.0258 121.41 122.45 121.34 87.42 87.72 86.73 1.3883 1.4008 1.3866 0.8254 0.8271 0.8175 2011-09-14 1.3768 1.3783 1.3589 76.61 77.06 76.57 0.8749 0.8853 0.8727 1.5787 1.5813 1.5704 0.9892 0.994 0.9843 0.872 0.8726 0.8639 105.47 105.58 104.55 1.2047 1.2053 1.2013 1.028 1.037 1.0173 120.96 121.56 120.72 87.55 87.77 86.89 1.381 1.3928 1.3785 0.8213 0.8265 0.8137 2011-09-15 1.3878 1.3936 1.3701 76.6 77.29 76.51 0.8695 0.8796 0.8646 1.5797 1.5868 1.5729 0.9841 0.9949 0.9832 0.8784 0.8791 0.8696 106.35 107.01 105.11 1.2071 1.2094 1.2022 1.0315 1.0346 1.0178 121.05 122.26 120.69 88.09 88.78 87.18 1.3737 1.3865 1.3709 0.8235 0.828 0.8115 2011-09-16 1.3791 1.3884 1.3752 76.83 76.98 76.63 0.8762 0.8776 0.8691 1.5789 1.5841 1.5742 0.9793 0.986 0.9791 0.8732 0.8789 0.8711 105.94 106.55 105.54 1.2081 1.2095 1.2048 1.0361 1.0398 1.029 121.29 121.76 120.8 87.68 88.25 87.54 1.3835 1.3863 1.3737 0.8289 0.8341 0.8198 2011-09-19 1.3698 1.3719 1.3585 76.5 76.98 76.3 0.8808 0.8875 0.8796 1.5715 1.5754 1.5628 0.9888 0.9923 0.9803 0.8716 0.8726 0.8671 104.81 105.47 103.96 1.2069 1.2092 1.2047 1.0237 1.0315 1.0163 120.22 121.06 119.49 86.85 87.41 86.24 1.3843 1.3927 1.3832 0.8275 0.8286 0.8166 2011-09-20 1.3665 1.3744 1.3591 76.38 76.76 76.34 0.8887 0.8919 0.8787 1.5725 1.574 1.5653 0.9935 0.9948 0.9879 0.8689 0.8738 0.8678 104.36 105.2 104.02 1.2145 1.221 1.2045 1.0244 1.0312 1.0144 120.09 120.57 119.8 85.9 87.06 85.82 1.3972 1.4015 1.3826 0.8214 0.8265 0.8158 2011-09-21 1.3607 1.3799 1.3602 76.67 76.69 76.1 0.8979 0.8982 0.8853 1.5522 1.5742 1.5514 1.0047 1.0057 0.9914 0.8766 0.8795 0.8689 104.32 105.34 104.03 1.222 1.2296 1.2151 1.0069 1.0291 1.0058 118.95 120.43 118.98 85.28 86.34 85.19 1.3931 1.4105 1.3919 0.8007 0.8237 0.7998 2011-09-22 1.3462 1.3601 1.3382 76.25 76.97 76.09 0.9083 0.9182 0.8974 1.5345 1.5516 1.5325 1.0278 1.036 1.005 0.8772 0.8792 0.8708 102.68 104.37 102.22 1.2227 1.2343 1.2179 0.9734 1.0077 0.9689 117.04 119.12 116.87 83.94 85.47 83.09 1.3936 1.4147 1.3889 0.7792 0.8066 0.7748 2011-09-23 1.3502 1.3567 1.3415 76.65 76.88 76.12 0.9043 0.9082 0.8992 1.5476 1.5487 1.5336 1.0294 1.0348 1.0222 0.8724 0.8792 0.8711 103.5 103.72 102.24 1.2213 1.2282 1.2184 0.9754 0.9865 0.9664 118.64 118.77 117.04 84.72 84.95 83.9 1.3997 1.4007 1.3909 0.7737 0.7893 0.7721 2011-09-26 1.3495 1.3549 1.3361 76.44 76.76 76.21 0.9032 0.9142 0.9003 1.555 1.557 1.5431 1.0282 1.0385 1.0256 0.8677 0.8747 0.8652 103.16 103.76 101.95 1.219 1.2252 1.2154 0.9808 0.9837 0.9611 118.87 118.91 117.79 84.62 84.76 83.45 1.4047 1.4125 1.3996 0.7786 0.7807 0.7634 2011-09-27 1.3596 1.3668 1.3477 76.73 76.83 76.23 0.8965 0.9057 0.8923 1.5631 1.5705 1.5525 1.0196 1.028 1.0139 0.8696 0.8717 0.8673 104.31 104.96 102.88 1.2195 1.2236 1.2176 0.9902 0.9985 0.9772 119.9 120.44 118.54 85.59 86.01 84.41 1.4013 1.4075 1.3999 0.7868 0.7957 0.7762 2011-09-28 1.355 1.3689 1.3539 76.47 76.86 76.3 0.8991 0.9 0.8923 1.5581 1.5677 1.5572 1.0316 1.033 1.0189 0.8696 0.874 0.8671 103.64 104.52 103.52 1.2184 1.2226 1.2177 0.979 0.9955 0.9775 119.17 120.21 118.97 85.04 85.73 84.9 1.4004 1.4074 1.3975 0.777 0.79 0.7754 2011-09-29 1.3585 1.3678 1.3518 76.77 77.02 76.38 0.8974 0.9021 0.8916 1.5602 1.5715 1.5541 1.0363 1.0401 1.0253 0.8705 0.8725 0.8673 104.3 104.93 103.34 1.2192 1.2221 1.2183 0.9767 0.9878 0.9697 119.82 120.83 118.8 85.52 86.05 84.74 1.4 1.4061 1.3983 0.7699 0.7831 0.7646 2011-09-30 1.3395 1.3602 1.3392 77.07 77.19 76.47 0.9063 0.9084 0.8962 1.5591 1.5665 1.553 1.0482 1.0484 1.0352 0.8589 0.8712 0.8579 103.23 104.43 103.04 1.2142 1.2209 1.2129 0.9678 0.9808 0.9666 120.16 120.79 119.13 84.99 85.6 84.8 1.4128 1.417 1.4003 0.7621 0.7703 0.7603 2011-10-03 1.3224 1.3381 1.319 76.58 77.26 76.49 0.9184 0.92 0.9075 1.547 1.5587 1.5442 1.0495 1.0528 1.043 0.8545 0.8633 0.8539 101.26 103.23 101.05 1.215 1.2168 1.2124 0.9589 0.9699 0.9536 118.43 120.37 118.32 83.34 85.01 83.27 1.421 1.4221 1.409 0.7568 0.7641 0.7526 2011-10-04 1.3343 1.3366 1.3144 76.87 76.98 76.51 0.918 0.926 0.9159 1.5467 1.5483 1.5339 1.053 1.0657 1.0508 0.8625 0.8645 0.8535 102.58 102.78 100.81 1.2247 1.228 1.2129 0.9568 0.9595 0.9386 118.91 119.07 117.75 83.71 83.9 82.88 1.4196 1.4239 1.4132 0.7609 0.7629 0.7466 2011-10-05 1.3342 1.3383 1.3257 76.76 77.07 76.58 0.924 0.9247 0.9159 1.5455 1.5492 1.5393 1.0414 1.0571 1.0404 0.863 0.8649 0.8595 102.4 102.75 101.63 1.2331 1.2353 1.2221 0.9646 0.9664 0.9484 118.61 119.01 118.12 83.04 83.78 82.98 1.4285 1.43 1.4189 0.7652 0.7668 0.755 2011-10-06 1.3443 1.3449 1.324 76.58 76.85 76.53 0.9197 0.9314 0.9183 1.5449 1.5501 1.527 1.0383 1.0482 1.0367 0.8699 0.8728 0.8619 102.99 103.06 101.65 1.2366 1.2418 1.2292 0.9755 0.9767 0.9617 118.37 118.87 116.98 83.28 83.47 82.43 1.4209 1.4373 1.4121 0.7713 0.7724 0.762 2011-10-07 1.3395 1.3524 1.3359 76.85 76.91 76.55 0.9258 0.9278 0.9143 1.5555 1.5644 1.5421 1.0362 1.0417 1.0231 0.8609 0.8704 0.8597 102.95 103.85 102.63 1.2404 1.2423 1.2339 0.9801 0.9878 0.9723 119.54 119.98 118.14 82.94 83.9 82.82 1.44 1.4426 1.4189 0.7723 0.7796 0.7671 2011-10-10 1.3637 1.3698 1.3376 76.64 76.85 76.53 0.9036 0.9271 0.9 1.5665 1.5688 1.5526 1.0285 1.0386 1.0248 0.8703 0.8731 0.8606 104.51 105 102.75 1.2325 1.2439 1.2303 0.9957 1.0014 0.975 120.07 120.3 119.19 84.79 85.12 82.84 1.4158 1.4414 1.4125 0.7814 0.7857 0.7671 2011-10-11 1.3674 1.3684 1.3564 76.66 76.76 76.57 0.9064 0.9125 0.9023 1.5608 1.5663 1.5579 1.029 1.0338 1.0253 0.8759 0.8766 0.8689 104.79 104.9 103.99 1.2388 1.2421 1.2316 0.9988 1.0003 0.9902 119.59 120.13 119.47 84.58 84.94 84.01 1.4135 1.4278 1.4118 0.782 0.7844 0.7757 2011-10-12 1.3803 1.3833 1.358 77.25 77.48 76.3 0.8936 0.9115 0.8916 1.5772 1.5797 1.5541 1.0149 1.0328 1.013 0.8751 0.8787 0.8733 106.66 107.06 104.21 1.2335 1.2434 1.2323 1.0173 1.0206 0.9863 121.87 122.36 119.25 86.46 86.78 84.15 1.4094 1.4199 1.4061 0.7969 0.7996 0.7739 2011-10-13 1.379 1.3827 1.3683 76.86 77.29 76.66 0.8971 0.9039 0.8925 1.5766 1.5782 1.5665 1.0202 1.0272 1.0159 0.8746 0.8781 0.8707 105.99 106.56 105.13 1.2374 1.2376 1.2326 1.0188 1.023 1.0098 121.18 121.69 120.36 85.63 86.34 84.98 1.4147 1.4196 1.4056 0.7947 0.7966 0.7887 2011-10-14 1.3875 1.3894 1.372 77.23 77.45 76.82 0.8928 0.9008 0.89 1.5806 1.5851 1.5719 1.0105 1.0234 1.0102 0.8777 0.8779 0.8722 107.15 107.44 105.62 1.239 1.2412 1.2357 1.0338 1.0343 1.0142 122.06 122.61 120.99 86.47 86.77 85.41 1.4113 1.4177 1.4094 0.8049 0.8052 0.7904 2011-10-17 1.3748 1.3914 1.3729 76.8 77.45 76.59 0.8984 0.8995 0.8878 1.5753 1.5848 1.5728 1.0216 1.0225 1.004 0.8726 0.8796 0.8714 105.58 107.67 105.37 1.2352 1.2395 1.2345 1.0197 1.0371 1.0174 121.02 122.63 120.89 85.49 87.17 85.32 1.4153 1.4175 1.4051 0.7934 0.8068 0.7918 2011-10-18 1.3788 1.3817 1.3651 76.76 76.91 76.6 0.8964 0.9048 0.8943 1.574 1.5821 1.5629 1.0129 1.0264 1.0108 0.8759 0.8768 0.8691 105.85 106.19 104.8 1.2361 1.2378 1.2328 1.0294 1.0326 1.0114 120.8 121.58 120.01 85.59 85.87 84.86 1.4108 1.4201 1.4104 0.7966 0.8007 0.7856 2011-10-19 1.375 1.3869 1.3723 76.8 76.86 76.63 0.9027 0.9038 0.8949 1.577 1.5847 1.5697 1.0199 1.0216 1.0081 0.8716 0.8788 0.8714 105.59 106.53 105.34 1.2413 1.2474 1.2352 1.0219 1.0353 1.0201 121.1 121.7 120.47 85.06 85.68 84.9 1.4236 1.4261 1.4104 0.791 0.801 0.7896 2011-10-20 1.3784 1.3842 1.3655 76.84 77.08 76.65 0.8935 0.9081 0.8927 1.5799 1.5803 1.5679 1.0143 1.0246 1.0128 0.8724 0.877 0.869 105.93 106.31 104.89 1.2316 1.2441 1.228 1.0246 1.0297 1.0143 121.38 121.52 120.39 86 86.17 84.47 1.411 1.4275 1.4061 0.7944 0.7989 0.7868 2011-10-21 1.3869 1.39 1.3703 76.14 76.91 75.78 0.8832 0.8952 0.8822 1.5944 1.5961 1.5752 1.0091 1.0187 1.0063 0.8697 0.8733 0.8668 105.59 106.09 105.08 1.2244 1.2335 1.221 1.0332 1.0364 1.0199 121.34 122.07 120.82 86.19 86.7 85.56 1.4071 1.4191 1.4001 0.8018 0.8027 0.7897 2011-10-24 1.3925 1.3956 1.382 76.05 76.46 75.97 0.8809 0.8877 0.8788 1.5979 1.6008 1.5898 1.0037 1.01 1.0018 0.871 0.8726 0.8675 105.9 106.45 105.15 1.2272 1.2306 1.2233 1.0476 1.05 1.0311 121.54 122.09 121.02 86.3 86.66 85.71 1.4075 1.4147 1.4063 0.8074 0.8108 0.7995 2011-10-25 1.391 1.3959 1.3847 75.92 76.27 75.73 0.8781 0.8845 0.8769 1.6004 1.6037 1.5955 1.0151 1.0212 0.9987 0.8691 0.8725 0.867 105.6 106.31 105.26 1.2221 1.2282 1.2222 1.0437 1.0496 1.0393 121.45 122.02 120.97 86.4 86.81 85.91 1.4059 1.4131 1.4024 0.7957 0.8076 0.7937 2011-10-26 1.3902 1.3974 1.3796 76.3 76.32 75.69 0.8808 0.8859 0.8726 1.5967 1.6041 1.589 1.0046 1.0176 1.0039 0.8705 0.8722 0.8674 106.06 106.16 104.75 1.2244 1.2271 1.2157 1.0397 1.0436 1.0319 121.83 121.96 120.72 86.58 86.9 85.71 1.4063 1.4098 1.3963 0.794 0.8001 0.791 2011-10-27 1.4179 1.4247 1.3863 75.94 76.28 75.64 0.8612 0.8824 0.8566 1.6081 1.614 1.5952 0.9921 1.005 0.9888 0.8814 0.8831 0.869 107.66 108.13 105.69 1.2213 1.2288 1.2179 1.0706 1.0752 1.038 122.13 122.52 121.13 88.15 88.54 86.37 1.3851 1.4083 1.381 0.8199 0.8222 0.7982 2011-10-28 1.4165 1.42 1.4132 75.72 76 75.64 0.8615 0.8651 0.8593 1.6124 1.6152 1.6069 0.9922 0.9969 0.9892 0.8783 0.8821 0.8776 107.29 107.91 107.1 1.2207 1.2245 1.2193 1.0719 1.073 1.0654 122.12 122.35 121.85 87.85 88.36 87.56 1.3895 1.3932 1.3838 0.8232 0.8241 0.8161 2011-10-31 1.384 1.4169 1.3827 78.15 79.51 75.55 0.8775 0.8787 0.8607 1.6081 1.6165 1.5964 0.9967 1.0026 0.991 0.8603 0.8784 0.8597 108.16 111.57 106.95 1.2143 1.223 1.2143 1.0538 1.0709 1.0502 125.63 127.26 121.91 89.04 91.33 87.7 1.4112 1.4135 1.3892 0.8085 0.8227 0.8067 2011-11-01 1.3678 1.3871 1.3608 78.35 78.61 77.99 0.8881 0.8959 0.876 1.5931 1.6093 1.5889 1.0193 1.0207 0.997 0.8585 0.8623 0.8548 107.23 108.75 106.51 1.2151 1.2211 1.214 1.0313 1.0566 1.0268 124.87 126.28 124.3 88.2 89.83 87.34 1.4146 1.4271 1.4097 0.7944 0.8105 0.7915 2011-11-02 1.3745 1.3829 1.3635 78.08 78.41 77.93 0.884 0.8904 0.8791 1.5946 1.6046 1.5915 1.0137 1.0222 1.0104 0.8618 0.8642 0.8565 107.32 107.9 106.9 1.215 1.2182 1.2143 1.0335 1.0427 1.0276 124.5 125.29 124.44 88.31 88.7 88.03 1.4094 1.4179 1.4069 0.7896 0.798 0.7861 2011-11-03 1.3831 1.3854 1.3654 78.02 78.16 77.87 0.8772 0.8893 0.8758 1.6042 1.606 1.5875 1.0072 1.0215 1.0052 0.8621 0.8643 0.8562 107.93 108.07 106.59 1.2134 1.2172 1.2114 1.0417 1.0446 1.0198 125.19 125.3 123.93 88.93 89.03 87.73 1.4074 1.4191 1.4044 0.7951 0.7967 0.7801 2011-11-04 1.3769 1.3866 1.371 78.13 78.26 77.94 0.886 0.8906 0.8766 1.603 1.6063 1.5943 1.0165 1.0228 1.0068 0.8587 0.8653 0.8573 107.61 108.25 107.23 1.2205 1.2249 1.2135 1.039 1.0439 1.0311 125.26 125.55 124.63 88.17 88.98 87.81 1.4201 1.4246 1.4073 0.7945 0.7965 0.7878 2011-11-07 1.377 1.3837 1.3679 78.03 78.18 77.95 0.9011 0.903 0.8865 1.6048 1.6078 1.5978 1.0129 1.0203 1.0121 0.858 0.8611 0.8555 107.5 108.16 106.83 1.2411 1.242 1.2266 1.0366 1.0426 1.0271 125.24 125.64 124.8 86.58 88.1 86.47 1.4458 1.4472 1.4251 0.7966 0.7997 0.7907 2011-11-08 1.3837 1.3847 1.3722 77.68 78.09 77.59 0.8948 0.9074 0.8918 1.6103 1.6129 1.6033 1.0081 1.0182 1.0073 0.8593 0.8597 0.8556 107.5 107.64 107.12 1.2382 1.2458 1.2324 1.04 1.0404 1.0277 125.05 125.61 124.98 86.81 87.17 85.99 1.4408 1.4554 1.4373 0.7983 0.7991 0.7919 2011-11-09 1.3546 1.3858 1.3522 77.81 77.88 77.52 0.9087 0.911 0.8919 1.5922 1.6119 1.5903 1.0215 1.0232 1.0075 0.8508 0.8599 0.8501 105.4 107.6 105.26 1.2314 1.2401 1.2281 1.0147 1.0397 1.0133 123.85 125.18 123.63 85.58 86.96 85.43 1.4472 1.4499 1.4385 0.7813 0.7987 0.7803 2011-11-10 1.3595 1.3652 1.3481 77.65 77.87 77.49 0.9063 0.9148 0.9016 1.5921 1.5984 1.5866 1.018 1.0264 1.0161 0.8538 0.8558 0.8485 105.56 105.98 104.75 1.2323 1.2383 1.2293 1.0136 1.0209 1.0049 123.64 124.08 123.1 85.63 86.08 85 1.4431 1.4562 1.4392 0.7762 0.7821 0.7728 2011-11-11 1.3746 1.3795 1.3576 77.12 77.69 77.03 0.9015 0.9083 0.895 1.6065 1.6092 1.5893 1.0124 1.0232 1.0104 0.8554 0.8587 0.8529 105.98 106.38 105.38 1.2392 1.2414 1.2322 1.0268 1.0304 1.0101 123.89 124.16 122.95 85.49 86.13 85.23 1.4484 1.4498 1.4389 0.7853 0.7871 0.7741 2011-11-14 1.3637 1.3811 1.359 77.09 77.27 76.78 0.9067 0.9092 0.8958 1.5911 1.609 1.5879 1.0163 1.0194 1.0078 0.8569 0.8603 0.8557 105.14 106.71 104.76 1.2365 1.2417 1.233 1.0198 1.035 1.0157 122.68 124.31 122.33 85.04 86.02 84.77 1.4422 1.4481 1.4379 0.779 0.793 0.7757 2011-11-15 1.3541 1.364 1.3495 77.03 77.31 76.88 0.915 0.9197 0.9073 1.5827 1.5931 1.5797 1.02 1.0262 1.0155 0.8555 0.8575 0.8519 104.35 105.26 104 1.2392 1.2428 1.2373 1.0185 1.0226 1.0109 121.94 122.82 121.69 84.19 85 83.79 1.448 1.456 1.4441 0.7712 0.7853 0.7667 2011-11-16 1.3484 1.3558 1.3427 76.99 77.14 76.83 0.9176 0.9222 0.9135 1.5748 1.5827 1.5734 1.0223 1.0287 1.0168 0.8561 0.8585 0.852 103.8 104.37 103.41 1.2378 1.2411 1.236 1.0099 1.0184 1.0056 121.25 121.99 121.17 83.87 84.25 83.46 1.4449 1.4542 1.4424 0.7653 0.7723 0.7621 2011-11-17 1.3463 1.3539 1.342 76.94 77.09 76.86 0.9215 0.9235 0.9149 1.5747 1.5811 1.5689 1.0285 1.0291 1.0204 0.8549 0.8577 0.8536 103.6 104.16 103.43 1.2406 1.244 1.2367 0.9978 1.0117 0.9969 121.19 121.68 120.91 83.48 84.06 83.35 1.4504 1.4537 1.4448 0.7571 0.7687 0.7561 2011-11-18 1.3517 1.3614 1.3445 76.9 77.02 76.55 0.917 0.9222 0.9081 1.5786 1.5888 1.5737 1.0267 1.0301 1.0195 0.8561 0.8586 0.8518 103.92 104.28 103.54 1.2398 1.2414 1.2344 1.0015 1.0107 0.996 121.4 121.75 121.08 83.79 84.3 83.47 1.4483 1.4527 1.4407 0.7569 0.7649 0.7549 2011-11-21 1.3505 1.354 1.3429 76.93 76.99 76.72 0.916 0.9209 0.9137 1.5656 1.5796 1.561 1.0367 1.0418 1.0268 0.8625 0.8641 0.8555 103.89 104.22 103.23 1.2375 1.2412 1.2351 0.9862 1.0014 0.9805 120.44 121.46 120.04 83.95 84.2 83.43 1.4345 1.4491 1.4321 0.7485 0.7575 0.7445 2011-11-22 1.351 1.3568 1.3467 76.96 77.31 76.79 0.9141 0.9186 0.9104 1.5632 1.5691 1.5581 1.0383 1.0412 1.0342 0.8639 0.8665 0.8618 103.98 104.34 103.7 1.2351 1.2385 1.2337 0.9841 0.9898 0.9809 120.33 120.91 120.13 84.18 84.39 83.81 1.4292 1.436 1.4258 0.7476 0.7513 0.7437 2011-11-23 1.3356 1.3531 1.3318 77.34 77.58 76.9 0.919 0.9213 0.9123 1.5534 1.5654 1.5492 1.0468 1.0497 1.0371 0.8594 0.8648 0.8588 103.29 104.11 103.06 1.2271 1.2353 1.2263 0.9718 0.9855 0.9659 120.14 120.46 119.85 84.14 84.33 83.9 1.4275 1.4323 1.4228 0.7406 0.7503 0.7381 2011-11-24 1.3338 1.3411 1.3315 77.09 77.32 76.99 0.9192 0.9215 0.915 1.5487 1.5565 1.5482 1.0472 1.049 1.0435 0.8609 0.8623 0.8585 102.82 103.46 102.71 1.2263 1.2319 1.2254 0.9721 0.9784 0.9678 119.39 120.16 119.39 83.81 84.15 83.7 1.4237 1.4306 1.4233 0.7405 0.7454 0.7382 2011-11-25 1.3233 1.3355 1.321 77.74 77.75 77.07 0.9292 0.933 0.9187 1.5448 1.5518 1.5421 1.0486 1.0523 1.0436 0.8563 0.8619 0.8546 102.88 103.24 102.48 1.2295 1.238 1.2249 0.9706 0.9773 0.9663 120.11 120.44 119.39 83.66 84.1 83.21 1.4354 1.4454 1.4241 0.7395 0.7441 0.7367 2011-11-28 1.3294 1.3398 1.3271 77.99 78.23 77.42 0.9238 0.9306 0.9172 1.549 1.5593 1.5456 1.0363 1.0448 1.03 0.858 0.8609 0.8569 103.71 104.51 103.1 1.2283 1.2362 1.2281 0.9878 0.9976 0.9786 120.76 121.66 120 84.4 84.88 83.46 1.4312 1.44 1.4287 0.7531 0.7574 0.7468 2011-11-29 1.3327 1.3442 1.3284 77.9 78.27 77.59 0.9198 0.9243 0.9136 1.5608 1.5656 1.5466 1.0301 1.0363 1.0256 0.8538 0.861 0.8528 103.83 104.4 103.44 1.2261 1.2322 1.2258 1.0024 1.0077 0.9859 121.6 121.84 120.78 84.66 84.95 84.21 1.4356 1.441 1.4271 0.7621 0.7651 0.7506 2011-11-30 1.344 1.3531 1.3257 77.55 78.15 77.28 0.9121 0.925 0.9061 1.5701 1.5779 1.5524 1.0194 1.0362 1.0119 0.8559 0.8591 0.8517 104.23 104.72 103.35 1.2267 1.233 1.2232 1.0284 1.033 0.9938 121.77 122.52 121.06 84.97 85.52 84.31 1.4328 1.4419 1.4278 0.7809 0.7822 0.7572 2011-12-01 1.3456 1.3521 1.3415 77.68 77.8 77.47 0.916 0.919 0.9068 1.5684 1.5755 1.5635 1.014 1.0223 1.0133 0.858 0.8601 0.8559 104.57 105.05 104.21 1.2326 1.2392 1.2252 1.0226 1.0289 1.0146 121.83 122.5 121.44 84.78 85.62 84.5 1.4366 1.4419 1.4261 0.7788 0.7818 0.7718 2011-12-02 1.3402 1.3548 1.3361 77.97 78.08 77.64 0.9203 0.9241 0.9108 1.5598 1.5722 1.5575 1.0185 1.0194 1.0076 0.8591 0.8625 0.8574 104.51 105.66 104.13 1.2336 1.2373 1.2322 1.0213 1.0323 1.02 121.63 122.62 121.32 84.72 85.58 84.34 1.4355 1.4402 1.4325 0.7782 0.7837 0.7758 2011-12-05 1.3392 1.3486 1.3374 77.7 78.1 77.67 0.9206 0.923 0.9161 1.5638 1.5714 1.5586 1.0176 1.0193 1.0118 0.8563 0.8606 0.8558 104.08 105 104.01 1.2331 1.2397 1.2326 1.0268 1.0304 1.0196 121.49 122.27 121.48 84.37 84.94 84.35 1.4402 1.4432 1.4362 0.779 0.7835 0.7752 2011-12-06 1.3401 1.3427 1.3332 77.68 77.85 77.62 0.926 0.9294 0.9196 1.5596 1.5664 1.5559 1.009 1.0206 1.0083 0.8591 0.8603 0.8539 104.13 104.34 103.65 1.2411 1.2429 1.2332 1.0247 1.0271 1.0152 121.19 121.79 120.97 83.89 84.56 83.67 1.444 1.451 1.4402 0.7796 0.7818 0.7734 2011-12-07 1.3413 1.3454 1.3349 77.65 77.79 77.6 0.9235 0.9288 0.9224 1.5708 1.5722 1.5593 1.0093 1.0132 1.0063 0.8538 0.8614 0.8512 104.16 104.51 103.78 1.2387 1.2442 1.2375 1.0293 1.0298 1.0225 121.97 122.18 121.14 84.07 84.18 83.68 1.4506 1.4551 1.4412 0.7795 0.7827 0.7746 2011-12-08 1.3331 1.3459 1.3288 77.68 77.8 77.13 0.9262 0.929 0.9174 1.563 1.577 1.5609 1.0226 1.0234 1.0049 0.8529 0.8553 0.8495 103.58 104.21 103.01 1.2353 1.2415 1.2327 1.0156 1.0378 1.0148 121.4 122.05 120.95 83.85 84.18 83.39 1.448 1.455 1.4464 0.7718 0.7877 0.7706 2011-12-09 1.337 1.3433 1.328 77.49 77.77 77.47 0.924 0.9284 0.9179 1.566 1.5734 1.5583 1.0182 1.0262 1.0176 0.8536 0.8563 0.8516 103.62 104.4 103.16 1.2355 1.238 1.2315 1.0221 1.0224 1.0044 121.38 122.22 121.02 83.84 84.63 83.64 1.4471 1.4493 1.4418 0.7752 0.7759 0.7633 2011-12-12 1.3185 1.3385 1.3161 77.9 78 77.55 0.9371 0.9384 0.9245 1.5579 1.5657 1.5534 1.0258 1.0285 1.0181 0.8463 0.8554 0.8452 102.72 103.96 102.63 1.2359 1.2391 1.2323 1.0065 1.0213 1.0047 121.37 121.78 120.72 83.11 83.94 83.01 1.4601 1.4622 1.442 0.7627 0.7749 0.7606 2011-12-13 1.3027 1.3236 1.3007 77.99 78 77.62 0.9465 0.9476 0.9338 1.5468 1.5628 1.545 1.034 1.0349 1.0228 0.8418 0.8482 0.8403 101.59 102.98 101.48 1.233 1.2376 1.2298 1 1.0161 0.9976 120.64 121.66 120.53 82.38 83.27 82.3 1.464 1.4665 1.4573 0.7567 0.7674 0.7547 2011-12-14 1.2984 1.3063 1.2944 78.04 78.16 77.88 0.9527 0.9538 0.9426 1.5467 1.553 1.5407 1.0398 1.0423 1.0324 0.8394 0.8426 0.8372 101.34 101.81 101.1 1.2368 1.2376 1.2299 0.9904 1.0045 0.988 120.65 121.12 120.31 81.9 82.65 81.85 1.473 1.4748 1.4607 0.7501 0.7578 0.7483 2011-12-15 1.3016 1.3049 1.2955 77.9 78.14 77.7 0.9402 0.9548 0.9384 1.551 1.5529 1.5432 1.0349 1.0405 1.0316 0.8392 0.8425 0.8375 101.42 101.6 101.05 1.2238 1.24 1.2221 0.9919 0.9988 0.9857 120.83 120.92 120.5 82.85 82.97 81.78 1.4581 1.4757 1.455 0.753 0.7555 0.7457 2011-12-16 1.3034 1.3084 1.2994 77.8 77.96 77.58 0.9362 0.9414 0.9348 1.552 1.5556 1.5481 1.0378 1.0406 1.0294 0.8396 0.8413 0.8379 101.4 101.81 101.14 1.2207 1.2254 1.2199 0.9963 1.0027 0.9914 120.71 121.13 120.45 83.06 83.17 82.77 1.4531 1.4603 1.4524 0.7605 0.7645 0.7521 2011-12-19 1.2996 1.3043 1.298 78 78.15 77.71 0.9371 0.9399 0.9345 1.5497 1.5544 1.5463 1.038 1.0414 1.033 0.8384 0.8416 0.8378 101.38 101.6 101.28 1.2182 1.2212 1.2169 0.9887 0.9988 0.9882 120.88 121.1 120.55 83.23 83.34 83.01 1.452 1.4554 1.4482 0.7547 0.7641 0.7543 2011-12-20 1.3076 1.3131 1.2992 77.85 78.05 77.68 0.9314 0.9385 0.9264 1.5659 1.5701 1.5493 1.03 1.0387 1.0259 0.8351 0.839 0.834 101.8 102.18 101.37 1.2181 1.2212 1.2162 1.0073 1.0094 0.9889 121.91 122.16 120.94 83.57 83.97 83.08 1.4578 1.4598 1.4525 0.7693 0.7716 0.7542 2011-12-21 1.3043 1.3197 1.3023 78.08 78.1 77.66 0.9357 0.9392 0.924 1.5676 1.5773 1.5646 1.0255 1.0308 1.0206 0.8319 0.8375 0.8304 101.85 102.59 101.45 1.2206 1.2241 1.217 1.0092 1.0218 1.0047 122.36 122.58 121.87 83.4 84.04 83.06 1.4663 1.4716 1.4543 0.7686 0.7774 0.7648 2011-12-22 1.3051 1.3119 1.3015 78.16 78.2 77.97 0.9355 0.94 0.9305 1.5679 1.5727 1.5648 1.0203 1.028 1.0197 0.8321 0.8347 0.8305 101.99 102.33 101.75 1.2212 1.2244 1.2199 1.0127 1.0148 1.0056 122.49 122.76 122.26 83.5 83.81 83.19 1.4664 1.4736 1.4621 0.7731 0.7751 0.7661 2011-12-23 1.3038 1.3095 1.3024 78.03 78.22 77.97 0.9371 0.9388 0.9331 1.5592 1.5707 1.5591 1.0197 1.0215 1.0177 0.836 0.8366 0.8319 101.76 102.19 101.74 1.222 1.2242 1.2211 1.015 1.018 1.0121 121.68 122.66 121.71 83.16 83.61 83.21 1.4614 1.4697 1.4612 0.7738 0.7757 0.7714 2011-12-26 1.3059 1.3082 1.303 77.88 78.09 77.85 0.9359 0.9368 0.9337 1.5629 1.5645 1.5589 1.0188 1.0234 1.0178 0.8354 0.8373 0.8347 101.75 101.96 101.73 1.2224 1.2251 1.2205 1.0161 1.0167 1.0127 121.7 122 121.61 83.17 83.42 83.14 1.4627 1.466 1.4595 0.7736 0.7752 0.7708 2011-12-27 1.3066 1.3083 1.304 77.87 78.02 77.76 0.9343 0.9372 0.9327 1.5668 1.5679 1.5594 1.0188 1.0216 1.0174 0.8338 0.8373 0.8335 101.74 101.9 101.66 1.221 1.2237 1.2199 1.0154 1.0175 1.0135 122 122.12 121.61 83.29 83.44 83.18 1.4637 1.4673 1.4605 0.7708 0.7749 0.7701 2011-12-28 1.2938 1.308 1.291 77.91 78.03 77.54 0.9424 0.9441 0.9317 1.545 1.569 1.5444 1.0234 1.0251 1.0122 0.8373 0.8377 0.8332 100.78 101.79 100.73 1.2195 1.2222 1.2179 1.0091 1.0203 1.0067 120.36 122.02 120.36 82.62 83.36 82.59 1.4558 1.4658 1.4548 0.7685 0.7782 0.7668 2011-12-29 1.2961 1.2962 1.2856 77.61 77.98 77.59 0.9398 0.9469 0.9396 1.5416 1.5475 1.536 1.021 1.0268 1.02 0.8406 0.8421 0.8351 100.58 100.92 100.06 1.2182 1.22 1.2163 1.0141 1.0145 1.0041 119.66 120.56 119.49 82.56 82.76 82.15 1.4481 1.4598 1.4476 0.7716 0.7718 0.7648 2011-12-30 1.2941 1.2998 1.2902 76.95 77.73 76.88 0.9389 0.9426 0.9339 1.553 1.5571 1.54 1.0185 1.022 1.0153 0.8332 0.841 0.8329 99.58 100.68 99.58 1.2154 1.2188 1.2134 1.0225 1.0267 1.012 119.48 120.05 119.27 81.86 82.65 81.94 1.4576 1.4591 1.4488 0.7779 0.7811 0.7703 2012-01-02 1.2922 1.2967 1.2915 76.88 77.12 76.86 0.9401 0.9414 0.9366 1.5495 1.5545 1.5467 1.0207 1.0213 1.0176 0.8336 0.8365 0.8333 99.4 99.85 99.39 1.2148 1.2197 1.2131 1.022 1.0235 1.0192 119.14 119.58 118.98 81.71 82.17 81.64 1.4569 1.4624 1.4517 0.7777 0.7797 0.7762 2012-01-03 1.305 1.3076 1.293 76.62 76.96 76.59 0.9322 0.9399 0.9302 1.5643 1.5669 1.5504 1.0108 1.0195 1.0072 0.8342 0.8373 0.8331 100.04 100.27 99.44 1.2164 1.2196 1.2154 1.0372 1.0386 1.0226 119.85 120.17 119.26 82.22 82.36 81.75 1.458 1.4621 1.4525 0.7898 0.7907 0.778 2012-01-04 1.2947 1.3072 1.2896 76.72 76.82 76.58 0.9412 0.9448 0.9312 1.5623 1.5668 1.5579 1.0121 1.0161 1.0101 0.8286 0.8348 0.8265 99.32 100.21 99.06 1.2184 1.2201 1.2162 1.0366 1.0382 1.0301 119.85 120.12 119.62 81.49 82.36 81.3 1.4699 1.4745 1.4579 0.7875 0.7906 0.7849 2012-01-05 1.2779 1.2947 1.277 77.17 77.23 76.65 0.9531 0.9537 0.9407 1.5484 1.5629 1.5465 1.0195 1.0224 1.0118 0.8252 0.829 0.8249 98.66 99.35 98.48 1.218 1.2196 1.2173 1.025 1.0373 1.0229 119.53 119.95 119.19 80.98 81.52 80.8 1.4758 1.4766 1.4692 0.7796 0.7879 0.7789 2012-01-06 1.2721 1.2812 1.2696 77.02 77.32 76.95 0.9553 0.9578 0.9503 1.5424 1.5526 1.5374 1.0263 1.027 1.0167 0.8247 0.8267 0.8239 97.97 98.84 97.92 1.2153 1.2196 1.215 1.0228 1.0272 1.0198 118.79 119.74 118.56 80.61 81.13 80.52 1.4735 1.4798 1.4717 0.7808 0.7837 0.777 2012-01-09 1.2769 1.2785 1.2664 76.83 77 76.75 0.9494 0.9594 0.9488 1.5461 1.5469 1.5394 1.0233 1.0318 1.0223 0.8256 0.8278 0.8222 98.08 98.25 97.32 1.2123 1.2163 1.2105 1.0245 1.0257 1.0142 118.79 118.87 118.3 80.9 80.96 80.07 1.4676 1.4782 1.4672 0.7878 0.7887 0.7767 2012-01-10 1.2774 1.2818 1.2741 76.8 76.91 76.73 0.9489 0.9511 0.9461 1.5479 1.55 1.5445 1.0162 1.024 1.015 0.8252 0.8288 0.8247 98.14 98.47 97.98 1.2123 1.2149 1.2108 1.0305 1.0353 1.0224 118.86 119.06 118.74 80.95 81.15 80.83 1.4683 1.4718 1.4648 0.7934 0.7965 0.7861 2012-01-11 1.2705 1.2789 1.2661 76.86 77.04 76.78 0.9541 0.9566 0.9478 1.5327 1.549 1.5308 1.0189 1.021 1.0136 0.8287 0.8293 0.8241 97.67 98.37 97.46 1.2124 1.214 1.2102 1.0313 1.0329 1.0258 117.8 119.13 117.74 80.53 81.11 80.45 1.4623 1.4716 1.462 0.7972 0.7974 0.7921 2012-01-12 1.2825 1.2844 1.2697 76.77 76.98 76.64 0.9438 0.9546 0.9407 1.5335 1.5367 1.5277 1.0188 1.021 1.0136 0.836 0.8374 0.829 98.45 98.55 97.67 1.2106 1.213 1.2087 1.0334 1.0377 1.0281 117.68 118.13 117.54 81.32 81.51 80.56 1.4471 1.4625 1.4444 0.794 0.7981 0.7905 2012-01-13 1.2684 1.2878 1.2623 76.94 77 76.63 0.952 0.9574 0.9404 1.532 1.5408 1.5233 1.0227 1.0283 1.016 0.8278 0.8377 0.8274 97.56 98.81 97.2 1.2075 1.2132 1.2062 1.0299 1.0367 1.0228 117.87 118.19 117.3 80.8 81.52 80.43 1.4584 1.4608 1.4444 0.7928 0.7954 0.7862 2012-01-16 1.2675 1.2687 1.2624 76.74 77.11 76.59 0.9538 0.9568 0.9522 1.5332 1.5352 1.5276 1.0165 1.0252 1.0163 0.8266 0.8285 0.8255 97.27 97.5 97.05 1.209 1.2099 1.2067 1.0327 1.0337 1.0248 117.68 117.82 117.31 80.45 80.73 80.29 1.4624 1.4642 1.4578 0.7953 0.7966 0.7911 2012-01-17 1.2723 1.2808 1.2647 76.82 76.88 76.54 0.9501 0.9573 0.9444 1.5322 1.5404 1.5308 1.016 1.0188 1.011 0.8302 0.8324 0.8263 97.75 98.32 97.15 1.209 1.2115 1.2086 1.036 1.0449 1.0298 117.68 118.27 117.6 80.83 81.26 80.24 1.456 1.4656 1.4536 0.7986 0.8033 0.7926 2012-01-18 1.2849 1.2863 1.2732 76.78 76.87 76.62 0.9397 0.9496 0.938 1.5428 1.5438 1.5326 1.0115 1.0177 1.011 0.8326 0.8353 0.8304 98.65 98.78 97.71 1.2078 1.2131 1.2066 1.0423 1.0427 1.0354 118.43 118.62 117.59 81.67 81.8 80.79 1.4503 1.4564 1.4477 0.8071 0.8081 0.799 2012-01-19 1.2957 1.2958 1.2837 77.16 77.31 76.67 0.9327 0.9412 0.9322 1.5485 1.5487 1.5413 1.0111 1.0127 1.0068 0.8364 0.8368 0.8326 99.96 100.01 98.57 1.2086 1.2093 1.207 1.0412 1.0437 1.0366 119.49 119.71 118.34 82.72 82.77 81.56 1.4437 1.4515 1.4437 0.8027 0.8045 0.7998 2012-01-20 1.2928 1.2986 1.2886 76.94 77.3 76.9 0.9344 0.9369 0.9303 1.5554 1.5556 1.5448 1.0137 1.0159 1.0103 0.8311 0.8378 0.8308 99.47 100.32 99.43 1.2083 1.2089 1.2067 1.0479 1.0486 1.0379 119.61 119.92 119.22 82.32 83 82.27 1.4535 1.4548 1.4422 0.8054 0.8062 0.799 2012-01-23 1.3033 1.3052 1.2869 76.97 77.08 76.83 0.9266 0.9378 0.9247 1.5573 1.5602 1.5515 1.0074 1.0162 1.0048 0.8369 0.8373 0.8276 100.32 100.49 99.05 1.2076 1.2087 1.2058 1.0535 1.0574 1.0453 119.87 120.2 119.51 83.06 83.21 82.05 1.443 1.4593 1.4414 0.8102 0.8142 0.804 2012-01-24 1.3023 1.3062 1.2952 77.72 77.84 76.92 0.9282 0.931 0.923 1.5612 1.5616 1.5531 1.0098 1.0141 1.0068 0.8339 0.8391 0.8313 101.21 101.3 100.04 1.2087 1.2092 1.2055 1.0478 1.0536 1.0424 121.34 121.4 119.68 83.7 83.81 82.87 1.4486 1.451 1.4378 0.8106 0.8119 0.8051 2012-01-25 1.311 1.312 1.2929 77.71 78.28 77.53 0.9212 0.9339 0.92 1.5666 1.5678 1.5531 1.0039 1.0147 1.0025 0.8368 0.8386 0.831 101.9 101.94 100.98 1.2078 1.2109 1.2069 1.0607 1.0619 1.0437 121.76 122.04 121.24 84.34 84.4 83.61 1.4429 1.4539 1.4414 0.8183 0.8194 0.8034 2012-01-26 1.3105 1.3184 1.3088 77.46 77.82 77.27 0.9203 0.9228 0.9154 1.5688 1.5734 1.5648 1.0013 1.0048 0.9978 0.8351 0.8399 0.8349 101.52 102.21 101.43 1.2062 1.2094 1.206 1.0614 1.0688 1.0582 121.54 121.89 121.32 84.15 84.69 84.09 1.4432 1.4459 1.4372 0.8184 0.8235 0.815 2012-01-27 1.3215 1.3233 1.3075 76.68 77.48 76.62 0.9123 0.9228 0.9118 1.5732 1.5739 1.5639 1.0009 1.0041 0.9984 0.8399 0.8406 0.8339 101.31 101.56 100.61 1.2056 1.2085 1.2056 1.0654 1.067 1.0588 120.59 121.58 120.04 84.03 84.16 83.39 1.4354 1.4488 1.4352 0.8242 0.8249 0.8184 2012-01-30 1.3117 1.323 1.3074 76.3 76.78 76.2 0.9184 0.9209 0.9114 1.5686 1.573 1.5652 1.003 1.007 1.0007 0.8361 0.8406 0.8351 100.1 101.45 100 1.2052 1.2066 1.2039 1.0586 1.0652 1.0521 119.65 120.72 119.6 83.06 84.09 83 1.4405 1.4423 1.4354 0.8189 0.8238 0.8151 2012-01-31 1.3083 1.3213 1.3041 76.19 76.42 76.13 0.9202 0.9228 0.9118 1.5759 1.5795 1.5696 1.0023 1.0053 0.9962 0.8299 0.8386 0.8281 99.69 100.88 99.56 1.2041 1.2064 1.203 1.0614 1.0684 1.0572 120.1 120.63 119.79 82.8 83.72 82.71 1.4502 1.4534 1.4373 0.8255 0.8301 0.8167 2012-02-01 1.3153 1.3218 1.3023 76.22 76.34 76 0.9158 0.9249 0.911 1.5826 1.5882 1.5704 0.9986 1.0048 0.996 0.8309 0.8343 0.8283 100.27 100.68 99.26 1.2048 1.2057 1.2032 1.0696 1.074 1.0564 120.63 120.98 119.62 83.21 83.53 82.41 1.4485 1.4548 1.4424 0.8322 0.8358 0.8207 2012-02-02 1.3147 1.3196 1.3083 76.15 76.21 76.02 0.916 0.9208 0.9126 1.5807 1.5858 1.5792 0.999 1.0009 0.9964 0.8316 0.8333 0.8273 100.12 100.46 99.62 1.2048 1.2073 1.2039 1.0711 1.0756 1.0675 120.32 120.75 120.25 83.1 83.36 82.69 1.4484 1.4564 1.4458 0.8334 0.8369 0.8306 2012-02-03 1.3146 1.3205 1.3065 76.55 76.74 76.11 0.9183 0.9232 0.9122 1.5809 1.586 1.5749 0.9939 1.0033 0.9923 0.8314 0.8341 0.829 100.66 100.87 99.95 1.2073 1.2086 1.2043 1.0772 1.0793 1.0666 121.01 121.22 120.3 83.35 83.68 82.94 1.4517 1.4545 1.4451 0.8356 0.8379 0.8289 2012-02-06 1.3131 1.3141 1.3026 76.57 76.79 76.46 0.9185 0.9263 0.9174 1.5825 1.5838 1.5728 0.9956 0.9993 0.9925 0.8296 0.8309 0.8262 100.55 100.61 99.86 1.2063 1.2077 1.2052 1.0728 1.0769 1.0679 121.18 121.23 120.5 83.34 83.4 82.74 1.4538 1.4598 1.4524 0.8339 0.8351 0.8277 2012-02-07 1.3244 1.327 1.3086 76.79 76.95 76.5 0.9126 0.9229 0.9112 1.5894 1.5903 1.5786 0.9948 0.9994 0.9936 0.8329 0.8353 0.8283 101.7 101.98 100.39 1.2086 1.2105 1.2058 1.0796 1.0823 1.0697 122.07 122.24 121.04 84.12 84.31 83.22 1.4508 1.4582 1.4474 0.8352 0.8373 0.8309 2012-02-08 1.326 1.329 1.3218 76.98 77.18 76.7 0.9119 0.915 0.9103 1.582 1.5928 1.5794 0.9958 0.999 0.9931 0.838 0.8388 0.833 102.08 102.44 101.65 1.2097 1.2132 1.2085 1.0792 1.0844 1.0764 121.76 122.84 121.4 84.37 84.61 84.04 1.4434 1.4543 1.4424 0.8352 0.8407 0.8321 2012-02-09 1.3284 1.3321 1.3213 77.67 77.73 76.99 0.9115 0.9151 0.9085 1.5817 1.5884 1.579 0.9946 0.9979 0.9922 0.8399 0.8401 0.8336 103.17 103.29 101.87 1.2112 1.2117 1.2094 1.0781 1.0824 1.0735 122.83 122.98 121.74 85.17 85.28 84.22 1.442 1.4516 1.4407 0.8339 0.8378 0.8311 2012-02-10 1.3166 1.3291 1.3153 77.58 77.81 77.52 0.9179 0.92 0.9099 1.5735 1.5849 1.5728 1.0025 1.0038 0.9939 0.8366 0.8408 0.8351 102.18 103.23 102.17 1.2087 1.2114 1.2083 1.0657 1.0793 1.0636 122.11 123.18 122.06 84.54 85.28 84.44 1.4443 1.4493 1.4394 0.8268 0.8342 0.8246 2012-02-13 1.3191 1.3283 1.3186 77.6 77.77 77.36 0.9162 0.9166 0.9099 1.5769 1.5827 1.5757 0.9988 1.0016 0.9969 0.8365 0.8401 0.8365 102.37 103.18 102.25 1.2087 1.2106 1.2077 1.0734 1.0778 1.0673 122.37 122.92 122.18 84.68 85.33 84.63 1.4448 1.4454 1.4391 0.8346 0.8375 0.8271 2012-02-14 1.3115 1.3216 1.3078 78.44 78.53 77.35 0.9206 0.9229 0.9139 1.5683 1.577 1.5642 0.9998 1.0026 0.9976 0.8363 0.84 0.8357 102.89 103.19 101.85 1.2074 1.2088 1.2068 1.0682 1.0738 1.0625 123.02 123.09 121.7 85.19 85.44 84.27 1.4438 1.4454 1.438 0.8315 0.835 0.8271 2012-02-15 1.3074 1.319 1.3043 78.35 78.63 78.16 0.9228 0.9251 0.9151 1.5699 1.5735 1.5668 0.9987 1.0003 0.9934 0.8325 0.8402 0.8317 102.43 103.48 102.2 1.2064 1.2087 1.2056 1.0693 1.0776 1.0664 123.01 123.5 122.63 84.89 85.69 84.69 1.4487 1.4513 1.4374 0.8335 0.8421 0.8319 2012-02-16 1.3153 1.3159 1.2973 78.91 78.96 78.33 0.9177 0.93 0.9173 1.581 1.5816 1.5654 0.996 1.0051 0.995 0.8318 0.8327 0.8278 103.79 103.82 101.93 1.2072 1.2086 1.206 1.0757 1.0773 1.0642 124.77 124.8 122.84 85.97 85.98 84.5 1.4511 1.4585 1.4493 0.8335 0.8341 0.824 2012-02-17 1.3157 1.3198 1.3113 79.49 79.5 78.77 0.9183 0.9206 0.9155 1.5837 1.5862 1.5786 0.9956 0.9984 0.9937 0.8307 0.8338 0.829 104.59 104.66 103.45 1.2082 1.2093 1.2066 1.0718 1.0798 1.0684 125.86 125.91 124.55 86.54 86.6 85.72 1.4544 1.4565 1.4498 0.8339 0.8382 0.8314 2012-02-20 1.3241 1.3276 1.3172 79.57 79.88 79.34 0.9115 0.9178 0.9085 1.5845 1.588 1.5833 0.9933 0.9942 0.9903 0.8355 0.8367 0.8314 105.37 105.73 104.66 1.2071 1.2102 1.2065 1.0748 1.0815 1.0734 126.06 126.82 125.81 87.29 87.41 86.63 1.4439 1.4545 1.4425 0.8391 0.8426 0.8375 2012-02-21 1.3236 1.3292 1.3184 79.66 79.84 79.53 0.912 0.9148 0.908 1.5783 1.5865 1.577 0.9968 0.9975 0.9921 0.8386 0.8402 0.8341 105.47 105.99 105.05 1.2075 1.2108 1.2049 1.0659 1.0759 1.065 125.71 126.63 125.67 87.34 87.77 87.08 1.4396 1.4466 1.4378 0.8334 0.8405 0.8322 2012-02-22 1.3245 1.3266 1.3209 80.25 80.39 79.65 0.9103 0.9137 0.9093 1.5672 1.5813 1.5647 0.9989 1.0019 0.995 0.8452 0.846 0.8379 106.34 106.56 105.46 1.2058 1.2082 1.2058 1.0643 1.0685 1.0599 125.8 126.55 125.61 88.16 88.31 87.35 1.4267 1.4414 1.426 0.8295 0.8358 0.8259 2012-02-23 1.3365 1.3373 1.3229 79.86 80.35 79.85 0.9018 0.9114 0.9008 1.5732 1.5739 1.5648 0.9975 1.0009 0.9949 0.8496 0.8499 0.8454 106.76 107.01 106.17 1.2053 1.2072 1.2043 1.0701 1.0715 1.0593 125.62 126.21 125.49 88.55 88.73 88.04 1.4185 1.427 1.4183 0.8343 0.8355 0.826 2012-02-24 1.3463 1.3486 1.3355 80.91 80.99 79.89 0.8948 0.9027 0.8927 1.5893 1.5894 1.5719 0.9992 1.0003 0.9962 0.8469 0.8505 0.8467 108.94 109.02 106.86 1.2048 1.2066 1.2039 1.0697 1.0755 1.0685 128.57 128.69 125.84 90.4 90.51 88.67 1.4216 1.4236 1.4177 0.8355 0.8396 0.8347 2012-02-27 1.34 1.3478 1.3364 80.5 81.61 80.11 0.8987 0.901 0.8935 1.5821 1.5901 1.5808 0.9989 1.0049 0.9972 0.8469 0.8486 0.8441 107.88 109.9 107.2 1.2051 1.2059 1.2039 1.076 1.0784 1.0644 127.37 129.7 126.97 89.49 91.19 89.01 1.4226 1.4272 1.4194 0.8398 0.8417 0.8313 2012-02-28 1.3461 1.347 1.3388 80.49 80.78 79.99 0.895 0.9001 0.8941 1.5896 1.59 1.5798 0.9951 0.9993 0.9938 0.8468 0.849 0.8465 108.38 108.75 107.33 1.2049 1.2061 1.2044 1.0776 1.0787 1.0725 127.98 128.22 126.73 89.94 90.24 89.06 1.4222 1.4238 1.4193 0.8377 0.8418 0.8345 2012-02-29 1.3322 1.3485 1.3313 81.26 81.31 80.23 0.9045 0.9052 0.8932 1.5917 1.599 1.5896 0.9899 0.9957 0.9842 0.8369 0.847 0.8366 108.28 108.72 107.9 1.2052 1.2065 1.2036 1.0728 1.0856 1.0711 129.34 129.61 127.85 89.82 90.18 89.52 1.4398 1.441 1.4231 0.8337 0.847 0.8327 2012-03-01 1.3306 1.3356 1.328 81.11 81.36 80.83 0.9058 0.9075 0.9017 1.5945 1.5975 1.5895 0.9858 0.9902 0.9838 0.8344 0.8383 0.8335 107.92 108.42 107.71 1.2058 1.207 1.2045 1.0783 1.0813 1.0718 129.32 129.57 128.78 89.49 89.94 89.35 1.4447 1.4463 1.4377 0.8374 0.8406 0.8318 2012-03-02 1.3207 1.3332 1.3185 81.8 81.86 81.05 0.9137 0.9152 0.9042 1.5838 1.5966 1.5822 0.9883 0.9894 0.9845 0.8337 0.8351 0.8315 108.04 108.45 107.58 1.2063 1.2081 1.2048 1.0734 1.0817 1.0724 129.58 130.08 129.17 89.53 89.91 89.16 1.4466 1.4504 1.4446 0.8293 0.8402 0.8281 2012-03-05 1.3221 1.324 1.3158 81.47 81.86 81.13 0.9121 0.9169 0.9102 1.5864 1.5876 1.5784 0.9939 0.9959 0.9881 0.8332 0.8353 0.8326 107.7 108.04 106.93 1.2059 1.2083 1.2047 1.0669 1.0743 1.0652 129.2 129.63 128.24 89.3 89.53 88.62 1.4462 1.4492 1.4433 0.8204 0.8307 0.82 2012-03-06 1.3112 1.3226 1.3101 80.8 81.57 80.56 0.9188 0.9199 0.911 1.5716 1.5882 1.5694 1.0009 1.0028 0.9933 0.8341 0.8351 0.8319 105.97 107.85 105.65 1.2048 1.2077 1.2048 1.0547 1.069 1.0522 127.02 129.48 126.57 87.95 89.43 87.65 1.4438 1.45 1.4433 0.8121 0.8223 0.8096 2012-03-07 1.3148 1.3164 1.3095 81.18 81.21 80.56 0.9165 0.9204 0.9152 1.5736 1.5758 1.5696 0.9973 1.0025 0.9972 0.8352 0.8364 0.8339 106.74 106.8 105.72 1.2051 1.2071 1.2047 1.0588 1.059 1.0505 127.73 127.82 126.66 88.56 88.61 87.68 1.4424 1.446 1.4412 0.8154 0.8201 0.8107 2012-03-08 1.3266 1.3291 1.3133 81.58 81.73 81.06 0.9084 0.9179 0.9067 1.582 1.5833 1.5722 0.9907 0.999 0.9889 0.8383 0.8399 0.8343 108.23 108.45 106.6 1.2053 1.2066 1.2046 1.064 1.0669 1.053 129.01 129.24 127.6 89.77 89.95 88.42 1.4371 1.4459 1.4348 0.8241 0.828 0.8135 2012-03-09 1.3114 1.3283 1.3095 82.41 82.64 81.46 0.9192 0.921 0.9072 1.5674 1.5832 1.566 0.9908 0.9936 0.9868 0.8366 0.8394 0.8345 108.07 108.63 107.72 1.2055 1.2067 1.2045 1.057 1.0663 1.0561 129.17 129.75 128.74 89.63 90.1 89.37 1.4407 1.4445 1.436 0.821 0.8275 0.8183 2012-03-12 1.315 1.3157 1.3079 82.229 82.529 82.117 0.9169 0.9222 0.9162 1.5635 1.5695 1.5603 0.9933 0.9947 0.9899 0.8409 0.842 0.835 108.138 108.282 107.519 1.2057 1.2063 1.2051 1.0501 1.058 1.0474 128.56 129.35 128.191 89.69 89.79 89.16 1.4336 1.4439 1.4326 0.8172 0.8206 0.8138 2012-03-13 1.3071 1.3191 1.3052 82.99 83.08 81.97 0.9236 0.9249 0.9141 1.5693 1.5748 1.5621 0.9892 0.9927 0.9882 0.8328 0.8424 0.8321 108.48 108.73 107.89 1.2071 1.2077 1.2051 1.0526 1.0563 1.0482 130.246 130.39 128.27 89.85 90.16 89.52 1.4495 1.4504 1.4313 0.8209 0.8247 0.8179 2012-03-14 1.302 1.309 1.301 83.747 83.83 82.882 0.9302 0.9331 0.9232 1.5672 1.5744 1.565 0.9937 0.9944 0.9883 0.8307 0.8334 0.8295 109.047 109.373 108.385 1.2112 1.2147 1.2074 1.0441 1.0558 1.0426 131.247 131.467 130.125 90.021 90.33 89.63 1.4578 1.4621 1.4495 0.8082 0.8232 0.8066 2012-03-15 1.3094 1.3119 1.3004 83.39 84.178 83.197 0.9217 0.9335 0.9202 1.5718 1.5737 1.5635 0.9913 0.9949 0.9905 0.8329 0.835 0.8313 109.19 109.636 108.59 1.2069 1.2139 1.2062 1.0542 1.0556 1.0424 131.079 131.713 130.224 90.466 90.516 89.835 1.4487 1.4601 1.4458 0.8206 0.8217 0.8062 2012-03-16 1.3168 1.3187 1.3049 83.33 83.944 83.187 0.916 0.9254 0.9149 1.5831 1.5861 1.5695 0.9918 0.9941 0.9898 0.8317 0.8332 0.8294 109.74 109.972 109.018 1.2063 1.2081 1.2056 1.0586 1.0598 1.051 131.93 132.441 130.915 90.961 91.143 90.274 1.4503 1.4552 1.4483 0.8238 0.826 0.8179 2012-03-19 1.3236 1.3265 1.3141 83.31 83.57 83.02 0.9114 0.9178 0.9091 1.589 1.5914 1.5822 0.9876 0.993 0.9857 0.8329 0.8343 0.8281 110.34 110.57 109.18 1.2064 1.207 1.2054 1.0608 1.0637 1.0555 132.43 132.67 131.46 91.44 91.67 90.52 1.4483 1.4567 1.4452 0.8262 0.829 0.8231 2012-03-20 1.3217 1.3252 1.3172 83.764 83.833 83.323 0.9121 0.9154 0.91 1.5855 1.5897 1.5831 0.9917 0.9969 0.9869 0.8334 0.8355 0.8316 110.711 110.825 110.284 1.2057 1.2069 1.2048 1.0475 1.0629 1.0458 132.817 132.99 132.27 91.807 91.879 91.41 1.4464 1.4507 1.4436 0.8163 0.8271 0.8138 2012-03-21 1.3207 1.3285 1.3178 83.43 84.094 83.38 0.9128 0.9149 0.9074 1.5864 1.5923 1.5818 0.992 0.9935 0.9875 0.8324 0.8371 0.8319 110.235 111.435 110.045 1.2055 1.2064 1.2049 1.0453 1.0528 1.0419 132.408 133.489 132.19 91.429 92.414 91.26 1.448 1.449 1.4398 0.8151 0.822 0.8115 2012-03-22 1.3187 1.3254 1.3134 82.528 83.47 82.3 0.914 0.9179 0.9096 1.5816 1.5892 1.5772 0.9995 1.0008 0.9913 0.8337 0.835 0.83 108.836 110.471 108.47 1.2054 1.2059 1.2046 1.0387 1.0486 1.0335 130.525 132.5 130.04 90.285 91.629 89.96 1.4454 1.4525 1.4432 0.8087 0.8157 0.8056 2012-03-23 1.3262 1.3293 1.319 82.476 82.95 81.978 0.9084 0.914 0.9067 1.5872 1.5909 1.5807 0.9984 1.0034 0.9971 0.8355 0.8366 0.8336 109.381 109.83 108.58 1.2047 1.2057 1.2044 1.0456 1.0482 1.0371 130.89 131.561 129.999 90.767 91.123 90.086 1.4419 1.4461 1.4401 0.8174 0.819 0.81 2012-03-26 1.3361 1.3368 1.319 82.761 83.002 82.36 0.9026 0.9137 0.9021 1.5964 1.597 1.5799 0.9916 0.9999 0.9903 0.8367 0.837 0.8335 110.57 110.65 109.16 1.2061 1.2061 1.204 1.0529 1.0548 1.0426 132.128 132.21 130.69 91.671 91.735 90.561 1.4411 1.4459 1.4392 0.8219 0.8239 0.8142 2012-03-27 1.3329 1.3385 1.3317 83.1 83.39 82.6 0.9042 0.9053 0.9013 1.5958 1.6001 1.594 0.9946 0.9949 0.9898 0.8352 0.8371 0.8334 110.8 111.26 110.3 1.2054 1.207 1.2047 1.0474 1.0558 1.0467 132.633 133.38 131.99 91.9 92.28 91.48 1.4431 1.4464 1.44 0.8213 0.8264 0.82 2012-03-28 1.3321 1.3374 1.3276 82.815 83.196 82.613 0.9048 0.9082 0.9015 1.589 1.5964 1.5839 0.9983 1 0.9944 0.8383 0.8395 0.8348 110.315 110.93 109.86 1.2053 1.2066 1.2047 1.0386 1.0464 1.0352 131.593 132.73 131.022 91.506 91.98 91.15 1.4378 1.4438 1.4363 0.8167 0.8217 0.8144 2012-03-29 1.3293 1.3346 1.3252 82.45 82.97 81.908 0.9068 0.9093 0.9033 1.5942 1.5945 1.5859 0.9973 1.0019 0.9967 0.8338 0.8385 0.833 109.594 110.53 108.751 1.2054 1.2058 1.204 1.0371 1.0407 1.0301 131.443 131.86 130.143 90.904 91.676 90.263 1.4454 1.4462 1.4376 0.8159 0.8197 0.8114 2012-03-30 1.3336 1.3377 1.3298 82.737 82.87 81.835 0.9025 0.9065 0.9009 1.5996 1.6037 1.5948 0.9973 0.9999 0.9953 0.8336 0.836 0.8325 110.351 110.55 109.04 1.2038 1.2058 1.203 1.0359 1.042 1.0347 132.33 132.581 130.65 91.66 91.84 90.465 1.4438 1.447 1.4417 0.8189 0.8232 0.8166 2012-04-02 1.3328 1.338 1.3279 82.065 83.303 81.878 0.9032 0.9071 0.9002 1.6033 1.6063 1.5979 0.9902 0.999 0.9886 0.8312 0.835 0.8291 109.385 111.142 108.962 1.204 1.2048 1.2033 1.0426 1.0458 1.0355 131.58 133.255 131.19 90.83 92.3 90.513 1.4482 1.4517 1.4424 0.824 0.826 0.8186 2012-04-03 1.3229 1.3368 1.3212 82.87 82.993 81.558 0.9102 0.9115 0.9004 1.5908 1.6046 1.5891 0.9914 0.9929 0.9888 0.8316 0.8358 0.831 109.625 109.811 108.698 1.204 1.2046 1.2027 1.0321 1.0465 1.03 131.827 131.984 130.779 91.029 91.232 90.314 1.4477 1.4491 1.4396 0.8178 0.8265 0.8165 2012-04-04 1.3139 1.3239 1.3107 82.48 82.94 82.1 0.916 0.9183 0.9096 1.5889 1.5914 1.5833 0.9963 0.9973 0.9908 0.8268 0.8326 0.8259 108.37 109.7 107.91 1.2035 1.2049 1.2027 1.0255 1.0335 1.0244 131.062 131.85 130.27 90.05 91.08 89.64 1.4552 1.4565 1.4467 0.8143 0.8198 0.8125 2012-04-05 1.3064 1.3164 1.3035 82.427 82.472 81.83 0.9199 0.9223 0.9144 1.5822 1.5908 1.5806 0.9934 0.9998 0.9907 0.8255 0.8279 0.8238 107.688 108.41 106.896 1.2019 1.204 1.1996 1.0298 1.0323 1.0252 130.433 131.17 129.521 89.597 90.08 88.916 1.4556 1.4595 1.4536 0.8154 0.8188 0.8126 2012-04-06 1.3088 1.3113 1.3052 81.559 82.554 81.312 0.9176 0.9206 0.9161 1.5877 1.5891 1.5824 0.9972 0.9986 0.9917 0.8241 0.8257 0.8236 106.732 107.835 106.549 1.201 1.2024 1.2005 1.0307 1.0336 1.0273 129.47 130.875 129.166 88.85 89.759 88.72 1.457 1.4589 1.4547 0.8191 0.8205 0.8143 2012-04-09 1.3117 1.3134 1.3031 81.6 81.67 81.19 0.9164 0.9217 0.9147 1.5904 1.5914 1.5835 0.9962 1.0002 0.9941 0.8247 0.8257 0.8227 107.055 107.25 106.09 1.2022 1.2024 1.2005 1.0327 1.0335 1.0253 129.789 129.915 128.806 89.015 89.23 88.299 1.4575 1.4599 1.4547 0.823 0.8241 0.8149 2012-04-10 1.3076 1.3144 1.3053 80.68 81.87 80.65 0.9186 0.921 0.9147 1.5869 1.5931 1.5809 1.0037 1.0041 0.9951 0.8239 0.8277 0.8234 105.52 107.48 105.49 1.2014 1.203 1.201 1.0255 1.0358 1.0246 128.048 130.23 127.86 87.82 89.38 87.79 1.4577 1.4602 1.4523 0.8143 0.8243 0.8118 2012-04-11 1.3102 1.3157 1.3067 80.901 81.121 80.578 0.9176 0.9194 0.9129 1.5902 1.5938 1.5853 1.004 1.0052 1.0009 0.8238 0.8264 0.8231 106.02 106.686 105.459 1.2023 1.2035 1.2003 1.0298 1.0333 1.0227 128.662 129.189 127.885 88.146 88.784 87.781 1.4593 1.4605 1.4537 0.817 0.8221 0.814 2012-04-12 1.3187 1.3213 1.3102 80.75 81.135 80.7 0.911 0.9179 0.9092 1.5966 1.5985 1.5909 0.9943 1.0037 0.9937 0.8259 0.827 0.8227 106.529 106.805 105.974 1.2011 1.2034 1.201 1.0438 1.0452 1.0303 128.96 129.35 128.619 88.66 88.919 88.1 1.4545 1.4612 1.4529 0.8269 0.8281 0.8181 2012-04-13 1.3072 1.3201 1.3068 81.073 81.2 80.848 0.9199 0.9202 0.9105 1.5843 1.597 1.5841 0.9982 0.999 0.9926 0.8249 0.827 0.8229 105.973 107.103 105.756 1.2027 1.203 1.2011 1.0376 1.0454 1.0356 128.445 129.581 128.238 88.109 89.121 87.932 1.4576 1.4609 1.4534 0.8243 0.8321 0.823 2012-04-16 1.3138 1.3148 1.2995 80.472 80.998 80.295 0.9146 0.9252 0.914 1.5897 1.5911 1.5819 0.9992 1.0033 0.9971 0.8263 0.8269 0.821 105.723 105.817 104.626 1.2017 1.2031 1.2012 1.0361 1.0384 1.0312 127.93 128.35 127.115 87.969 88.025 87.034 1.4542 1.4644 1.4531 0.821 0.8252 0.8172 2012-04-17 1.313 1.3173 1.309 80.9 80.93 80.34 0.9148 0.9182 0.9126 1.5935 1.5971 1.5863 0.9902 1.0012 0.9866 0.8239 0.8262 0.823 106.22 106.32 105.29 1.2014 1.2021 1.2009 1.0398 1.042 1.03 128.912 128.99 127.58 88.42 88.47 87.59 1.4579 1.4601 1.4546 0.822 0.8235 0.8151 2012-04-18 1.3114 1.3141 1.3058 81.244 81.564 80.888 0.9163 0.921 0.9145 1.6021 1.6042 1.5896 0.9914 0.9924 0.988 0.8186 0.8244 0.8174 106.558 106.894 106.174 1.2019 1.2034 1.2013 1.035 1.0418 1.034 130.155 130.448 128.829 88.648 88.957 88.285 1.4681 1.4713 1.4575 0.815 0.8231 0.8148 2012-04-19 1.3134 1.3165 1.307 81.53 81.734 81.176 0.9152 0.9195 0.9129 1.6054 1.6078 1.601 0.9952 0.9964 0.988 0.818 0.8194 0.8162 107.102 107.346 106.515 1.2021 1.2026 1.2014 1.0337 1.0391 1.0314 130.92 131.103 130.11 89.085 89.321 88.625 1.4693 1.4725 1.4667 0.8139 0.8197 0.8123 2012-04-20 1.3215 1.3225 1.3129 81.543 81.78 81.499 0.9089 0.9155 0.9086 1.6133 1.6143 1.6039 0.9925 0.9959 0.9898 0.819 0.8205 0.8165 107.777 108.003 107.11 1.2014 1.2023 1.2009 1.0371 1.0384 1.031 131.55 131.81 130.874 89.699 89.89 89.115 1.4663 1.472 1.4638 0.8174 0.8181 0.812 2012-04-23 1.3154 1.3217 1.3105 81.14 81.67 80.976 0.9136 0.9172 0.9092 1.613 1.6134 1.6077 0.9912 0.9979 0.9911 0.8153 0.8198 0.8145 106.726 107.81 106.327 1.2018 1.2022 1.2012 1.0314 1.0386 1.0273 130.878 131.727 130.217 88.787 89.721 88.466 1.4738 1.475 1.4661 0.8131 0.819 0.8089 2012-04-24 1.3182 1.3218 1.3145 81.31 81.343 80.861 0.9112 0.9142 0.909 1.6135 1.6164 1.611 0.9884 0.9929 0.9874 0.8169 0.8187 0.8145 107.196 107.312 106.323 1.2014 1.2022 1.2009 1.0284 1.0327 1.0248 131.137 131.26 130.346 89.2 89.3 88.49 1.4703 1.4758 1.4673 0.8109 0.8159 0.8094 2012-04-25 1.3214 1.3236 1.3173 81.33 81.698 81.076 0.9091 0.9122 0.9078 1.6165 1.6182 1.6082 0.9837 0.988 0.9824 0.8173 0.8222 0.8161 107.474 107.654 107.127 1.2015 1.2021 1.201 1.0352 1.0361 1.0307 131.473 131.83 130.535 89.445 89.593 89.15 1.4696 1.4718 1.4617 0.8142 0.8152 0.8106 2012-04-26 1.324 1.3263 1.3199 80.996 81.423 80.669 0.9076 0.9103 0.9059 1.6196 1.6207 1.6159 0.9836 0.9848 0.9807 0.8175 0.8185 0.8156 107.241 107.656 106.49 1.2018 1.2019 1.2011 1.0395 1.0399 1.0351 131.19 131.604 130.525 89.223 89.585 88.637 1.47 1.4732 1.468 0.8156 0.819 0.8126 2012-04-27 1.3247 1.327 1.3158 80.369 81.443 80.32 0.9066 0.9133 0.9047 1.6263 1.628 1.6154 0.9809 0.987 0.9797 0.8144 0.817 0.8134 106.471 107.481 106.164 1.2012 1.2018 1.2004 1.0465 1.0474 1.0354 130.701 131.755 130.234 88.617 89.44 88.363 1.4745 1.4773 1.47 0.8226 0.8233 0.8107 2012-04-30 1.3236 1.3267 1.3208 79.81 80.39 79.7 0.9075 0.9097 0.9056 1.623 1.6301 1.6218 0.9871 0.9894 0.9802 0.8154 0.816 0.8123 105.655 106.44 105.41 1.2014 1.2018 1.2005 1.042 1.0475 1.0402 129.543 130.865 129.311 87.935 88.603 87.77 1.473 1.4793 1.4717 0.8178 0.8239 0.8159 2012-05-01 1.3235 1.3284 1.3204 80.178 80.303 79.64 0.9079 0.91 0.9042 1.6221 1.6247 1.6184 0.9854 0.9898 0.9831 0.8159 0.8198 0.8146 106.131 106.23 105.548 1.2017 1.2019 1.2005 1.0332 1.0433 1.0305 130.05 130.18 129.09 88.299 88.39 87.85 1.4725 1.4746 1.4653 0.8157 0.8191 0.8121 2012-05-02 1.3156 1.3241 1.3122 80.132 80.612 80.04 0.9133 0.9157 0.9076 1.6192 1.6239 1.6159 0.9866 0.9903 0.9849 0.8123 0.8163 0.811 105.425 106.547 105.12 1.2017 1.202 1.2009 1.0329 1.0355 1.0279 129.761 130.771 129.43 87.721 88.67 87.476 1.4789 1.4818 1.4722 0.8102 0.8155 0.8081 2012-05-03 1.315 1.318 1.3096 80.24 80.551 80.104 0.9131 0.9174 0.9111 1.618 1.6215 1.6159 0.9888 0.9889 0.9823 0.8127 0.8143 0.8103 105.516 106.124 105.317 1.2013 1.2017 1.2007 1.0256 1.0325 1.0237 129.823 130.46 129.7 87.824 88.334 87.65 1.4781 1.4827 1.4745 0.7996 0.8092 0.7984 2012-05-04 1.3089 1.3178 1.308 79.84 80.394 79.78 0.9176 0.9184 0.9116 1.615 1.6203 1.614 0.9951 0.9963 0.9862 0.8106 0.8139 0.8096 104.516 105.59 104.41 1.2011 1.2016 1.2005 1.0187 1.028 1.0178 128.934 129.989 128.81 87.009 87.88 86.924 1.4818 1.4832 1.476 0.795 0.8023 0.7938 2012-05-07 1.3058 1.3064 1.2956 79.948 80 79.648 0.92 0.9271 0.9195 1.6189 1.6197 1.6115 0.9927 0.9987 0.9923 0.8065 0.8084 0.8036 104.381 104.45 103.233 1.2012 1.2015 1.2008 1.0205 1.0222 1.0111 129.403 129.49 128.411 86.877 86.945 85.943 1.4893 1.4947 1.4856 0.7953 0.7972 0.7908 2012-05-08 1.3016 1.3066 1.298 79.829 80.078 79.68 0.9227 0.9251 0.9196 1.6159 1.6199 1.6122 0.9977 1.0023 0.9924 0.8055 0.8073 0.8043 103.915 104.439 103.51 1.2011 1.2015 1.2004 1.0123 1.022 1.0084 128.989 129.579 128.6 86.517 86.926 86.18 1.491 1.4932 1.4876 0.7886 0.7976 0.7856 2012-05-09 1.2942 1.3006 1.2912 79.63 79.941 79.432 0.928 0.9302 0.9236 1.6141 1.6159 1.6067 1.0014 1.0063 0.9985 0.8017 0.8061 0.8013 103.099 103.941 102.762 1.2009 1.2015 1.2005 1.0063 1.0117 1.0021 128.585 129.11 127.829 85.838 86.53 85.563 1.4978 1.4983 1.49 0.785 0.7882 0.7814 2012-05-10 1.2946 1.298 1.2925 79.98 80 79.61 0.9277 0.9293 0.9254 1.615 1.6182 1.6092 1.0016 1.0031 0.9973 0.8015 0.8045 0.8 103.57 103.78 102.94 1.201 1.2015 1.2005 1.0093 1.0145 1.004 129.172 129.4 128.14 86.21 86.38 85.71 1.4979 1.5012 1.493 0.7859 0.7903 0.783 2012-05-11 1.2922 1.2958 1.2904 79.891 79.992 79.71 0.9294 0.9307 0.927 1.6073 1.6143 1.6059 1.0009 1.0055 0.9951 0.8038 0.805 0.7996 103.232 103.594 102.93 1.201 1.2014 1.2005 1.0029 1.0082 1.0015 128.392 129.037 128.208 85.946 86.234 85.71 1.4938 1.5018 1.4916 0.7839 0.7883 0.7807 2012-05-14 1.2839 1.2907 1.2824 79.85 80.184 79.65 0.9354 0.9365 0.9301 1.6097 1.6123 1.6052 1.0024 1.0053 0.9993 0.7976 0.8035 0.7961 102.519 103.372 102.205 1.2011 1.2014 1.2003 0.9969 1.0043 0.9956 128.532 128.87 128.02 85.366 86.05 85.1 1.5058 1.5083 1.4946 0.7779 0.7843 0.7756 2012-05-15 1.2728 1.287 1.2718 80.231 80.335 79.815 0.9435 0.9441 0.9334 1.5994 1.6114 1.5987 1.0063 1.0073 0.9988 0.7957 0.8014 0.795 102.129 102.871 102.03 1.201 1.2014 1.2004 0.993 1.0018 0.9919 128.332 128.771 128.058 85.038 85.637 84.969 1.509 1.5102 1.4986 0.7684 0.7798 0.7678 2012-05-16 1.2723 1.2759 1.2682 80.21 80.552 80.196 0.9438 0.9471 0.9414 1.5915 1.5998 1.5889 1.0115 1.013 1.0054 0.7993 0.8008 0.795 102.114 102.714 101.914 1.201 1.2014 1.2005 0.9917 0.9968 0.9871 127.72 128.51 127.607 85.004 85.507 84.85 1.502 1.5107 1.5 0.7644 0.7696 0.7624 2012-05-17 1.27 1.2749 1.2666 79.263 80.393 79.12 0.9455 0.9481 0.9421 1.5799 1.5932 1.579 1.0188 1.0188 1.0103 0.8038 0.8046 0.7991 100.673 102.385 100.52 1.2008 1.2013 1.2 0.9908 0.9965 0.9893 125.239 127.984 125.15 83.819 85.24 83.715 1.4938 1.5031 1.4921 0.7644 0.7684 0.7621 2012-05-18 1.2773 1.2794 1.2643 79.029 79.463 79.015 0.9403 0.95 0.9388 1.5822 1.5838 1.5732 1.0206 1.0227 1.0139 0.8072 0.8078 0.8024 100.942 101.099 100.215 1.2009 1.2012 1.2006 0.9813 0.9899 0.9795 125.041 125.655 124.658 84.042 84.169 83.437 1.4875 1.4967 1.4868 0.7545 0.765 0.7522 2012-05-21 1.2816 1.2825 1.2723 79.279 79.449 79.03 0.9372 0.9438 0.9366 1.584 1.5841 1.5774 1.0166 1.0246 1.0162 0.8091 0.8098 0.8059 101.621 101.706 100.83 1.2012 1.2015 1.2004 0.9916 0.992 0.9804 125.589 125.825 124.963 84.578 84.655 83.97 1.4846 1.4897 1.4831 0.765 0.7661 0.7542 2012-05-22 1.2676 1.2817 1.2655 79.923 80.147 79.274 0.9473 0.9488 0.9372 1.5749 1.5848 1.5739 1.0219 1.0234 1.0152 0.8048 0.8102 0.8039 101.331 102.123 101.12 1.201 1.2014 1.2 0.9808 0.9937 0.9787 125.898 126.46 125.448 84.35 85.028 84.18 1.4918 1.4935 1.4825 0.7541 0.7676 0.752 2012-05-23 1.2584 1.2688 1.2545 79.489 80.073 79.2 0.9542 0.9573 0.9467 1.5702 1.5771 1.5673 1.0236 1.0296 1.0207 0.8012 0.8062 0.7994 100.04 101.478 99.52 1.2009 1.2013 1.2003 0.9756 0.9803 0.9689 124.812 126.182 124.293 83.281 84.48 82.86 1.4984 1.5017 1.4898 0.7513 0.7555 0.7457 2012-05-24 1.2533 1.262 1.2516 79.61 79.63 79.35 0.9585 0.9595 0.9534 1.5664 1.5727 1.5639 1.0272 1.0296 1.0226 0.8 0.8027 0.7997 99.77 100.26 99.37 1.2012 1.2076 1.2006 0.9748 0.9813 0.9712 124.69 124.97 124.16 83.03 83.4 82.74 1.5014 1.5055 1.4964 0.7514 0.7574 0.7482 2012-05-25 1.2518 1.2603 1.2496 79.64 79.821 79.45 0.9595 0.9611 0.9535 1.5657 1.57 1.5629 1.029 1.0305 1.0243 0.7993 0.8045 0.7979 99.695 100.331 99.475 1.2011 1.2037 1.2 0.9771 0.9802 0.9727 124.712 124.977 124.4 82.992 83.427 82.821 1.5024 1.5053 1.4945 0.7549 0.7588 0.7515 2012-05-28 1.2543 1.2624 1.2524 79.447 79.718 79.3 0.9582 0.9596 0.9526 1.5684 1.5717 1.5659 1.0237 1.029 1.0214 0.7996 0.8037 0.7982 99.645 100.28 99.475 1.2019 1.2032 1.2009 0.985 0.9891 0.9766 124.6 125.12 124.35 82.903 83.44 82.778 1.503 1.5058 1.4964 0.7602 0.7648 0.756 2012-05-29 1.2493 1.2575 1.2461 79.512 79.64 79.34 0.9612 0.9638 0.956 1.5641 1.5717 1.5605 1.0229 1.027 1.0207 0.7987 0.8006 0.7979 99.337 99.943 98.905 1.201 1.2025 1.2004 0.9842 0.9899 0.9797 124.37 124.985 123.887 82.7 83.15 82.373 1.5035 1.5048 1.5006 0.7618 0.765 0.7579 2012-05-30 1.2373 1.2494 1.236 79.04 79.567 78.83 0.9706 0.9714 0.9613 1.5485 1.5638 1.5475 1.0294 1.0311 1.0222 0.7988 0.8 0.7971 97.845 99.371 97.74 1.2008 1.2014 1.2002 0.9716 0.9846 0.9702 122.439 124.398 122.283 81.46 82.738 81.389 1.5028 1.5064 1.5011 0.7539 0.7625 0.7527 2012-05-31 1.2375 1.243 1.2337 78.38 79.13 78.22 0.9705 0.9736 0.9666 1.5422 1.5526 1.5361 1.0314 1.0366 1.0262 0.8023 0.8036 0.7989 96.99 98.03 96.52 1.201 1.202 1.2003 0.9765 0.977 0.9674 120.856 122.49 120.16 80.74 81.61 80.36 1.4966 1.5035 1.4947 0.7551 0.7576 0.7501 2012-06-01 1.2408 1.2459 1.2289 78.125 78.714 77.666 0.9677 0.9772 0.964 1.5358 1.5438 1.5269 1.0399 1.0443 1.0322 0.8078 0.8092 0.8017 96.945 97.513 95.602 1.2007 1.2013 1.2004 0.9681 0.9736 0.9582 119.992 121.05 118.808 80.714 81.206 79.622 1.4864 1.498 1.484 0.7531 0.7567 0.7457 2012-06-04 1.2496 1.251 1.2386 78.36 78.47 77.99 0.9609 0.9696 0.9597 1.5387 1.5415 1.5343 1.0397 1.0446 1.0368 0.812 0.813 0.8068 97.92 98 96.77 1.2009 1.2014 1.2 0.9724 0.9747 0.9628 120.562 120.68 119.78 81.52 81.6 80.56 1.4786 1.4887 1.4764 0.7567 0.7597 0.7502 2012-06-05 1.2446 1.2542 1.241 78.756 78.97 78.109 0.9649 0.9676 0.9577 1.5373 1.5408 1.5322 1.0383 1.0426 1.0361 0.8095 0.8141 0.8089 98.025 98.332 97.051 1.2008 1.2014 1.2001 0.9748 0.9804 0.9711 121.076 121.35 119.765 81.616 81.875 80.809 1.4833 1.4849 1.4756 0.7564 0.7604 0.7521 2012-06-06 1.2572 1.2583 1.244 79.239 79.278 78.616 0.9549 0.9653 0.9541 1.5497 1.5515 1.5374 1.0278 1.0384 1.0272 0.811 0.8125 0.805 99.634 99.723 97.929 1.2007 1.2012 1.2 0.9923 0.993 0.9738 122.82 122.96 120.898 82.964 83.051 81.54 1.48 1.4915 1.4776 0.7694 0.7703 0.7561 2012-06-07 1.2582 1.2626 1.254 79.659 79.793 79.209 0.9543 0.9578 0.9513 1.5539 1.5601 1.5431 1.0266 1.0296 1.0207 0.8096 0.8132 0.8064 100.2 100.627 99.417 1.2009 1.2016 1.2004 0.9908 1.0003 0.9878 123.786 124.344 122.328 83.448 83.773 82.77 1.4829 1.4892 1.477 0.7695 0.7754 0.7681 2012-06-08 1.2501 1.2575 1.2436 79.353 79.753 79.113 0.9605 0.9658 0.9552 1.5467 1.5537 1.5404 1.027 1.0355 1.0266 0.8082 0.81 0.8071 99.202 100.27 98.546 1.2009 1.2014 1.2003 0.9918 0.9928 0.9821 122.71 123.841 121.921 82.6 83.482 82.05 1.4858 1.4882 1.4829 0.7709 0.7715 0.7619 2012-06-11 1.2483 1.2668 1.248 79.459 79.729 79.34 0.9619 0.9623 0.9479 1.5487 1.5582 1.547 1.0313 1.0316 1.0201 0.806 0.8157 0.8052 99.19 100.91 99.14 1.2008 1.2026 1.2003 0.9867 1.001 0.9863 123.057 124.08 122.97 82.585 84.029 82.56 1.4899 1.4913 1.4723 0.7687 0.7789 0.7686 2012-06-12 1.2499 1.253 1.2442 79.471 79.692 79.167 0.9607 0.965 0.9585 1.557 1.559 1.5455 1.0266 1.0326 1.0253 0.8026 0.808 0.8009 99.332 99.791 98.72 1.201 1.2012 1.2 0.9933 0.9941 0.9851 123.747 123.84 122.56 82.698 83.085 82.2 1.496 1.4988 1.4865 0.7758 0.7775 0.7671 2012-06-13 1.2571 1.261 1.2474 79.35 79.75 79.26 0.9553 0.9628 0.9521 1.5515 1.5598 1.5512 1.0296 1.0296 1.0238 0.8102 0.8107 0.8024 99.76 100.11 99.27 1.201 1.2016 1.2001 0.9942 1.0004 0.993 123.121 124.28 123.04 83.06 83.37 82.66 1.4821 1.4969 1.4811 0.7747 0.7809 0.7744 2012-06-14 1.2614 1.2635 1.2543 79.3 79.48 79.16 0.952 0.9574 0.9506 1.5548 1.5562 1.5473 1.0236 1.0294 1.023 0.8111 0.8121 0.8084 100.06 100.26 99.47 1.2012 1.2021 1.2004 0.9998 1.0007 0.9922 123.317 123.48 122.78 83.29 83.47 82.84 1.4805 1.4854 1.479 0.7813 0.7824 0.775 2012-06-15 1.2645 1.2664 1.2592 78.664 79.51 78.6 0.9496 0.9538 0.9486 1.5688 1.5725 1.5477 1.0222 1.0256 1.0218 0.8059 0.8153 0.8054 99.479 100.38 99.086 1.201 1.2012 1.2003 1.0084 1.0093 0.9995 123.422 123.623 122.138 82.82 83.56 82.503 1.4898 1.4906 1.4731 0.789 0.7904 0.781 2012-06-18 1.2577 1.2747 1.2556 79.112 79.306 78.676 0.9547 0.9564 0.9423 1.5668 1.579 1.5633 1.0243 1.0279 1.0193 0.8027 0.8111 0.802 99.5 100.86 99.109 1.2009 1.2017 1.2002 1.0118 1.0142 1.0056 123.948 124.645 123.351 82.84 83.95 82.525 1.4959 1.497 1.4814 0.7921 0.7947 0.7884 2012-06-19 1.2691 1.2731 1.2569 79.046 79.108 78.847 0.9462 0.9555 0.9428 1.5739 1.5757 1.5616 1.0175 1.0244 1.0163 0.8063 0.808 0.8025 100.333 100.49 99.191 1.2009 1.2012 1.2002 1.0193 1.0203 1.0104 124.419 124.519 123.25 83.537 83.67 82.593 1.4892 1.4967 1.4859 0.7981 0.799 0.7909 2012-06-20 1.267 1.2743 1.2638 79.488 79.702 78.797 0.9478 0.9502 0.9425 1.5692 1.5777 1.5652 1.0198 1.0232 1.016 0.8073 0.8099 0.8057 100.701 101.409 99.835 1.201 1.2014 1.2004 1.0167 1.0224 1.0134 124.721 125.48 123.507 83.851 84.443 83.13 1.4873 1.4906 1.4827 0.7933 0.7986 0.7918 2012-06-21 1.2545 1.2701 1.2532 80.26 80.33 79.39 0.9571 0.9583 0.9457 1.5587 1.5734 1.5577 1.029 1.0296 1.0174 0.8048 0.8091 0.8041 100.69 101.63 100.52 1.201 1.2013 1.2003 1.0041 1.0205 1.0028 125.103 125.83 124.63 83.84 84.62 83.7 1.4921 1.4934 1.4846 0.7872 0.8018 0.7861 2012-06-22 1.2565 1.2583 1.252 80.413 80.57 80.011 0.9556 0.9592 0.9544 1.5583 1.5634 1.5557 1.0242 1.03 1.0238 0.8062 0.8067 0.8024 101.039 101.231 100.385 1.2008 1.2013 1.2002 1.0069 1.0081 1.0009 125.314 125.757 124.787 84.142 84.295 83.58 1.4891 1.4968 1.4886 0.7909 0.7923 0.7847 2012-06-25 1.25 1.2569 1.2472 79.65 80.62 79.41 0.9606 0.9629 0.9556 1.5572 1.5595 1.5539 1.0289 1.0318 1.0248 0.8027 0.8074 0.8017 99.58 101.11 99.12 1.2008 1.2012 1.2 1.0008 1.0063 0.9967 124.029 125.66 123.53 82.92 84.18 82.57 1.4959 1.4973 1.4878 0.7875 0.7908 0.784 2012-06-26 1.2499 1.2531 1.2442 79.451 79.788 79.235 0.9608 0.9652 0.9585 1.5645 1.5651 1.5564 1.0233 1.0297 1.0228 0.7989 0.804 0.7983 99.314 99.89 98.752 1.201 1.2012 1.2004 1.0077 1.0086 1.0001 124.305 124.445 123.54 82.674 83.17 82.225 1.503 1.5042 1.494 0.7923 0.7934 0.787 2012-06-27 1.2469 1.2508 1.2446 79.73 79.87 79.36 0.9631 0.965 0.9602 1.5566 1.5641 1.5546 1.0252 1.0267 1.0237 0.801 0.8016 0.7986 99.43 99.61 99.08 1.2009 1.2012 1.2004 1.0079 1.009 1.0041 124.11 124.56 123.88 82.79 82.94 82.5 1.4993 1.5038 1.4983 0.7915 0.7923 0.7876 2012-06-28 1.2445 1.2524 1.2408 79.418 79.755 79.224 0.9649 0.9678 0.9592 1.5512 1.5624 1.5483 1.033 1.0363 1.0233 0.8022 0.8029 0.7984 98.841 99.49 98.332 1.2009 1.2015 1.2 1.004 1.013 0.9994 123.185 124.18 122.868 82.288 82.83 81.885 1.4967 1.5038 1.4958 0.7873 0.7965 0.7835 2012-06-29 1.2654 1.2693 1.2433 79.916 79.976 79.138 0.949 0.966 0.9463 1.5671 1.5707 1.551 1.0181 1.0341 1.0166 0.8074 0.8095 0.801 101.138 101.394 98.537 1.201 1.2038 1.2005 1.0229 1.0257 1.0019 125.257 125.44 122.89 84.201 84.415 82.035 1.4876 1.4994 1.4843 0.7996 0.8044 0.785 2012-07-02 1.2583 1.268 1.2569 79.48 79.979 79.315 0.9543 0.9559 0.9475 1.5695 1.5722 1.5642 1.0167 1.0201 1.0156 0.8017 0.8078 0.8013 100.019 101.293 99.766 1.201 1.2019 1.2005 1.0255 1.0278 1.0213 124.754 125.51 124.32 83.264 84.32 83.042 1.498 1.4992 1.4871 0.8041 0.805 0.8002 2012-07-03 1.2607 1.2627 1.2559 79.825 79.931 79.416 0.9525 0.9564 0.9513 1.5691 1.5713 1.5658 1.0126 1.0172 1.0121 0.8034 0.8044 0.8013 100.649 100.832 99.898 1.2009 1.2016 1.2006 1.0288 1.0299 1.0227 125.255 125.453 124.615 83.788 83.945 83.168 1.4946 1.4993 1.4932 0.8048 0.8064 0.8015 2012-07-04 1.2533 1.2607 1.2508 79.828 79.89 79.594 0.9583 0.9605 0.9527 1.5603 1.569 1.5575 1.0127 1.0142 1.0119 0.8031 0.8054 0.8026 100.04 100.667 99.798 1.2011 1.2014 1.2008 1.028 1.032 1.0261 124.554 125.286 124.267 83.295 83.808 83.084 1.4951 1.4966 1.4915 0.8041 0.8064 0.8025 2012-07-05 1.2389 1.254 1.2364 79.893 80.095 79.563 0.9693 0.9716 0.9581 1.5527 1.5623 1.55 1.0138 1.0157 1.01 0.7977 0.8042 0.7965 98.976 100.342 98.797 1.201 1.2017 1.2004 1.029 1.0329 1.0243 124.029 124.868 123.861 82.393 83.538 82.258 1.5053 1.5081 1.4938 0.8036 0.8075 0.8006 2012-07-06 1.2275 1.2401 1.2259 79.614 80.022 79.483 0.9782 0.9795 0.9685 1.5483 1.5551 1.5459 1.0186 1.0208 1.014 0.7926 0.7983 0.7923 97.72 99.103 97.59 1.2008 1.2015 1.2003 1.0218 1.0291 1.0175 123.28 124.29 123 81.374 82.498 81.28 1.5146 1.5153 1.5047 0.7985 0.8051 0.7954 2012-07-09 1.231 1.2324 1.2225 79.579 79.78 79.4 0.9753 0.9818 0.974 1.5522 1.5531 1.5468 1.0191 1.0221 1.0175 0.793 0.7948 0.7908 97.969 98.135 97.472 1.2005 1.2014 1.2 1.0201 1.0213 1.0151 123.535 123.685 122.94 81.576 81.71 81.14 1.5141 1.5196 1.5109 0.7964 0.7982 0.7925 2012-07-10 1.2252 1.2334 1.2236 79.376 79.595 79.215 0.9801 0.9815 0.9738 1.5514 1.5549 1.5479 1.0226 1.0229 1.0166 0.7896 0.7935 0.7893 97.244 98.06 97.22 1.2008 1.2013 1.2004 1.0181 1.0245 1.016 123.145 123.61 122.78 80.973 81.64 80.96 1.5205 1.521 1.5136 0.7931 0.7987 0.7926 2012-07-11 1.2233 1.2297 1.2212 79.672 79.76 79.12 0.9814 0.9832 0.9767 1.5493 1.5578 1.5485 1.0209 1.0231 1.0174 0.7892 0.7904 0.787 97.473 97.737 97.006 1.2006 1.2012 1.2 1.023 1.0284 1.018 123.44 123.988 122.965 81.16 81.387 80.775 1.5206 1.5257 1.5196 0.7956 0.8002 0.7933 2012-07-12 1.221 1.2249 1.2165 79.288 79.954 79.15 0.9833 0.987 0.9803 1.5438 1.5516 1.5392 1.0176 1.025 1.0173 0.7907 0.7914 0.788 96.803 97.868 96.38 1.2007 1.201 1.2001 1.0151 1.026 1.0097 122.393 124.033 121.977 80.613 81.494 80.278 1.5182 1.5236 1.517 0.7913 0.7979 0.786 2012-07-13 1.224 1.2257 1.216 79.26 79.393 79.078 0.9811 0.9873 0.9797 1.557 1.558 1.5415 1.0138 1.0203 1.0125 0.7861 0.7913 0.7854 97.009 97.103 96.415 1.2008 1.2011 1.2 1.0219 1.0232 1.0123 123.389 123.52 122.177 80.77 80.85 80.295 1.5274 1.5285 1.5175 0.7942 0.7966 0.789 2012-07-16 1.2279 1.229 1.2176 78.824 79.284 78.691 0.9779 0.9864 0.9771 1.5633 1.5655 1.5518 1.0143 1.0173 1.0133 0.7853 0.7878 0.783 96.799 97.32 96.171 1.2007 1.2012 1.2004 1.0256 1.0263 1.0203 123.225 123.54 122.527 80.58 81.03 80.08 1.5289 1.5335 1.5247 0.7983 0.799 0.7937 2012-07-17 1.2281 1.2317 1.2188 79.1 79.17 78.8 0.9781 0.9852 0.9751 1.5643 1.5678 1.5551 1.0125 1.017 1.012 0.7851 0.7875 0.7831 97.15 97.38 96.37 1.2013 1.2015 1.2 1.031 1.0318 1.0234 123.732 123.81 122.96 80.86 81.07 80.26 1.5297 1.5336 1.5251 0.7978 0.8006 0.7929 2012-07-18 1.2276 1.2306 1.2215 78.764 79.155 78.72 0.9781 0.983 0.9761 1.5653 1.5668 1.558 1.0104 1.0149 1.0096 0.7842 0.787 0.7828 96.69 97.31 96.44 1.2009 1.2016 1.2 1.0363 1.0368 1.0288 123.3 123.913 123.047 80.499 81.01 80.318 1.5312 1.5338 1.5264 0.7995 0.8007 0.7916 2012-07-19 1.2271 1.2324 1.2228 78.589 78.823 78.42 0.9785 0.982 0.9746 1.5719 1.5738 1.5637 1.0074 1.0107 1.0061 0.7806 0.7854 0.779 96.433 96.822 96.1 1.201 1.2014 1.2003 1.0427 1.0448 1.0357 123.49 123.681 122.935 80.301 80.615 80.03 1.5383 1.5413 1.5292 0.803 0.8057 0.7993 2012-07-20 1.2164 1.2283 1.2144 78.467 78.802 78.41 0.9872 0.9888 0.9779 1.5617 1.5721 1.5608 1.0126 1.0131 1.007 0.7788 0.782 0.777 95.438 96.712 95.31 1.2009 1.2014 1.2002 1.0375 1.043 1.0359 122.523 123.797 122.423 79.465 80.52 79.38 1.5417 1.5452 1.5358 0.7993 0.8039 0.7976 2012-07-23 1.2134 1.2145 1.2068 78.375 78.532 77.947 0.9891 0.9951 0.9887 1.5522 1.5626 1.5486 1.0168 1.0204 1.0132 0.7816 0.7825 0.7756 95.116 95.268 94.243 1.2009 1.2013 1.2003 1.0276 1.0375 1.0244 121.67 122.58 121.148 79.195 79.319 78.48 1.5359 1.5484 1.5347 0.789 0.7991 0.7866 2012-07-24 1.2064 1.2138 1.2041 78.194 78.374 78.08 0.9954 0.9972 0.9895 1.5506 1.5552 1.5486 1.0214 1.0227 1.0153 0.7778 0.7821 0.7766 94.324 95.02 94.075 1.2008 1.2011 1.2 1.0234 1.0319 1.0211 121.262 121.71 120.973 78.535 79.116 78.35 1.5435 1.5459 1.5358 0.7853 0.7926 0.7838 2012-07-25 1.2152 1.2171 1.2054 78.13 78.28 78.07 0.9882 0.9964 0.9869 1.5496 1.5551 1.5459 1.0151 1.0232 1.0136 0.7841 0.7854 0.7776 94.946 95.205 94.144 1.201 1.2012 1.2004 1.0312 1.0337 1.0178 121.069 121.7 120.933 79.051 79.271 78.385 1.5311 1.5446 1.5292 0.789 0.7916 0.7809 2012-07-26 1.2282 1.233 1.2115 78.273 78.316 77.988 0.9776 0.991 0.974 1.5687 1.5724 1.5467 1.0097 1.0166 1.0061 0.7827 0.786 0.7814 96.135 96.429 94.625 1.2008 1.2013 1.2001 1.0394 1.0425 1.0289 122.78 123.005 120.776 80.042 80.283 78.81 1.5341 1.5365 1.5278 0.802 0.8024 0.7887 2012-07-27 1.2317 1.239 1.224 78.47 78.678 78.04 0.9749 0.9809 0.9692 1.5733 1.5768 1.5665 1.0038 1.0106 1.0033 0.7827 0.7873 0.7798 96.682 97.333 95.605 1.201 1.2013 1.2 1.0479 1.0483 1.038 123.516 123.775 122.414 80.495 81.026 79.638 1.5341 1.5395 1.525 0.8094 0.8106 0.7986 2012-07-30 1.2253 1.2339 1.2226 78.203 78.545 78.122 0.98 0.9823 0.9732 1.569 1.5751 1.5673 1.0028 1.0053 1.0022 0.7809 0.7839 0.779 95.837 96.85 95.54 1.2009 1.2012 1.2008 1.0482 1.0512 1.045 122.7 123.67 122.51 79.795 80.61 79.55 1.5378 1.5416 1.5321 0.8079 0.8112 0.8073 2012-07-31 1.2308 1.233 1.2247 78.117 78.304 78.01 0.9758 0.9805 0.9739 1.5679 1.573 1.5623 1.0026 1.0043 0.9999 0.7849 0.7865 0.7796 96.146 96.28 95.71 1.2011 1.202 1.2003 1.0506 1.0538 1.0484 122.485 123.045 122.188 80.043 80.145 79.694 1.5299 1.5402 1.5272 0.8098 0.8122 0.8076 2012-08-01 1.2239 1.2336 1.2218 78.48 78.495 77.915 0.9814 0.9831 0.9738 1.5554 1.5691 1.5531 1.004 1.0056 0.9999 0.7868 0.7894 0.7842 96.06 96.459 95.703 1.2014 1.202 1.2005 1.047 1.0544 1.0447 122.059 122.685 121.76 79.941 80.295 79.68 1.5266 1.5316 1.5215 0.8093 0.8144 0.8077 2012-08-02 1.2176 1.2405 1.2131 78.22 78.538 78.122 0.9863 0.9899 0.9691 1.5509 1.568 1.5489 1.0074 1.0085 1 0.785 0.7913 0.7822 95.237 96.983 94.89 1.201 1.2029 1.2005 1.0454 1.058 1.0435 121.297 122.63 121.079 79.282 80.665 79.017 1.5296 1.5352 1.5193 0.8089 0.8172 0.8071 2012-08-03 1.2379 1.2392 1.2167 78.547 78.773 78.073 0.9706 0.9873 0.9691 1.564 1.5657 1.5505 1.0015 1.0077 0.9977 0.7914 0.7924 0.7844 97.234 97.397 95.03 1.2015 1.2017 1.2007 1.0547 1.0572 1.0446 122.836 123.06 121.095 80.908 81.06 79.11 1.518 1.5317 1.5163 0.8182 0.8201 0.8087 2012-08-06 1.2412 1.2443 1.2339 78.199 78.642 78.1 0.9674 0.9734 0.9656 1.5619 1.5665 1.5545 0.9988 1.002 0.9979 0.7946 0.7963 0.7914 97.068 97.8 96.66 1.2012 1.2079 1.2005 1.0582 1.0595 1.0532 122.15 123.18 121.683 80.796 81.382 80.485 1.5115 1.5183 1.5081 0.821 0.8224 0.816 2012-08-07 1.2405 1.2442 1.2373 78.64 78.74 78.161 0.9682 0.9706 0.9653 1.5633 1.5684 1.5563 0.9967 1.0012 0.9958 0.7934 0.796 0.7921 97.559 97.82 96.83 1.201 1.202 1.2007 1.0555 1.0606 1.0545 122.942 123.26 121.708 81.2 81.411 80.615 1.5137 1.5166 1.5092 0.8153 0.8224 0.8146 2012-08-08 1.2358 1.2402 1.2326 78.501 78.66 78.19 0.9717 0.9745 0.9678 1.5653 1.5677 1.5573 0.9944 0.9989 0.9932 0.7896 0.7948 0.7878 97.027 97.484 96.545 1.2008 1.2015 1.2005 1.057 1.0585 1.0528 122.878 122.99 121.87 80.769 81.155 80.386 1.5211 1.5244 1.511 0.8154 0.8166 0.811 2012-08-09 1.2292 1.2387 1.2266 78.578 78.792 78.27 0.9768 0.979 0.969 1.563 1.5686 1.5602 0.992 0.9951 0.9908 0.7864 0.7901 0.7853 96.6 97.284 96.32 1.2008 1.2014 1.2 1.0579 1.0616 1.0549 122.834 123.205 122.35 80.433 80.98 80.188 1.527 1.5287 1.52 0.8121 0.8164 0.8094 2012-08-10 1.2293 1.2317 1.2242 78.26 78.64 78.16 0.9766 0.981 0.9749 1.5668 1.5701 1.5578 0.9914 0.997 0.9908 0.7845 0.788 0.7827 96.22 96.74 95.72 1.2008 1.2011 1.2 1.057 1.0581 1.0497 122.635 122.95 121.8 80.12 80.54 79.71 1.5306 1.5339 1.5245 0.8122 0.8135 0.8084 2012-08-13 1.2332 1.2374 1.2258 78.361 78.376 78.13 0.9737 0.9795 0.9704 1.5684 1.5717 1.5657 0.9926 0.994 0.9901 0.7861 0.7874 0.7828 96.655 96.91 95.946 1.2009 1.2013 1.2 1.051 1.0574 1.0492 122.901 123.1 122.41 80.465 80.69 79.89 1.5272 1.5342 1.5248 0.8087 0.8132 0.8073 2012-08-14 1.2324 1.2386 1.2314 78.707 78.934 78.315 0.9743 0.9751 0.9698 1.5684 1.5728 1.567 0.9913 0.994 0.9902 0.7857 0.7884 0.7852 97.024 97.47 96.55 1.2009 1.2013 1.2 1.0494 1.0541 1.0479 123.46 123.926 122.77 80.77 81.15 80.39 1.5281 1.5291 1.5231 0.8051 0.8114 0.8047 2012-08-15 1.2287 1.2344 1.226 78.877 79.05 78.588 0.9772 0.9792 0.973 1.5687 1.5701 1.566 0.989 0.9935 0.9882 0.7832 0.788 0.7821 96.924 97.426 96.51 1.2009 1.2013 1.2003 1.0503 1.0515 1.0455 123.732 124.04 123.3 80.701 81.11 80.368 1.5331 1.535 1.5245 0.8068 0.8078 0.8037 2012-08-16 1.2362 1.2373 1.2256 79.277 79.404 78.955 0.9715 0.9799 0.9702 1.5739 1.5744 1.5637 0.986 0.99 0.9855 0.7854 0.786 0.7813 98.003 98.179 96.996 1.2007 1.2011 1.2 1.0519 1.0529 1.0475 124.75 124.938 123.795 81.593 81.747 80.76 1.5288 1.5373 1.5276 0.8109 0.812 0.8056 2012-08-17 1.2318 1.2382 1.2288 79.544 79.575 79.234 0.9748 0.9773 0.9697 1.5683 1.5739 1.5671 0.989 0.9901 0.986 0.7852 0.788 0.7834 97.98 98.41 97.67 1.2008 1.2013 1.2003 1.0411 1.0532 1.0408 124.758 124.97 124.469 81.58 81.935 81.35 1.529 1.5327 1.5242 0.8063 0.8126 0.8057 2012-08-20 1.2344 1.237 1.2294 79.394 79.658 79.29 0.9729 0.9768 0.9709 1.5707 1.5717 1.5679 0.9885 0.9902 0.9871 0.7857 0.7871 0.7832 98.008 98.353 97.73 1.2009 1.2013 1.2 1.045 1.0472 1.0419 124.694 125.015 124.508 81.588 81.888 81.362 1.5282 1.5331 1.5259 0.8089 0.8109 0.8064 2012-08-21 1.2465 1.2488 1.2347 79.239 79.525 79.19 0.9634 0.9728 0.9613 1.5777 1.5804 1.5707 0.9893 0.99 0.9838 0.79 0.7908 0.7855 98.774 99.182 97.966 1.2008 1.2013 1.2 1.0473 1.0522 1.0443 125.027 125.52 124.636 82.238 82.57 81.56 1.52 1.529 1.5184 0.8101 0.8145 0.8089 2012-08-22 1.2518 1.2538 1.2432 78.491 79.375 78.287 0.9593 0.966 0.9577 1.5861 1.5873 1.5766 0.9915 0.9947 0.9891 0.7892 0.791 0.7877 98.267 99.02 98.094 1.201 1.2012 1.2 1.0503 1.0521 1.0413 124.48 125.518 124.09 81.825 82.44 81.683 1.5213 1.5245 1.5182 0.8129 0.8144 0.8077 2012-08-23 1.2561 1.259 1.2524 78.452 78.695 78.34 0.956 0.9589 0.9534 1.5862 1.5913 1.5856 0.9933 0.9949 0.9883 0.7917 0.7924 0.7884 98.56 98.814 98.23 1.2008 1.2012 1.2 1.0441 1.0547 1.0432 124.43 124.995 124.306 82.059 82.27 81.82 1.5163 1.5234 1.5148 0.8133 0.8189 0.8126 2012-08-24 1.2516 1.2569 1.2482 78.7 78.723 78.459 0.9594 0.9621 0.9554 1.5806 1.5869 1.58 0.9912 0.9947 0.9902 0.7917 0.7933 0.789 98.495 98.827 97.981 1.2005 1.2011 1.2 1.0406 1.0446 1.0374 124.386 124.815 124.06 82.016 82.29 81.59 1.5166 1.5221 1.5132 0.8112 0.8144 0.8077 2012-08-27 1.2496 1.2536 1.249 78.753 78.842 78.61 0.9609 0.9615 0.9571 1.5791 1.5829 1.5788 0.9907 0.9925 0.9886 0.7911 0.7929 0.7902 98.418 98.715 98.322 1.2009 1.2011 1.2002 1.0369 1.0429 1.0364 124.35 124.638 124.138 81.94 82.19 81.87 1.5175 1.5199 1.5143 0.8084 0.8128 0.808 2012-08-28 1.2563 1.2577 1.2466 78.517 78.773 78.42 0.9557 0.9635 0.9541 1.5822 1.5836 1.5755 0.988 0.9918 0.9843 0.794 0.7955 0.7907 98.63 98.83 97.895 1.2007 1.2012 1.2 1.0373 1.0392 1.0346 124.21 124.41 123.71 82.13 82.285 81.504 1.5123 1.519 1.5098 0.8036 0.8092 0.8029 2012-08-29 1.2528 1.2574 1.2518 78.685 78.786 78.45 0.9583 0.9593 0.9548 1.5833 1.5856 1.58 0.9889 0.9899 0.9861 0.7911 0.7946 0.7905 98.567 98.83 98.345 1.2008 1.2011 1.2 1.0358 1.0399 1.0352 124.574 124.77 124.02 82.07 82.287 81.9 1.5173 1.5191 1.511 0.8011 0.8061 0.8006 2012-08-30 1.2515 1.2564 1.2487 78.619 78.748 78.46 0.9594 0.9617 0.9553 1.5793 1.5875 1.5769 0.9916 0.9932 0.9887 0.7923 0.7936 0.79 98.396 98.79 97.99 1.2007 1.2012 1.2 1.0308 1.0351 1.0274 124.183 124.81 123.847 81.92 82.26 81.621 1.5153 1.5198 1.5128 0.7989 0.8035 0.7965 2012-08-31 1.2578 1.2637 1.2494 78.283 78.64 78.189 0.9544 0.9612 0.9503 1.5881 1.5896 1.5779 0.9856 0.9931 0.9852 0.792 0.7956 0.7916 98.462 99.027 97.986 1.2008 1.2012 1.2003 1.0326 1.0355 1.0278 124.312 124.605 123.759 81.99 82.465 81.595 1.5159 1.517 1.5093 0.803 0.8044 0.7975 2012-09-03 1.2593 1.2611 1.2554 78.29 78.401 78.15 0.9533 0.9561 0.9518 1.5886 1.5899 1.5847 0.986 0.9878 0.9848 0.7926 0.7934 0.7906 98.586 98.7 98.19 1.2006 1.2011 1.2 1.0241 1.0303 1.0228 124.373 124.56 123.892 82.099 82.195 81.777 1.5146 1.5189 1.5133 0.798 0.8019 0.7964 2012-09-04 1.257 1.2628 1.2554 78.39 78.471 78.24 0.9556 0.9566 0.9503 1.5877 1.591 1.5855 0.9856 0.9875 0.9838 0.7916 0.7943 0.7901 98.571 99.02 98.355 1.2011 1.2012 1.2 1.0225 1.0288 1.0211 124.512 124.8 124.248 82.057 82.445 81.91 1.517 1.5197 1.5116 0.7939 0.7999 0.7919 2012-09-05 1.2598 1.2624 1.2501 78.39 78.54 78.26 0.9557 0.9608 0.9529 1.5906 1.5934 1.5822 0.9904 0.9918 0.9853 0.792 0.793 0.7886 98.75 98.92 97.95 1.204 1.2048 1.2004 1.0194 1.0233 1.0165 124.686 124.95 123.96 82.02 82.28 81.56 1.52 1.5231 1.5166 0.7949 0.796 0.7911 2012-09-06 1.2639 1.2652 1.256 78.862 79.034 78.383 0.9533 0.9597 0.9519 1.5937 1.5943 1.5881 0.9828 0.9914 0.9808 0.793 0.7946 0.7905 99.681 99.808 98.761 1.2051 1.2068 1.2037 1.0285 1.0303 1.0169 125.703 125.885 124.647 82.713 82.841 81.965 1.5193 1.5251 1.5154 0.8014 0.8034 0.794 2012-09-07 1.2798 1.2807 1.2623 78.266 79.019 78 0.9451 0.958 0.9433 1.5999 1.6034 1.592 0.9782 0.9835 0.9762 0.7998 0.8002 0.7924 100.166 100.432 99.57 1.2098 1.2155 1.2042 1.0393 1.0402 1.0273 125.211 126.205 124.969 82.78 82.927 82.378 1.5123 1.5297 1.5114 0.8114 0.8126 0.8003 2012-09-10 1.2761 1.2812 1.2755 78.25 78.33 78.15 0.9462 0.9485 0.9429 1.599 1.6019 1.5956 0.9777 0.9788 0.9751 0.7981 0.8011 0.7975 99.87 100.27 99.81 1.2076 1.2119 1.2071 1.0339 1.0389 1.0329 125.11 125.39 124.86 82.67 82.94 82.55 1.5131 1.5177 1.5091 0.809 0.8136 0.8081 2012-09-11 1.2855 1.2871 1.2758 77.724 78.273 77.67 0.9388 0.947 0.9373 1.6067 1.6084 1.5988 0.9732 0.9776 0.9709 0.8 0.8006 0.7965 99.918 100.244 99.5 1.2068 1.2091 1.2059 1.0436 1.0453 1.0323 124.872 125.4 124.692 82.771 83.062 82.435 1.5081 1.5151 1.5073 0.8186 0.8194 0.8083 2012-09-12 1.2895 1.2937 1.2816 77.8 77.966 77.73 0.9375 0.9404 0.9337 1.6105 1.6131 1.606 0.9765 0.9768 0.9711 0.8006 0.803 0.7969 100.373 100.645 99.747 1.209 1.2103 1.2033 1.0454 1.0507 1.0422 125.363 125.63 124.852 83.014 83.255 82.752 1.5099 1.5136 1.5048 0.8195 0.8237 0.8164 2012-09-13 1.2988 1.3002 1.2855 77.489 77.87 77.12 0.9349 0.9421 0.9343 1.6154 1.6174 1.6071 0.9684 0.9774 0.9664 0.8039 0.8044 0.7991 100.651 100.774 99.469 1.2143 1.2163 1.2076 1.0543 1.0568 1.0425 125.17 125.44 124.397 82.871 83.11 82.12 1.5101 1.5173 1.507 0.8303 0.8324 0.8194 2012-09-14 1.3122 1.3169 1.2977 78.362 78.374 77.46 0.9268 0.9356 0.9235 1.623 1.6256 1.6141 0.971 0.9714 0.9629 0.8084 0.8115 0.8035 102.835 103.023 100.6 1.2162 1.2178 1.2138 1.056 1.0624 1.0527 127.179 127.26 125.072 84.529 84.678 82.82 1.5045 1.5136 1.499 0.8304 0.8356 0.8278 2012-09-17 1.3101 1.3172 1.3081 78.733 78.93 78.13 0.9282 0.9297 0.9243 1.6236 1.6273 1.6209 0.9756 0.976 0.9688 0.8068 0.8102 0.8058 103.152 103.858 102.536 1.216 1.2185 1.2137 1.0466 1.0562 1.0452 127.836 128.24 126.764 84.8 85.27 84.25 1.5072 1.509 1.5007 0.8257 0.8305 0.8245 2012-09-18 1.3035 1.3119 1.3027 78.85 78.874 78.49 0.9291 0.9298 0.9246 1.624 1.6267 1.6219 0.9749 0.9766 0.9727 0.8024 0.8073 0.8019 102.77 103.28 102.392 1.2113 1.217 1.2095 1.044 1.049 1.0406 127.985 128.11 127.408 84.835 85.146 84.499 1.509 1.5102 1.501 0.8267 0.8287 0.8236 2012-09-19 1.3056 1.3085 1.2991 78.35 79.217 78.23 0.9276 0.9307 0.9256 1.6221 1.6271 1.6181 0.9742 0.9764 0.9726 0.8048 0.806 0.8015 102.303 103.634 102.097 1.2111 1.2126 1.2079 1.0486 1.0498 1.0418 127.105 128.834 126.904 84.445 85.542 84.328 1.5047 1.5097 1.502 0.8279 0.8299 0.8257 2012-09-20 1.2969 1.3059 1.2919 78.278 78.46 77.99 0.933 0.9356 0.9254 1.6217 1.6236 1.616 0.9763 0.9816 0.9741 0.7997 0.8046 0.7986 101.52 102.395 100.907 1.21 1.2106 1.2075 1.0439 1.048 1.0365 126.92 127.292 126.22 83.883 84.65 83.496 1.5128 1.5136 1.503 0.8287 0.8305 0.8206 2012-09-21 1.2989 1.3048 1.2955 78.13 78.37 78.07 0.9322 0.9344 0.9279 1.625 1.6309 1.6211 0.9771 0.978 0.9726 0.7992 0.801 0.7973 101.5 102.1 101.22 1.211 1.2121 1.209 1.045 1.0522 1.0424 126.985 127.63 126.78 83.79 84.28 83.63 1.515 1.518 1.5116 0.8293 0.8339 0.8281 2012-09-24 1.2927 1.299 1.289 77.855 78.2 77.78 0.9359 0.9392 0.9321 1.6216 1.6249 1.6179 0.9785 0.9818 0.9763 0.7971 0.7996 0.7955 100.647 101.53 100.34 1.21 1.2114 1.2083 1.0422 1.046 1.0381 126.249 127.084 125.933 83.162 83.83 82.94 1.5179 1.5208 1.5139 0.8212 0.8308 0.8182 2012-09-25 1.2906 1.2971 1.2886 77.763 77.928 77.63 0.9373 0.9384 0.9327 1.6198 1.6267 1.6191 0.9801 0.9809 0.9752 0.7967 0.7986 0.7934 100.354 101.047 100.13 1.2096 1.2114 1.2082 1.0393 1.0464 1.0387 125.962 126.7 125.835 82.94 83.485 82.81 1.5181 1.5238 1.5154 0.8227 0.8287 0.8202 2012-09-26 1.2857 1.2913 1.2836 77.713 77.906 77.593 0.9399 0.9417 0.9368 1.6156 1.6209 1.6138 0.9855 0.9856 0.9801 0.7957 0.797 0.794 99.937 100.48 99.719 1.2086 1.21 1.2079 1.0352 1.0388 1.0329 125.566 126.104 125.35 82.663 83.07 82.504 1.5187 1.5226 1.5169 0.8234 0.8247 0.8185 2012-09-27 1.2914 1.2928 1.2829 77.59 77.756 77.54 0.937 0.9417 0.9354 1.6237 1.6244 1.6166 0.9808 0.9854 0.9788 0.7953 0.7966 0.7924 100.217 100.359 99.636 1.2103 1.2111 1.2076 1.0446 1.0461 1.0365 125.989 126.13 125.6 82.794 82.94 82.463 1.5214 1.5249 1.5185 0.8314 0.8328 0.8243 2012-09-28 1.2844 1.296 1.2838 77.97 78.11 77.44 0.9407 0.9415 0.9332 1.6126 1.6272 1.6112 0.9837 0.9851 0.978 0.7962 0.7995 0.7948 100.16 100.67 99.89 1.2081 1.2108 1.2076 1.0366 1.0475 1.0362 125.758 126.22 125.4 82.91 83.21 82.61 1.5167 1.5229 1.5132 0.8275 0.8359 0.8272 2012-10-01 1.288 1.2939 1.2804 78 78.149 77.793 0.9385 0.9438 0.9349 1.6126 1.6175 1.611 0.9828 0.9854 0.9795 0.7987 0.8004 0.7943 100.47 101.026 99.794 1.209 1.2102 1.208 1.036 1.0406 1.0325 125.783 126.315 125.519 83.089 83.486 82.564 1.5137 1.5214 1.5112 0.8273 0.8325 0.8264 2012-10-02 1.2919 1.2968 1.288 78.1 78.215 77.979 0.936 0.9388 0.9333 1.6142 1.6187 1.6125 0.9835 0.9842 0.981 0.8002 0.802 0.7979 100.921 101.196 100.488 1.2094 1.2104 1.2089 1.0264 1.0379 1.0251 126.084 126.455 125.821 83.433 83.619 83.11 1.5111 1.5154 1.5091 0.8267 0.8339 0.8254 2012-10-03 1.29 1.2937 1.2878 78.512 78.584 78.121 0.9388 0.9398 0.9348 1.6073 1.6142 1.6065 0.9879 0.9884 0.984 0.8026 0.8033 0.7996 101.293 101.472 100.723 1.211 1.2114 1.2094 1.0203 1.0269 1.0193 126.21 126.471 125.809 83.624 83.84 83.227 1.5087 1.513 1.5065 0.8184 0.8269 0.817 2012-10-04 1.3014 1.3031 1.2908 78.47 78.718 78.26 0.9304 0.9386 0.9294 1.6182 1.6202 1.6078 0.9806 0.9877 0.9796 0.804 0.8052 0.8022 102.124 102.22 101.314 1.2113 1.2136 1.2104 1.024 1.0276 1.0183 127.01 127.11 126.2 84.292 84.37 83.636 1.5065 1.5113 1.5048 0.8212 0.8234 0.8165 2012-10-05 1.3017 1.3071 1.2994 78.668 78.871 78.28 0.9304 0.9324 0.9269 1.6126 1.6217 1.6121 0.9799 0.9812 0.9731 0.8071 0.8076 0.8028 102.413 102.803 101.865 1.211 1.2129 1.2105 1.0155 1.0278 1.015 126.853 127.815 126.772 84.553 84.83 84.081 1.5002 1.5093 1.4993 0.816 0.8268 0.815 2012-10-08 1.2972 1.3027 1.2938 78.33 78.76 78.05 0.9326 0.9357 0.9298 1.6036 1.6142 1.6018 0.9766 0.98 0.9747 0.8089 0.8095 0.8059 101.624 102.501 101.129 1.2101 1.2126 1.2092 1.0201 1.0223 1.015 125.614 127.066 125.08 83.971 84.63 83.537 1.4956 1.5041 1.4946 0.8205 0.8226 0.8149 2012-10-09 1.2873 1.2991 1.2858 78.223 78.436 78.14 0.941 0.9416 0.9323 1.5989 1.6046 1.5974 0.9783 0.9808 0.9743 0.8049 0.81 0.804 100.701 101.86 100.57 1.2115 1.2143 1.2095 1.0201 1.025 1.0173 125.077 125.841 124.887 83.105 84.052 83.07 1.5046 1.5052 1.4953 0.817 0.8242 0.8156 2012-10-10 1.2894 1.2913 1.2836 78.15 78.37 78.09 0.9384 0.9432 0.9373 1.6009 1.6034 1.5977 0.981 0.9816 0.9765 0.8053 0.8062 0.8029 100.75 101.16 100.45 1.2099 1.2116 1.2096 1.0236 1.0264 1.0184 125.09 125.62 124.97 83.25 83.54 82.97 1.5022 1.5074 1.5009 0.8169 0.8206 0.8146 2012-10-11 1.293 1.2952 1.2826 78.29 78.59 77.95 0.9345 0.9418 0.9331 1.6047 1.6054 1.5985 0.9787 0.9835 0.976 0.8056 0.8071 0.8023 101.26 101.72 100.16 1.2083 1.2101 1.2067 1.0264 1.0295 1.0209 125.618 126.13 124.76 83.8 84.12 82.9 1.4994 1.5058 1.498 0.8176 0.8194 0.8154 2012-10-12 1.2956 1.2992 1.2923 78.366 78.534 78.25 0.9332 0.9357 0.9304 1.6076 1.6097 1.6019 0.9793 0.9809 0.9764 0.8058 0.8087 0.8048 101.53 101.915 101.245 1.2091 1.21 1.2074 1.0231 1.029 1.0212 125.98 126.18 125.527 83.96 84.248 83.74 1.5004 1.5008 1.495 0.8175 0.8211 0.8158 2012-10-15 1.2951 1.298 1.2891 78.67 78.86 78.33 0.9331 0.9372 0.9317 1.6071 1.6082 1.6021 0.9791 0.9811 0.9768 0.8057 0.808 0.804 101.88 102.29 101.03 1.2084 1.2095 1.2077 1.0249 1.0263 1.0203 126.42 126.7 125.55 84.29 84.59 83.64 1.4996 1.5027 1.497 0.8183 0.8199 0.813 2012-10-16 1.3045 1.3061 1.2943 78.87 78.963 78.697 0.9263 0.9335 0.9253 1.6111 1.6132 1.6061 0.987 0.9879 0.9801 0.8097 0.8102 0.8054 102.88 103.08 101.872 1.2086 1.2101 1.208 1.0263 1.029 1.0244 127.08 127.326 126.48 85.149 85.244 84.323 1.4925 1.5002 1.4917 0.8133 0.8184 0.8105 2012-10-17 1.3123 1.314 1.3084 79.024 79.051 78.58 0.9221 0.9247 0.9206 1.6149 1.6178 1.6113 0.9773 0.9871 0.9769 0.8125 0.8137 0.8108 103.714 103.748 102.918 1.2101 1.2114 1.209 1.0384 1.0388 1.0291 127.629 127.67 126.784 85.692 85.717 85.06 1.4892 1.4923 1.4864 0.8218 0.8229 0.8153 2012-10-18 1.3068 1.313 1.3054 79.264 79.463 78.995 0.9247 0.9257 0.9207 1.6055 1.6171 1.6046 0.9854 0.9859 0.9765 0.8138 0.8139 0.8108 103.584 104.14 103.289 1.2086 1.2104 1.2079 1.037 1.0413 1.0354 127.264 128.23 127.103 85.7 86.116 85.455 1.4845 1.4919 1.4843 0.8194 0.8233 0.8183 2012-10-19 1.3021 1.3078 1.3012 79.33 79.43 79.1 0.9285 0.929 0.9239 1.6007 1.6067 1.5995 0.9928 0.994 0.9845 0.8133 0.8147 0.812 103.3 103.81 103.11 1.209 1.2094 1.2077 1.0328 1.0384 1.0314 126.97 127.53 126.72 85.42 85.89 85.29 1.4864 1.4883 1.4834 0.8163 0.8209 0.8145 2012-10-22 1.3049 1.3083 1.3016 79.89 79.935 79.219 0.9272 0.9289 0.9246 1.6006 1.6052 1.5991 0.9931 0.9964 0.9918 0.8151 0.8165 0.8123 104.269 104.458 103.14 1.2101 1.2107 1.2085 1.0309 1.034 1.0292 127.91 128.19 126.716 86.152 86.34 85.31 1.4841 1.4894 1.4818 0.8167 0.8191 0.8148 2012-10-23 1.2977 1.3076 1.2951 79.86 80.008 79.68 0.9329 0.9343 0.926 1.5946 1.6024 1.591 0.9926 0.9976 0.9898 0.8137 0.8161 0.8122 103.64 104.595 103.253 1.2107 1.2111 1.2089 1.0259 1.0342 1.0232 127.352 128.2 126.9 85.592 86.38 85.36 1.4875 1.4895 1.4837 0.8115 0.8187 0.8099 2012-10-24 1.2964 1.2997 1.292 79.786 79.925 79.69 0.933 0.9365 0.9313 1.6029 1.6048 1.5937 0.9947 0.9958 0.9884 0.8087 0.8148 0.8075 103.433 103.824 102.988 1.2094 1.211 1.2089 1.0337 1.0367 1.026 127.88 128.1 127.125 85.509 85.76 85.139 1.4957 1.4977 1.4855 0.8158 0.8177 0.8107 2012-10-25 1.2945 1.3023 1.2938 80.294 80.334 79.801 0.9342 0.9347 0.9288 1.6125 1.6144 1.6027 0.9941 0.9949 0.99 0.8027 0.81 0.8023 103.948 104.424 103.465 1.2096 1.2103 1.2089 1.0357 1.0397 1.0334 129.473 129.65 127.95 85.93 86.305 85.54 1.5065 1.5072 1.4941 0.8216 0.8243 0.8192 2012-10-26 1.2934 1.2956 1.2883 79.6 80.38 79.49 0.9351 0.9386 0.9333 1.609 1.6141 1.6079 0.9979 0.9994 0.9939 0.8037 0.804 0.7999 102.97 104.04 102.66 1.2096 1.2102 1.2083 1.0368 1.0388 1.0306 128.115 129.58 127.92 85.11 85.99 84.91 1.5047 1.5113 1.5043 0.8223 0.8238 0.8171 2012-10-29 1.2898 1.2968 1.2883 79.799 79.833 79.51 0.9364 0.9381 0.9328 1.6029 1.6123 1.6003 0.9999 1.0008 0.9977 0.8046 0.8056 0.8024 102.9 103.26 102.527 1.2083 1.2102 1.2079 1.0333 1.0371 1.0322 127.909 128.37 127.567 85.165 85.36 84.811 1.5014 1.5071 1.5002 0.8186 0.8231 0.8174 2012-10-30 1.2962 1.2983 1.2886 79.62 80.13 79.28 0.9322 0.9375 0.9301 1.6071 1.6085 1.6022 0.9999 1.0019 0.9984 0.8063 0.8072 0.804 103.196 103.408 102.181 1.2084 1.2094 1.2075 1.0367 1.0384 1.0326 127.951 128.48 127.044 85.38 85.565 84.576 1.4983 1.5027 1.496 0.8207 0.8234 0.8187 2012-10-31 1.292 1.302 1.2942 79.8 79.96 79.48 0.9316 0.9333 0.9273 1.6029 1.6039 1.5965 1.0001 1.0014 0.9955 0.8031 0.8075 0.8026 103.39 103.94 103.04 1.207 1.2081 1.206 1.0374 1.0399 1.0349 128.69 128.99 127.82 85.62 86.06 85.3 1.5026 1.5035 1.4949 0.8223 0.8231 0.8195 2012-11-01 1.2936 1.2983 1.2923 80.19 80.21 79.78 0.9322 0.9343 0.9292 1.6122 1.6175 1.6118 0.9963 1.0013 0.9955 0.8022 0.8041 0.8 103.74 104 103.32 1.2058 1.208 1.2049 1.0393 1.0414 1.0356 129.292 129.46 128.69 86.02 86.17 85.58 1.503 1.5087 1.5009 0.8264 0.8281 0.8212 2012-11-02 1.2832 1.2951 1.2819 80.417 80.675 80.131 0.9406 0.9414 0.9314 1.6018 1.6133 1.6004 0.9953 0.9985 0.9918 0.8011 0.8028 0.7997 103.204 103.868 103.02 1.2071 1.2086 1.2058 1.0335 1.0419 1.0326 128.809 129.61 128.627 85.478 86.12 85.35 1.5068 1.5121 1.5024 0.8242 0.8288 0.8235 2012-11-05 1.2794 1.2842 1.2766 80.28 80.563 80.12 0.9435 0.9449 0.94 1.5978 1.6039 1.5956 0.9962 0.9977 0.9941 0.8006 0.8012 0.7986 102.72 103.34 102.41 1.2071 1.2075 1.2052 1.0364 1.0373 1.0334 128.281 129.1 127.936 85.066 85.639 84.888 1.5075 1.5108 1.5054 0.825 0.8269 0.8225 2012-11-06 1.281 1.2827 1.2763 80.4 80.44 79.93 0.9431 0.946 0.9415 1.5994 1.6008 1.5963 0.992 0.9967 0.9906 0.8009 0.802 0.798 102.99 103.15 102.16 1.2083 1.2087 1.2064 1.0434 1.0448 1.0361 128.574 128.73 127.78 85.23 85.38 84.65 1.5084 1.5118 1.5056 0.8275 0.8295 0.8242 2012-11-07 1.2765 1.2876 1.2734 79.933 80.416 79.75 0.9447 0.9473 0.9381 1.5991 1.6042 1.5953 0.9966 0.9983 0.9874 0.7982 0.8031 0.7971 102.049 103.42 101.76 1.2063 1.209 1.2054 1.0414 1.048 1.0395 127.827 128.845 127.406 84.585 85.61 84.394 1.511 1.5131 1.5032 0.8254 0.8309 0.8238 2012-11-08 1.2745 1.278 1.2717 79.354 80.01 79.3 0.9459 0.9482 0.9441 1.5977 1.6005 1.5926 0.9997 0.9999 0.9945 0.7976 0.7995 0.796 101.134 102.197 101.027 1.2057 1.2071 1.2049 1.0416 1.0445 1.039 126.793 127.915 126.666 83.87 84.68 83.786 1.5114 1.5148 1.508 0.8153 0.8201 0.8151 2012-11-09 1.2711 1.279 1.2689 79.484 79.611 79.04 0.9484 0.9501 0.9429 1.5899 1.6019 1.5887 1.0009 1.0033 0.9983 0.7996 0.7999 0.7967 101.069 101.749 100.388 1.2056 1.207 1.2048 1.0389 1.0436 1.0355 126.384 127.48 125.876 83.803 84.37 83.3 1.5078 1.5134 1.5073 0.8146 0.818 0.812 2012-11-12 1.271 1.2739 1.2698 79.457 79.563 79.32 0.9479 0.9498 0.9464 1.588 1.5915 1.5861 0.9994 1.0009 0.9982 0.8003 0.802 0.7989 101.007 101.29 100.87 1.205 1.2064 1.2044 1.0425 1.0443 1.0386 126.195 126.56 125.917 83.812 83.98 83.662 1.5053 1.5094 1.503 0.8176 0.8186 0.8142 2012-11-13 1.2705 1.2728 1.2662 79.39 79.64 79.213 0.9473 0.9515 0.9459 1.5875 1.5916 1.5858 1.0018 1.0035 0.9987 0.8002 0.8008 0.7969 100.87 101.249 100.32 1.2038 1.2053 1.203 1.0433 1.0449 1.0396 126.02 126.635 125.684 83.774 84.035 83.29 1.5041 1.5114 1.5033 0.8193 0.8207 0.8149 2012-11-14 1.2732 1.2779 1.27 80.23 80.31 79.39 0.9451 0.9477 0.9423 1.5841 1.5902 1.5837 1.0036 1.0037 0.9996 0.8036 0.8049 0.8001 102.17 102.4 100.84 1.2031 1.2045 1.2029 1.0369 1.0462 1.0366 127.112 127.51 125.99 84.89 85.04 83.78 1.4974 1.5048 1.4954 0.8092 0.8182 0.8083 2012-11-15 1.2763 1.2802 1.2718 81.2 81.461 80.125 0.943 0.9463 0.9395 1.5849 1.5879 1.5826 1.0016 1.0041 0.9998 0.8054 0.8065 0.803 103.67 103.992 102.01 1.2039 1.2044 1.203 1.0322 1.039 1.0303 128.69 128.99 126.945 86.101 86.394 84.755 1.4945 1.4988 1.4923 0.8088 0.813 0.8075 2012-11-16 1.2734 1.2785 1.2691 81.229 81.439 80.899 0.9458 0.9491 0.942 1.5885 1.5901 1.5835 1.0008 1.0057 0.9996 0.8016 0.806 0.8007 103.445 103.891 103.051 1.2045 1.2049 1.2037 1.0341 1.0351 1.0288 129.036 129.25 128.265 85.873 86.255 85.59 1.5026 1.5039 1.4942 0.8117 0.8126 0.8053 2012-11-19 1.2804 1.282 1.2734 81.34 81.587 81.05 0.9404 0.9458 0.939 1.59 1.5923 1.5883 0.9965 1.0018 0.9951 0.8052 0.8055 0.8014 104.157 104.215 103.5 1.2043 1.2057 1.2037 1.0407 1.042 1.0339 129.346 129.729 128.853 86.483 86.54 85.88 1.4952 1.5043 1.4946 0.8187 0.8201 0.8119 2012-11-20 1.2815 1.283 1.2765 81.714 81.757 81.139 0.9399 0.943 0.9391 1.592 1.5936 1.5892 0.9972 0.9991 0.9951 0.8047 0.8056 0.8027 104.72 104.77 103.675 1.2047 1.2054 1.2036 1.0382 1.0425 1.0354 130.05 130.19 129.03 86.9 86.96 86.068 1.4963 1.4996 1.4951 0.8162 0.82 0.8138 2012-11-21 1.2825 1.2833 1.2737 82.513 82.534 81.656 0.9389 0.946 0.9375 1.5953 1.5955 1.5883 0.9965 0.9992 0.9958 0.8038 0.8051 0.8006 105.83 105.848 104.103 1.2041 1.2051 1.2032 1.0363 1.0395 1.0334 131.63 131.654 130.017 87.864 87.911 86.416 1.4981 1.5046 1.4952 0.8137 0.8178 0.8108 2012-11-22 1.2871 1.2899 1.2826 82.569 82.837 82.264 0.9353 0.9394 0.9338 1.593 1.5978 1.5924 0.9977 0.9982 0.9952 0.8079 0.8085 0.8039 106.29 106.58 105.723 1.2045 1.2049 1.2041 1.038 1.0402 1.0353 131.547 132.33 131.09 88.24 88.474 87.77 1.4906 1.4981 1.4897 0.8147 0.8169 0.8135 2012-11-23 1.2982 1.2991 1.2869 82.35 82.509 82.065 0.9274 0.9358 0.9263 1.604 1.6051 1.5926 0.9917 0.9981 0.9911 0.8093 0.811 0.8074 106.908 106.953 105.721 1.2041 1.2054 1.2034 1.0462 1.0471 1.0376 132.11 132.174 130.804 88.77 88.887 87.749 1.4875 1.4925 1.4853 0.8246 0.825 0.8153 2012-11-26 1.297 1.2985 1.2945 82.049 82.622 81.927 0.9277 0.93 0.9271 1.6025 1.6038 1.5996 0.9934 0.996 0.9917 0.8093 0.8109 0.8081 106.42 107.134 106.093 1.2033 1.2047 1.2028 1.0464 1.047 1.0435 131.495 132.46 131.145 88.431 88.985 88.11 1.4868 1.4896 1.4847 0.8223 0.825 0.8208 2012-11-27 1.2932 1.3009 1.2914 82.154 82.315 81.86 0.9309 0.9325 0.9253 1.6013 1.6056 1.601 0.9946 0.9948 0.9902 0.8076 0.8113 0.8057 106.24 106.962 106.119 1.2038 1.2052 1.2033 1.0439 1.0491 1.0434 131.548 132.095 131.189 88.23 88.781 88.13 1.4904 1.4941 1.4837 0.8195 0.8239 0.8189 2012-11-28 1.2934 1.2946 1.2879 81.925 82.212 81.66 0.9305 0.9341 0.9289 1.6011 1.6025 1.5958 0.9925 0.9961 0.9917 0.8077 0.8086 0.8062 105.96 106.358 105.25 1.2035 1.2044 1.2026 1.0478 1.0483 1.0423 131.168 131.69 130.438 88.03 88.329 87.489 1.4898 1.4927 1.488 0.8236 0.8242 0.8189 2012-11-29 1.2973 1.3014 1.2939 82.08 82.215 81.9 0.928 0.9303 0.9251 1.6039 1.6048 1.6002 0.9928 0.9939 0.9907 0.8087 0.8113 0.8079 106.499 106.814 106.156 1.2039 1.2043 1.203 1.0429 1.0483 1.0415 131.652 131.87 131.214 88.44 88.695 88.206 1.4882 1.4895 1.4837 0.8226 0.8267 0.8207 2012-11-30 1.3006 1.3027 1.2966 82.422 82.748 82.05 0.9266 0.9292 0.9246 1.6024 1.6062 1.5987 0.9931 0.9952 0.992 0.8116 0.8132 0.8087 107.21 107.673 106.444 1.2051 1.2059 1.2037 1.0438 1.0447 1.0398 132.087 132.805 131.588 88.946 89.385 88.42 1.4848 1.4887 1.482 0.8214 0.8238 0.8171 2012-12-03 1.3051 1.3076 1.2973 82.242 82.504 81.97 0.9258 0.9287 0.9238 1.6091 1.6116 1.6004 0.9947 0.9949 0.9911 0.8111 0.8131 0.8103 107.35 107.585 106.81 1.2083 1.2097 1.2049 1.0418 1.0446 1.0394 132.331 132.54 131.56 88.826 89.155 88.56 1.4895 1.4907 1.4831 0.8202 0.8226 0.8171 2012-12-04 1.3098 1.3108 1.3046 81.825 82.271 81.68 0.9261 0.9294 0.9245 1.6103 1.6131 1.6084 0.9924 0.9954 0.9912 0.8133 0.8139 0.81 107.179 107.394 106.92 1.2129 1.2145 1.2081 1.0475 1.0488 1.0412 131.763 132.396 131.507 88.32 88.887 88.18 1.4915 1.4982 1.4887 0.8239 0.8263 0.8203 2012-12-05 1.3079 1.3126 1.3058 82.395 82.44 81.797 0.926 0.9299 0.9249 1.6089 1.6118 1.6079 0.991 0.9941 0.9903 0.8127 0.8147 0.811 107.772 107.96 107.139 1.2112 1.2168 1.2102 1.046 1.0485 1.0438 132.56 132.752 131.7 88.97 89.02 88.287 1.4901 1.4979 1.4899 0.8281 0.8293 0.8232 2012-12-06 1.2965 1.3087 1.2951 82.37 82.617 82.203 0.933 0.934 0.9256 1.6052 1.6128 1.604 0.991 0.9926 0.9893 0.8077 0.8125 0.8066 106.799 107.893 106.61 1.2096 1.2129 1.2084 1.0476 1.0517 1.0441 132.2 132.91 132.065 88.272 89.111 88.144 1.4976 1.4995 1.4897 0.8316 0.835 0.8284 2012-12-07 1.2927 1.2974 1.2877 82.429 82.829 82.179 0.9343 0.9388 0.9321 1.6038 1.6061 1.6003 0.9901 0.9933 0.9877 0.806 0.8082 0.8045 106.563 107.08 106.126 1.2079 1.2101 1.2076 1.0488 1.0499 1.046 132.186 132.605 131.695 88.199 88.57 87.818 1.4983 1.5019 1.4952 0.8327 0.834 0.8311 2012-12-10 1.2935 1.2943 1.2885 82.363 82.638 82.08 0.9334 0.9373 0.9319 1.6069 1.6096 1.6014 0.9866 0.9888 0.9862 0.8049 0.8058 0.8032 106.545 106.64 105.94 1.2074 1.2081 1.2057 1.0486 1.0506 1.0466 132.32 132.48 131.663 88.233 88.33 87.845 1.4999 1.503 1.4979 0.8337 0.8356 0.8315 2012-12-11 1.3002 1.3015 1.2929 82.47 82.575 82.28 0.9325 0.9369 0.9313 1.6111 1.6122 1.607 0.9863 0.988 0.9852 0.807 0.8077 0.8044 107.283 107.423 106.482 1.2125 1.213 1.2077 1.052 1.0535 1.0462 132.92 133.09 132.355 88.468 88.565 87.942 1.5024 1.5067 1.4989 0.8379 0.8395 0.8336 2012-12-12 1.3064 1.3097 1.2996 83.16 83.3 82.48 0.9265 0.9328 0.9242 1.614 1.6172 1.6096 0.9846 0.9866 0.9822 0.8093 0.8101 0.806 108.65 109.04 107.27 1.2105 1.2128 1.2098 1.0549 1.0586 1.0523 134.24 134.62 132.72 89.75 90 88.45 1.4954 1.5034 1.4943 0.8429 0.8453 0.8387 2012-12-13 1.3073 1.31 1.3041 83.602 83.672 83.135 0.9239 0.9275 0.9226 1.6107 1.6153 1.6085 0.985 0.9856 0.9825 0.8116 0.812 0.809 109.26 109.537 108.645 1.208 1.2128 1.2073 1.0516 1.0565 1.0504 134.583 135.08 134.155 90.47 90.575 89.73 1.4882 1.4966 1.4873 0.8426 0.8463 0.8418 2012-12-14 1.3154 1.3173 1.3066 83.49 83.963 83.29 0.9183 0.9247 0.9161 1.6156 1.6178 1.6104 0.9863 0.9866 0.9832 0.8141 0.8145 0.8096 109.832 109.984 109.01 1.2081 1.2092 1.2068 1.0556 1.058 1.0511 134.885 135.405 134.26 90.903 91.058 90.256 1.4836 1.4922 1.4816 0.8451 0.8476 0.8388 2012-12-17 1.316 1.3188 1.3143 83.8 84.36 83.53 0.9178 0.9194 0.9158 1.6201 1.6216 1.6156 0.9837 0.9881 0.9831 0.8121 0.8155 0.8109 110.26 111.18 109.893 1.2079 1.2096 1.207 1.0546 1.0574 1.0523 135.75 136.51 135.099 91.294 92.046 90.99 1.4871 1.4889 1.4811 0.844 0.8476 0.8417 2012-12-18 1.3224 1.3238 1.3156 84.2 84.268 83.8 0.9134 0.9186 0.912 1.6249 1.6269 1.6196 0.9857 0.9859 0.9832 0.8137 0.8145 0.8115 111.32 111.473 110.352 1.2078 1.2089 1.206 1.0532 1.0561 1.0511 136.818 136.92 135.752 92.178 92.283 91.36 1.4842 1.4886 1.4825 0.8421 0.8453 0.8397 2012-12-19 1.3247 1.3308 1.3223 84.4 84.616 84.173 0.9121 0.9137 0.9088 1.6255 1.6307 1.6246 0.9875 0.9881 0.985 0.8149 0.817 0.8128 111.83 112.499 111.32 1.2084 1.2101 1.2073 1.0491 1.0538 1.0479 137.218 137.86 136.78 92.547 93.057 92.17 1.4823 1.4874 1.4801 0.8366 0.8422 0.8349 2012-12-20 1.3243 1.3295 1.3189 84.392 84.454 83.864 0.9116 0.9155 0.9082 1.6277 1.6296 1.6239 0.9871 0.9896 0.9865 0.8135 0.8161 0.8117 111.762 112.152 110.736 1.2072 1.2085 1.2066 1.0484 1.0502 1.0458 137.35 137.55 136.23 92.576 92.858 91.71 1.4838 1.4877 1.4793 0.8338 0.8369 0.8312 2012-12-21 1.3178 1.3252 1.3154 84.25 84.444 83.862 0.9165 0.9179 0.911 1.6165 1.6283 1.6149 0.9935 0.9953 0.9874 0.815 0.8154 0.8115 110.99 111.79 110.62 1.208 1.2083 1.206 1.0399 1.0488 1.039 136.189 137.42 135.818 91.902 92.623 91.61 1.4816 1.4873 1.4806 0.8235 0.8346 0.8216 2012-12-24 1.3173 1.3234 1.317 84.83 84.87 84.32 0.9161 0.9171 0.912 1.6115 1.6206 1.6099 0.9915 0.9945 0.9906 0.8174 0.8184 0.8148 111.78 112.004 111.09 1.2071 1.2085 1.2066 1.0362 1.042 1.0354 136.66 136.95 136.233 92.576 92.71 91.98 1.4759 1.4825 1.4747 0.8223 0.825 0.8212 2012-12-25 1.3191 1.3207 1.3167 84.78 84.95 84.62 0.9142 0.9171 0.914 1.6013 1.6142 1.6013 0.9931 0.9931 0.9911 0.8203 0.8215 0.8161 111.7 112.04 111.53 1.207 1.2082 1.206 1.0368 1.0413 1.0353 136.27 136.96 135.8 92.63 92.78 92.32 1.4711 1.4794 1.4671 0.8217 0.8234 0.8208 2012-12-26 1.3218 1.3254 1.3167 85.597 85.728 84.71 0.9133 0.9167 0.911 1.613 1.6171 1.6105 0.9939 0.9951 0.9908 0.8195 0.8209 0.8167 113.15 113.39 111.652 1.2073 1.2081 1.2068 1.0373 1.0386 1.0341 138.05 138.225 136.67 93.708 93.886 92.52 1.4733 1.4784 1.4704 0.8185 0.8242 0.8152 2012-12-27 1.3242 1.3284 1.3199 86.01 86.147 85.45 0.913 0.9157 0.9088 1.6113 1.6202 1.6065 0.9945 0.9959 0.9903 0.8218 0.8224 0.8183 113.91 114.324 112.99 1.2089 1.2095 1.2069 1.0381 1.039 1.0342 138.615 139.174 137.808 94.21 94.611 93.58 1.4712 1.476 1.4695 0.8204 0.8228 0.8156 2012-12-28 1.3219 1.3257 1.3166 86.112 86.637 85.95 0.9131 0.9182 0.9118 1.6168 1.6169 1.6079 0.9963 0.9968 0.9939 0.8176 0.8226 0.8168 113.84 114.694 113.3 1.2071 1.2092 1.2066 1.0368 1.0398 1.0362 139.21 139.527 138.21 94.307 94.89 93.786 1.4761 1.4787 1.4695 0.8195 0.8228 0.8182 2012-12-31 1.3188 1.3235 1.317 86.756 86.79 85.674 0.9156 0.9167 0.9113 1.6234 1.6274 1.613 0.9921 0.9971 0.9912 0.8121 0.8187 0.8101 114.421 114.54 113.226 1.2077 1.2079 1.2061 1.0395 1.0409 1.036 140.828 141.01 138.57 94.732 94.85 93.78 1.4867 1.4897 1.4739 0.8283 0.8294 0.8197 2013-01-01 1.3219 1.322 1.319 86.7 86.76 86.69 0.9156 0.9216 0.9152 1.623 1.6259 1.6229 0.9934 0.9935 0.9922 0.8121 0.813 0.8112 114.47 114.66 114.42 1.2078 1.2116 1.2075 1.0403 1.0404 1.0395 140.76 141.49 140.65 94.7 94.76 94.66 1.4852 1.4904 1.4851 0.8278 0.828 0.827 2013-01-02 1.3177 1.3299 1.3154 87.203 87.33 86.5 0.9184 0.9199 0.907 1.6244 1.638 1.6223 0.9857 0.9944 0.9832 0.8111 0.8152 0.8104 114.92 115.995 114.15 1.21 1.2107 1.2067 1.0496 1.0527 1.0372 141.64 142.743 140.53 94.942 96.03 94.52 1.4919 1.4933 1.4802 0.8327 0.8397 0.8257 2013-01-03 1.305 1.3191 1.3049 87.25 87.357 86.73 0.9267 0.9267 0.9174 1.6093 1.6256 1.6088 0.9878 0.9884 0.984 0.8109 0.812 0.8085 113.884 115.22 113.62 1.2091 1.2106 1.2079 1.0462 1.053 1.0458 140.41 142 140.13 94.158 95.2 93.98 1.4913 1.4954 1.4882 0.8274 0.8354 0.827 2013-01-04 1.308 1.3089 1.2995 88.12 88.41 87.21 0.9239 0.9303 0.9228 1.6076 1.6109 1.6008 0.9869 0.9923 0.9845 0.8136 0.8144 0.8095 115.26 115.41 113.82 1.2085 1.2094 1.2078 1.048 1.0491 1.039 141.657 141.81 140.41 95.36 95.51 94.11 1.4852 1.4929 1.4835 0.8318 0.8327 0.821 2013-01-07 1.3106 1.3119 1.3016 87.77 88.37 87.6 0.9221 0.9287 0.9208 1.6103 1.6108 1.6018 0.986 0.9886 0.9849 0.8138 0.815 0.8104 115.071 115.555 114.07 1.2083 1.2097 1.2077 1.0498 1.0513 1.0463 141.399 142.08 140.49 95.21 95.587 94.388 1.4846 1.4911 1.4826 0.8365 0.8377 0.8278 2013-01-08 1.3083 1.314 1.3057 87.173 87.823 86.94 0.924 0.9257 0.9202 1.6055 1.6129 1.6026 0.9868 0.9882 0.9844 0.8147 0.8161 0.8137 114.059 115.235 113.61 1.2088 1.2093 1.2079 1.0497 1.0518 1.047 139.95 141.535 139.46 94.343 95.36 94 1.4834 1.4854 1.4817 0.837 0.8381 0.8329 2013-01-09 1.3064 1.3096 1.3035 87.77 88.014 86.826 0.9251 0.9274 0.9232 1.6025 1.6075 1.5989 0.9874 0.988 0.9851 0.8151 0.8162 0.8132 114.68 115.03 113.555 1.2086 1.2093 1.2081 1.0509 1.0535 1.0487 140.666 141.035 139.412 94.863 95.15 93.949 1.4826 1.4862 1.4808 0.839 0.8412 0.8347 2013-01-10 1.3254 1.3266 1.3039 88.56 88.7 87.86 0.915 0.9269 0.9134 1.6151 1.6168 1.6005 0.9839 0.988 0.9836 0.8205 0.8212 0.8145 117.38 117.6 114.78 1.2125 1.2134 1.2086 1.0594 1.0601 1.0494 143.02 143.267 140.786 96.772 96.997 94.955 1.4779 1.4839 1.4753 0.8444 0.8456 0.8384 2013-01-11 1.3334 1.3365 1.3246 89.198 89.45 88.685 0.9138 0.9179 0.9108 1.6119 1.6178 1.6088 0.9843 0.9845 0.9813 0.8271 0.8288 0.8204 118.94 119.343 117.57 1.2186 1.22 1.212 1.053 1.0601 1.0527 143.791 144.421 142.94 97.61 97.946 96.777 1.473 1.4824 1.4687 0.8364 0.846 0.8359 2013-01-14 1.3387 1.3404 1.3336 89.4 89.67 89.05 0.9211 0.9229 0.912 1.6089 1.6154 1.6028 0.9835 0.9866 0.9831 0.8319 0.8325 0.8272 119.68 120.12 118.85 1.2333 1.2341 1.2188 1.0571 1.0577 1.0522 143.834 144.81 142.8 97.04 98.23 96.87 1.4821 1.4842 1.4719 0.8412 0.843 0.8363 2013-01-15 1.3311 1.3394 1.3264 88.87 89.63 88.28 0.9313 0.9332 0.9212 1.6064 1.6101 1.603 0.9841 0.9867 0.9832 0.8285 0.8325 0.8265 118.3 119.98 117.6 1.2399 1.2413 1.2307 1.056 1.057 1.0524 142.753 144.19 141.64 95.4 97.25 94.98 1.4962 1.4976 1.4813 0.8396 0.8439 0.8366 2013-01-16 1.3282 1.3325 1.3256 88.35 88.87 87.8 0.9314 0.9329 0.928 1.5995 1.6081 1.5974 0.9859 0.9878 0.9839 0.8303 0.832 0.8267 117.4 118.25 116.48 1.2373 1.2404 1.2334 1.0574 1.058 1.0532 141.374 142.78 140.52 94.86 95.38 94.37 1.4898 1.4985 1.4857 0.8413 0.8429 0.8368 2013-01-17 1.3374 1.3388 1.327 89.95 90.13 88.14 0.933 0.936 0.9292 1.6 1.6039 1.5955 0.9852 0.9886 0.9839 0.8355 0.8365 0.83 120.3 120.6 117.02 1.2478 1.249 1.237 1.0541 1.0576 1.0495 143.928 144.25 140.88 96.4 96.61 94.58 1.4929 1.4958 1.4882 0.8413 0.8426 0.8377 2013-01-18 1.3318 1.34 1.3279 90.08 90.21 89.64 0.9343 0.9389 0.9305 1.5872 1.6007 1.5853 0.9922 0.9947 0.9853 0.839 0.8397 0.8354 119.98 120.72 119.34 1.2444 1.2568 1.2388 1.0508 1.0558 1.0481 142.985 144.12 142.48 96.41 96.7 95.69 1.4829 1.5005 1.4787 0.8362 0.8382 0.8332 2013-01-21 1.3317 1.3332 1.33 89.74 90.246 89.34 0.9321 0.9352 0.9308 1.5825 1.5893 1.5807 0.9929 0.9939 0.9911 0.8413 0.8421 0.8378 119.495 120.25 118.88 1.2413 1.2453 1.2394 1.0516 1.0526 1.0493 142.026 143.07 141.77 96.255 96.603 95.76 1.4751 1.4833 1.4745 0.836 0.8373 0.8334 2013-01-22 1.3313 1.3371 1.3267 88.7 90.15 88.37 0.929 0.9347 0.9272 1.5826 1.5884 1.581 0.9926 0.9946 0.991 0.8411 0.8441 0.8362 118.09 120.16 117.33 1.2371 1.2463 1.2337 1.0563 1.0578 1.0505 140.379 142.85 139.8 95.44 96.54 94.99 1.4708 1.4803 1.4697 0.8408 0.843 0.8356 2013-01-23 1.3315 1.3355 1.3264 88.68 88.792 88.061 0.9295 0.9316 0.9278 1.5842 1.5893 1.5802 0.9991 1.0004 0.9904 0.8403 0.842 0.8379 118.129 118.333 117.058 1.2377 1.2406 1.2326 1.0547 1.0574 1.0528 140.527 140.85 139.271 95.417 95.565 94.714 1.4723 1.4769 1.4685 0.8413 0.844 0.8401 2013-01-24 1.3375 1.3393 1.3287 90.13 90.25 88.42 0.928 0.9325 0.9277 1.579 1.5852 1.5757 1.0027 1.0036 0.9989 0.8469 0.8481 0.8391 120.6 120.69 117.59 1.2414 1.2445 1.2362 1.0468 1.0554 1.0451 142.35 142.49 139.89 97.14 97.23 95.04 1.4655 1.4769 1.4648 0.8387 0.8447 0.8368 2013-01-25 1.3458 1.348 1.335 90.9 91.195 90.291 0.9268 0.9307 0.9222 1.5805 1.5827 1.5746 1.0063 1.01 1.0021 0.8514 0.8537 0.8463 122.389 122.78 120.668 1.2474 1.2494 1.238 1.0424 1.0468 1.0398 143.726 144.243 142.495 98.1 98.647 97.119 1.4649 1.4687 1.4549 0.8375 0.8394 0.8349 2013-01-28 1.3454 1.3477 1.3425 90.753 91.254 90.52 0.9264 0.9292 0.9254 1.5693 1.5785 1.5673 1.0063 1.01 1.0057 0.8572 0.8586 0.8526 122.107 122.914 121.629 1.2462 1.2514 1.2452 1.0408 1.043 1.0383 142.43 143.989 142.14 97.956 98.385 97.575 1.4538 1.465 1.4524 0.8322 0.8365 0.8281 2013-01-29 1.3491 1.3497 1.3413 90.74 91.016 90.3 0.9218 0.9268 0.9192 1.5759 1.5773 1.5686 1.0022 1.0066 1.0014 0.8561 0.8574 0.8526 122.46 122.57 121.21 1.2437 1.2468 1.2397 1.0462 1.0471 1.0406 143.047 143.15 141.9 98.44 98.648 97.597 1.4527 1.4551 1.4475 0.8378 0.8383 0.8327 2013-01-30 1.3566 1.3587 1.3482 91.129 91.404 90.663 0.9108 0.9227 0.909 1.5805 1.5817 1.5726 1.0014 1.0053 1.0006 0.8582 0.8606 0.8557 123.643 123.864 122.295 1.2356 1.2462 1.2342 1.0409 1.0475 1.0397 144.035 144.195 142.905 100.052 100.155 98.4 1.4395 1.4542 1.4359 0.8357 0.8393 0.8293 2013-01-31 1.3577 1.3594 1.3538 91.49 91.545 90.747 0.91 0.912 0.9073 1.5858 1.5875 1.5774 0.9975 1.0034 0.9954 0.856 0.8594 0.8551 124.217 124.32 122.987 1.2353 1.2383 1.2326 1.0429 1.0451 1.0381 145.088 145.186 143.45 100.526 100.58 99.637 1.4431 1.4445 1.4366 0.8394 0.8423 0.8344 2013-02-01 1.3651 1.3711 1.3574 92.8 92.96 91.62 0.9071 0.9109 0.9015 1.5705 1.5879 1.5698 0.9973 1.0004 0.9964 0.8693 0.8717 0.8559 126.7 126.97 124.41 1.2386 1.2414 1.2302 1.04 1.0446 1.0361 145.734 146.49 144.89 102.28 102.63 100.64 1.4247 1.446 1.4191 0.8446 0.8471 0.8388 2013-02-04 1.3511 1.3659 1.3503 92.27 93.18 92.24 0.9083 0.9117 0.9065 1.5762 1.5772 1.5684 0.9983 0.9993 0.9943 0.857 0.8703 0.8564 124.685 126.85 124.64 1.2274 1.2405 1.2258 1.0428 1.0442 1.0405 145.45 146.615 145.215 101.572 102.395 101.5 1.4319 1.4337 1.4245 0.8433 0.8491 0.8428 2013-02-05 1.3584 1.3597 1.3459 93.535 93.622 91.984 0.9083 0.9116 0.907 1.5659 1.5804 1.5631 0.9962 0.9994 0.9953 0.8674 0.8687 0.8554 127.08 127.2 124.024 1.2338 1.2344 1.2257 1.0404 1.0458 1.0366 146.45 147.255 144.87 102.97 103.06 101.172 1.4221 1.4365 1.4189 0.8454 0.8465 0.8407 2013-02-06 1.3522 1.3596 1.3494 93.542 94.057 93.25 0.9098 0.9149 0.9057 1.5667 1.5678 1.5632 0.9953 0.9988 0.9949 0.863 0.8681 0.8613 126.488 127.706 125.888 1.2304 1.2369 1.2281 1.0317 1.04 1.0292 146.566 147.245 145.93 102.793 103.651 102.131 1.4253 1.4322 1.4183 0.8427 0.8461 0.8392 2013-02-07 1.3396 1.3577 1.3371 93.58 93.916 93.087 0.9186 0.9201 0.9065 1.5703 1.5768 1.5646 0.9982 0.9994 0.9933 0.8531 0.8662 0.8515 125.36 127.466 124.502 1.2305 1.2332 1.2274 1.0282 1.0338 1.0271 146.967 147.975 146.015 101.884 103.49 101.343 1.4422 1.4448 1.4208 0.8322 0.8401 0.8289 2013-02-08 1.3363 1.3429 1.335 92.71 93.736 92.175 0.917 0.9197 0.9154 1.5795 1.5844 1.5706 1.0027 1.0035 0.997 0.8459 0.8534 0.8444 123.95 125.574 123.388 1.2257 1.2312 1.2252 1.0318 1.0348 1.0256 146.48 147.305 145.063 101.116 102.071 100.53 1.4486 1.4537 1.4417 0.8351 0.8388 0.8327 2013-02-11 1.3398 1.3427 1.3337 93.92 93.945 92.375 0.9188 0.9204 0.9157 1.5663 1.581 1.5653 1.0041 1.0084 1.0025 0.8554 0.8574 0.8446 125.839 125.882 123.512 1.2311 1.233 1.2261 1.0274 1.0325 1.0263 147.09 147.14 145.88 102.208 102.252 100.644 1.4392 1.4542 1.4372 0.8364 0.8379 0.831 2013-02-12 1.3447 1.3475 1.3364 93.585 94.409 92.94 0.9175 0.9216 0.9147 1.5652 1.567 1.5568 1.0027 1.0087 1.0016 0.8591 0.8631 0.854 125.84 126.942 124.968 1.2335 1.2356 1.2286 1.0304 1.0321 1.0228 146.46 147.775 145.26 101.99 103.008 101.435 1.436 1.4425 1.4281 0.84 0.8437 0.8334 2013-02-13 1.345 1.352 1.3424 93.46 93.778 92.826 0.9172 0.9196 0.9151 1.5537 1.5689 1.5522 1.002 1.0044 1.0009 0.8653 0.8684 0.8571 125.702 126.567 124.777 1.2338 1.2386 1.2326 1.0344 1.0362 1.0306 145.201 146.61 144.942 101.868 102.276 101.146 1.4254 1.4395 1.4249 0.8407 0.8429 0.8392 2013-02-14 1.3354 1.3456 1.3315 92.91 93.71 92.87 0.9223 0.9246 0.9169 1.5489 1.5543 1.5472 1.0008 1.0024 0.9995 0.8621 0.8666 0.8584 124.082 125.962 123.802 1.2314 1.2348 1.2277 1.0353 1.0371 1.0327 143.92 145.383 143.84 100.71 102.1 100.67 1.4287 1.434 1.4234 0.8489 0.8514 0.845 2013-02-15 1.3362 1.3393 1.3304 93.472 93.84 92.228 0.9216 0.9241 0.9203 1.5516 1.555 1.5462 1.0061 1.0082 1.0001 0.8612 0.8633 0.8575 124.912 125.28 122.902 1.2313 1.2335 1.2286 1.0301 1.0375 1.0284 145.028 145.639 142.774 101.406 101.626 99.98 1.4298 1.4345 1.4249 0.8448 0.8534 0.8429 2013-02-18 1.3349 1.3379 1.3322 93.938 94.216 93.618 0.9234 0.9258 0.921 1.5463 1.5509 1.5438 1.0109 1.0121 1.0058 0.8631 0.8648 0.8605 125.407 125.895 124.98 1.2329 1.2345 1.2311 1.0296 1.0315 1.0275 145.27 145.895 145.01 101.703 102.16 101.47 1.4281 1.4334 1.425 0.8447 0.8464 0.842 2013-02-19 1.339 1.3396 1.3326 93.53 93.96 93.26 0.9226 0.9249 0.9208 1.5425 1.5504 1.5413 1.0117 1.0137 1.0102 0.868 0.8685 0.8601 125.21 125.47 124.56 1.2355 1.2359 1.2318 1.0352 1.0367 1.0302 144.281 145.39 143.83 101.37 101.76 101.07 1.4232 1.4334 1.421 0.8469 0.8489 0.8405 2013-02-20 1.3283 1.3434 1.3273 93.735 94.036 93.142 0.9275 0.9286 0.9185 1.5245 1.5451 1.5193 1.0173 1.0185 1.0109 0.8712 0.8764 0.8675 124.512 125.896 124.31 1.2321 1.236 1.2312 1.0247 1.0367 1.0232 142.915 144.74 142.687 101.03 101.885 100.93 1.414 1.424 1.4074 0.834 0.847 0.8323 2013-02-21 1.3182 1.329 1.316 93.202 93.863 92.76 0.9314 0.9333 0.9269 1.5249 1.5273 1.5132 1.0185 1.0207 1.0164 0.8644 0.8759 0.8627 122.871 124.702 122.251 1.2282 1.233 1.2266 1.0248 1.0265 1.0217 142.126 142.959 141.349 100.025 101.187 99.506 1.4207 1.4235 1.4069 0.8337 0.8363 0.831 2013-02-22 1.3184 1.3245 1.3146 93.41 93.514 92.931 0.9297 0.9329 0.9284 1.5246 1.5321 1.5234 1.0207 1.0256 1.016 0.8646 0.8678 0.8605 123.14 123.769 122.561 1.226 1.2306 1.2254 1.0328 1.034 1.0236 142.419 143.062 141.712 100.444 100.583 99.808 1.4178 1.426 1.416 0.838 0.8397 0.8336 2013-02-25 1.3089 1.3318 1.3069 91.265 94.751 90.871 0.9293 0.9324 0.9232 1.5195 1.5199 1.5072 1.0256 1.0277 1.0213 0.8613 0.8815 0.8601 119.448 125.33 118.778 1.2165 1.2325 1.2154 1.0312 1.033 1.0262 138.666 143.09 138.038 98.18 101.832 97.614 1.4122 1.4161 1.3966 0.8375 0.8417 0.8349 2013-02-26 1.3054 1.3122 1.3019 92.06 92.749 91.119 0.9325 0.9335 0.9287 1.5123 1.5219 1.5113 1.0261 1.0303 1.0241 0.8631 0.865 0.8576 120.179 121.361 118.979 1.2173 1.2197 1.212 1.0233 1.0292 1.0197 139.21 140.589 137.849 98.72 99.508 97.75 1.4102 1.417 1.4069 0.8256 0.8353 0.8224 2013-02-27 1.3136 1.314 1.3042 92.229 92.437 91.13 0.9303 0.9332 0.9285 1.5156 1.5188 1.5081 1.023 1.0277 1.0223 0.8666 0.868 0.8623 121.14 121.453 119.216 1.2218 1.2229 1.216 1.0233 1.0246 1.0181 139.75 139.95 138.142 99.12 99.325 97.955 1.4099 1.4119 1.4048 0.8269 0.8285 0.8221 2013-02-28 1.3064 1.3162 1.305 92.66 92.85 92.01 0.9369 0.9373 0.9281 1.5158 1.5221 1.5148 1.0305 1.0309 1.0217 0.8617 0.8677 0.8603 121.05 121.83 120.48 1.2242 1.2242 1.2189 1.0217 1.029 1.0196 140.475 140.89 139.48 98.88 99.76 98.66 1.4204 1.4216 1.4078 0.827 0.8325 0.8254 2013-03-01 1.3024 1.3101 1.2965 93.53 93.683 92.4 0.9428 0.9463 0.9347 1.5025 1.5186 1.4985 1.027 1.0342 1.0259 0.8667 0.8685 0.8605 121.84 122.168 120.35 1.2275 1.2291 1.2224 1.0197 1.0242 1.0178 140.575 140.92 139.1 99.224 99.417 98.19 1.4162 1.4216 1.4092 0.8246 0.8295 0.8214 2013-03-04 1.3017 1.3031 1.298 93.434 93.727 93.15 0.9411 0.944 0.9404 1.5108 1.5117 1.5 1.0278 1.0309 1.0266 0.8617 0.8665 0.861 121.626 121.986 121.12 1.2252 1.2276 1.2234 1.0187 1.0205 1.0116 141.165 141.23 140.225 99.263 99.441 98.902 1.422 1.4224 1.4151 0.8268 0.8277 0.8194 2013-03-05 1.3039 1.3075 1.3011 93.274 93.54 92.918 0.9413 0.9434 0.9394 1.5117 1.5199 1.5095 1.0274 1.0294 1.0257 0.8626 0.8635 0.8588 121.65 121.871 121.145 1.2277 1.2287 1.2251 1.0247 1.0263 1.0189 141.009 141.45 140.588 99.07 99.414 98.76 1.423 1.4289 1.4212 0.8316 0.8332 0.8256 2013-03-06 1.2991 1.3071 1.2983 94.05 94.11 93.001 0.9477 0.9481 0.9403 1.5033 1.5155 1.5017 1.0315 1.0337 1.0256 0.864 0.865 0.8618 122.188 122.29 121.501 1.2309 1.232 1.2277 1.0238 1.0301 1.0233 141.396 141.51 140.705 99.231 99.31 98.795 1.4245 1.4266 1.4226 0.8285 0.835 0.8278 2013-03-07 1.3106 1.3118 1.2967 94.825 95.093 93.794 0.9425 0.9489 0.9406 1.5013 1.5082 1.4967 1.0288 1.0329 1.0281 0.873 0.8732 0.8634 124.29 124.584 121.77 1.2351 1.2362 1.2303 1.027 1.029 1.022 142.366 143.008 140.589 100.593 100.831 98.927 1.4151 1.427 1.4144 0.8283 0.8314 0.8257 2013-03-08 1.2997 1.3134 1.2954 96.081 96.566 94.794 0.952 0.9553 0.9412 1.4918 1.5047 1.4886 1.0295 1.0315 1.0233 0.871 0.8743 0.8673 124.876 125.971 123.79 1.2372 1.2391 1.2346 1.0228 1.0284 1.0207 143.339 144.765 142.29 100.906 101.867 100.07 1.4202 1.4261 1.4142 0.8206 0.8294 0.8183 2013-03-11 1.3031 1.3043 1.298 96.27 96.362 95.92 0.948 0.953 0.9472 1.4917 1.4944 1.4866 1.027 1.0295 1.0252 0.8736 0.8747 0.8703 125.505 125.592 124.58 1.2357 1.2381 1.234 1.0265 1.0278 1.0205 143.654 143.795 142.82 101.563 101.645 100.73 1.4143 1.4215 1.4128 0.8256 0.8267 0.8193 2013-03-12 1.3034 1.3074 1.2991 96.05 96.71 95.64 0.9465 0.9504 0.9435 1.4905 1.4919 1.4832 1.0261 1.0284 1.0246 0.8742 0.8794 0.8719 125.2 126.04 124.39 1.2342 1.2368 1.2323 1.0321 1.0335 1.0267 143.174 144.14 142.02 101.43 101.99 100.88 1.411 1.4157 1.4028 0.8254 0.8274 0.8232 2013-03-13 1.296 1.3065 1.2921 96.05 96.26 95.45 0.9522 0.953 0.943 1.4928 1.4981 1.4893 1.0272 1.0295 1.024 0.8681 0.8746 0.8659 124.5 125.22 124.15 1.2343 1.235 1.23 1.0308 1.0334 1.0279 143.378 143.82 142.65 100.86 101.48 100.71 1.4214 1.4222 1.4092 0.8261 0.8276 0.8216 2013-03-14 1.3005 1.3032 1.291 96.107 96.591 95.67 0.9466 0.9567 0.9444 1.5083 1.5119 1.4915 1.0222 1.0283 1.0209 0.8621 0.8687 0.8608 124.984 125.24 124.056 1.2311 1.237 1.2305 1.0378 1.0401 1.0288 144.958 145.02 143.027 101.515 101.53 100.53 1.4277 1.4317 1.4213 0.8213 0.8235 0.8162 2013-03-15 1.3059 1.3107 1.3 95.363 96.276 95.06 0.9392 0.9476 0.9379 1.5095 1.5177 1.5069 1.019 1.0231 1.0177 0.865 0.8659 0.8603 124.532 125.791 124.173 1.2265 1.2335 1.2252 1.0406 1.0413 1.0358 143.953 145.875 143.743 101.521 102.288 101.25 1.4177 1.4319 1.4171 0.8271 0.8278 0.8194 2013-03-18 1.2934 1.3071 1.2882 95.19 95.598 94.094 0.9461 0.9487 0.9392 1.5093 1.5146 1.5073 1.0223 1.025 1.0198 0.8568 0.8639 0.8532 123.1 124.665 121.588 1.2237 1.229 1.2169 1.0389 1.041 1.0339 143.65 144.377 142.346 100.613 101.113 99.61 1.4281 1.4361 1.4226 0.8243 0.8265 0.8218 2013-03-19 1.2888 1.297 1.2843 94.99 95.748 94.726 0.9472 0.9491 0.9423 1.5098 1.5144 1.5073 1.0272 1.0284 1.0213 0.8535 0.8586 0.8502 122.425 124.127 121.8 1.2206 1.2267 1.2174 1.0366 1.0406 1.0348 143.428 144.66 143.137 100.27 101.225 99.939 1.4302 1.433 1.4233 0.824 0.827 0.8221 2013-03-20 1.294 1.2978 1.2857 96.04 96.12 94.83 0.9439 0.9481 0.941 1.5109 1.5186 1.5027 1.0251 1.0276 1.0236 0.8565 0.8601 0.8519 124.33 124.5 122.04 1.2216 1.2235 1.2187 1.0379 1.0406 1.0356 145.156 145.26 143.24 101.75 101.91 100.08 1.426 1.4339 1.4208 0.8223 0.8254 0.8208 2013-03-21 1.2904 1.2955 1.288 94.898 96.107 94.555 0.9466 0.9482 0.9439 1.5177 1.5209 1.5089 1.024 1.0263 1.0201 0.8503 0.8574 0.8489 122.474 124.38 122.043 1.2217 1.2237 1.2195 1.0446 1.0458 1.0364 144.025 145.22 143.462 100.238 101.695 99.911 1.4364 1.4388 1.4256 0.8325 0.8345 0.8251 2013-03-22 1.2981 1.301 1.2889 94.43 95.13 94.2 0.9406 0.9475 0.94 1.5238 1.5248 1.5167 1.0232 1.0264 1.0217 0.852 0.8546 0.8485 122.64 123.46 121.48 1.2213 1.2237 1.22 1.0442 1.046 1.0422 143.95 144.55 143.04 100.41 101.01 99.51 1.4333 1.4389 1.4303 0.8355 0.8362 0.8308 2013-03-25 1.2857 1.3048 1.283 94.082 94.962 93.53 0.9483 0.9497 0.935 1.5181 1.5261 1.5142 1.0212 1.0235 1.0183 0.8469 0.8561 0.8457 120.97 123.854 120.088 1.2192 1.2254 1.2178 1.0461 1.0479 1.0433 142.844 144.79 141.884 99.19 101.364 98.568 1.4397 1.4409 1.4268 0.8355 0.8371 0.8333 2013-03-26 1.2858 1.289 1.2829 94.55 94.619 93.869 0.9481 0.9505 0.9471 1.5159 1.5208 1.5133 1.0166 1.0217 1.0157 0.8482 0.85 0.846 121.595 121.638 120.73 1.2192 1.2218 1.2185 1.0484 1.0497 1.0448 143.35 143.541 142.493 99.728 99.756 99.01 1.4374 1.4427 1.4356 0.8388 0.8393 0.8335 2013-03-27 1.277 1.2867 1.2751 94.425 94.909 94.01 0.9545 0.9553 0.9479 1.5124 1.5181 1.5089 1.0163 1.0195 1.0151 0.8443 0.8485 0.8434 120.569 121.87 119.925 1.2188 1.2198 1.2166 1.0446 1.0482 1.0414 142.803 143.815 142.03 98.925 99.95 98.518 1.4436 1.4453 1.436 0.8371 0.8397 0.8342 2013-03-28 1.2817 1.2845 1.2756 94.08 94.434 93.878 0.9495 0.9548 0.9466 1.519 1.52 1.5112 1.0158 1.0174 1.0142 0.8437 0.8476 0.8416 120.62 120.946 119.753 1.2172 1.2202 1.2155 1.0412 1.0457 1.0395 142.98 143.105 142.205 99.113 99.335 98.344 1.4423 1.4475 1.4371 0.8364 0.8385 0.8348 2013-03-29 1.2813 1.2837 1.2794 94.197 94.303 93.947 0.9494 0.9512 0.9482 1.5189 1.5219 1.5179 1.0176 1.0177 1.0155 0.8435 0.8443 0.8425 120.68 120.877 120.306 1.2167 1.2174 1.2158 1.0408 1.0427 1.0402 143.078 143.29 142.634 99.183 99.3 98.865 1.442 1.4452 1.4411 0.8359 0.8377 0.8354 2013-04-01 1.2845 1.2868 1.2771 93.359 94.374 93.14 0.9469 0.9527 0.9451 1.5229 1.5242 1.5178 1.0168 1.0183 1.0154 0.8434 0.8446 0.8411 119.927 120.876 119.508 1.2163 1.2178 1.2157 1.042 1.0431 1.0387 142.18 143.4 141.825 98.588 99.321 98.242 1.4421 1.4464 1.4397 0.8371 0.8385 0.8349 2013-04-02 1.2814 1.2878 1.2807 93.382 93.557 92.572 0.9492 0.9497 0.9445 1.5105 1.5259 1.5099 1.0148 1.0168 1.0125 0.848 0.8494 0.8426 119.662 120.149 119.144 1.2163 1.2179 1.2136 1.0445 1.0479 1.0425 141.059 142.079 140.93 98.37 98.701 97.965 1.4338 1.4426 1.4333 0.8414 0.8445 0.8374 2013-04-03 1.2846 1.2864 1.279 92.77 93.688 92.68 0.9446 0.952 0.9432 1.5146 1.5158 1.5076 1.0148 1.0155 1.012 0.8481 0.8495 0.8469 119.22 120.179 119.07 1.2136 1.2183 1.2128 1.0453 1.0497 1.0447 140.563 141.531 140.382 98.234 98.705 98.08 1.4309 1.4378 1.4298 0.8415 0.8448 0.8398 2013-04-04 1.2933 1.2949 1.2744 96.17 96.41 92.737 0.9397 0.9526 0.9378 1.5234 1.5245 1.5034 1.0123 1.0166 1.0101 0.8488 0.8521 0.8434 124.368 124.579 119.161 1.2154 1.2172 1.2131 1.0427 1.0491 1.0381 146.49 146.701 140.402 102.319 102.502 98.148 1.4318 1.4397 1.4273 0.8418 0.8437 0.8363 2013-04-05 1.301 1.304 1.29 97.77 97.83 95.75 0.933 0.9434 0.9312 1.5336 1.5364 1.52 1.0162 1.0236 1.0125 0.8482 0.8515 0.8473 127.2 127.289 123.881 1.2139 1.2172 1.2133 1.0394 1.0438 1.0354 149.946 150.04 145.97 104.779 104.836 101.942 1.4309 1.4345 1.4254 0.8431 0.8436 0.8372 2013-04-08 1.2995 1.3038 1.2966 99.312 99.326 97.86 0.9356 0.9363 0.9326 1.5245 1.5351 1.5241 1.0177 1.0214 1.0151 0.8524 0.8532 0.8464 129.059 129.24 127.03 1.2163 1.2172 1.213 1.0405 1.0424 1.0349 151.4 151.79 149.96 106.096 106.228 104.62 1.4268 1.4342 1.425 0.8454 0.8475 0.8406 2013-04-09 1.3083 1.3103 1.3005 99 99.662 98.593 0.9323 0.9366 0.9306 1.5319 1.5342 1.5251 1.0159 1.0176 1.0135 0.8538 0.856 0.8507 129.525 130.094 128.442 1.22 1.2212 1.2168 1.0485 1.0509 1.0406 151.664 152.385 150.578 106.166 106.684 105.445 1.4285 1.4335 1.4227 0.8518 0.8537 0.8459 2013-04-10 1.3057 1.3122 1.3049 99.77 99.873 98.916 0.933 0.9336 0.9296 1.5324 1.5343 1.5293 1.0142 1.0168 1.0135 0.8521 0.856 0.8515 130.29 130.505 129.408 1.2187 1.2203 1.2173 1.0543 1.0552 1.0476 152.909 153.005 151.39 106.93 107.1 106.11 1.4297 1.4304 1.4239 0.8575 0.8577 0.8516 2013-04-11 1.3111 1.3138 1.3044 99.82 99.947 99.098 0.9301 0.934 0.9276 1.5391 1.5411 1.5319 1.0099 1.0157 1.0079 0.8518 0.8535 0.8503 130.879 131.12 129.71 1.2197 1.2204 1.218 1.0546 1.0582 1.0501 153.647 153.867 152.31 107.28 107.443 106.437 1.4319 1.4335 1.4279 0.8632 0.8677 0.8573 2013-04-12 1.3103 1.3126 1.3036 98.561 99.8 98.45 0.9282 0.9333 0.9277 1.5352 1.541 1.5339 1.0139 1.0145 1.0094 0.8534 0.8537 0.8487 129.15 130.81 128.988 1.2164 1.2202 1.2153 1.0507 1.0561 1.0479 151.3 153.55 151.147 106.152 107.22 105.99 1.4251 1.4338 1.425 0.8584 0.8643 0.8543 2013-04-15 1.304 1.3131 1.3032 97.182 98.712 97.05 0.9317 0.9327 0.9262 1.5282 1.5385 1.527 1.0255 1.0257 1.0129 0.8532 0.8551 0.8515 126.735 129.319 126.531 1.215 1.2173 1.214 1.0313 1.0524 1.0306 148.511 151.735 148.254 104.286 106.319 104.092 1.4238 1.4285 1.4209 0.8393 0.8581 0.8393 2013-04-16 1.3184 1.3201 1.3028 97.56 98.16 96.53 0.9218 0.9327 0.9205 1.5373 1.5379 1.5274 1.0204 1.0257 1.0199 0.8576 0.8601 0.8523 128.64 129.02 125.95 1.2155 1.2171 1.214 1.0392 1.0397 1.0308 149.989 150.3 147.61 105.82 106.05 103.71 1.4169 1.4255 1.4143 0.85 0.8508 0.8413 2013-04-17 1.3022 1.32 1.2999 97.841 98.432 97.19 0.9328 0.9339 0.9207 1.5237 1.537 1.5215 1.0266 1.0294 1.021 0.8544 0.8637 0.8531 127.405 129.741 126.39 1.2148 1.2165 1.2137 1.0295 1.0394 1.0274 149.085 151.17 148.09 104.869 106.765 104.09 1.4216 1.4229 1.4075 0.8441 0.8509 0.8423 2013-04-18 1.3053 1.3096 1.3021 98.171 98.532 97.637 0.9318 0.9335 0.9286 1.5278 1.5313 1.5218 1.0257 1.0277 1.0226 0.8542 0.8574 0.8528 128.151 128.784 127.163 1.2167 1.2169 1.215 1.0299 1.0339 1.027 149.98 150.486 148.74 105.3 105.93 104.608 1.424 1.4255 1.4178 0.8415 0.8469 0.8399 2013-04-19 1.3053 1.3129 1.3048 99.51 99.69 98.11 0.9336 0.9343 0.9277 1.5229 1.5368 1.5225 1.0265 1.027 1.0231 0.8573 0.8582 0.8504 129.85 130.25 128.06 1.2186 1.2191 1.2164 1.0257 1.0358 1.0261 151.56 152.53 149.89 106.58 106.97 105.23 1.4215 1.4315 1.4196 0.8419 0.8491 0.8403 2013-04-22 1.306 1.3092 1.3014 99.343 99.884 98.988 0.9342 0.9371 0.9309 1.5286 1.5292 1.5204 1.0259 1.0285 1.0244 0.8544 0.8591 0.854 129.77 130.67 128.906 1.2205 1.2208 1.2178 1.0271 1.0308 1.0233 151.871 152.24 150.905 106.3 107.195 105.624 1.4282 1.4285 1.4183 0.8418 0.8461 0.8385 2013-04-23 1.2996 1.3084 1.297 99.455 99.532 98.47 0.945 0.9457 0.9328 1.5243 1.5298 1.5197 1.0264 1.0285 1.0248 0.8527 0.857 0.8508 129.276 129.824 127.845 1.2285 1.2286 1.2191 1.026 1.0272 1.0221 151.598 152.025 149.94 105.219 106.36 104.613 1.4408 1.4416 1.424 0.8408 0.8429 0.8361 2013-04-24 1.3018 1.3034 1.2956 99.48 99.76 99.2 0.9467 0.9499 0.9444 1.5269 1.5287 1.5227 1.0253 1.0278 1.0243 0.8526 0.854 0.8494 129.53 129.8 128.79 1.2325 1.2343 1.2266 1.0284 1.0296 1.0232 151.9 152.3 151.11 105.06 105.53 104.5 1.4456 1.4506 1.4392 0.8479 0.8487 0.8414 2013-04-25 1.3005 1.3093 1.2988 99.26 99.56 98.97 0.9447 0.9484 0.942 1.543 1.548 1.5266 1.0206 1.0259 1.0182 0.8427 0.8533 0.8406 129.15 129.9 129 1.2287 1.2349 1.2279 1.0288 1.0339 1.0272 153.221 153.77 151.44 105.11 105.28 104.66 1.4578 1.4645 1.4454 0.8504 0.8563 0.8469 2013-04-26 1.303 1.3048 1.2988 98.08 99.413 97.548 0.9426 0.9456 0.9399 1.5485 1.5499 1.5417 1.0164 1.0214 1.0154 0.8415 0.8448 0.8395 127.807 129.377 127.125 1.2281 1.2312 1.2246 1.0283 1.0336 1.0263 151.895 153.43 151.1 104.042 105.222 103.639 1.4596 1.4613 1.4556 0.8487 0.8539 0.8476 2013-04-29 1.3093 1.3117 1.3032 97.99 99.413 97.355 0.9374 0.943 0.9352 1.5493 1.5546 1.5478 1.0109 1.0171 1.0106 0.8451 0.846 0.8405 128.31 128.592 127.06 1.2277 1.2307 1.226 1.0353 1.0358 1.0273 151.806 152.215 151.062 104.503 105.222 103.404 1.4525 1.462 1.45 0.857 0.8577 0.8483 2013-04-30 1.3167 1.3186 1.3055 97.52 98.13 97.01 0.9297 0.9384 0.9279 1.5533 1.5568 1.5468 1.0073 1.0123 1.0055 0.8477 0.8485 0.8425 128.41 128.52 127.21 1.2242 1.2277 1.2226 1.0367 1.0384 1.0329 151.45 151.99 150.76 104.89 104.99 103.89 1.444 1.454 1.4413 0.8569 0.8586 0.8543 2013-05-01 1.3175 1.3243 1.3161 97.292 97.676 97.029 0.9275 0.9309 0.9247 1.5558 1.5606 1.5527 1.0082 1.01 1.005 0.8468 0.8497 0.8459 128.17 128.928 127.858 1.2223 1.2263 1.2219 1.0269 1.0382 1.0264 151.359 152.236 150.867 104.88 105.315 104.451 1.4433 1.449 1.4415 0.8487 0.8582 0.8478 2013-05-02 1.3063 1.3218 1.3036 97.92 98.39 97.09 0.9347 0.9363 0.9266 1.5536 1.5591 1.5494 1.008 1.0089 1.0056 0.8407 0.8482 0.8401 127.95 129.9 127.5 1.2211 1.2259 1.219 1.025 1.0285 1.0218 152.15 153.25 150.96 104.79 106.01 104.44 1.4521 1.4528 1.4418 0.8495 0.8512 0.8454 2013-05-03 1.3114 1.3159 1.3032 98.99 99.27 97.9 0.9354 0.9399 0.9307 1.5563 1.5602 1.5479 1.0073 1.0132 1.0071 0.8426 0.845 0.8403 129.87 130.34 127.9 1.227 1.2275 1.2213 1.0315 1.0323 1.0239 154.106 154.68 152.08 105.8 106.38 104.71 1.4564 1.4587 1.4469 0.8543 0.8549 0.8472 2013-05-06 1.3075 1.3141 1.305 99.36 99.45 99.06 0.9383 0.9397 0.9338 1.5542 1.5598 1.5519 1.0068 1.0096 1.0059 0.8412 0.844 0.8398 129.92 130.41 129.57 1.2266 1.2291 1.2256 1.0251 1.0316 1.022 154.432 154.79 154.08 105.86 106.15 105.66 1.4582 1.46 1.4517 0.8516 0.8557 0.8481 2013-05-07 1.3073 1.3132 1.3067 99.01 99.434 98.818 0.9404 0.9437 0.9367 1.5479 1.5552 1.5445 1.0045 1.0083 1.0032 0.8445 0.8467 0.8409 129.433 130.365 129.241 1.2295 1.2337 1.2255 1.0178 1.0253 1.0152 153.257 154.5 152.945 105.263 105.945 104.967 1.4558 1.4661 1.4531 0.8454 0.8524 0.8422 2013-05-08 1.3154 1.3194 1.3072 98.956 99.151 98.58 0.935 0.9411 0.9331 1.5537 1.5592 1.5471 1.0031 1.0059 1.0014 0.8465 0.849 0.8444 130.17 130.421 128.999 1.2302 1.2348 1.2295 1.0161 1.0209 1.0155 153.73 154.121 152.74 105.792 105.882 104.863 1.4534 1.4578 1.4507 0.8383 0.8461 0.8361 2013-05-09 1.3033 1.3177 1.3008 100.606 100.791 98.62 0.9477 0.9499 0.9333 1.5446 1.5587 1.5423 1.007 1.0089 1.0012 0.8436 0.8474 0.8429 131.116 131.767 129.579 1.2356 1.2408 1.228 1.0077 1.0254 1.0043 155.394 155.815 153.274 106.09 106.375 105.34 1.4645 1.469 1.4511 0.8371 0.8481 0.8348 2013-05-10 1.2985 1.3051 1.2933 101.57 101.984 100.543 0.9571 0.9628 0.9477 1.5359 1.5458 1.531 1.011 1.0152 1.006 0.8453 0.8461 0.843 131.902 132.259 131.078 1.2428 1.246 1.2363 1.001 1.0095 0.9958 156.03 156.685 155.333 106.11 106.6 105.73 1.4699 1.4771 1.4638 0.83 0.8418 0.8256 2013-05-13 1.2968 1.2999 1.294 101.87 102.15 101.51 0.9577 0.9596 0.9544 1.5296 1.5385 1.5275 1.0109 1.0133 1.008 0.8477 0.8494 0.8432 132.1 132.4 131.58 1.2421 1.2445 1.2391 0.9953 1.0015 0.9937 155.818 156.78 155.54 106.34 106.63 105.96 1.4652 1.4743 1.4624 0.8245 0.8318 0.8225 2013-05-14 1.294 1.3029 1.2929 102.26 102.4 101.26 0.9653 0.9661 0.9522 1.5227 1.5331 1.5217 1.0172 1.0179 1.0089 0.8497 0.8516 0.8471 132.33 132.77 131.47 1.2493 1.2502 1.2387 0.9889 1.0004 0.9874 155.72 156.06 154.98 105.91 106.65 105.78 1.4699 1.4711 1.4582 0.8188 0.8302 0.8176 2013-05-15 1.288 1.2942 1.2841 102.337 102.763 101.85 0.9659 0.9748 0.9643 1.5221 1.5272 1.5171 1.0171 1.0219 1.0164 0.8462 0.85 0.8433 131.82 132.439 131.174 1.2442 1.2525 1.242 0.9881 0.9919 0.9852 155.76 156.468 155.374 105.93 106.049 105.31 1.4703 1.482 1.4684 0.8224 0.8256 0.8175 2013-05-16 1.2874 1.293 1.2847 102.293 102.682 101.82 0.9636 0.9708 0.9576 1.5269 1.5322 1.5198 1.0189 1.0207 1.0145 0.8431 0.8464 0.8418 131.713 132.206 131.29 1.2408 1.2483 1.2382 0.9804 0.9913 0.9795 156.194 156.508 155.377 106.129 106.375 105.475 1.4715 1.4762 1.4664 0.8152 0.8272 0.8134 2013-05-17 1.2829 1.289 1.2797 103.29 103.31 102.08 0.9729 0.9761 0.9637 1.5162 1.5281 1.5158 1.0291 1.0313 1.0181 0.846 0.8462 0.843 132.51 132.56 131.3 1.2481 1.2493 1.2416 0.9722 0.983 0.9712 156.599 156.7 155.69 106.15 106.26 105.31 1.4748 1.4808 1.4693 0.8061 0.8177 0.8056 2013-05-20 1.2887 1.2901 1.282 102.335 103.115 102.03 0.9661 0.9735 0.9645 1.5259 1.5281 1.5167 1.0234 1.0296 1.0215 0.8444 0.847 0.8438 131.879 132.33 131.03 1.2454 1.2481 1.2431 0.9817 0.9827 0.9735 156.18 156.44 155.095 105.875 106.101 105.155 1.4748 1.4767 1.4698 0.8169 0.8179 0.8076 2013-05-21 1.2909 1.2934 1.2839 102.48 102.884 102.078 0.9697 0.9751 0.9655 1.5155 1.5277 1.5111 1.0262 1.0321 1.0236 0.8518 0.852 0.8441 132.295 132.403 131.68 1.2519 1.2529 1.2447 0.9807 0.9842 0.975 155.32 156.55 155.11 105.656 106.24 105.41 1.4697 1.4783 1.4657 0.8163 0.8213 0.8114 2013-05-22 1.2852 1.2998 1.283 102.766 103.736 102.353 0.9774 0.9839 0.968 1.5043 1.5174 1.5018 1.0377 1.0388 1.025 0.8542 0.859 0.8517 132.08 133.807 131.96 1.2562 1.265 1.2516 0.9693 0.9828 0.966 154.58 156.11 154.479 105.12 106.24 104.979 1.4704 1.4782 1.4608 0.8065 0.8204 0.8053 2013-05-23 1.2931 1.2956 1.2822 101.86 103.572 100.835 0.9687 0.9818 0.9631 1.5103 1.5128 1.5015 1.0302 1.0393 1.0284 0.8563 0.8571 0.8533 131.747 132.872 129.945 1.2529 1.2596 1.2419 0.9739 0.9778 0.9594 153.867 155.589 151.797 105.138 105.517 104.058 1.463 1.4752 1.4505 0.8143 0.8171 0.8007 2013-05-24 1.2934 1.2993 1.2905 101.1 102.59 100.67 0.9611 0.9717 0.9589 1.5124 1.5143 1.5065 1.0323 1.0356 1.0301 0.8551 0.86 0.8534 130.76 132.56 130.09 1.2432 1.2548 1.2404 0.9651 0.9741 0.9634 152.896 154.76 152.25 105.16 105.78 104.62 1.4538 1.4656 1.4505 0.8089 0.8129 0.8067 2013-05-27 1.2929 1.295 1.2916 101.15 101.805 100.748 0.9645 0.9646 0.9593 1.5091 1.5156 1.5084 1.0328 1.0334 1.0304 0.8566 0.8572 0.8536 130.76 131.58 130.273 1.2471 1.2473 1.241 0.9626 0.967 0.9615 152.646 153.81 152.45 104.857 105.4 104.79 1.4555 1.457 1.4516 0.8081 0.8115 0.8062 2013-05-28 1.2871 1.295 1.285 102.14 102.52 101.051 0.9737 0.9765 0.9626 1.5054 1.5134 1.5031 1.0393 1.0397 1.032 0.8548 0.8562 0.8539 131.45 132.148 130.67 1.2536 1.2555 1.2448 0.9635 0.9696 0.9597 153.76 154.649 152.66 104.851 105.552 104.63 1.4663 1.4687 1.4545 0.8094 0.8128 0.8062 2013-05-29 1.2936 1.2977 1.2838 101.121 102.55 100.71 0.962 0.979 0.9597 1.5127 1.5145 1.5008 1.0353 1.042 1.0346 0.8551 0.8595 0.8542 130.832 131.706 130.387 1.245 1.2572 1.2432 0.9638 0.967 0.9528 152.97 154.05 152.21 105.074 105.195 104.429 1.4558 1.4697 1.4498 0.8131 0.8162 0.805 2013-05-30 1.3047 1.3061 1.2934 100.693 101.83 100.47 0.9529 0.9651 0.9524 1.5232 1.5237 1.511 1.03 1.0388 1.0292 0.8564 0.8599 0.8546 131.38 131.946 130.2 1.2434 1.2493 1.2421 0.967 0.9697 0.9582 153.389 154.024 152.275 105.655 105.99 104.725 1.4514 1.4593 1.4483 0.808 0.8125 0.8002 2013-05-31 1.2997 1.3059 1.2942 100.48 101.31 100.224 0.9567 0.9625 0.9512 1.5193 1.5239 1.5137 1.0359 1.0381 1.0294 0.8554 0.858 0.8526 130.59 132.077 130.24 1.2435 1.2461 1.2377 0.9573 0.9685 0.9548 152.65 154.245 152.388 105.012 106.115 104.825 1.4536 1.4586 1.4459 0.7946 0.8103 0.7937 2013-06-03 1.3074 1.3107 1.2954 99.466 100.75 98.86 0.9467 0.9625 0.9407 1.5317 1.5375 1.5182 1.0275 1.0385 1.0259 0.8535 0.8553 0.8499 130.035 130.988 129.488 1.2376 1.2487 1.233 0.9758 0.9792 0.9592 152.38 153.26 151.893 105.03 105.34 103.929 1.4503 1.4666 1.4457 0.8084 0.8118 0.7943 2013-06-04 1.3082 1.3101 1.3041 100.119 100.44 99.337 0.9469 0.952 0.9452 1.5306 1.5343 1.5271 1.0343 1.0361 1.0278 0.8546 0.856 0.8522 130.98 131.409 129.933 1.2387 1.2429 1.2374 0.9644 0.9769 0.9608 153.27 153.81 152.338 105.71 105.919 104.92 1.4495 1.4555 1.4461 0.8007 0.8105 0.7966 2013-06-05 1.3094 1.3116 1.3052 99.16 100.48 98.962 0.9416 0.9494 0.9395 1.5404 1.5409 1.5291 1.0343 1.038 1.0322 0.8499 0.8548 0.8489 129.87 131.405 129.57 1.233 1.2412 1.2307 0.9539 0.9657 0.9509 152.74 153.76 152.396 105.307 105.88 104.94 1.4505 1.4581 1.4469 0.7945 0.8061 0.7924 2013-06-06 1.3243 1.3305 1.3075 97.06 99.5 95.913 0.9296 0.9439 0.9226 1.5606 1.5683 1.5382 1.026 1.0367 1.0197 0.8486 0.8521 0.8475 128.568 130.727 127.504 1.2312 1.2388 1.2272 0.9607 0.9673 0.9435 151.475 153.587 150.366 104.408 105.735 103.758 1.4508 1.4569 1.4459 0.8028 0.8102 0.7903 2013-06-07 1.3216 1.3285 1.3191 97.46 97.81 94.99 0.9364 0.9374 0.9248 1.5551 1.5618 1.5487 1.0194 1.0288 1.0167 0.8498 0.8527 0.8482 128.81 129.18 126.16 1.2376 1.238 1.2266 0.9502 0.9574 0.9429 151.556 152.04 148.18 104.06 104.8 102.63 1.4562 1.4564 1.4403 0.7886 0.8016 0.7854 2013-06-10 1.3257 1.3269 1.3178 98.756 99.31 97.44 0.933 0.9419 0.9318 1.5578 1.5587 1.5493 1.0186 1.0224 1.0165 0.8509 0.8518 0.8487 130.917 131.108 128.65 1.237 1.2419 1.2355 0.9473 0.9481 0.9394 153.838 154.205 151.21 105.823 105.88 104.08 1.4535 1.4606 1.4521 0.7905 0.7923 0.7822 2013-06-11 1.3305 1.3315 1.3232 96.02 99.02 95.58 0.9249 0.9349 0.9222 1.5642 1.5646 1.5521 1.0189 1.0251 1.0176 0.8505 0.8551 0.8499 127.782 131.24 127.102 1.2311 1.2387 1.2242 0.9451 0.9469 0.9326 150.217 154.18 149.34 103.769 106.02 103.42 1.4473 1.4548 1.4393 0.7882 0.7911 0.7761 2013-06-12 1.3332 1.336 1.3264 95.77 97.04 95.142 0.9204 0.9287 0.917 1.5676 1.57 1.5634 1.0214 1.0217 1.0149 0.8505 0.8514 0.8467 127.68 129.343 127.038 1.2273 1.2335 1.2253 0.9468 0.9564 0.9416 150.13 152.029 149.31 104.031 104.911 103.579 1.4429 1.4546 1.4391 0.7959 0.8023 0.7866 2013-06-13 1.3366 1.339 1.3278 94.806 95.98 93.795 0.9214 0.9259 0.9131 1.57 1.5737 1.5641 1.0171 1.0226 1.0146 0.8512 0.8541 0.8474 126.718 127.985 125.001 1.2313 1.2317 1.2223 0.9619 0.9623 0.943 148.866 150.465 147.119 102.896 104.205 101.826 1.4465 1.4503 1.4311 0.8071 0.8072 0.7896 2013-06-14 1.3348 1.3373 1.3295 94.374 95.76 93.987 0.9213 0.927 0.9197 1.5705 1.5719 1.5616 1.0171 1.0187 1.0135 0.8496 0.8535 0.8488 125.973 127.95 125.181 1.2298 1.2338 1.2278 0.9589 0.9656 0.9568 148.216 150.4 147.428 102.407 103.756 101.865 1.4471 1.451 1.4428 0.8059 0.8136 0.8038 2013-06-17 1.3376 1.3379 1.3319 94.46 95.25 94.12 0.9222 0.9272 0.9206 1.5733 1.5751 1.568 1.0176 1.0205 1.0146 0.85 0.8508 0.8473 126.36 126.92 125.6 1.2335 1.2363 1.2297 0.9571 0.9641 0.9508 148.617 149.45 147.92 102.42 103.08 102.06 1.4509 1.456 1.4469 0.8005 0.8099 0.7963 2013-06-18 1.3401 1.3415 1.3325 95.212 95.79 94.441 0.9195 0.9263 0.9175 1.5647 1.5723 1.5563 1.0202 1.0217 1.0177 0.8563 0.8585 0.85 127.606 128.08 126.225 1.2325 1.2357 1.2292 0.9483 0.9574 0.9437 148.985 149.59 148.45 103.52 103.979 102.415 1.4385 1.4515 1.4337 0.7997 0.8021 0.7946 2013-06-19 1.3277 1.3417 1.326 96.723 96.96 94.837 0.9302 0.9322 0.9177 1.5493 1.5677 1.5479 1.0266 1.0287 1.0171 0.8569 0.858 0.8541 128.428 128.75 127.06 1.2352 1.2363 1.2305 0.9328 0.9556 0.9306 149.84 150.305 148.24 103.953 104.281 103.12 1.4413 1.4434 1.4361 0.788 0.8053 0.7855 2013-06-20 1.322 1.3302 1.3161 97.354 98.32 96.206 0.9273 0.9361 0.9252 1.5487 1.5494 1.5414 1.0374 1.0394 1.0268 0.8535 0.8591 0.8515 128.7 129.902 127.8 1.226 1.235 1.224 0.9192 0.9313 0.916 150.77 151.95 148.882 104.977 105.72 103.59 1.4361 1.4463 1.4324 0.7749 0.7894 0.771 2013-06-21 1.3124 1.3254 1.3097 97.716 98.17 96.867 0.9343 0.9368 0.9243 1.5422 1.553 1.5365 1.0452 1.0488 1.036 0.8509 0.8552 0.8506 128.241 129.696 127.76 1.2262 1.2285 1.2243 0.9233 0.9259 0.9181 150.696 151.925 149.718 104.565 105.615 104.079 1.4409 1.4421 1.4335 0.7764 0.7807 0.7696 2013-06-24 1.313 1.3144 1.3058 97.59 98.73 97.21 0.9326 0.9381 0.9311 1.5446 1.5465 1.534 1.0476 1.0556 1.0454 0.85 0.8542 0.848 128.15 129.21 127.28 1.2246 1.228 1.2216 0.9277 0.9299 0.9148 150.747 151.75 149.72 104.63 105.3 104.09 1.4406 1.4429 1.4333 0.7766 0.779 0.7684 2013-06-25 1.3097 1.3151 1.3065 97.77 98.07 96.96 0.9373 0.9407 0.932 1.5434 1.5477 1.5398 1.0506 1.0547 1.0456 0.8486 0.8512 0.8472 128.07 128.67 127.29 1.2276 1.2296 1.2236 0.9267 0.9297 0.9198 150.911 151.47 149.69 104.3 105 103.88 1.4463 1.4512 1.439 0.7739 0.7795 0.7697 2013-06-26 1.3012 1.3087 1.2983 97.79 98.24 97.24 0.9424 0.9443 0.9373 1.5325 1.544 1.5296 1.0471 1.0528 1.0456 0.849 0.85 0.8467 127.26 128.46 126.54 1.2264 1.2283 1.2237 0.9278 0.9345 0.9236 149.85 151.39 149.22 103.74 104.61 103.17 1.4443 1.448 1.4427 0.779 0.7861 0.7719 2013-06-27 1.3043 1.3057 1.2999 98.261 98.573 97.564 0.9444 0.9488 0.9407 1.5264 1.5346 1.5201 1.0473 1.0504 1.0422 0.8544 0.856 0.8492 128.165 128.39 127.049 1.232 1.2338 1.2259 0.928 0.934 0.9258 149.981 150.615 149.398 104.034 104.23 103.426 1.4417 1.4461 1.439 0.7787 0.7853 0.777 2013-06-28 1.3015 1.3103 1.2989 99.18 99.48 98.378 0.9446 0.9475 0.941 1.5208 1.5279 1.5164 1.0511 1.0553 1.0453 0.8557 0.859 0.8542 129.086 129.651 128.26 1.2296 1.2354 1.2281 0.9141 0.9287 0.9111 150.823 151.174 150.13 104.96 105.165 104.08 1.4365 1.4447 1.4336 0.7748 0.7822 0.7705 2013-07-01 1.3063 1.3068 1.3006 99.555 99.858 99.183 0.9449 0.9503 0.9437 1.5215 1.5249 1.5184 1.0497 1.0534 1.0484 0.8585 0.8591 0.8544 130.05 130.26 129.07 1.2344 1.2377 1.229 0.9228 0.9253 0.9113 151.47 152.07 150.83 105.337 105.488 104.833 1.4378 1.4464 1.4348 0.7807 0.783 0.7713 2013-07-02 1.2978 1.308 1.2964 100.58 100.726 99.512 0.9504 0.953 0.9446 1.516 1.5238 1.5136 1.054 1.0578 1.0495 0.856 0.8594 0.8551 130.54 131.123 129.78 1.2335 1.2382 1.2323 0.9145 0.925 0.9128 152.47 152.74 151.23 105.8 106.1 105.13 1.4407 1.4433 1.4372 0.7746 0.7829 0.7734 2013-07-03 1.3006 1.3032 1.2923 99.94 100.856 99.24 0.9466 0.9523 0.9445 1.5281 1.5304 1.5131 1.051 1.0564 1.0505 0.8511 0.8575 0.8479 129.983 130.861 128.607 1.2314 1.2348 1.2278 0.9088 0.919 0.9052 152.7 153.02 151.249 105.55 106.07 104.537 1.4466 1.4507 1.4379 0.7775 0.779 0.7711 2013-07-04 1.2918 1.3023 1.2884 100.02 100.159 99.494 0.9559 0.9584 0.946 1.5075 1.5283 1.5055 1.0518 1.0557 1.047 0.8569 0.8632 0.851 129.21 130.202 128.839 1.2349 1.2363 1.2307 0.9161 0.9181 0.9073 150.77 152.87 150.307 104.6 105.7 104.41 1.4412 1.4488 1.4283 0.7841 0.7858 0.7764 2013-07-05 1.283 1.2917 1.2805 101.135 101.224 99.893 0.963 0.966 0.9562 1.4902 1.5077 1.4858 1.0569 1.0609 1.0507 0.8608 0.8629 0.8565 129.75 129.87 128.585 1.2357 1.2378 1.2329 0.9059 0.918 0.9045 150.713 151.12 149.503 104.99 105.07 104.099 1.4351 1.4421 1.4302 0.7713 0.7842 0.7686 2013-07-08 1.2868 1.2882 1.2812 100.99 101.55 100.77 0.9634 0.9666 0.9621 1.4951 1.4966 1.4859 1.0559 1.0585 1.0541 0.8607 0.8628 0.8599 129.966 130.192 129.406 1.2398 1.2415 1.2358 0.9124 0.9145 0.9041 150.987 151.06 150.211 104.81 105.13 104.555 1.4405 1.4413 1.4346 0.7804 0.782 0.7696 2013-07-09 1.2787 1.2898 1.2754 100.97 101.3 100.77 0.9723 0.9751 0.9634 1.4875 1.4981 1.4812 1.0523 1.0574 1.051 0.8594 0.867 0.8584 129.12 130.57 128.7 1.2432 1.2466 1.2399 0.9192 0.9201 0.9083 150.215 151.61 149.77 103.83 105.05 103.56 1.4464 1.4492 1.4357 0.786 0.7885 0.7764 2013-07-10 1.3023 1.3024 1.2761 99.52 101.22 99.35 0.9534 0.9745 0.9531 1.493 1.4994 1.4846 1.0505 1.054 1.0444 0.863 0.8637 0.8575 129.137 129.387 128.025 1.2437 1.2452 1.2402 0.9114 0.9234 0.9092 149.59 150.37 148.79 103.81 104.133 103.121 1.4407 1.449 1.4374 0.7795 0.7883 0.7778 2013-07-11 1.3114 1.3207 1.3002 98.846 99.66 98.259 0.945 0.9548 0.9406 1.5205 1.5222 1.5034 1.0379 1.0448 1.0326 0.8621 0.8694 0.861 129.623 130.432 128.65 1.2392 1.2457 1.2368 0.9182 0.9305 0.9118 150.29 150.633 148.955 104.58 104.94 103.77 1.4368 1.4392 1.4273 0.7837 0.7969 0.7763 2013-07-12 1.3065 1.31 1.2999 99.36 99.694 98.677 0.946 0.9514 0.9437 1.5103 1.5189 1.5075 1.0393 1.0404 1.0356 0.8649 0.8652 0.861 129.812 129.953 128.895 1.2359 1.2408 1.2344 0.9057 0.9188 0.8999 150.06 150.666 149.422 105.016 105.172 104.152 1.4287 1.4393 1.4273 0.7786 0.7878 0.7751 2013-07-15 1.3069 1.3078 1.2995 99.328 100.48 99.05 0.9456 0.9534 0.9445 1.5107 1.5129 1.5023 1.0427 1.0434 1.0373 0.8653 0.8665 0.8627 129.818 129.953 128.895 1.236 1.2408 1.2344 0.9059 0.9188 0.8999 149.996 150.666 149.422 105.008 105.172 104.152 1.4282 1.4393 1.4273 0.7786 0.7878 0.7751 2013-07-16 1.316 1.3174 1.3052 99.096 100.069 98.896 0.9395 0.9496 0.938 1.5151 1.5169 1.5045 1.0369 1.0442 1.0364 0.8685 0.871 0.8643 130.43 130.816 130.02 1.2367 1.2404 1.2356 0.9256 0.9261 0.9087 150.151 151.12 149.809 105.45 105.695 104.919 1.4234 1.4347 1.4209 0.7896 0.79 0.7793 2013-07-17 1.3119 1.3177 1.3082 99.604 99.944 99.05 0.9409 0.9446 0.9358 1.5212 1.5267 1.5079 1.0415 1.0439 1.0352 0.8623 0.8711 0.8612 130.665 131.364 130.282 1.2345 1.2376 1.232 0.9225 0.9292 0.9192 151.514 152.05 149.935 105.83 106.336 105.349 1.4314 1.4327 1.4196 0.7893 0.7939 0.7839 2013-07-18 1.3105 1.3126 1.3066 100.46 100.653 99.468 0.9445 0.9478 0.9406 1.5217 1.5242 1.5158 1.0381 1.0439 1.0373 0.8612 0.8647 0.8598 131.66 131.891 130.541 1.238 1.2391 1.2344 0.9165 0.9244 0.9138 152.85 153.11 151.385 106.32 106.47 105.726 1.4372 1.4396 1.43 0.7898 0.7913 0.7849 2013-07-19 1.3142 1.3154 1.309 100.32 100.87 99.81 0.9405 0.9462 0.939 1.5269 1.5282 1.5197 1.0363 1.0393 1.0351 0.8604 0.863 0.8586 131.85 132.1 131.23 1.236 1.2386 1.2347 0.9195 0.9235 0.9156 153.17 153.38 152.18 106.64 106.78 106.06 1.436 1.4397 1.4337 0.7942 0.799 0.7887 2013-07-22 1.3186 1.3218 1.3136 99.54 100.71 99.278 0.936 0.9415 0.9323 1.5351 1.5384 1.5259 1.0338 1.037 1.0319 0.8588 0.8612 0.8579 131.24 132.43 131.105 1.2344 1.2378 1.2322 0.9244 0.927 0.9175 152.805 153.83 152.38 106.292 107.06 106.134 1.4374 1.4414 1.4341 0.7958 0.7974 0.7893 2013-07-23 1.3221 1.3239 1.3162 99.49 100.18 99.15 0.9351 0.9407 0.9338 1.5377 1.5394 1.5324 1.0286 1.0349 1.0273 0.8597 0.8608 0.8579 131.54 132.02 130.78 1.2363 1.2395 1.2342 0.9289 0.9298 0.922 152.98 153.67 152.35 106.37 106.61 105.95 1.4378 1.443 1.4368 0.7993 0.8009 0.7952 2013-07-24 1.3196 1.3256 1.3176 100.314 100.438 99.389 0.9376 0.9389 0.934 1.5312 1.539 1.5287 1.0317 1.0325 1.0259 0.8616 0.863 0.8588 132.389 132.738 131.383 1.2371 1.2403 1.2356 0.9158 0.9318 0.913 153.58 154.05 152.833 106.968 107.185 106.33 1.4355 1.4405 1.4346 0.7931 0.8013 0.7902 2013-07-25 1.3291 1.3296 1.3166 99.037 100.453 98.877 0.9282 0.9395 0.9284 1.5424 1.5435 1.5264 1.0256 1.0319 1.0253 0.8616 0.8644 0.8588 131.636 132.49 131.46 1.2339 1.2385 1.2336 0.9276 0.9281 0.9129 152.766 153.828 152.266 106.675 107.08 106.309 1.4319 1.4406 1.4289 0.8093 0.8105 0.7959 2013-07-26 1.3281 1.33 1.3251 98.192 99.389 97.94 0.9282 0.9305 0.9262 1.5389 1.5417 1.5354 1.027 1.0303 1.026 0.8629 0.864 0.8605 130.41 131.911 130.088 1.2329 1.2349 1.2309 0.9269 0.9295 0.9225 151.116 152.85 150.7 105.76 106.835 105.559 1.4284 1.4324 1.4261 0.8089 0.8104 0.8051 2013-07-29 1.3265 1.3295 1.3237 97.837 98.339 97.6 0.9303 0.9322 0.9267 1.5352 1.5414 1.5325 1.0259 1.0285 1.0248 0.864 0.8643 0.8619 129.792 130.61 129.56 1.2342 1.2351 1.2319 0.9197 0.9287 0.9184 150.195 151.27 149.983 105.145 105.89 104.96 1.4282 1.4309 1.4259 0.8024 0.8099 0.8007 2013-07-30 1.3262 1.3302 1.3233 97.98 98.46 97.74 0.9295 0.9324 0.9271 1.5245 1.5357 1.5222 1.0304 1.0311 1.0254 0.8699 0.8706 0.8641 129.96 130.52 129.77 1.2329 1.2354 1.2319 0.9067 0.9207 0.9039 149.369 150.92 149.14 105.39 105.75 105.08 1.4172 1.4289 1.4155 0.7978 0.8037 0.7956 2013-07-31 1.3301 1.3344 1.3203 97.92 98.54 97.59 0.9256 0.9337 0.9229 1.5211 1.5254 1.5127 1.0269 1.0335 1.0247 0.8744 0.8765 0.8702 130.26 130.79 129.33 1.2313 1.2344 1.2305 0.8989 0.9076 0.8936 148.947 149.52 148.3 105.75 106.04 105.07 1.4077 1.4171 1.4053 0.7988 0.8015 0.7933 2013-08-01 1.3206 1.3311 1.3194 99.55 99.572 97.659 0.9365 0.9372 0.9254 1.512 1.5243 1.5109 1.0346 1.035 1.0266 0.8733 0.877 0.8681 131.47 131.495 129.938 1.2367 1.2377 1.2311 0.8923 0.8993 0.8906 150.55 150.679 148.265 106.31 106.48 105.496 1.4159 1.419 1.4047 0.7871 0.7983 0.7851 2013-08-02 1.3281 1.3294 1.3188 98.84 99.95 98.66 0.9293 0.9389 0.9274 1.5279 1.5309 1.5103 1.0391 1.0402 1.0339 0.8692 0.8745 0.8679 131.28 131.96 131.06 1.2343 1.2397 1.2322 0.89 0.897 0.8871 151.02 151.53 150.22 106.34 106.69 106.03 1.42 1.4224 1.4157 0.7835 0.7935 0.7814 2013-08-05 1.3258 1.33 1.3233 98.359 99.151 98.23 0.9278 0.9333 0.927 1.5353 1.5379 1.5259 1.0362 1.0403 1.0359 0.8635 0.8696 0.8628 130.4 131.57 130.21 1.2302 1.2358 1.2297 0.8912 0.8926 0.8849 150.99 151.5 150.341 105.966 106.635 105.61 1.4246 1.4307 1.4189 0.7804 0.7817 0.7696 2013-08-06 1.3309 1.3323 1.3246 97.7 98.585 97.521 0.9252 0.9296 0.9237 1.5354 1.5392 1.533 1.037 1.0391 1.0349 0.8667 0.8668 0.8619 130.03 130.733 129.808 1.2319 1.2328 1.2268 0.8991 0.9005 0.8907 150 151.436 149.86 105.536 106.17 105.43 1.421 1.4278 1.4202 0.7909 0.7918 0.7828 2013-08-07 1.3339 1.3342 1.3266 96.46 97.78 96.3 0.9211 0.9289 0.9204 1.5493 1.5531 1.5205 1.042 1.0445 1.0368 0.8609 0.8731 0.8578 128.68 130.121 128.42 1.2289 1.2327 1.2278 0.899 0.9025 0.892 149.44 150.7 147.62 104.685 105.63 104.33 1.4272 1.4342 1.4116 0.7958 0.7998 0.788 2013-08-08 1.338 1.34 1.3328 96.69 96.934 95.78 0.9201 0.9229 0.9173 1.5534 1.5574 1.5485 1.0324 1.0431 1.0301 0.8612 0.8622 0.8592 129.377 129.405 128.222 1.2311 1.2318 1.2281 0.9112 0.9135 0.8974 150.18 150.237 148.949 105.075 105.104 104.24 1.429 1.4321 1.4252 0.8018 0.8047 0.7935 2013-08-09 1.3344 1.339 1.3333 96.217 96.968 96.12 0.9216 0.9229 0.9191 1.5511 1.5559 1.5498 1.0288 1.0353 1.0272 0.8602 0.862 0.8596 128.4 129.709 128.25 1.2299 1.2318 1.2293 0.9193 0.9214 0.9087 149.244 150.655 149.044 104.35 105.34 104.27 1.4299 1.4317 1.4276 0.8045 0.8057 0.7984 2013-08-12 1.3308 1.3344 1.3277 96.671 96.911 95.93 0.9248 0.9285 0.9218 1.5469 1.5522 1.5459 1.0297 1.0317 1.0281 0.8601 0.861 0.858 128.659 128.91 127.985 1.2306 1.233 1.2296 0.9153 0.9221 0.9135 149.532 149.91 148.883 104.512 104.7 104.06 1.4305 1.4365 1.4294 0.8007 0.8057 0.7994 2013-08-13 1.3264 1.3317 1.323 98.132 98.342 97.057 0.9326 0.9349 0.9258 1.5454 1.5512 1.5426 1.0337 1.0348 1.0304 0.8582 0.861 0.8535 130.168 130.471 129.11 1.2372 1.2382 1.2313 0.9112 0.9149 0.907 151.634 152.076 150.08 105.19 105.665 104.84 1.4411 1.4486 1.4316 0.7967 0.8007 0.793 2013-08-14 1.3259 1.328 1.3236 98.14 98.427 97.869 0.9348 0.9378 0.9325 1.5508 1.5547 1.5423 1.0329 1.037 1.0314 0.8548 0.86 0.8525 130.09 130.66 129.843 1.2392 1.2427 1.2367 0.9137 0.916 0.9082 152.192 152.584 151.209 104.96 105.38 104.71 1.4497 1.4538 1.4406 0.8033 0.8051 0.7958 2013-08-15 1.3355 1.3362 1.3205 97.332 98.648 97.24 0.9256 0.9396 0.9247 1.5646 1.5652 1.5502 1.03 1.0364 1.0296 0.8535 0.8569 0.8502 130 130.73 129.4 1.2362 1.2434 1.2336 0.9134 0.919 0.9058 152.286 153.232 151.504 105.136 105.383 104.44 1.4483 1.4591 1.4462 0.807 0.8104 0.7995 2013-08-16 1.3332 1.338 1.3308 97.52 97.77 97.06 0.9263 0.9288 0.9217 1.562 1.5657 1.5603 1.0335 1.036 1.0294 0.8534 0.8555 0.852 130.03 130.43 129.58 1.2352 1.2383 1.2327 0.9183 0.9215 0.9125 152.341 152.76 151.8 105.26 105.53 104.86 1.4471 1.4511 1.4416 0.81 0.8128 0.8054 2013-08-19 1.334 1.3375 1.3315 97.615 98.125 97.361 0.9237 0.9285 0.9224 1.5653 1.5673 1.561 1.0342 1.0348 1.0314 0.8522 0.854 0.851 130.227 131.034 129.86 1.2324 1.2371 1.231 0.9123 0.9233 0.9099 152.8 153.58 152.225 105.659 106.04 105.16 1.4461 1.4515 1.4446 0.8079 0.8163 0.8056 2013-08-20 1.3419 1.3452 1.3324 97.26 97.862 96.914 0.9172 0.9251 0.9148 1.5672 1.5696 1.5629 1.0385 1.0401 1.0342 0.8561 0.8573 0.8518 130.522 130.798 129.295 1.2307 1.2339 1.2286 0.9091 0.9133 0.9028 152.42 153.12 151.75 106 106.228 105.011 1.4375 1.4474 1.4352 0.7987 0.8075 0.7953 2013-08-21 1.3365 1.3427 1.3336 97.8 97.982 97.1 0.9219 0.9235 0.9159 1.5679 1.5717 1.5647 1.0463 1.0476 1.0388 0.8523 0.8578 0.8507 130.72 131.014 130.29 1.2322 1.2332 1.2297 0.9003 0.9069 0.8975 153.33 153.644 152.09 106.05 106.409 105.89 1.4456 1.4474 1.4348 0.7869 0.7967 0.7847 2013-08-22 1.335 1.3373 1.3299 98.703 98.809 97.694 0.9238 0.929 0.9221 1.5583 1.566 1.5563 1.0517 1.0531 1.0469 0.8567 0.858 0.8531 131.781 131.87 130.414 1.2333 1.2358 1.2315 0.9009 0.9043 0.8932 153.815 153.94 152.665 106.829 106.852 105.84 1.4394 1.4465 1.4382 0.7826 0.7866 0.7805 2013-08-23 1.3383 1.341 1.3333 98.61 99.149 98.38 0.9207 0.9263 0.9189 1.5583 1.5638 1.5538 1.0497 1.0568 1.0493 0.8587 0.8603 0.8542 131.98 132.425 131.842 1.2324 1.2362 1.2316 0.9035 0.905 0.8969 153.64 154.671 153.394 107.085 107.21 106.871 1.4349 1.4455 1.4326 0.7813 0.7858 0.776 2013-08-26 1.3375 1.3394 1.3354 98.46 98.843 98.19 0.922 0.9246 0.9207 1.5582 1.5612 1.5557 1.0501 1.0533 1.0496 0.8583 0.86 0.8578 131.694 132.31 131.47 1.2332 1.2357 1.2326 0.9031 0.907 0.9003 153.395 153.977 153.03 106.762 107.3 106.592 1.4367 1.4393 1.4333 0.7851 0.7874 0.7786 2013-08-27 1.3389 1.34 1.3323 97.061 98.535 96.98 0.9177 0.9229 0.9167 1.5543 1.5592 1.5478 1.0477 1.054 1.0476 0.8613 0.8624 0.858 129.958 131.76 129.827 1.2289 1.234 1.228 0.8994 0.9031 0.8934 150.89 153.52 150.687 105.752 106.79 105.65 1.4265 1.4377 1.4246 0.7797 0.7859 0.7763 2013-08-28 1.3341 1.3398 1.3305 97.71 97.838 96.821 0.9216 0.9235 0.9172 1.5526 1.5552 1.543 1.0478 1.0511 1.0471 0.8592 0.8652 0.8571 130.36 130.559 129.664 1.2296 1.23 1.2278 0.8946 0.8984 0.8893 151.69 151.9 150.495 105.99 106.18 105.57 1.4308 1.4338 1.4201 0.7795 0.7808 0.7745 2013-08-29 1.3243 1.3345 1.3218 98.213 98.521 97.454 0.9306 0.9321 0.9219 1.5504 1.5548 1.5479 1.0529 1.0537 1.0478 0.8541 0.8593 0.8526 130.07 130.536 129.99 1.2325 1.2327 1.2296 0.8931 0.8979 0.8915 152.279 152.662 151.515 105.521 106.06 105.48 1.4428 1.4444 1.4314 0.777 0.784 0.7746 2013-08-30 1.3216 1.3255 1.3174 98.154 98.476 97.888 0.9302 0.9332 0.929 1.5493 1.5528 1.546 1.0536 1.0558 1.0507 0.8529 0.8553 0.8519 129.732 130.35 129.314 1.2295 1.2329 1.228 0.8896 0.8958 0.8889 151.994 152.67 151.687 105.48 105.73 105.17 1.4412 1.4462 1.4393 0.7727 0.7797 0.7718 2013-09-02 1.3184 1.3235 1.3181 99.37 99.431 98.283 0.9343 0.9352 0.9305 1.5532 1.5593 1.5503 1.0556 1.0557 1.0511 0.8488 0.853 0.847 131.011 131.384 129.8 1.2326 1.2333 1.2302 0.8965 0.9014 0.8925 154.33 154.928 152.417 106.28 106.65 105.435 1.4518 1.4547 1.443 0.7794 0.7833 0.7739 2013-09-03 1.3171 1.3197 1.3139 99.54 99.86 99.169 0.9363 0.9382 0.9342 1.5566 1.5604 1.5518 1.053 1.0559 1.0506 0.846 0.8488 0.8446 131.11 131.478 130.653 1.2334 1.2342 1.2314 0.9054 0.9072 0.8973 154.93 155.455 154.377 106.28 106.632 106.03 1.4574 1.4605 1.4523 0.7796 0.7838 0.7766 2013-09-04 1.3212 1.3218 1.3157 99.63 99.81 99.3 0.9355 0.9383 0.9343 1.5627 1.5648 1.5556 1.049 1.0542 1.0471 0.8452 0.8465 0.8424 131.64 131.82 130.78 1.2359 1.2368 1.2329 0.917 0.9187 0.9038 155.715 156 154.77 106.49 106.62 105.97 1.4617 1.465 1.4571 0.791 0.7927 0.7794 2013-09-05 1.3117 1.3223 1.3109 100.13 100.194 99.57 0.9446 0.9455 0.9354 1.5588 1.5667 1.5573 1.0502 1.0516 1.0475 0.8415 0.8465 0.8408 131.35 132.144 131.033 1.2392 1.24 1.2353 0.9133 0.9188 0.9111 156.078 156.43 155.509 105.97 106.676 105.85 1.4725 1.4733 1.4613 0.7892 0.7914 0.7856 2013-09-06 1.3178 1.3188 1.3103 99.05 100.23 98.54 0.9374 0.9455 0.9345 1.563 1.568 1.5562 1.0406 1.0505 1.0377 0.843 0.8433 0.839 130.53 131.48 129.89 1.2355 1.2401 1.2324 0.9186 0.9216 0.9117 154.8 156.22 154.13 105.63 106.04 105.12 1.4652 1.4742 1.462 0.7997 0.8022 0.7884 2013-09-09 1.3257 1.3281 1.3161 99.58 100.13 99.338 0.9322 0.9392 0.9302 1.5697 1.5733 1.5608 1.0374 1.0429 1.0356 0.8445 0.845 0.841 132.02 132.207 130.55 1.2357 1.2369 1.2336 0.923 0.9242 0.9168 156.317 156.64 154.88 106.8 107.018 105.64 1.4631 1.4696 1.4619 0.8015 0.8031 0.7962 2013-09-10 1.3269 1.3276 1.3229 100.32 100.456 99.477 0.9345 0.9367 0.9317 1.5732 1.5744 1.5683 1.0346 1.0382 1.0326 0.8434 0.8454 0.8419 133.113 133.303 131.914 1.24 1.2403 1.2357 0.9314 0.9314 0.9218 157.835 157.93 156.185 107.334 107.53 106.68 1.4703 1.4714 1.463 0.8069 0.8076 0.8007 2013-09-11 1.3308 1.3324 1.3244 99.947 100.61 99.83 0.9298 0.9372 0.9284 1.5822 1.5829 1.5719 1.0318 1.0365 1.031 0.8411 0.8439 0.8384 133.013 133.375 132.769 1.2378 1.2415 1.2367 0.9327 0.9338 0.9273 158.12 158.548 157.525 107.43 107.568 107.12 1.4714 1.4783 1.4693 0.8079 0.809 0.8038 2013-09-12 1.33 1.3325 1.3257 99.44 99.986 99.017 0.9303 0.9335 0.9273 1.5805 1.584 1.5777 1.0324 1.0337 1.0306 0.8414 0.8426 0.8393 132.26 133.1 131.734 1.2374 1.2391 1.2353 0.9262 0.9354 0.9227 157.155 158.23 156.709 106.878 107.44 106.505 1.4703 1.4737 1.4681 0.8138 0.8157 0.8111 2013-09-13 1.3303 1.3322 1.3254 99.24 99.98 99.2 0.9292 0.9341 0.9281 1.5875 1.5884 1.5777 1.0347 1.0351 1.0322 0.8378 0.8418 0.8357 132.01 132.66 131.66 1.2361 1.239 1.2357 0.9245 0.9272 0.9224 157.53 157.97 157.22 106.79 107.11 106.39 1.4753 1.4812 1.4705 0.814 0.8169 0.8095 2013-09-16 1.3336 1.3386 1.3299 99.066 99.504 98.464 0.927 0.9303 0.9227 1.5899 1.5963 1.5871 1.0323 1.0356 1.0282 0.8387 0.8391 0.8369 132.13 132.42 131.622 1.2364 1.238 1.2338 0.9313 0.9393 0.9247 157.537 158.03 156.927 106.85 107.129 106.413 1.4739 1.4786 1.4703 0.8163 0.8228 0.8129 2013-09-17 1.3354 1.337 1.3321 99.14 99.383 99.009 0.9262 0.9279 0.9248 1.5903 1.5936 1.5882 1.0295 1.0335 1.0275 0.8396 0.8411 0.8379 132.395 132.66 132.041 1.2368 1.2385 1.2354 0.9355 0.9366 0.9285 157.63 158.16 157.424 107.023 107.218 106.775 1.4729 1.4764 1.4704 0.8241 0.8248 0.816 2013-09-18 1.3529 1.3542 1.3338 97.893 99.335 97.75 0.9117 0.9268 0.9106 1.6146 1.6163 1.5893 1.0223 1.0318 1.0202 0.8377 0.8399 0.8353 132.45 132.68 131.866 1.2334 1.2375 1.2328 0.9519 0.9529 0.9337 158.072 158.247 157.356 107.35 107.456 106.65 1.4719 1.4805 1.47 0.8371 0.8383 0.8207 2013-09-19 1.3529 1.357 1.3501 99.37 99.615 97.987 0.9103 0.9138 0.9089 1.6036 1.6147 1.6019 1.026 1.0265 1.0181 0.8436 0.8442 0.8372 134.451 134.947 132.526 1.2315 1.2351 1.2306 0.9436 0.9524 0.9424 159.34 160 158.19 109.134 109.405 107.419 1.46 1.4736 1.4585 0.8368 0.8436 0.8327 2013-09-20 1.3522 1.355 1.3496 99.33 99.669 99.174 0.9106 0.9127 0.9087 1.6017 1.6067 1.5984 1.0298 1.0302 1.0263 0.8442 0.846 0.8422 134.33 134.736 134.17 1.2314 1.2331 1.2299 0.9403 0.9458 0.9376 159.125 159.69 158.992 109.06 109.38 108.93 1.4587 1.4636 1.4557 0.8373 0.8401 0.8353 2013-09-23 1.3497 1.3553 1.3477 98.76 99.36 98.64 0.9105 0.913 0.9082 1.6051 1.6073 1.5993 1.028 1.0314 1.0271 0.8409 0.8472 0.8401 133.31 134.61 133.06 1.2293 1.2335 1.2274 0.9442 0.9457 0.935 158.514 159.08 158.18 108.45 109.28 108.23 1.4617 1.4652 1.4531 0.8374 0.839 0.8345 2013-09-24 1.347 1.3519 1.3465 98.74 99.18 98.48 0.9128 0.9133 0.91 1.6004 1.6044 1.5956 1.0303 1.0311 1.0271 0.8415 0.8449 0.841 133.02 134 132.71 1.2297 1.2304 1.2286 0.939 0.9428 0.9364 158.04 158.97 157.35 108.16 108.93 108.01 1.4608 1.4615 1.4558 0.828 0.8373 0.8257 2013-09-25 1.3528 1.3537 1.3462 98.45 98.81 98.35 0.9089 0.9137 0.9075 1.6084 1.6088 1.598 1.0312 1.032 1.0281 0.841 0.8446 0.8396 133.21 133.56 132.69 1.2296 1.231 1.2285 0.9367 0.9393 0.9339 158.356 158.83 157.38 108.3 108.67 107.93 1.4617 1.4648 1.4557 0.8246 0.8278 0.8213 2013-09-26 1.348 1.3526 1.3473 98.849 99.134 98.27 0.9106 0.9117 0.9088 1.6032 1.6096 1.6 1.0312 1.034 1.0301 0.8407 0.843 0.8395 133.26 133.939 132.89 1.2274 1.2311 1.2272 0.9351 0.9402 0.9341 158.47 159.28 158.034 108.54 108.895 108.05 1.4596 1.4645 1.4568 0.8277 0.8302 0.8236 2013-09-27 1.3521 1.3564 1.3474 98.2 99.04 98.07 0.9054 0.9111 0.902 1.6144 1.6146 1.603 1.0301 1.0332 1.0294 0.8375 0.842 0.8361 132.79 133.59 132.58 1.2247 1.2278 1.2234 0.9315 0.9375 0.9294 158.531 159.1 158.19 108.41 109.04 108.27 1.4619 1.4667 1.4542 0.8275 0.8319 0.8247 2013-09-30 1.3519 1.3556 1.3465 98.203 98.46 97.46 0.9058 0.9075 0.9021 1.6183 1.6203 1.6096 1.0299 1.0319 1.027 0.8374 0.839 0.8337 132.762 133.23 131.28 1.2247 1.2246 1.221 0.9314 0.9356 0.9278 158.517 159.43 157.04 108.381 108.82 107.69 1.4622 1.4652 1.458 0.8277 0.8334 0.8246 2013-10-01 1.3534 1.35878 1.3513 97.79 98.725 97.62 0.9051 0.9075 0.8989 1.6204 1.62601 1.6179 1.0323 1.03367 1.0282 0.8352 0.83668 0.8329 132.372 133.486 132.267 1.2256 1.22683 1.2213 0.9396 0.94353 0.9286 158.476 159.955 158.372 108.007 108.93 107.94 1.4673 1.46982 1.46027 0.8268 0.83412 0.82391 2013-10-02 1.3587 1.36071 1.3503 97.372 98.085 97.11 0.9021 0.90772 0.8992 1.62291 1.6251 1.6159 1.0325 1.03564 1.032 0.837 0.8382 0.833 132.309 132.64 131.378 1.2257 1.2268 1.2219 0.9385 0.94083 0.9329 158.03 158.84 157.45 107.92 108.24 107.4 1.4639 1.46861 1.4605 0.8308 0.8317 0.819 2013-10-03 1.3617 1.3646 1.3574 97.275 97.873 96.89 0.8995 0.90333 0.8965 1.61567 1.62414 1.6151 1.0323 1.03398 1.0308 0.8428 0.844 0.8363 132.47 133.213 132.09 1.2251 1.22792 1.2228 0.94 0.94149 0.9363 157.18 158.85 156.642 108.127 108.574 107.77 1.4532 1.4653 1.4494 0.8291 0.83404 0.8271 2013-10-04 1.3554 1.36317 1.3535 97.42 97.48 96.92 0.9069 0.90817 0.8975 1.6023 1.6178 1.6017 1.0296 1.03403 1.0291 0.8458 0.8476 0.8419 132.04 132.694 131.73 1.2294 1.23006 1.2231 0.9427 0.94586 0.9385 156.1 157.373 155.668 107.391 108.324 107.24 1.4531 1.45629 1.44696 0.8321 0.83505 0.8275 2013-10-07 1.3574 1.3591 1.3539 96.89 97.33 96.77 0.9037 0.90672 0.9013 1.6088 1.61 1.6021 1.0311 1.03334 1.0291 0.8436 0.8466 0.8426 131.517 132.049 131.315 1.2269 1.2298 1.2247 0.9431 0.94507 0.9384 155.853 156.18 155.37 107.17 107.51 107.06 1.4543 1.4559 1.4483 0.832 0.83362 0.8262 2013-10-08 1.3575 1.36071 1.3554 96.964 97.249 96.56 0.9038 0.9066 0.902 1.6085 1.61244 1.6016 1.0364 1.03736 1.0303 0.8438 0.847 0.8421 131.653 132.05 131.14 1.2271 1.22947 1.2255 0.9436 0.94846 0.9408 155.994 156.67 155.391 107.271 107.498 106.93 1.4538 1.45811 1.451 0.8295 0.8333 0.8265 2013-10-09 1.3518 1.3605 1.3483 97.34 97.65 96.79 0.9103 0.9128 0.9012 1.5955 1.6122 1.5912 1.0389 1.0407 1.0349 0.8473 0.8487 0.8426 131.58 132.19 131.18 1.2308 1.232 1.2257 0.9443 0.9464 0.941 155.287 156.58 154.66 106.89 107.54 106.63 1.4527 1.4585 1.4484 0.83 0.832 0.8267 2013-10-10 1.3527 1.3546 1.3485 98.24 98.27 97.3 0.911 0.9131 0.9081 1.5975 1.5979 1.5909 1.0393 1.042 1.0368 0.8467 0.8493 0.8462 132.9 132.97 131.61 1.2326 1.2329 1.2297 0.9459 0.9472 0.9385 156.932 157 155.22 107.82 107.88 106.93 1.4554 1.4559 1.4495 0.829 0.8309 0.8227 2013-10-11 1.355 1.35817 1.3515 98.48 98.573 97.88 0.9113 0.9132 0.9066 1.59551 1.60014 1.5919 1.0352 1.04122 1.0337 0.8492 0.851 0.8457 133.45 133.6 132.4 1.2349 1.23535 1.2307 0.9467 0.94858 0.9431 157.12 157.54 156.398 108.04 108.435 107.52 1.4539 1.45625 1.4485 0.8322 0.8354 0.8257 2013-10-14 1.3565 1.35976 1.3541 98.53 98.563 98.06 0.9099 0.91221 0.9061 1.59904 1.60182 1.595 1.0349 1.03699 1.0337 0.8482 0.8496 0.8475 133.665 133.711 133.07 1.2341 1.236 1.2317 0.9498 0.95073 0.9428 157.564 157.61 156.69 108.264 108.31 107.72 1.4552 1.45665 1.4506 0.8372 0.83809 0.8305 2013-10-15 1.3517 1.3571 1.3476 98.329 98.703 98.12 0.9129 0.91779 0.9089 1.5995 1.60105 1.5911 1.0378 1.03912 1.0327 0.845 0.84949 0.8442 132.93 133.8 132.76 1.2342 1.23756 1.2329 0.9507 0.95479 0.9474 157.284 157.72 156.788 107.698 108.37 107.39 1.4604 1.4632 1.4524 0.8365 0.84056 0.8343 2013-10-16 1.3528 1.35675 1.347 98.754 98.97 98.1 0.9134 0.91754 0.9095 1.5948 1.6058 1.589 1.0331 1.03852 1.0323 0.8482 0.849 0.8426 133.618 133.751 132.7 1.2358 1.23673 1.23318 0.9546 0.95576 0.9495 157.513 158.03 156.865 108.09 108.2 107.55 1.4567 1.4641 1.4549 0.8423 0.84447 0.837 2013-10-17 1.3675 1.36817 1.3512 97.89 99.004 97.7 0.902 0.91465 0.9006 1.61595 1.6172 1.5937 1.0292 1.0332 1.0277 0.8462 0.8497 0.8446 133.867 133.912 133.285 1.2336 1.23637 1.2306 0.9625 0.96469 0.95203 158.192 158.3 156.992 108.51 108.621 107.87 1.4576 1.46017 1.451 0.8493 0.85245 0.8411 2013-10-18 1.3678 1.3704 1.3656 97.84 98.16 97.52 0.9019 0.9037 0.9002 1.6165 1.6225 1.6139 1.0294 1.0302 1.0271 0.8462 0.847 0.8438 133.86 134.19 133.54 1.234 1.2352 1.2332 0.9667 0.9677 0.9601 158.16 158.68 158.01 108.45 108.71 108.16 1.458 1.4626 1.4569 0.8483 0.8506 0.8443 2013-10-21 1.3678 1.36885 1.3647 98.2 98.242 97.8 0.9018 0.90451 0.9002 1.6146 1.6181 1.6127 1.03 1.03034 1.0283 0.8471 0.84731 0.8446 134.33 134.38 133.83 1.2337 1.23577 1.2318 0.9655 0.9679 0.9639 158.559 158.763 158.125 108.871 108.97 108.36 1.4561 1.46175 1.4548 0.8456 0.85085 0.8433 2013-10-22 1.3778 1.3792 1.3658 98.1 98.483 97.85 0.8949 0.90392 0.8936 1.6229 1.6248 1.6112 1.0287 1.031 1.0264 0.8489 0.85 0.8467 135.16 135.507 134.16 1.2331 1.2365 1.2309 0.9706 0.97305 0.96388 159.215 159.525 158.212 109.597 109.74 108.694 1.4526 1.45795 1.44977 0.8515 0.85436 0.8431 2013-10-23 1.3779 1.3793 1.3739 97.3 98.19 97.13 0.8918 0.8966 0.8907 1.6168 1.6257 1.6116 1.0385 1.0397 1.0278 0.8521 0.8532 0.8481 134.09 135.28 133.56 1.229 1.2335 1.2278 0.9625 0.9758 0.9601 157.31 159.38 156.79 109.08 109.7 108.53 1.4418 1.4537 1.4404 0.8394 0.8519 0.8355 2013-10-24 1.3801 1.3827 1.376 97.28 97.617 97.14 0.8921 0.8928 0.8889 1.6203 1.6223 1.6133 1.0425 1.0438 1.0361 0.8518 0.8555 0.8504 134.272 134.791 133.86 1.2313 1.2318 1.228 0.9616 0.9671 0.9568 157.63 158.205 156.986 109.036 109.493 108.92 1.4453 1.4465 1.4371 0.8353 0.8446 0.8318 2013-10-25 1.3809 1.3832 1.3772 97.38 97.491 96.91 0.892 0.8965 0.889 1.6179 1.6247 1.6146 1.0452 1.0461 1.0406 0.8535 0.8542 0.8501 134.471 134.53 133.84 1.232 1.2349 1.2296 0.9582 0.9624 0.9568 157.52 157.96 157.063 109.13 109.182 108.57 1.4431 1.4498 1.4424 0.8282 0.8346 0.8269 2013-10-28 1.3803 1.3818 1.3772 97.65 97.789 97.41 0.8943 0.8963 0.8917 1.6157 1.6208 1.612 1.0438 1.0451 1.0426 0.8541 0.8548 0.8516 134.76 134.94 134.508 1.2344 1.2349 1.2316 0.9579 0.9623 0.9551 157.76 158.31 157.494 109.16 109.425 108.99 1.4449 1.449 1.4423 0.83 0.8332 0.8268 2013-10-29 1.3742 1.3813 1.3734 98.17 98.278 97.43 0.8986 0.9002 0.8941 1.6038 1.6144 1.6019 1.0463 1.0471 1.0423 0.8567 0.8585 0.8538 134.91 135.174 134.21 1.2355 1.2371 1.2332 0.9478 0.9575 0.9467 157.44 157.71 156.7 109.188 109.41 108.59 1.4416 1.4462 1.4388 0.8252 0.8304 0.8229 2013-10-30 1.3728 1.3785 1.3694 98.583 98.676 97.99 0.8996 0.9024 0.8946 1.6031 1.6078 1.5996 1.0478 1.0498 1.0437 0.8562 0.8577 0.8554 135.345 135.41 134.749 1.235 1.2371 1.2331 0.9469 0.9516 0.9437 158.03 158.12 157.267 109.57 109.657 108.95 1.442 1.4448 1.4376 0.8233 0.8287 0.819 2013-10-31 1.3585 1.3739 1.3582 98.32 98.571 98.06 0.9064 0.9069 0.8985 1.6036 1.6068 1.6001 1.042 1.049 1.0407 0.8471 0.8568 0.8459 133.61 135.29 133.305 1.2319 1.236 1.2296 0.9457 0.9526 0.9448 157.668 157.99 157.206 108.45 109.526 108.27 1.4538 1.4552 1.4408 0.8265 0.8311 0.8227 2013-11-01 1.3489 1.359 1.3478 98.766 98.849 97.78 0.9123 0.9138 0.9059 1.5922 1.6047 1.5904 1.0426 1.0454 1.0407 0.8471 0.8477 0.8441 133.238 133.69 132.56 1.2307 1.2327 1.2292 0.9435 0.949 0.9417 157.267 157.85 156.747 108.236 108.511 107.65 1.4529 1.4582 1.4515 0.8231 0.8286 0.8208 2013-11-04 1.3519 1.3524 1.3439 98.59 98.844 98.5 0.9093 0.9152 0.9088 1.5971 1.5978 1.59 1.0419 1.0428 1.0394 0.8464 0.8477 0.8449 133.28 133.36 132.81 1.2294 1.2326 1.2287 0.9509 0.9514 0.9442 157.44 157.68 157.01 108.39 108.42 107.96 1.4521 1.4575 1.4511 0.8282 0.8315 0.8244 2013-11-05 1.3471 1.3522 1.3447 98.56 98.661 98.13 0.9136 0.9147 0.909 1.6047 1.6063 1.5944 1.0454 1.0462 1.0412 0.8395 0.8464 0.8388 132.772 133.35 132.32 1.2308 1.2316 1.2282 0.9499 0.9538 0.946 158.14 158.26 156.58 107.864 108.43 107.52 1.4658 1.4664 1.4516 0.8317 0.8335 0.8252 2013-11-06 1.3521 1.3547 1.3465 98.69 98.76 98.38 0.9116 0.914 0.9094 1.6081 1.6118 1.604 1.0417 1.0459 1.0408 0.8407 0.8417 0.8376 133.46 133.73 132.51 1.2327 1.2329 1.23 0.9528 0.9544 0.9483 158.719 159 157.88 108.23 108.5 107.67 1.4659 1.4693 1.4635 0.8388 0.8414 0.8346 2013-11-07 1.342 1.3529 1.3294 97.88 99.409 97.59 0.9157 0.925 0.9105 1.6077 1.6114 1.6006 1.0455 1.0455 1.04 0.8347 0.8412 0.8297 131.385 133.56 131.176 1.229 1.2339 1.2279 0.9446 0.9527 0.9441 157.354 159.276 157.244 106.89 108.296 106.755 1.4721 1.482 1.4646 0.8315 0.8395 0.8303 2013-11-08 1.336 1.3438 1.3316 99.14 99.221 97.93 0.922 0.9247 0.9147 1.6006 1.6105 1.5953 1.0479 1.0503 1.0443 0.8345 0.8362 0.832 132.45 132.51 131.26 1.232 1.2323 1.2284 0.9379 0.9481 0.9348 158.698 158.76 157.456 107.49 107.53 106.78 1.476 1.4774 1.4707 0.8242 0.8349 0.8223 2013-11-11 1.3408 1.3416 1.3342 99.205 99.298 98.88 0.9191 0.9232 0.9183 1.5986 1.6022 1.5961 1.0474 1.0486 1.046 0.8385 0.8396 0.8336 133.024 133.149 132.15 1.2325 1.2333 1.231 0.9356 0.939 0.934 158.59 158.83 158.266 107.91 107.993 107.24 1.4693 1.4777 1.4675 0.8247 0.8288 0.8223 2013-11-12 1.3428 1.3456 1.3357 99.68 99.8 99.06 0.9177 0.9226 0.9152 1.5897 1.5993 1.585 1.0493 1.0508 1.046 0.8447 0.845 0.8374 133.86 134.02 132.87 1.2325 1.2338 1.2309 0.9296 0.9368 0.9265 158.45 159.24 157.97 108.6 108.79 107.75 1.4587 1.4718 1.4572 0.82 0.8261 0.8165 2013-11-13 1.3462 1.3471 1.3388 99.375 99.674 99.15 0.915 0.9201 0.9143 1.6028 1.6047 1.5874 1.0457 1.0497 1.0451 0.8399 0.8464 0.8374 133.778 133.99 133.178 1.2318 1.233 1.231 0.9329 0.9333 0.9274 159.281 159.332 157.912 108.603 108.68 108.11 1.4665 1.4707 1.4559 0.8257 0.827 0.819 2013-11-14 1.346 1.3494 1.3416 100 100.15 99.1 0.9161 0.9188 0.9128 1.6063 1.6101 1.5984 1.0472 1.0526 1.0437 0.8378 0.8415 0.8358 134.61 134.72 133.7 1.2331 1.2338 1.2315 0.9321 0.9386 0.9277 160.625 160.92 159.02 109.14 109.29 108.47 1.4714 1.4752 1.4648 0.8278 0.8357 0.8227 2013-11-15 1.3493 1.3506 1.343 100.19 100.43 99.91 0.9147 0.9191 0.9128 1.6116 1.6135 1.6044 1.0445 1.0484 1.0439 0.8372 0.8387 0.8355 135.18 135.26 134.45 1.2344 1.2351 1.232 0.9369 0.9375 0.9301 161.442 161.67 160.61 109.5 109.67 108.94 1.4743 1.4769 1.4709 0.8337 0.8341 0.8259 2013-11-18 1.3497 1.3542 1.3472 99.911 100.39 99.768 0.9131 0.9162 0.9093 1.6101 1.6149 1.6077 1.0433 1.0442 1.041 0.8382 0.84 0.8359 134.857 135.36 134.71 1.2326 1.2345 1.2312 0.9366 0.9419 0.9355 160.867 161.77 160.648 109.39 109.836 109.27 1.4701 1.4759 1.4661 0.8334 0.8408 0.832 2013-11-19 1.3535 1.3547 1.3485 100.18 100.255 99.54 0.9107 0.9144 0.9099 1.6121 1.6133 1.6055 1.0473 1.0485 1.0411 0.8395 0.8404 0.8374 135.56 135.717 134.57 1.2329 1.2338 1.2316 0.9421 0.9447 0.935 161.489 161.62 160.339 109.96 110.05 109.16 1.4683 1.4711 1.4662 0.8353 0.8372 0.8302 2013-11-20 1.3426 1.358 1.3413 99.96 100.246 99.75 0.9171 0.9191 0.9076 1.6102 1.6178 1.6085 1.0448 1.0474 1.0432 0.8337 0.8415 0.8322 134.21 135.942 134.07 1.2314 1.2341 1.2304 0.933 0.9447 0.9313 160.94 161.72 160.81 108.97 110.265 108.85 1.4767 1.48 1.4648 0.8259 0.8395 0.825 2013-11-21 1.3465 1.348 1.3397 101.094 101.156 100 0.9147 0.9188 0.9134 1.6168 1.6171 1.607 1.0523 1.0526 1.0449 0.8327 0.8357 0.8323 136.129 136.2 134.37 1.2318 1.2325 1.2304 0.9219 0.9334 0.9196 163.44 163.53 160.98 110.487 110.56 109.13 1.4788 1.4794 1.4736 0.82 0.8272 0.8172 2013-11-22 1.3548 1.3554 1.3459 101.32 101.35 100.92 0.9072 0.915 0.9063 1.6217 1.6219 1.6175 1.0523 1.0569 1.0511 0.8353 0.8361 0.8313 137.27 137.35 135.98 1.2293 1.2322 1.2279 0.9167 0.9249 0.914 164.312 164.35 163.47 111.66 111.72 110.39 1.4713 1.4811 1.4693 0.819 0.8244 0.8122 2013-11-25 1.3519 1.356 1.3488 101.45 101.916 101.1 0.9115 0.9132 0.9058 1.6155 1.624 1.6129 1.0549 1.0583 1.0522 0.8367 0.8374 0.8337 137.15 137.985 136.98 1.2324 1.233 1.2284 0.9162 0.9188 0.9116 163.88 165.285 163.754 111.27 112.128 111.19 1.4725 1.4754 1.4709 0.8206 0.8229 0.8179 2013-11-26 1.3569 1.3575 1.3518 101.277 101.653 101.14 0.9066 0.9115 0.9058 1.6209 1.6219 1.6134 1.0542 1.0558 1.0516 0.8367 0.8391 0.8358 137.418 137.68 137.09 1.2302 1.233 1.2296 0.9128 0.9204 0.9085 164.143 164.382 163.607 111.695 111.8 111.23 1.4696 1.4733 1.4673 0.8198 0.8265 0.8149 2013-11-27 1.3571 1.3613 1.3555 102.145 102.197 101.15 0.908 0.9092 0.9037 1.6272 1.633 1.6194 1.0593 1.0602 1.0527 0.8339 0.8387 0.8327 138.62 138.792 137.24 1.2323 1.2333 1.2297 0.9076 0.9137 0.9062 166.222 166.451 163.947 112.45 112.677 111.53 1.4776 1.479 1.4675 0.814 0.8211 0.8111 2013-11-28 1.3601 1.3618 1.3561 102.242 102.372 101.91 0.9058 0.9086 0.9039 1.6339 1.6358 1.6274 1.0587 1.0598 1.0564 0.8323 0.8352 0.8309 139.081 139.182 138.26 1.232 1.2328 1.2303 0.9095 0.9149 0.9075 167.05 167.32 165.924 112.86 112.978 112.19 1.4797 1.4821 1.4735 0.8121 0.8177 0.8106 2013-11-29 1.3587 1.3622 1.358 102.434 102.61 102.08 0.9062 0.9069 0.9025 1.6365 1.6384 1.631 1.0612 1.0628 1.0554 0.8301 0.8345 0.8297 139.175 139.708 138.92 1.2314 1.2332 1.2288 0.9105 0.9141 0.9052 167.651 167.9 166.78 113.011 113.393 112.75 1.4833 1.4839 1.4747 0.8134 0.8165 0.8078 2013-12-02 1.3537 1.3616 1.3523 103.017 103.13 102.2 0.9086 0.911 0.904 1.6351 1.6443 1.6339 1.0642 1.0654 1.0609 0.8278 0.8297 0.825 139.46 139.703 138.98 1.2301 1.2324 1.229 0.9102 0.9168 0.9085 168.441 168.795 167.675 113.363 113.56 112.82 1.4857 1.4923 1.483 0.8185 0.8224 0.8147 2013-12-03 1.3591 1.3614 1.3522 102.323 103.378 101.95 0.9042 0.9101 0.9017 1.6392 1.6437 1.6344 1.065 1.0673 1.0626 0.8291 0.8293 0.8254 139.097 140.025 138.679 1.2291 1.2313 1.2273 0.914 0.9146 0.9054 167.721 169.15 167.254 113.141 113.81 112.86 1.4824 1.4885 1.4807 0.8254 0.8259 0.8151 2013-12-04 1.3585 1.3605 1.3526 102.25 102.84 101.79 0.9025 0.9076 0.901 1.6383 1.6404 1.6322 1.0678 1.0707 1.0633 0.8292 0.832 0.8271 138.93 139.61 138.4 1.2262 1.2298 1.2252 0.903 0.9141 0.8994 167.493 168.39 166.81 113.28 113.62 112.88 1.4786 1.4849 1.4748 0.8196 0.8243 0.8159 2013-12-05 1.3671 1.3677 1.3542 101.73 102.44 101.6 0.8961 0.9049 0.8954 1.6334 1.6404 1.6296 1.0648 1.0699 1.0621 0.8369 0.838 0.8289 139.08 139.567 138.4 1.2251 1.2283 1.2247 0.9063 0.9077 0.8999 166.13 167.78 165.789 113.514 113.785 112.96 1.4636 1.4787 1.4628 0.8214 0.8228 0.815 2013-12-06 1.3702 1.3706 1.3618 102.87 102.96 101.6 0.8919 0.8984 0.8909 1.6339 1.6393 1.6289 1.0655 1.0708 1.0617 0.8385 0.8389 0.8345 140.96 141.02 138.9 1.2222 1.2261 1.2211 0.9097 0.9118 0.8987 168.08 168.27 165.95 115.32 115.42 113.33 1.4574 1.4671 1.4562 0.8282 0.8292 0.8135 2013-12-09 1.3738 1.3746 1.3692 103.29 103.32 102.86 0.8901 0.8934 0.8892 1.6428 1.6432 1.6321 1.0635 1.067 1.0631 0.8363 0.8395 0.8357 141.91 141.95 140.95 1.2229 1.2245 1.2218 0.9105 0.9129 0.9067 169.683 169.71 168.08 116.03 116.05 115.23 1.4622 1.4635 1.4559 0.8278 0.8321 0.8253 2013-12-10 1.3765 1.3795 1.3732 102.78 103.392 102.55 0.8871 0.8908 0.8848 1.6445 1.6466 1.6416 1.0603 1.0645 1.0599 0.8369 0.8391 0.8347 141.473 142.166 141.23 1.2212 1.2239 1.22 0.9157 0.9167 0.9076 169.014 170.07 168.64 115.835 116.197 115.65 1.4588 1.4647 1.4544 0.8311 0.8334 0.8264 2013-12-11 1.3788 1.3811 1.3739 102.48 102.95 102.14 0.8861 0.8886 0.8836 1.6381 1.6457 1.6338 1.0592 1.062 1.058 0.8416 0.8431 0.836 141.3 141.69 140.87 1.2219 1.2228 1.22 0.9061 0.9153 0.9042 167.86 169.36 167.45 115.63 116.02 115.29 1.4518 1.4605 1.4484 0.827 0.831 0.8197 2013-12-12 1.3745 1.3803 1.3736 103.303 103.342 102.37 0.8896 0.8909 0.8846 1.6343 1.6418 1.6316 1.064 1.0656 1.0556 0.841 0.8431 0.8387 141.991 142.044 141.15 1.2229 1.2247 1.2196 0.8929 0.9081 0.8912 168.835 168.925 167.59 116.102 116.15 115.48 1.4537 1.4589 1.45 0.8249 0.832 0.822 2013-12-13 1.3732 1.377 1.3707 103.12 103.923 102.96 0.8901 0.8917 0.8879 1.6286 1.636 1.6259 1.0595 1.0669 1.0588 0.8431 0.844 0.8405 141.617 142.824 141.375 1.2224 1.224 1.2208 0.8951 0.8964 0.8905 167.94 169.82 167.647 115.82 116.72 115.7 1.4499 1.4554 1.4476 0.8262 0.8271 0.8196 2013-12-16 1.3764 1.3799 1.3734 103.01 103.29 102.62 0.8871 0.8903 0.8843 1.6304 1.6349 1.6285 1.0588 1.0594 1.0568 0.8442 0.8455 0.8413 141.79 142.13 141.2 1.2211 1.2232 1.2199 0.8947 0.897 0.8918 167.93 168.44 167.31 116.09 116.44 115.5 1.4465 1.4515 1.4426 0.8261 0.8288 0.8236 2013-12-17 1.3767 1.3782 1.3721 102.615 103.109 102.47 0.8846 0.8895 0.8829 1.6269 1.6336 1.6213 1.0607 1.0618 1.0571 0.8461 0.8467 0.8428 141.271 141.951 140.94 1.218 1.2217 1.2165 0.8903 0.8958 0.8878 166.942 168.2 166.497 115.979 116.276 115.56 1.4393 1.4485 1.4374 0.8268 0.8287 0.8235 2013-12-18 1.3696 1.3812 1.3693 103.81 103.859 102.53 0.8925 0.8928 0.8838 1.6385 1.6484 1.6266 1.0676 1.0691 1.0598 0.8357 0.8463 0.8356 142.223 142.676 141.2 1.2224 1.2236 1.2177 0.8851 0.8944 0.8819 170.138 170.37 166.84 116.324 116.709 115.62 1.4626 1.4629 1.439 0.8216 0.8288 0.817 2013-12-19 1.3655 1.3694 1.3647 104.212 104.365 103.76 0.8982 0.8986 0.8931 1.637 1.6396 1.6331 1.0665 1.0728 1.0657 0.8341 0.8367 0.8332 142.315 142.694 141.84 1.2267 1.2275 1.2224 0.8858 0.8875 0.8819 170.59 170.845 169.87 115.996 116.612 115.88 1.4703 1.4713 1.463 0.8184 0.8221 0.8147 2013-12-20 1.3677 1.3709 1.3622 104.03 104.64 103.83 0.8954 0.9001 0.8929 1.6341 1.6395 1.6311 1.0645 1.0737 1.0643 0.8368 0.8374 0.8326 142.3 142.74 142.05 1.2247 1.227 1.223 0.8924 0.8933 0.8851 170.027 171.07 169.81 116.16 116.54 115.94 1.4632 1.4711 1.462 0.8198 0.8223 0.8146 2013-12-23 1.3693 1.3717 1.3669 104.076 104.115 103.73 0.8937 0.8967 0.892 1.635 1.6375 1.6321 1.0611 1.0653 1.0577 0.8372 0.839 0.8351 142.526 142.71 142.05 1.2242 1.2265 1.2233 0.8937 0.8958 0.8915 170.18 170.38 169.691 116.407 116.591 115.88 1.4614 1.4672 1.459 0.8201 0.8216 0.8181 2013-12-24 1.3675 1.3699 1.3653 104.27 104.411 104.11 0.8957 0.8972 0.8931 1.6372 1.6381 1.6317 1.0618 1.0636 1.06 0.8354 0.8381 0.8341 142.601 142.91 142.41 1.2254 1.2259 1.2233 0.8923 0.8934 0.8903 170.607 170.83 170.05 116.355 116.73 116.23 1.4667 1.4687 1.46 0.8183 0.8197 0.8163 2013-12-25 1.3695 1.3705 1.3659 104.38 104.482 104.19 0.8934 0.897 0.8934 1.6298 1.6362 1.6296 1.062 1.0636 1.0594 0.8404 0.8409 0.8347 142.67 142.94 142.47 1.2254 1.2257 1.2243 0.8919 0.893 0.8906 170.17 170.844 169.91 116.64 116.7 116.298 1.4652 1.4677 1.463 0.8173 0.8195 0.8166 2013-12-26 1.3692 1.3702 1.3661 104.738 104.848 104.4 0.8963 0.897 0.8947 1.6418 1.6438 1.6345 1.0642 1.065 1.0611 0.8338 0.8366 0.8325 143.405 143.53 142.79 1.2271 1.2274 1.2245 0.8892 0.8922 0.8873 171.94 172.193 170.71 116.83 117.044 116.41 1.4716 1.4724 1.4639 0.8161 0.8192 0.8145 2013-12-27 1.374 1.3893 1.3687 105.12 105.175 104.61 0.8916 0.8965 0.8798 1.6467 1.6578 1.6401 1.071 1.0719 1.0614 0.8343 0.8392 0.8335 144.468 145.685 143.46 1.2252 1.2278 1.2224 0.8863 0.8929 0.8858 173.138 173.948 171.76 117.915 119.179 116.86 1.4683 1.4716 1.4564 0.815 0.8194 0.8136 2013-12-30 1.3798 1.382 1.3726 105.079 105.412 104.94 0.8873 0.8932 0.8857 1.6506 1.6533 1.6455 1.0639 1.0728 1.0633 0.8359 0.8372 0.8326 144.99 145.17 144.535 1.2249 1.227 1.2239 0.891 0.893 0.883 173.432 173.854 173.015 118.362 118.534 117.89 1.465 1.4721 1.4634 0.82 0.8223 0.8114 2013-12-31 1.3774 1.3812 1.3757 105.25 105.29 104.82 0.8905 0.8919 0.8862 1.6569 1.6578 1.647 1.0636 1.0657 1.0612 0.8312 0.8373 0.8306 144.98 145.06 144.37 1.2269 1.2277 1.2241 0.8926 0.8952 0.8899 174.369 174.53 172.74 118.13 118.38 117.62 1.4759 1.4763 1.462 0.8224 0.8243 0.8192 2014-01-01 1.3745 1.3754 1.3744 105.26 105.27 105.23 0.8927 0.893 0.8902 1.6543 1.6556 1.6543 1.0614 1.0623 1.0614 0.8296 0.8308 0.8296 144.62 144.81 144.62 1.2271 1.2272 1.2267 0.8919 0.892 0.8913 174.19 174.22 174.19 117.9 117.93 117.84 1.4773 1.4778 1.4773 0.8217 0.8223 0.8212 2014-01-02 1.3655 1.3775 1.3627 104.741 105.441 104.52 0.9004 0.9029 0.8903 1.6426 1.6603 1.6409 1.0668 1.0669 1.0583 0.8312 0.832 0.8268 143.032 145.135 142.829 1.2295 1.2321 1.226 0.8909 0.8943 0.8838 172.03 174.85 171.8 116.311 118.24 116.14 1.4791 1.4876 1.4763 0.8184 0.8233 0.8137 2014-01-03 1.3587 1.3672 1.3583 104.759 104.869 104.03 0.9051 0.9056 0.8985 1.6411 1.6474 1.6391 1.0628 1.0672 1.0597 0.8279 0.8317 0.8273 142.34 143.316 141.923 1.23 1.2313 1.2277 0.8959 0.9004 0.8882 171.917 172.52 171.01 115.706 116.61 115.36 1.4856 1.4869 1.4774 0.828 0.8317 0.8174 2014-01-06 1.3634 1.3653 1.3569 104.215 104.948 103.88 0.9035 0.907 0.9016 1.6401 1.6434 1.6333 1.0652 1.068 1.0605 0.8311 0.8331 0.8276 142.087 142.778 141.48 1.2319 1.2333 1.2292 0.8962 0.8983 0.8931 170.916 172.23 170.326 115.32 115.913 114.96 1.482 1.4869 1.4769 0.829 0.8305 0.8244 2014-01-07 1.3614 1.366 1.3594 104.52 104.733 104.15 0.909 0.9099 0.9033 1.6407 1.6438 1.637 1.0774 1.0777 1.0654 0.8296 0.832 0.8288 142.293 142.6 141.92 1.2376 1.2379 1.2313 0.8915 0.8971 0.8889 171.47 171.71 170.76 114.96 115.495 114.9 1.4914 1.4921 1.4822 0.8284 0.8302 0.8246 2014-01-08 1.3581 1.3635 1.3551 104.75 105.122 104.58 0.91 0.9127 0.9074 1.6454 1.6472 1.6374 1.0803 1.0829 1.0758 0.8253 0.8317 0.8239 142.26 143.18 142.09 1.2366 1.2394 1.2355 0.8912 0.8952 0.8893 172.37 172.84 171.425 115.03 115.636 114.86 1.4983 1.5009 1.4878 0.8265 0.8318 0.8247 2014-01-09 1.3607 1.3633 1.3547 104.75 105.06 104.55 0.9067 0.9124 0.9062 1.648 1.6497 1.6438 1.0853 1.0874 1.0815 0.8255 0.828 0.8227 142.55 143.03 142 1.2339 1.2387 1.2332 0.8891 0.8913 0.8862 172.64 173.13 172.12 115.51 115.69 114.84 1.4945 1.5026 1.4926 0.8252 0.8272 0.8228 2014-01-10 1.3665 1.3687 1.3568 104.08 105.355 103.81 0.9029 0.9091 0.9003 1.6481 1.6517 1.6375 1.0892 1.0946 1.0833 0.8291 0.8307 0.8253 142.23 143.072 142.013 1.2339 1.2348 1.2317 0.9002 0.9005 0.8872 171.548 173.028 171.21 115.24 115.924 115.13 1.4879 1.4952 1.4841 0.8303 0.8308 0.8198 2014-01-13 1.3668 1.3685 1.3634 102.94 104.109 102.82 0.8994 0.9048 0.8984 1.6385 1.6508 1.6343 1.0855 1.0929 1.0847 0.8343 0.8349 0.8281 140.704 142.265 140.48 1.2295 1.2343 1.2286 0.9056 0.9086 0.8982 168.651 171.63 168.277 114.435 115.36 113.94 1.4737 1.4887 1.4723 0.8366 0.8387 0.8274 2014-01-14 1.3681 1.37 1.3646 104.17 104.28 103 0.9021 0.9032 0.8984 1.6442 1.6464 1.6363 1.0946 1.0959 1.0866 0.8319 0.8343 0.8305 142.53 142.58 140.77 1.2343 1.2348 1.2286 0.8962 0.9056 0.8952 171.288 171.38 168.79 115.44 115.49 114.5 1.4835 1.4851 1.4727 0.8378 0.8432 0.835 2014-01-15 1.3604 1.3681 1.3579 104.563 104.69 104.07 0.9084 0.918 0.9118 1.6368 1.6464 1.6362 1.094 1.0991 1.0917 0.8311 0.833 0.8282 142.24 142.62 141.76 1.2361 1.237 1.2336 0.8911 0.897 0.8883 171.165 171.59 170.4 115.04 115.54 114.75 1.4874 1.4914 1.4821 0.8334 0.8394 0.8319 2014-01-16 1.3617 1.3649 1.3581 104.293 104.922 104.11 0.9049 0.9103 0.903 1.6357 1.6383 1.6312 1.0923 1.0963 1.09 0.8325 0.8341 0.8305 142.014 142.91 141.665 1.2318 1.2375 1.2311 0.8816 0.891 0.8772 170.581 171.8 170.136 115.242 115.579 114.9 1.4797 1.4886 1.4781 0.8348 0.8353 0.8287 2014-01-17 1.3524 1.3621 1.3515 104.27 104.474 104.17 0.9112 0.912 0.9041 1.6406 1.6459 1.6305 1.0974 1.0984 1.0922 0.8243 0.834 0.8231 141.024 142.162 140.94 1.2326 1.2337 1.2313 0.8774 0.8827 0.8759 171.05 171.874 170.088 114.403 115.361 114.32 1.4949 1.4977 1.4769 0.8257 0.8357 0.8244 2014-01-20 1.3562 1.357 1.3506 104.1 104.295 103.84 0.9092 0.9132 0.9085 1.6423 1.6452 1.6394 1.0958 1.0972 1.0927 0.8257 0.8263 0.823 141.179 141.375 140.3 1.2331 1.2342 1.2321 0.8802 0.8821 0.8753 170.971 171.49 170.26 114.469 114.64 113.77 1.4934 1.4986 1.4924 0.8262 0.8272 0.8211 2014-01-21 1.3558 1.3569 1.3514 104.332 104.749 103.99 0.9104 0.9156 0.9081 1.647 1.6486 1.6395 1.0973 1.1019 1.0943 0.823 0.8255 0.8211 141.458 141.855 140.98 1.2344 1.2377 1.232 0.881 0.8837 0.8771 171.838 172.369 170.975 114.589 114.851 114.18 1.4994 1.5035 1.4948 0.8315 0.8341 0.8292 2014-01-22 1.3548 1.3583 1.3532 104.4 104.57 103.94 0.9112 0.9122 0.9087 1.658 1.6587 1.6446 1.1075 1.1092 1.0949 0.8171 0.8236 0.8164 141.458 141.831 141.04 1.2346 1.2353 1.2329 0.8854 0.8888 0.8784 173.093 173.23 171.26 114.552 114.895 114.22 1.5108 1.5116 1.4975 0.8312 0.8346 0.8293 2014-01-23 1.3694 1.3698 1.3528 103.17 104.84 102.94 0.8972 0.9134 0.8957 1.663 1.6636 1.6554 1.1106 1.1173 1.1088 0.8233 0.8248 0.8169 141.28 142.415 141 1.2289 1.2361 1.2271 0.8759 0.885 0.8727 171.584 173.646 171.138 114.953 115.645 114.29 1.4924 1.5123 1.4896 0.8299 0.8338 0.8258 2014-01-24 1.368 1.3739 1.366 102.229 103.584 101.97 0.8943 0.8991 0.89 1.65 1.6668 1.6475 1.1071 1.1138 1.1049 0.829 0.83 0.8207 139.839 141.771 139.72 1.2235 1.2301 1.2224 0.8697 0.8775 0.8656 168.667 172.32 168.51 114.29 115.383 114.14 1.4756 1.4973 1.4741 0.8246 0.8296 0.8214 2014-01-27 1.3672 1.3717 1.365 102.705 102.93 101.88 0.8968 0.8984 0.8929 1.658 1.6587 1.6472 1.11 1.1111 1.1027 0.8244 0.8306 0.8233 140.417 140.693 139.41 1.2264 1.2273 1.2224 0.8753 0.876 0.8674 170.287 170.535 167.88 114.468 114.81 113.93 1.4875 1.4882 1.4718 0.8244 0.8261 0.8194 2014-01-28 1.3666 1.3688 1.3626 102.867 103.25 102.49 0.8976 0.901 0.8951 1.6578 1.6625 1.6533 1.1157 1.1177 1.1073 0.8242 0.8252 0.8219 140.591 140.983 140.11 1.2268 1.2284 1.2247 0.8772 0.8821 0.8723 170.541 171.311 169.877 114.58 114.88 114.31 1.4879 1.4931 1.4844 0.8268 0.8304 0.8212 2014-01-29 1.3661 1.3685 1.36 102.147 103.418 101.82 0.8944 0.9009 0.8932 1.6559 1.6607 1.6521 1.1167 1.1186 1.1098 0.8248 0.826 0.8216 139.544 141.25 139.02 1.222 1.2297 1.221 0.8728 0.8825 0.8722 169.152 171.46 168.65 114.18 114.923 113.77 1.4813 1.4927 1.4797 0.8195 0.8298 0.8173 2014-01-30 1.355 1.3664 1.3541 102.713 102.891 102.04 0.9033 0.9047 0.8941 1.6478 1.6564 1.644 1.1166 1.1199 1.1146 0.8223 0.827 0.8211 139.186 139.945 138.852 1.2241 1.2255 1.2214 0.8784 0.8803 0.8707 169.258 169.78 168.109 113.698 114.396 113.53 1.4885 1.4914 1.4784 0.8144 0.8218 0.8122 2014-01-31 1.3487 1.3573 1.3477 102.13 102.933 101.92 0.9065 0.908 0.9006 1.6434 1.6498 1.6422 1.1135 1.1224 1.1085 0.8204 0.8242 0.8185 137.77 139.503 137.45 1.2224 1.2245 1.2208 0.8745 0.8823 0.869 167.892 169.747 167.508 112.672 114.006 112.53 1.4897 1.4931 1.4829 0.8076 0.818 0.8059 2014-02-03 1.3531 1.3536 1.3475 101.013 102.41 100.75 0.901 0.9081 0.9 1.6311 1.6441 1.6286 1.1094 1.1134 1.1037 0.8295 0.8302 0.8199 136.699 138.11 136.34 1.2192 1.2242 1.2181 0.8754 0.8833 0.8734 164.78 168.215 164.236 112.105 112.91 111.87 1.4697 1.4917 1.4673 0.8092 0.8137 0.8079 2014-02-04 1.3515 1.3539 1.3491 101.646 101.663 100.73 0.904 0.9062 0.9006 1.6324 1.6345 1.6253 1.107 1.1123 1.1044 0.8278 0.8326 0.8263 137.386 137.45 136.188 1.2221 1.2232 1.2181 0.8937 0.8942 0.8727 165.95 165.99 163.821 112.411 112.428 111.67 1.4758 1.4783 1.4645 0.8208 0.8225 0.8042 2014-02-05 1.3531 1.3555 1.3497 101.386 101.766 100.77 0.9037 0.9057 0.9001 1.6308 1.6341 1.6248 1.1079 1.1121 1.1033 0.8298 0.8334 0.8262 137.2 137.542 136.5 1.2229 1.2234 1.2203 0.891 0.8938 0.8869 165.328 166.18 163.913 112.168 112.575 111.706 1.4738 1.4786 1.4646 0.8212 0.8233 0.8179 2014-02-06 1.3588 1.362 1.3481 102.122 102.171 101.21 0.9007 0.9063 0.8966 1.6321 1.6349 1.6268 1.1064 1.1122 1.1046 0.8324 0.835 0.8277 138.76 138.825 136.74 1.224 1.2243 1.2209 0.8962 0.8981 0.8915 166.681 166.825 165.01 113.34 113.472 111.87 1.4703 1.4763 1.4623 0.8255 0.8283 0.8204 2014-02-07 1.3638 1.3643 1.355 102.277 102.58 101.39 0.8972 0.9022 0.8953 1.6415 1.6418 1.6299 1.1039 1.1079 1.0963 0.8307 0.8329 0.8284 139.481 139.53 138.13 1.2237 1.225 1.2216 0.896 0.8998 0.8919 167.876 168.08 166.112 113.967 114.02 112.96 1.4728 1.4777 1.4667 0.8292 0.8295 0.8204 2014-02-10 1.3634 1.3651 1.3615 102.225 102.643 101.97 0.8972 0.8994 0.8956 1.6399 1.6427 1.6379 1.1052 1.1062 1.1012 0.8313 0.8326 0.8292 139.371 139.8 139.11 1.2232 1.225 1.222 0.8941 0.8959 0.8903 167.651 168.441 167.16 113.928 114.23 113.69 1.4712 1.4764 1.4681 0.8263 0.8287 0.8249 2014-02-11 1.3637 1.3683 1.3626 102.616 102.703 102.05 0.8983 0.8988 0.8936 1.645 1.6488 1.6388 1.1013 1.109 1.0998 0.829 0.8337 0.8282 139.93 140.306 139.228 1.2251 1.2257 1.2225 0.9039 0.9048 0.8939 168.815 169.085 167.46 114.221 114.611 113.83 1.4777 1.4788 1.467 0.8325 0.8344 0.8259 2014-02-12 1.3592 1.3653 1.3559 102.47 102.648 102.19 0.9005 0.9038 0.8964 1.6592 1.66 1.6421 1.0997 1.1025 1.097 0.8191 0.83 0.8187 139.277 139.968 138.63 1.224 1.226 1.223 0.9029 0.9067 0.9004 170.016 170.23 168.266 113.776 114.26 113.23 1.4942 1.4959 1.4746 0.8312 0.8368 0.8295 2014-02-13 1.368 1.3692 1.3582 102.232 102.533 101.63 0.8938 0.901 0.8916 1.6658 1.6674 1.6596 1.0976 1.1026 1.095 0.8212 0.8227 0.8176 139.881 139.92 138.85 1.2227 1.2244 1.2202 0.8985 0.9031 0.8924 170.32 170.381 169.163 114.37 114.43 113.55 1.4886 1.4966 1.4844 0.835 0.8358 0.8286 2014-02-14 1.3697 1.3715 1.3671 101.833 102.407 101.54 0.8915 0.8941 0.8901 1.6746 1.6748 1.664 1.0984 1.0988 1.0935 0.818 0.8227 0.8173 139.494 140.09 138.979 1.2215 1.2228 1.2201 0.9033 0.9043 0.8972 170.51 170.605 169.08 114.186 114.552 113.82 1.4933 1.4946 1.4845 0.8365 0.8384 0.8326 2014-02-17 1.3708 1.3724 1.3689 101.86 101.987 101.36 0.8914 0.8926 0.8898 1.6701 1.6822 1.6691 1.0956 1.0983 1.0948 0.8206 0.8209 0.8154 139.65 139.755 138.9 1.222 1.2227 1.2208 0.9036 0.9069 0.9018 170.159 171.07 169.849 114.279 114.36 113.69 1.4886 1.4976 1.4882 0.8366 0.8392 0.8347 2014-02-18 1.3757 1.377 1.3691 102.336 102.743 101.74 0.8881 0.8929 0.8868 1.668 1.6741 1.6651 1.0945 1.0977 1.0936 0.8246 0.8248 0.8186 140.778 141.034 139.475 1.2218 1.2238 1.2207 0.9035 0.908 0.8997 170.69 171.879 170.19 115.21 115.464 114.09 1.4814 1.4936 1.4808 0.8306 0.8381 0.8295 2014-02-19 1.3733 1.3773 1.3722 102.22 102.466 101.79 0.8879 0.8895 0.8853 1.6689 1.6734 1.6632 1.1083 1.1086 1.0905 0.8229 0.8261 0.8218 140.42 140.9 139.952 1.2196 1.2226 1.2187 0.8998 0.9044 0.8986 170.645 171.19 169.537 115.11 115.39 114.61 1.4822 1.4867 1.4777 0.8272 0.8343 0.8266 2014-02-20 1.372 1.3763 1.3684 102.315 102.42 101.64 0.8892 0.8915 0.8856 1.6654 1.67 1.6621 1.1098 1.1113 1.1055 0.8238 0.8253 0.8212 140.386 140.622 139.17 1.2201 1.221 1.2182 0.9014 0.9019 0.8933 170.394 170.794 169.19 115.041 115.21 114.19 1.4809 1.4861 1.4766 0.8308 0.8312 0.8238 2014-02-21 1.374 1.3758 1.37 102.56 102.828 102.26 0.8872 0.8911 0.8863 1.6638 1.6725 1.6608 1.1122 1.1195 1.1092 0.8257 0.8263 0.8212 140.911 141.266 140.27 1.2192 1.2211 1.2185 0.897 0.9015 0.8948 170.636 171.75 170.072 115.579 115.784 114.89 1.4763 1.4857 1.4753 0.8281 0.8315 0.8265 2014-02-24 1.3734 1.3771 1.3705 102.465 102.68 102.13 0.8887 0.8911 0.8848 1.6661 1.6679 1.6579 1.1062 1.1142 1.105 0.8242 0.8286 0.8237 140.721 141.039 140.31 1.2206 1.2218 1.2181 0.9035 0.9049 0.8935 170.705 170.87 169.797 115.266 115.692 115.06 1.4807 1.4818 1.4714 0.8329 0.8341 0.8256 2014-02-25 1.3742 1.3767 1.3713 102.09 102.626 101.98 0.887 0.8892 0.8851 1.6675 1.6727 1.6639 1.1085 1.1096 1.1049 0.824 0.8256 0.8222 140.298 140.966 140.087 1.2188 1.2211 1.2183 0.9013 0.9044 0.8999 170.22 171.086 170.04 115.081 115.503 114.9 1.4788 1.4826 1.4771 0.8325 0.8345 0.8312 2014-02-26 1.3685 1.3757 1.3659 102.34 102.61 102.05 0.8907 0.893 0.8862 1.6664 1.6702 1.6617 1.1119 1.1144 1.1067 0.8213 0.8252 0.8206 140.124 140.786 139.608 1.2191 1.2204 1.2184 0.896 0.9026 0.894 170.607 170.945 169.877 114.923 115.411 114.46 1.4841 1.4859 1.4778 0.8306 0.8345 0.8277 2014-02-27 1.3707 1.3727 1.364 102.08 102.444 101.69 0.888 0.8919 0.8867 1.6681 1.6699 1.6614 1.1141 1.116 1.1113 0.8216 0.8223 0.8195 139.92 140.222 138.755 1.2178 1.2189 1.2152 0.8958 0.8971 0.8899 170.289 170.825 168.985 114.879 115.125 114.13 1.4819 1.485 1.4799 0.8363 0.8391 0.8288 2014-02-28 1.3806 1.3825 1.369 101.773 102.292 101.52 0.879 0.8889 0.8774 1.6747 1.6769 1.6672 1.1075 1.1146 1.1037 0.8244 0.827 0.8188 140.524 141.121 139.073 1.2136 1.2183 1.2129 0.8919 0.8989 0.8912 170.451 171.202 169.315 115.782 116.04 114.28 1.472 1.4853 1.469 0.8383 0.8425 0.8354 2014-03-03 1.3729 1.3793 1.3723 101.385 101.571 101.16 0.8831 0.8836 0.8779 1.6654 1.6751 1.6649 1.108 1.111 1.1034 0.8243 0.825 0.822 139.181 139.88 139.13 1.2128 1.2139 1.21 0.8927 0.8946 0.8887 168.831 169.978 168.794 114.75 115.498 114.7 1.4712 1.4751 1.4688 0.8363 0.8384 0.8338 2014-03-04 1.3738 1.3782 1.3718 102.262 102.273 101.36 0.8873 0.8878 0.882 1.667 1.6716 1.6638 1.1103 1.1118 1.1055 0.8241 0.8261 0.8224 140.508 140.52 139.21 1.2191 1.2192 1.2123 0.895 0.8969 0.8906 170.473 170.56 168.884 115.2 115.406 114.78 1.4793 1.4797 1.4706 0.8389 0.84 0.8348 2014-03-05 1.3732 1.3749 1.3705 102.28 102.55 102.07 0.8874 0.8895 0.8856 1.672 1.6742 1.6653 1.1037 1.1099 1.1031 0.8212 0.8248 0.82 140.459 140.781 140.14 1.2186 1.22 1.2172 0.8985 0.8997 0.8934 171.017 171.391 170.063 115.23 115.575 115.03 1.4839 1.4861 1.4772 0.8418 0.8432 0.8373 2014-03-06 1.3859 1.3873 1.3719 103.048 103.167 102.29 0.8804 0.8891 0.8791 1.6735 1.6777 1.6682 1.0984 1.1046 1.0949 0.8278 0.8287 0.8202 142.814 142.918 140.47 1.2201 1.2215 1.2177 0.9091 0.9113 0.8969 172.467 172.835 170.964 117.031 117.13 115.28 1.4734 1.4866 1.4726 0.8479 0.8503 0.8402 2014-03-07 1.3869 1.3915 1.385 103.278 103.76 102.81 0.8777 0.8816 0.8753 1.6722 1.6786 1.6703 1.1093 1.1101 1.0974 0.829 0.8301 0.8271 143.236 143.79 142.5 1.2174 1.2214 1.2163 0.9066 0.9133 0.9057 172.707 173.583 171.92 117.646 117.865 116.91 1.4676 1.475 1.4666 0.846 0.8523 0.8441 2014-03-10 1.3869 1.3898 1.3858 103.24 103.405 102.91 0.8781 0.8793 0.8758 1.6638 1.6741 1.6618 1.1098 1.1131 1.1081 0.8335 0.835 0.8288 143.186 143.615 142.8 1.218 1.2193 1.2164 0.9018 0.9063 0.9008 171.782 172.87 171.4 117.54 117.845 117.32 1.461 1.4691 1.4589 0.8464 0.8481 0.8437 2014-03-11 1.3864 1.3879 1.3831 102.95 103.425 102.81 0.8774 0.8805 0.8763 1.6621 1.6653 1.6592 1.1104 1.1131 1.1066 0.8341 0.8347 0.8317 142.73 143.45 142.59 1.2169 1.2192 1.2161 0.8972 0.9051 0.8961 171.11 172.13 170.857 117.286 117.71 117.15 1.459 1.4643 1.4575 0.8468 0.8506 0.8456 2014-03-12 1.3906 1.3915 1.3841 102.638 103.1 102.51 0.8735 0.8788 0.8731 1.662 1.6636 1.6564 1.1119 1.1154 1.1087 0.8366 0.8374 0.8321 142.71 142.966 142.19 1.2151 1.2168 1.2147 0.8982 0.8993 0.892 170.592 171.45 170.087 117.444 117.58 116.95 1.4519 1.4614 1.4511 0.8461 0.8492 0.8434 2014-03-13 1.3859 1.3967 1.3843 101.628 102.862 101.52 0.8749 0.8764 0.8696 1.6614 1.6718 1.6604 1.1056 1.1122 1.1039 0.8341 0.838 0.8327 140.839 143.377 140.68 1.2126 1.2168 1.2122 0.902 0.9103 0.8985 168.837 171.64 168.679 116.149 117.861 115.94 1.4536 1.4568 1.4484 0.8534 0.8605 0.8507 2014-03-14 1.3908 1.3937 1.3845 101.33 101.87 101.18 0.8726 0.8762 0.87 1.6632 1.6645 1.6583 1.1092 1.1111 1.1063 0.8361 0.838 0.8331 140.91 141.51 140.4 1.2136 1.2146 1.2117 0.9024 0.9049 0.8993 168.526 169.36 167.89 116.1 116.63 115.75 1.4514 1.4556 1.4463 0.8531 0.8564 0.852 2014-03-17 1.3923 1.3947 1.3877 101.74 101.872 101.25 0.873 0.8756 0.871 1.6631 1.6666 1.66 1.1058 1.1107 1.104 0.8371 0.8377 0.8338 141.65 141.978 140.79 1.2156 1.216 1.2126 0.9086 0.9098 0.9007 169.19 169.604 168.433 116.51 116.807 116.022 1.4521 1.4559 1.4503 0.8566 0.8582 0.8522 2014-03-18 1.3934 1.3943 1.3878 101.391 101.941 101.24 0.8731 0.8769 0.872 1.6591 1.6648 1.6542 1.1139 1.1146 1.1021 0.8398 0.84 0.8358 141.282 141.97 140.69 1.2166 1.2178 1.2146 0.9127 0.9136 0.906 168.21 169.596 167.692 116.109 116.72 115.68 1.4487 1.4535 1.4472 0.8626 0.864 0.8537 2014-03-19 1.3829 1.3934 1.3808 102.52 102.682 101.26 0.8811 0.8829 0.8721 1.6529 1.6654 1.6505 1.1244 1.1271 1.1117 0.8365 0.8398 0.8354 141.77 141.923 141.03 1.2186 1.2202 1.2157 0.9031 0.914 0.9017 169.456 169.682 167.987 116.32 116.46 115.93 1.4564 1.459 1.4478 0.8543 0.8636 0.8525 2014-03-20 1.3775 1.3845 1.3747 102.407 102.548 102.17 0.884 0.8869 0.8795 1.6497 1.6569 1.6476 1.1242 1.1278 1.123 0.8348 0.837 0.8325 141.06 141.74 140.76 1.2178 1.2203 1.216 0.9036 0.9051 0.8991 168.949 169.72 168.637 115.83 116.295 115.5 1.4584 1.4648 1.4557 0.8529 0.8548 0.8498 2014-03-21 1.3796 1.3811 1.3763 102.104 102.431 101.99 0.8821 0.8842 0.881 1.6495 1.652 1.6471 1.1212 1.1263 1.117 0.8364 0.8371 0.8341 140.882 141.295 140.42 1.217 1.2186 1.2162 0.9085 0.91 0.9028 168.414 169.12 168.046 115.75 116.041 115.4 1.455 1.4591 1.4539 0.8536 0.8568 0.8519 2014-03-24 1.384 1.3876 1.3758 102.238 102.646 102.1 0.8808 0.8866 0.8784 1.6502 1.6536 1.6461 1.1189 1.1246 1.118 0.8386 0.8391 0.8341 141.5 141.885 140.68 1.219 1.2203 1.2164 0.913 0.9149 0.9046 168.731 169.439 168.258 116.06 116.343 115.41 1.4533 1.4622 1.4523 0.8544 0.8566 0.8511 2014-03-25 1.3824 1.3847 1.3747 102.276 102.487 102.06 0.8829 0.888 0.8797 1.6531 1.6549 1.6476 1.1158 1.121 1.1152 0.8362 0.8393 0.8331 141.387 141.595 140.653 1.2204 1.2217 1.2176 0.9159 0.9174 0.9115 169.07 169.29 168.303 115.848 116.192 115.22 1.4592 1.4647 1.4514 0.8572 0.8589 0.8528 2014-03-26 1.3793 1.3828 1.3774 102.048 102.471 101.89 0.884 0.887 0.8822 1.659 1.6597 1.6505 1.1106 1.117 1.1087 0.8314 0.8365 0.831 140.778 141.51 140.55 1.22 1.2235 1.2189 0.9231 0.9245 0.915 169.284 169.68 168.8 115.376 115.94 115.23 1.4672 1.4677 1.4584 0.8605 0.862 0.8564 2014-03-27 1.3744 1.3797 1.3726 102.155 102.433 101.69 0.8862 0.8873 0.8838 1.661 1.6647 1.6551 1.103 1.1106 1.1015 0.8274 0.8322 0.826 140.417 141.04 140.138 1.2181 1.2207 1.217 0.9259 0.9272 0.9211 169.67 170.325 168.577 115.25 115.61 114.944 1.472 1.4749 1.4657 0.8674 0.8686 0.8586 2014-03-28 1.375 1.3773 1.3703 102.807 102.982 102 0.8867 0.8899 0.8846 1.6641 1.6651 1.6595 1.1062 1.1078 1.0996 0.8261 0.8282 0.8243 141.368 141.647 139.915 1.2193 1.2202 1.2174 0.9247 0.9295 0.9233 171.07 171.315 169.482 115.924 116.139 114.72 1.4756 1.4791 1.471 0.865 0.8697 0.8646 2014-03-31 1.3781 1.3809 1.3721 103.214 103.437 102.76 0.8838 0.8889 0.8821 1.6673 1.6684 1.6609 1.1051 1.1067 1.0999 0.8264 0.8297 0.8249 142.253 142.604 141.275 1.2178 1.2205 1.2166 0.927 0.9278 0.9214 172.097 172.14 170.9 116.773 116.945 115.81 1.4731 1.4783 1.4689 0.8674 0.8684 0.8636 2014-04-01 1.3793 1.3815 1.3767 103.679 103.711 103.05 0.8832 0.8849 0.8812 1.6631 1.6675 1.6613 1.1028 1.107 1.1008 0.8291 0.8307 0.8258 143.02 143.08 141.98 1.2183 1.219 1.2169 0.9244 0.9304 0.9225 172.45 172.52 171.661 117.386 117.45 116.54 1.4689 1.4748 1.4656 0.8647 0.8702 0.8639 2014-04-02 1.3762 1.382 1.375 103.837 103.932 103.55 0.8865 0.8875 0.8815 1.6622 1.6664 1.6618 1.1023 1.1047 1.1 0.8279 0.831 0.8267 142.9 143.476 142.675 1.2205 1.2209 1.2175 0.9243 0.9263 0.9219 172.519 173 172.2 117.077 117.715 116.9 1.4738 1.4757 1.4663 0.8556 0.8628 0.8543 2014-04-03 1.3715 1.3807 1.3695 103.94 104.114 103.77 0.8912 0.8928 0.8841 1.6594 1.6661 1.6566 1.1032 1.1045 1.1 0.8265 0.8315 0.8256 142.559 143.436 142.255 1.2223 1.2233 1.219 0.9228 0.9252 0.9201 172.47 173.16 172.085 116.616 117.49 116.33 1.479 1.4801 1.4679 0.8541 0.858 0.8509 2014-04-04 1.3705 1.3731 1.367 103.24 104.126 103.17 0.891 0.8953 0.8903 1.6579 1.6606 1.6549 1.098 1.1042 1.0953 0.8267 0.8277 0.8246 141.518 142.64 141.38 1.2218 1.2249 1.221 0.9284 0.9308 0.9225 171.17 172.52 171.005 115.811 116.67 115.67 1.4778 1.4828 1.4768 0.8589 0.8604 0.8526 2014-04-07 1.3743 1.375 1.3694 103.15 103.41 102.97 0.8877 0.8927 0.8869 1.6608 1.6624 1.6561 1.0965 1.1009 1.0957 0.8274 0.8285 0.8257 141.762 141.894 141.078 1.2199 1.2229 1.2191 0.9268 0.9299 0.925 171.3 171.6 170.603 116.189 116.31 115.44 1.4744 1.4798 1.4728 0.8608 0.8615 0.8572 2014-04-08 1.3794 1.3812 1.3734 101.694 103.118 101.52 0.8834 0.8879 0.8822 1.6745 1.6754 1.6603 1.0922 1.0977 1.0909 0.8237 0.8276 0.8229 140.274 141.72 140.06 1.2187 1.2203 1.2177 0.9354 0.9366 0.9258 170.25 171.559 169.92 115.088 116.15 114.96 1.4791 1.4816 1.4732 0.8668 0.8681 0.8598 2014-04-09 1.3851 1.3858 1.3777 101.974 102.158 101.69 0.8796 0.8846 0.8784 1.6789 1.68 1.672 1.0869 1.0942 1.0854 0.8249 0.8256 0.8228 141.253 141.268 140.42 1.2185 1.2196 1.2166 0.9386 0.9399 0.9332 171.21 171.228 170.404 115.907 115.928 115.18 1.4767 1.4811 1.4742 0.871 0.8726 0.8641 2014-04-10 1.3887 1.39 1.3833 101.485 102.136 101.3 0.8763 0.8805 0.8748 1.6778 1.682 1.6751 1.0925 1.0928 1.0864 0.8276 0.828 0.8237 140.94 141.553 140.56 1.2169 1.2191 1.2161 0.9412 0.9461 0.9367 170.288 171.63 170.004 115.79 116.184 115.42 1.4703 1.4788 1.4687 0.868 0.8746 0.8675 2014-04-11 1.3882 1.3906 1.386 101.62 101.87 101.3 0.8755 0.8771 0.8738 1.6737 1.6787 1.6713 1.0972 1.0983 1.0913 0.8294 0.831 0.827 141.079 141.555 140.59 1.2156 1.2179 1.2147 0.9397 0.9426 0.9359 170.091 170.917 169.427 116.04 116.27 115.61 1.4653 1.471 1.463 0.8688 0.8706 0.862 2014-04-14 1.382 1.3863 1.3806 101.743 102.011 101.39 0.8795 0.8806 0.8758 1.6728 1.6744 1.6692 1.0963 1.0992 1.0938 0.826 0.8284 0.8249 140.621 140.923 140.4 1.2156 1.216 1.2137 0.9413 0.9423 0.9373 170.227 170.53 169.535 115.668 115.97 115.5 1.4715 1.4719 1.4658 0.8675 0.8693 0.8626 2014-04-15 1.3813 1.3833 1.3788 101.804 101.994 101.46 0.8802 0.8819 0.878 1.6723 1.6749 1.6656 1.0977 1.1013 1.0957 0.8259 0.8283 0.8242 140.63 140.904 140.188 1.2158 1.2166 1.2145 0.9351 0.9423 0.9332 170.264 170.69 169.439 115.651 115.829 115.32 1.4719 1.4749 1.4673 0.8641 0.8691 0.8621 2014-04-16 1.3813 1.3851 1.3801 102.28 102.365 101.78 0.882 0.8829 0.8778 1.6794 1.6818 1.6716 1.1017 1.1034 1.0956 0.8224 0.827 0.8216 141.288 141.763 140.61 1.2184 1.2204 1.2154 0.9372 0.9388 0.9329 171.75 172.105 170.224 115.955 116.534 115.63 1.4811 1.4829 1.4709 0.8624 0.8647 0.8574 2014-04-17 1.3814 1.3865 1.3808 102.45 102.458 101.84 0.8828 0.8832 0.8774 1.6794 1.6842 1.6783 1.1009 1.1018 1.0979 0.8225 0.8247 0.8212 141.517 141.65 140.96 1.22 1.2202 1.2164 0.9326 0.939 0.9317 172.03 172.11 171.369 115.995 116.352 115.71 1.4832 1.4834 1.4755 0.8566 0.8648 0.856 2014-04-18 1.3818 1.3822 1.3806 102.379 102.57 102.32 0.8825 0.8836 0.882 1.679 1.6797 1.6771 1.1012 1.1015 1.0992 0.823 0.8238 0.8219 141.469 141.652 141.378 1.2197 1.2204 1.2189 0.9336 0.9342 0.932 171.89 172.187 171.731 115.975 116.095 115.83 1.482 1.4837 1.4798 0.8579 0.8592 0.856 2014-04-21 1.3793 1.383 1.3785 102.602 102.706 102.36 0.8844 0.8852 0.8815 1.6799 1.6819 1.6779 1.1012 1.1031 1.1002 0.8211 0.8231 0.8206 141.546 141.83 141.37 1.2205 1.2207 1.2189 0.9328 0.9346 0.9312 172.358 172.5 171.936 115.945 116.28 115.82 1.4862 1.4868 1.4819 0.856 0.8601 0.855 2014-04-22 1.3804 1.3825 1.3782 102.61 102.72 102.37 0.8848 0.8862 0.883 1.6823 1.684 1.6781 1.1024 1.1042 1.0996 0.8205 0.8217 0.8193 141.66 141.77 141.17 1.2215 1.222 1.22 0.9366 0.9378 0.9318 172.624 172.77 171.94 115.91 116.1 115.63 1.4888 1.4904 1.4851 0.8596 0.862 0.8562 2014-04-23 1.3816 1.3855 1.3798 102.44 102.692 102.145 0.883 0.8853 0.8804 1.6778 1.6836 1.6758 1.1032 1.1053 1.1013 0.8234 0.8246 0.8198 141.521 141.997 141.138 1.22 1.2225 1.2189 0.9282 0.9377 0.9263 171.866 172.79 171.284 115.996 116.305 115.76 1.4813 1.4894 1.4784 0.8585 0.862 0.8561 2014-04-24 1.3827 1.3843 1.3788 102.311 102.646 102.06 0.8819 0.8856 0.8809 1.6801 1.6806 1.6761 1.1026 1.1038 1.1009 0.8229 0.8245 0.8217 141.464 141.79 141 1.2194 1.2217 1.218 0.9258 0.9301 0.9248 171.896 172.188 171.399 115.994 116.184 115.68 1.4817 1.4852 1.4794 0.8567 0.8637 0.8543 2014-04-25 1.3832 1.385 1.3825 102.165 102.497 101.93 0.8812 0.8821 0.8798 1.6797 1.683 1.6786 1.1035 1.1047 1.1009 0.8234 0.8242 0.8219 141.326 141.747 140.985 1.2191 1.22 1.2181 0.9268 0.9298 0.925 171.616 172.28 171.336 115.922 116.205 115.64 1.4803 1.4829 1.4787 0.8578 0.8593 0.8547 2014-04-28 1.3848 1.388 1.3813 102.54 102.62 102.01 0.8803 0.8826 0.8767 1.6806 1.6858 1.6775 1.1019 1.104 1.1011 0.8239 0.8244 0.8214 142 142.15 140.96 1.2191 1.2198 1.2167 0.9257 0.9316 0.924 172.322 172.58 171.18 116.47 116.69 115.59 1.4794 1.4841 1.477 0.8535 0.8587 0.852 2014-04-29 1.3811 1.388 1.3802 102.566 102.782 102.43 0.8832 0.8846 0.8783 1.6829 1.6847 1.6788 1.0955 1.1028 1.0945 0.8205 0.826 0.8197 141.659 142.474 141.543 1.2199 1.2213 1.2188 0.9273 0.9282 0.9224 172.618 172.911 172.163 116.094 116.815 115.9 1.4864 1.4886 1.4765 0.8553 0.8557 0.8512 2014-04-30 1.387 1.3877 1.3772 102.16 102.66 102 0.88 0.8852 0.8788 1.6879 1.6901 1.6803 1.0951 1.0979 1.0938 0.8216 0.8235 0.8193 141.69 142.14 141.08 1.2206 1.221 1.2188 0.9287 0.9301 0.9248 172.42 172.72 171.8 116.07 116.49 115.63 1.4851 1.4877 1.481 0.862 0.8633 0.8541 2014-05-01 1.3865 1.3889 1.3859 102.304 102.366 102.1 0.8793 0.8803 0.878 1.6887 1.692 1.6869 1.0963 1.0995 1.0949 0.8209 0.8228 0.82 141.84 142.03 141.675 1.2191 1.2209 1.2185 0.9271 0.9313 0.9257 172.756 172.94 172.299 116.324 116.46 116.04 1.485 1.487 1.4824 0.8627 0.8637 0.8596 2014-05-02 1.387 1.3881 1.381 102.232 103.019 102.09 0.8781 0.8841 0.8769 1.6872 1.6895 1.6819 1.0981 1.1006 1.0933 0.822 0.8225 0.8196 141.803 142.44 141.62 1.2181 1.2213 1.2171 0.9267 0.928 0.9198 172.48 173.461 172.301 116.391 116.757 116.14 1.4816 1.4882 1.4799 0.8662 0.867 0.859 2014-05-05 1.3876 1.3886 1.3862 102.1 102.243 101.83 0.8776 0.8781 0.876 1.6866 1.6883 1.6849 1.0953 1.0989 1.0944 0.8226 0.8233 0.8211 141.698 141.86 141.26 1.2178 1.2184 1.2166 0.9272 0.9289 0.9249 172.21 172.55 171.696 116.349 116.51 116.03 1.4802 1.4819 1.4778 0.8677 0.8687 0.8644 2014-05-06 1.3928 1.3951 1.3869 101.639 102.19 101.47 0.874 0.878 0.8718 1.698 1.6996 1.6863 1.0877 1.0961 1.0872 0.8202 0.8227 0.8191 141.561 142.1 141.313 1.2174 1.2187 1.2159 0.9356 0.9367 0.9267 172.56 172.95 172.122 116.261 116.752 116.08 1.4843 1.485 1.4793 0.8752 0.8779 0.8674 2014-05-07 1.3912 1.394 1.3909 101.825 102.007 101.4 0.8757 0.8763 0.873 1.6955 1.6986 1.6951 1.0893 1.0908 1.0871 0.8206 0.8214 0.819 141.67 142.007 141.105 1.219 1.2192 1.216 0.9333 0.9354 0.9314 172.643 172.98 172.087 116.216 116.475 115.96 1.4852 1.4861 1.4822 0.8669 0.8727 0.8653 2014-05-08 1.3852 1.3993 1.3847 101.546 101.957 101.43 0.8791 0.8797 0.87 1.6939 1.6975 1.6921 1.0823 1.0904 1.0809 0.8176 0.825 0.8165 140.667 142.364 140.52 1.2181 1.2191 1.2168 0.9379 0.9394 0.9315 172.014 172.87 171.82 115.454 116.878 115.36 1.4897 1.4915 1.4761 0.8645 0.8672 0.8622 2014-05-09 1.3754 1.3844 1.3744 101.81 101.853 101.52 0.8865 0.8873 0.8795 1.6849 1.6938 1.6828 1.0898 1.0916 1.081 0.8162 0.8183 0.8157 140.02 140.82 139.843 1.2194 1.22 1.2175 0.9357 0.9379 0.9342 171.534 172.302 171.149 114.822 115.552 114.64 1.4938 1.4947 1.489 0.8611 0.8651 0.8601 2014-05-12 1.3757 1.3775 1.3747 102.168 102.186 101.79 0.8877 0.8881 0.8854 1.6867 1.6903 1.6845 1.0894 1.0904 1.0869 0.8155 0.817 0.814 140.55 140.633 140.04 1.2213 1.2219 1.2194 0.9364 0.9386 0.9345 172.337 172.508 171.478 115.073 115.139 114.75 1.4974 1.4993 1.4935 0.8622 0.8638 0.8604 2014-05-13 1.3701 1.3772 1.3687 102.271 102.364 102.03 0.8903 0.8908 0.886 1.6825 1.6883 1.6816 1.0907 1.0926 1.0882 0.8142 0.8174 0.8131 140.108 140.946 139.96 1.2198 1.2215 1.2187 0.9356 0.9382 0.9329 172.05 172.74 171.834 114.86 115.43 114.76 1.4977 1.4994 1.4933 0.8631 0.8669 0.8616 2014-05-14 1.371 1.3731 1.3694 101.772 102.276 101.69 0.8897 0.8905 0.888 1.6768 1.6874 1.6749 1.0877 1.0922 1.0866 0.8176 0.8184 0.8124 139.53 140.276 139.43 1.2197 1.2203 1.2185 0.9376 0.9409 0.9352 170.655 172.36 170.523 114.383 115 114.29 1.4919 1.5007 1.49 0.8664 0.8678 0.8619 2014-05-15 1.371 1.3733 1.3646 101.54 102.116 101.29 0.8904 0.896 0.8879 1.6793 1.6806 1.6729 1.0874 1.0891 1.0847 0.8163 0.8183 0.8141 139.204 139.866 138.9 1.2207 1.223 1.2194 0.9356 0.9393 0.9323 170.514 171.08 170.13 114.028 114.622 113.73 1.4954 1.5011 1.4907 0.864 0.8696 0.8623 2014-05-16 1.37 1.3727 1.3682 101.53 101.67 101.33 0.8915 0.8923 0.8894 1.682 1.6841 1.6781 1.0858 1.0889 1.0855 0.8144 0.8172 0.8136 139.1 139.44 138.74 1.2218 1.222 1.22 0.9366 0.9371 0.933 170.775 171 170.14 113.83 114.14 113.65 1.4996 1.5007 1.4942 0.8636 0.8655 0.8619 2014-05-19 1.3709 1.3734 1.3692 101.389 101.598 101.07 0.892 0.8925 0.8901 1.6821 1.6845 1.6801 1.0868 1.0875 1.0845 0.8149 0.816 0.8136 138.996 139.27 138.58 1.2229 1.2236 1.2211 0.9329 0.9369 0.9323 170.56 170.99 169.91 113.655 113.97 113.31 1.5003 1.5015 1.4976 0.8622 0.8654 0.8619 2014-05-20 1.3698 1.3714 1.3675 101.32 101.599 101.15 0.892 0.894 0.8909 1.684 1.6865 1.6798 1.0895 1.0917 1.0866 0.8132 0.8156 0.8116 138.8 139.315 138.503 1.222 1.2237 1.2209 0.9254 0.9336 0.9237 170.66 170.947 170.296 113.572 113.891 113.28 1.502 1.5058 1.4989 0.8576 0.8635 0.8556 2014-05-21 1.3685 1.3723 1.3633 101.406 101.619 100.798 0.8933 0.8966 0.8894 1.6902 1.6921 1.6828 1.0915 1.0942 1.089 0.8096 0.8145 0.8082 138.788 138.931 138.097 1.2226 1.2228 1.2203 0.9237 0.9244 0.9205 171.392 171.49 169.78 113.507 113.694 113.04 1.5098 1.5116 1.4983 0.8563 0.8595 0.8533 2014-05-22 1.3654 1.3688 1.3643 101.787 101.815 101.31 0.8944 0.8952 0.8919 1.6864 1.6918 1.6847 1.0894 1.0931 1.0881 0.8096 0.8112 0.8082 138.995 139.128 138.61 1.2212 1.2227 1.2206 0.9221 0.9274 0.921 171.665 171.87 171.13 113.8 113.85 113.41 1.5084 1.5116 1.5052 0.8561 0.8588 0.8547 2014-05-23 1.363 1.3656 1.3613 101.977 102.005 101.57 0.8954 0.8972 0.8937 1.6828 1.6876 1.6808 1.087 1.0909 1.0859 0.8099 0.8104 0.8078 139.004 139.04 138.54 1.2205 1.2217 1.22 0.9235 0.925 0.9209 171.6 171.795 171.196 113.879 113.9 113.42 1.5068 1.5117 1.5058 0.8542 0.8574 0.8527 2014-05-26 1.3645 1.3654 1.3611 101.922 102.051 101.8 0.8946 0.8967 0.8935 1.6844 1.6853 1.6815 1.0853 1.0873 1.0848 0.81 0.8105 0.8081 139.063 139.1 138.7 1.2207 1.2215 1.2199 0.9243 0.925 0.9222 171.643 171.8 171.354 113.899 113.95 113.61 1.5069 1.5103 1.5055 0.8553 0.8557 0.8522 2014-05-27 1.3636 1.3669 1.361 101.97 102.141 101.7 0.8966 0.8982 0.8933 1.6807 1.6882 1.6778 1.0859 1.0875 1.0829 0.8113 0.812 0.8082 139.056 139.364 138.775 1.2227 1.2229 1.2205 0.9259 0.9277 0.9229 171.399 171.99 171.233 113.718 114.08 113.6 1.5069 1.5106 1.5051 0.8546 0.8579 0.8526 2014-05-28 1.3594 1.364 1.3587 101.84 102.03 101.61 0.898 0.899 0.8961 1.6711 1.6816 1.6693 1.0875 1.0886 1.0837 0.8134 0.8143 0.8101 138.463 139.13 138.255 1.2208 1.2235 1.2205 0.9231 0.9271 0.921 170.206 171.52 169.806 113.388 113.8 113.14 1.5007 1.5085 1.4993 0.8493 0.8571 0.8467 2014-05-29 1.3602 1.3626 1.3584 101.7 101.834 101.39 0.8978 0.8983 0.8951 1.6713 1.6741 1.6689 1.0839 1.0878 1.0822 0.8136 0.8153 0.8125 138.38 138.517 137.93 1.2212 1.2214 1.2197 0.9293 0.9313 0.9208 170.053 170.21 169.47 113.31 113.438 112.99 1.5007 1.502 1.4972 0.8466 0.8508 0.8447 2014-05-30 1.3631 1.365 1.3596 101.802 101.846 101.45 0.8953 0.8983 0.8929 1.6761 1.6777 1.6712 1.0842 1.0868 1.0817 0.8132 0.814 0.8117 138.757 138.877 138.05 1.2203 1.2217 1.219 0.9303 0.9329 0.9284 170.636 170.71 169.698 113.696 113.884 113.04 1.5007 1.504 1.498 0.849 0.8517 0.8468 2014-06-02 1.3597 1.3643 1.3586 102.427 102.482 101.72 0.8986 0.8995 0.8937 1.6744 1.677 1.672 1.0899 1.0912 1.0834 0.8119 0.8143 0.8112 139.272 139.322 138.64 1.2218 1.2225 1.2198 0.9249 0.9321 0.923 171.51 171.621 170.374 113.973 114.02 113.49 1.5048 1.5057 1.4985 0.8452 0.8497 0.8437 2014-06-03 1.3625 1.3648 1.3585 102.527 102.552 102.24 0.8964 0.8995 0.8946 1.6746 1.6782 1.6726 1.0908 1.0922 1.0885 0.8136 0.815 0.8103 139.694 139.8 139 1.2215 1.2226 1.2207 0.9256 0.9287 0.9227 171.671 171.815 171.208 114.35 114.43 113.78 1.5013 1.5079 1.4987 0.8424 0.8477 0.8415 2014-06-04 1.3599 1.364 1.3594 102.713 102.796 102.4 0.897 0.8982 0.8942 1.6741 1.6769 1.6694 1.0934 1.0955 1.0903 0.8123 0.815 0.8116 139.67 139.96 139.508 1.22 1.2224 1.2189 0.9277 0.9297 0.9249 171.954 172.08 171.277 114.47 114.73 114.26 1.5018 1.5028 1.4983 0.8413 0.8442 0.8399 2014-06-05 1.3653 1.367 1.3501 102.472 102.734 102.31 0.8919 0.9037 0.8905 1.6811 1.6825 1.672 1.0928 1.096 1.0912 0.8121 0.814 0.806 139.908 139.988 138.65 1.2177 1.2208 1.2168 0.9334 0.9346 0.9255 172.275 172.312 171.5 114.87 114.955 113.62 1.4994 1.5131 1.496 0.8496 0.8514 0.8414 2014-06-06 1.3644 1.3677 1.3618 102.49 102.611 102.088 0.8934 0.8952 0.8906 1.6806 1.6845 1.6776 1.0927 1.0948 1.0902 0.8117 0.813 0.8097 139.902 139.99 139.328 1.2189 1.2195 1.2162 0.9333 0.9358 0.9314 172.33 172.51 171.74 114.77 114.93 114.45 1.5014 1.5044 1.4975 0.8495 0.8554 0.8477 2014-06-09 1.3587 1.367 1.358 102.517 102.649 102.34 0.8973 0.898 0.8916 1.6793 1.6832 1.6779 1.0907 1.0941 1.0896 0.8092 0.8123 0.8085 139.31 140.091 139.217 1.2193 1.22 1.2181 0.9351 0.9364 0.9328 172.172 172.538 171.924 114.242 114.902 114.17 1.5068 1.5079 1.4999 0.8486 0.8531 0.8476 2014-06-10 1.3545 1.3602 1.353 102.327 102.573 102.18 0.8989 0.9008 0.896 1.6756 1.6817 1.674 1.0905 1.0921 1.0885 0.8083 0.8094 0.806 138.621 139.43 138.397 1.218 1.2197 1.2175 0.9372 0.9384 0.9337 171.469 172.34 171.275 113.799 114.332 113.57 1.5066 1.5118 1.5059 0.8523 0.8527 0.8489 2014-06-11 1.3529 1.3557 1.3518 101.97 102.392 101.83 0.8997 0.9012 0.8977 1.6793 1.6811 1.6737 1.0868 1.0905 1.0857 0.8054 0.8086 0.8049 138.028 138.68 137.82 1.2173 1.2188 1.2166 0.9382 0.9406 0.9361 171.322 171.81 170.889 113.36 113.84 113.19 1.511 1.5129 1.5058 0.8554 0.8575 0.8519 2014-06-12 1.3564 1.3572 1.3509 101.623 102.143 101.57 0.8976 0.9012 0.8966 1.6832 1.686 1.6784 1.0853 1.087 1.0837 0.8058 0.8065 0.8029 137.836 138.34 137.71 1.2175 1.2184 1.2167 0.9422 0.9437 0.9347 171.04 171.916 170.948 113.205 113.551 113.13 1.511 1.516 1.5098 0.8683 0.8691 0.8599 2014-06-13 1.3538 1.358 1.3518 101.99 102.138 101.62 0.9002 0.9011 0.8956 1.6968 1.6992 1.6918 1.0856 1.0871 1.0843 0.7977 0.8007 0.7969 138.094 138.555 137.72 1.2187 1.2188 1.2161 0.9401 0.9427 0.9371 173.096 173.37 172.035 113.297 113.783 113.13 1.5275 1.5282 1.5198 0.8668 0.8686 0.864 2014-06-19 1.3602 1.3643 1.3581 101.95 102.001 101.7 0.8944 0.8966 0.8907 1.7035 1.7063 1.698 1.0823 1.084 1.0804 0.7983 0.8025 0.798 138.679 138.89 138.35 1.2165 1.2186 1.2149 0.9397 0.9432 0.9387 173.679 173.785 172.91 113.972 114.258 113.61 1.5235 1.5244 1.5165 0.871 0.8736 0.8699 2014-06-20 1.3595 1.3634 1.3562 102.101 102.196 101.78 0.8954 0.8974 0.892 1.7013 1.7061 1.6999 1.075 1.0826 1.0746 0.7991 0.7997 0.7965 138.815 138.894 138.495 1.2175 1.2178 1.2156 0.9385 0.9415 0.9373 173.711 174.093 173.458 114.021 114.141 113.77 1.5234 1.5275 1.5211 0.8697 0.8723 0.8675 2014-06-23 1.3603 1.3614 1.3571 101.9 102.14 101.78 0.8939 0.8968 0.8936 1.7025 1.7049 1.6997 1.0725 1.0762 1.0713 0.799 0.8 0.7973 138.62 138.85 138.24 1.2162 1.2177 1.2157 0.9418 0.9445 0.9365 173.471 173.83 173.08 113.97 114.13 113.56 1.522 1.526 1.5209 0.8712 0.8749 0.8686 2014-06-24 1.3601 1.3628 1.3581 101.922 102.167 101.79 0.8941 0.8958 0.8919 1.6978 1.7032 1.6961 1.0744 1.0745 1.071 0.801 0.8025 0.798 138.631 138.926 138.4 1.2162 1.2175 1.215 0.9372 0.9431 0.9367 173.06 173.77 172.866 113.983 114.235 113.75 1.5179 1.5241 1.515 0.8677 0.8723 0.8669 2014-06-25 1.363 1.3651 1.3598 101.855 101.969 101.59 0.8928 0.8945 0.8905 1.6979 1.7005 1.6948 1.0721 1.0752 1.0713 0.8027 0.8034 0.8006 138.828 138.901 138.5 1.2168 1.217 1.2155 0.9399 0.9402 0.9351 172.942 173.21 172.62 114.081 114.183 113.89 1.5158 1.5186 1.5134 0.8732 0.8741 0.8656 2014-06-26 1.3607 1.3641 1.3574 101.691 101.857 101.46 0.8937 0.8956 0.8917 1.7022 1.704 1.6967 1.0691 1.0725 1.0679 0.7994 0.8032 0.798 138.372 138.824 137.878 1.2161 1.2172 1.2152 0.9413 0.9419 0.9392 173.097 173.45 172.554 113.774 114.08 113.37 1.5213 1.5238 1.5146 0.8773 0.8776 0.8723 2014-06-27 1.3646 1.3648 1.3607 101.39 101.681 101.278 0.891 0.8938 0.8904 1.7031 1.7051 1.7002 1.0664 1.0696 1.0656 0.8009 0.8018 0.7988 138.362 138.41 137.938 1.2159 1.2166 1.2147 0.9424 0.9441 0.9401 172.692 173.13 172.376 113.791 113.822 113.41 1.5175 1.5219 1.5152 0.8778 0.8794 0.8748 2014-06-30 1.3693 1.3698 1.3637 101.318 101.472 101.21 0.8867 0.8915 0.8859 1.7114 1.7115 1.7004 1.0667 1.0697 1.0644 0.8001 0.803 0.7996 138.727 138.75 138.063 1.2143 1.2161 1.2135 0.9429 0.9439 0.9383 173.394 173.43 172.305 114.24 114.272 113.56 1.5177 1.5186 1.5135 0.8754 0.8782 0.8722 2014-07-01 1.3677 1.3701 1.3673 101.536 101.593 101.25 0.8875 0.8879 0.8854 1.7152 1.7166 1.7091 1.0634 1.0678 1.0626 0.7974 0.801 0.797 138.872 139.134 138.66 1.214 1.2147 1.2129 0.9495 0.9505 0.9409 174.161 174.286 173.179 114.395 114.586 114.18 1.5224 1.5225 1.5161 0.8778 0.8791 0.8746 2014-07-02 1.3655 1.3683 1.3639 101.808 101.843 101.37 0.8891 0.8899 0.8868 1.7165 1.7177 1.7135 1.0668 1.0671 1.0621 0.7954 0.798 0.7947 139.017 139.08 138.493 1.2141 1.2144 1.213 0.9436 0.9495 0.9424 174.755 174.802 173.9 114.491 114.545 114.1 1.5263 1.5268 1.5208 0.877 0.8775 0.8742 2014-07-03 1.3603 1.3664 1.3594 102.201 102.266 101.72 0.8939 0.8943 0.8883 1.7147 1.7165 1.7097 1.0624 1.068 1.0616 0.7932 0.7972 0.7928 139.033 139.279 138.91 1.216 1.2165 1.2135 0.9357 0.9443 0.9326 175.24 175.366 174.419 114.333 114.69 114.26 1.5328 1.5333 1.5228 0.8756 0.8777 0.8712 2014-07-04 1.3594 1.3611 1.3582 102.07 102.221 101.94 0.8944 0.8951 0.8926 1.7149 1.718 1.7127 1.0636 1.0646 1.0624 0.7927 0.7935 0.7916 138.768 139.121 138.53 1.2159 1.2163 1.2148 0.9354 0.9367 0.934 175.052 175.39 174.751 114.114 114.422 113.94 1.5338 1.5355 1.5317 0.8733 0.8757 0.8725 2014-07-07 1.3607 1.3609 1.3573 101.848 102.201 101.75 0.8932 0.8959 0.892 1.7128 1.7168 1.7104 1.0679 1.0683 1.0625 0.7944 0.7947 0.7911 138.586 138.83 138.39 1.2154 1.2165 1.2146 0.9372 0.9374 0.9338 174.446 175.254 174.24 114.003 114.18 113.83 1.5299 1.5368 1.5288 0.8758 0.8769 0.8708 2014-07-08 1.3612 1.362 1.3585 101.52 101.89 101.46 0.8929 0.8946 0.8915 1.7131 1.7148 1.7081 1.0681 1.0694 1.0657 0.7945 0.796 0.7923 138.18 138.63 138.07 1.2154 1.2157 1.214 0.9401 0.9415 0.9362 173.91 174.57 173.65 113.68 114.04 113.62 1.5296 1.5336 1.5263 0.8788 0.8806 0.8735 2014-07-09 1.3644 1.3648 1.3599 101.591 101.86 101.41 0.8908 0.8937 0.8902 1.7152 1.7161 1.709 1.0654 1.0684 1.0637 0.7953 0.7963 0.794 138.603 138.762 138.12 1.2153 1.2159 1.2147 0.9415 0.9424 0.938 174.259 174.395 173.722 114.029 114.169 113.62 1.528 1.5303 1.526 0.8822 0.8829 0.8775 2014-07-10 1.3603 1.3651 1.3587 101.293 101.631 101.04 0.8921 0.8934 0.8898 1.7136 1.7168 1.7101 1.0646 1.0676 1.064 0.7938 0.797 0.7931 137.781 138.64 137.455 1.2141 1.2155 1.213 0.9395 0.9457 0.9357 173.578 174.36 172.9 113.469 114.07 113.23 1.5294 1.5305 1.524 0.8821 0.8836 0.8788 2014-07-11 1.3608 1.3625 1.359 101.328 101.388 101.18 0.8922 0.8933 0.8908 1.7115 1.7151 1.7095 1.0734 1.0737 1.0624 0.795 0.7953 0.7933 137.88 138.048 137.628 1.2141 1.2147 1.213 0.9389 0.9408 0.9371 173.42 173.805 173.132 113.563 113.684 113.35 1.5271 1.53 1.526 0.8811 0.8833 0.8794 2014-07-14 1.3619 1.364 1.3595 101.565 101.623 101.333 0.8919 0.8932 0.8895 1.708 1.7144 1.7065 1.0714 1.0747 1.0704 0.7973 0.798 0.7939 138.317 138.45 137.721 1.2147 1.2148 1.213 0.9395 0.9403 0.937 173.45 174.009 173.27 113.864 114.019 113.47 1.5233 1.5289 1.521 0.8803 0.8823 0.879 2014-07-15 1.3567 1.363 1.3559 101.686 101.749 101.41 0.8959 0.8962 0.8906 1.7144 1.7191 1.7055 1.0762 1.0769 1.0705 0.7912 0.798 0.7907 137.952 138.43 137.837 1.2155 1.2156 1.2136 0.937 0.9402 0.9345 174.318 174.55 173.203 113.491 113.973 113.42 1.5359 1.5365 1.5213 0.8766 0.8818 0.8746 2014-07-16 1.3523 1.3571 1.3521 101.72 101.793 101.636 0.8985 0.8989 0.8956 1.7135 1.7151 1.7115 1.0748 1.0794 1.0724 0.7892 0.792 0.789 137.56 138.087 137.496 1.2152 1.2158 1.2152 0.9363 0.9374 0.933 174.299 174.434 174.02 113.193 113.598 113.127 1.5397 1.5404 1.535 0.8708 0.8772 0.869 2014-07-17 1.3528 1.354 1.3517 101.241 101.671 101.235 0.8973 0.8987 0.8969 1.7109 1.7144 1.7086 1.0751 1.0761 1.0725 0.7906 0.7914 0.7889 136.961 137.542 136.916 1.2139 1.2151 1.2138 0.9371 0.9391 0.9353 173.219 174.27 173.161 112.816 113.205 112.771 1.5351 1.54 1.5345 0.8688 0.872 0.8677 2014-07-18 1.3526 1.3536 1.3491 101.353 101.449 101.091 0.8982 0.9004 0.897 1.7085 1.7117 1.7037 1.0737 1.0766 1.0709 0.7916 0.7933 0.7904 137.088 137.294 136.715 1.2149 1.2151 1.2136 0.9393 0.9411 0.9336 173.162 173.583 172.684 112.81 113.071 112.63 1.5345 1.536 1.5308 0.8688 0.8694 0.865 2014-07-21 1.3521 1.3549 1.3513 101.387 101.395 101.198 0.8981 0.899 0.8972 1.7075 1.7099 1.7056 1.0733 1.0752 1.0726 0.7918 0.793 0.7913 137.088 137.2 136.894 1.2144 1.2156 1.2143 0.9377 0.9401 0.9371 173.125 173.29 172.808 112.87 112.91 112.645 1.5335 1.5358 1.5317 0.869 0.872 0.8686 2014-07-22 1.3468 1.353 1.3459 101.456 101.603 101.335 0.9021 0.9027 0.8979 1.7061 1.7083 1.7042 1.0735 1.076 1.0729 0.7894 0.7923 0.789 136.634 137.35 136.587 1.2151 1.2154 1.2144 0.9392 0.9422 0.936 173.108 173.475 172.984 112.43 113.055 112.417 1.5394 1.5399 1.5328 0.8662 0.8697 0.8654 2014-07-23 1.346 1.3474 1.3455 101.528 101.547 101.318 0.9024 0.9032 0.9016 1.7032 1.7095 1.7025 1.0727 1.0746 1.0711 0.7902 0.791 0.7874 136.647 136.76 136.39 1.2147 1.2154 1.2147 0.9454 0.9454 0.9381 172.91 173.333 172.614 112.499 112.562 112.25 1.5371 1.5433 1.5362 0.8687 0.8691 0.8659 2014-07-24 1.3463 1.3485 1.3438 101.814 101.859 101.418 0.9025 0.9038 0.9008 1.6985 1.7053 1.6966 1.0746 1.0752 1.0715 0.7926 0.794 0.7889 137.071 137.193 136.371 1.2151 1.2156 1.2144 0.9416 0.9473 0.9412 172.93 173.068 172.641 112.8 112.877 112.293 1.533 1.5395 1.5308 0.8574 0.8624 0.8568 2014-07-25 1.3432 1.3476 1.3422 101.826 101.938 101.716 0.9046 0.9052 0.9018 1.6977 1.6998 1.6962 1.0815 1.0821 1.0735 0.7911 0.7934 0.7906 136.769 137.25 136.656 1.2147 1.2158 1.2148 0.9396 0.9424 0.9393 172.874 173.169 172.659 112.552 112.937 112.488 1.5355 1.5368 1.5318 0.8553 0.8586 0.8539 2014-07-28 1.3433 1.3444 1.3427 101.87 101.908 101.752 0.9044 0.9051 0.9035 1.6983 1.7001 1.6973 1.0802 1.082 1.0797 0.7909 0.7917 0.7904 136.843 136.92 136.645 1.2149 1.2155 1.2146 0.9408 0.9413 0.9385 173.009 173.09 172.7 112.63 112.72 112.43 1.5359 1.5371 1.5347 0.8546 0.8568 0.853 2014-07-29 1.341 1.3445 1.3404 102.101 102.158 101.825 0.9067 0.9074 0.9037 1.6944 1.6995 1.6934 1.0853 1.0866 1.0797 0.7914 0.793 0.7907 136.92 137.106 136.761 1.216 1.2164 1.2147 0.9382 0.9416 0.9375 173.004 173.207 172.732 112.588 112.815 112.502 1.5364 1.5368 1.5329 0.8498 0.8557 0.8495 2014-07-30 1.3393 1.3415 1.3367 102.85 103.09 102.04 0.9088 0.9106 0.9066 1.6909 1.6955 1.689 1.0897 1.0917 1.0848 0.792 0.7921 0.791 137.75 137.86 136.84 1.2172 1.2178 1.216 0.9328 0.9388 0.9304 173.915 174.22 172.92 113.16 113.22 112.52 1.5366 1.539 1.5358 0.8486 0.8515 0.8464 2014-07-31 1.3388 1.3401 1.3372 102.85 103.01 102.73 0.9087 0.9103 0.9076 1.6883 1.6926 1.6857 1.09 1.0929 1.0877 0.793 0.7942 0.7914 137.7 137.85 137.52 1.2167 1.2175 1.2162 0.9293 0.933 0.928 173.643 174 173.41 113.16 113.31 113.03 1.5342 1.5378 1.5318 0.8493 0.8519 0.8473 2014-08-01 1.3423 1.3445 1.3379 102.584 103.03 102.34 0.9061 0.9096 0.9041 1.6823 1.6893 1.6814 1.0925 1.0944 1.0885 0.7979 0.7985 0.7925 137.712 138.03 137.571 1.2163 1.2171 1.2155 0.931 0.9336 0.9276 172.586 173.846 172.393 113.215 113.47 113.073 1.5244 1.5355 1.5225 0.8503 0.8535 0.8462 2014-08-04 1.342 1.3433 1.341 102.559 102.73 102.408 0.9067 0.9072 0.9055 1.6858 1.6859 1.6814 1.0906 1.0934 1.0906 0.796 0.7984 0.796 137.638 137.91 137.427 1.2166 1.2169 1.2161 0.9335 0.9335 0.9306 172.901 172.91 172.459 113.1 113.35 112.98 1.5285 1.5285 1.5216 0.8525 0.8527 0.8497 2014-08-05 1.3375 1.3425 1.3358 102.593 102.925 102.464 0.909 0.9111 0.906 1.6877 1.6888 1.6845 1.096 1.0977 1.0905 0.7924 0.7964 0.7919 137.23 137.722 137.079 1.2162 1.2177 1.216 0.9305 0.9343 0.9294 173.162 173.503 172.785 112.82 113.174 112.716 1.5348 1.5361 1.5279 0.8469 0.8531 0.8452 2014-08-06 1.3379 1.3387 1.3333 102.047 102.64 101.786 0.9076 0.9115 0.9071 1.6852 1.6884 1.6822 1.0916 1.0986 1.0914 0.7939 0.7945 0.7916 136.529 137.236 136.166 1.2143 1.2162 1.214 0.9354 0.9374 0.9292 171.957 173.28 171.583 112.424 112.852 112.121 1.5295 1.5359 1.5288 0.8475 0.8486 0.8424 2014-08-07 1.3364 1.3394 1.3337 102.009 102.46 102 0.9084 0.9105 0.9066 1.6835 1.6864 1.6824 1.0922 1.0938 1.0903 0.7938 0.7956 0.7924 136.343 137.122 136.271 1.2142 1.2154 1.214 0.9275 0.9358 0.9259 171.738 172.62 171.71 112.279 112.85 112.237 1.5294 1.5324 1.5263 0.8478 0.8494 0.8453 2014-08-08 1.3412 1.3433 1.3344 102.061 102.144 101.512 0.9053 0.9099 0.9033 1.6777 1.6834 1.6767 1.0971 1.0984 1.0909 0.7994 0.7997 0.7937 136.891 136.911 135.731 1.2142 1.2145 1.2121 0.9276 0.9287 0.9239 171.24 171.911 170.713 112.735 112.75 111.896 1.5189 1.5301 1.5177 0.8463 0.8489 0.8432 2014-08-11 1.3384 1.3412 1.338 102.218 102.226 102.026 0.9065 0.9067 0.9054 1.6788 1.6796 1.6771 1.0927 1.0977 1.0919 0.7972 0.7994 0.797 136.809 137.057 136.6 1.2132 1.2145 1.2129 0.9262 0.9286 0.9259 171.606 171.62 171.242 112.749 112.86 112.582 1.5219 1.5222 1.5186 0.8457 0.8475 0.8456 2014-08-12 1.3367 1.3387 1.3336 102.226 102.363 102.094 0.9077 0.9104 0.9065 1.6811 1.6815 1.6757 1.0922 1.0953 1.0914 0.7951 0.798 0.7945 136.651 136.889 136.372 1.2132 1.2142 1.213 0.9275 0.9277 0.9248 171.862 171.972 171.391 112.621 112.787 112.375 1.5259 1.5278 1.5211 0.8434 0.8458 0.8409 2014-08-13 1.3368 1.3415 1.3342 102.456 102.545 102.226 0.907 0.9099 0.9042 1.6688 1.6844 1.6686 1.0924 1.094 1.0904 0.801 0.802 0.7922 136.964 137.18 136.617 1.2129 1.2141 1.2129 0.9303 0.9319 0.9264 170.98 172.599 170.867 112.922 113.089 112.61 1.5138 1.5323 1.5125 0.8458 0.8479 0.842 2014-08-14 1.3369 1.3408 1.3349 102.436 102.657 102.312 0.9062 0.9086 0.9035 1.6688 1.6697 1.6657 1.0906 1.0921 1.0885 0.801 0.8036 0.8 136.949 137.245 136.799 1.2115 1.2132 1.2111 0.9316 0.9327 0.9288 170.93 171.23 170.664 113.03 113.292 112.838 1.5124 1.5159 1.5075 0.8491 0.8515 0.8456 2014-08-15 1.3392 1.3412 1.3359 102.342 102.716 102.139 0.9029 0.9071 0.9024 1.6694 1.6702 1.6677 1.0892 1.0919 1.086 0.8022 0.8033 0.8005 137.057 137.618 136.774 1.2093 1.2121 1.2087 0.9322 0.9334 0.9298 170.849 171.453 170.435 113.338 113.622 112.985 1.5073 1.5139 1.5057 0.8485 0.8502 0.8468 2014-08-18 1.3361 1.34 1.3353 102.54 102.595 102.2 0.9064 0.907 0.9026 1.6728 1.6738 1.6713 1.0887 1.0899 1.0875 0.7987 0.8014 0.7984 137.007 137.265 136.81 1.2111 1.2113 1.2093 0.9323 0.9334 0.9309 171.526 171.678 170.913 113.115 113.392 113.05 1.5163 1.5169 1.5089 0.8472 0.8501 0.8468 2014-08-19 1.3321 1.3363 1.3313 102.89 102.92 102.523 0.9089 0.9094 0.9059 1.6619 1.6728 1.6612 1.0942 1.0949 1.0885 0.8015 0.803 0.7983 137.064 137.157 136.818 1.2107 1.2116 1.21 0.9304 0.9346 0.9304 170.994 171.641 170.71 113.2 113.308 113.003 1.5105 1.5175 1.5076 0.8422 0.8484 0.8417 2014-08-20 1.3263 1.3326 1.3256 103.716 103.745 102.907 0.9131 0.9135 0.9091 1.6601 1.6679 1.6591 1.0968 1.0973 1.0932 0.7989 0.8016 0.797 137.55 137.584 137.019 1.2112 1.2114 1.2103 0.9294 0.9318 0.9276 172.185 172.237 170.999 113.56 113.612 113.16 1.5161 1.5186 1.5107 0.8379 0.8435 0.8373 2014-08-21 1.328 1.329 1.3242 103.81 103.959 103.601 0.9113 0.9146 0.9111 1.6581 1.6601 1.6564 1.0945 1.0986 1.094 0.8009 0.801 0.7987 137.866 137.94 137.473 1.2103 1.2116 1.2103 0.93 0.9311 0.9238 172.138 172.395 171.892 113.906 113.936 113.503 1.5112 1.5166 1.5111 0.8403 0.8413 0.8348 2014-08-22 1.3244 1.3297 1.3221 103.941 104.193 103.504 0.9136 0.9154 0.9104 1.6573 1.6597 1.6562 1.0944 1.098 1.0928 0.7991 0.802 0.798 137.661 138.004 137.316 1.21 1.2107 1.2093 0.9312 0.9329 0.9293 172.258 172.627 171.627 113.763 113.993 113.543 1.5141 1.5162 1.51 0.8399 0.843 0.8381 2014-08-25 1.3194 1.3223 1.3184 103.982 104.46 103.864 0.9151 0.9179 0.9143 1.658 1.6598 1.6518 1.0982 1.0983 1.0943 0.7957 0.7997 0.7952 137.199 138.01 137.098 1.2075 1.2109 1.2072 0.9296 0.9323 0.929 172.409 172.99 172.311 113.62 114.07 113.42 1.5174 1.5202 1.5131 0.8347 0.8402 0.8337 2014-08-26 1.3176 1.3215 1.3165 104.08 104.172 103.751 0.9171 0.9181 0.9138 1.6547 1.6595 1.6544 1.095 1.0998 1.0941 0.7962 0.797 0.7955 137.136 137.417 137.02 1.2084 1.2093 1.2074 0.9306 0.9331 0.9272 172.227 172.59 172.136 113.485 113.66 113.425 1.5176 1.5192 1.5157 0.8324 0.835 0.8312 2014-08-27 1.3197 1.321 1.3153 103.86 104.161 103.782 0.9146 0.9185 0.9138 1.6577 1.6605 1.6537 1.0846 1.0956 1.0828 0.796 0.7964 0.7939 137.066 137.296 136.749 1.2069 1.2085 1.206 0.9338 0.9351 0.9305 172.178 172.535 172.075 113.54 113.726 113.274 1.516 1.52 1.5155 0.8377 0.8381 0.8332 2014-08-28 1.3184 1.3221 1.316 103.661 103.921 103.558 0.9147 0.9161 0.9126 1.6589 1.6614 1.6568 1.0848 1.0869 1.0835 0.7948 0.7967 0.7938 136.673 137.216 136.423 1.2061 1.2072 1.205 0.9354 0.9374 0.9333 171.95 172.292 171.684 113.311 113.687 113.178 1.5175 1.5187 1.5148 0.8382 0.8408 0.8364 2014-08-29 1.3139 1.3196 1.3134 104.037 104.107 103.658 0.9181 0.9184 0.914 1.6601 1.6613 1.6563 1.0871 1.0875 1.081 0.7914 0.796 0.7914 136.698 137.191 136.584 1.2062 1.2067 1.2056 0.9337 0.9363 0.9333 172.716 172.74 171.95 113.32 113.758 113.24 1.524 1.5244 1.5156 0.8364 0.8398 0.8357 2014-09-01 1.3136 1.3146 1.3119 104.252 104.307 104.073 0.9189 0.9195 0.9177 1.6618 1.6644 1.6586 1.0865 1.0878 1.0856 0.7903 0.7917 0.789 136.945 137.06 136.668 1.2071 1.2076 1.2061 0.9343 0.9352 0.9321 173.255 173.415 172.65 113.43 113.56 113.28 1.5272 1.5286 1.5235 0.8385 0.8389 0.835 2014-09-02 1.3133 1.3137 1.311 105.06 105.213 104.298 0.9186 0.9212 0.9189 1.6475 1.6615 1.6473 1.0929 1.0935 1.0867 0.7971 0.7972 0.7903 137.99 138.103 136.934 1.2067 1.2081 1.2067 0.9277 0.9337 0.9268 173.148 173.954 173.128 114.373 114.413 113.43 1.5138 1.5276 1.5137 0.8313 0.8391 0.8292 2014-09-03 1.3145 1.316 1.3122 104.818 105.31 104.761 0.9178 0.9201 0.9176 1.6455 1.6498 1.644 1.0886 1.0943 1.087 0.7988 0.7996 0.7965 137.791 138.28 137.72 1.2066 1.209 1.2064 0.9344 0.9351 0.9264 172.481 173.375 172.427 114.195 114.54 114.076 1.5103 1.5163 1.5102 0.8322 0.8332 0.8288 2014-09-04 1.2945 1.3154 1.292 105.119 105.365 104.761 0.9317 0.9329 0.9175 1.6342 1.6466 1.6333 1.0873 1.0909 1.0821 0.7921 0.7993 0.7903 136.05 138.011 135.969 1.2062 1.2076 1.2045 0.9349 0.9393 0.933 171.784 172.774 171.765 112.815 114.32 112.794 1.5227 1.5266 1.5102 0.8305 0.8351 0.8298 2014-09-05 1.2952 1.2988 1.2922 105.07 105.706 104.686 0.9312 0.9335 0.9287 1.6328 1.634 1.6283 1.0882 1.0903 1.0841 0.7931 0.7958 0.792 136.081 136.616 135.82 1.206 1.207 1.2054 0.9376 0.9402 0.9333 171.54 172.258 170.973 112.823 113.24 112.575 1.5204 1.5228 1.5151 0.8327 0.8347 0.827 2014-09-08 1.2899 1.296 1.2882 105.99 106.087 104.947 0.935 0.9358 0.9307 1.611 1.6233 1.6103 1.0971 1.0983 1.088 0.8007 0.804 0.7978 136.73 136.999 135.79 1.2061 1.2072 1.2056 0.9285 0.9374 0.928 170.758 171.104 169.353 113.358 113.535 112.59 1.5063 1.5119 1.5007 0.8278 0.8329 0.8262 2014-09-09 1.2943 1.295 1.2859 106.201 106.473 105.947 0.9324 0.938 0.9319 1.6107 1.6157 1.606 1.0983 1.1032 1.0967 0.8035 0.8037 0.7981 137.462 137.504 136.625 1.2069 1.2071 1.2057 0.9205 0.9289 0.9188 171.068 171.53 170.55 113.889 113.93 113.246 1.5018 1.511 1.5015 0.8238 0.8286 0.8224 2014-09-10 1.2908 1.2963 1.2884 106.8 106.885 106.044 0.9375 0.9396 0.9319 1.6194 1.623 1.6052 1.0943 1.1014 1.0934 0.7969 0.8066 0.7954 137.898 138.171 137.314 1.21 1.2118 1.2067 0.9159 0.9218 0.9113 173.01 173.268 171.02 113.942 114.375 113.665 1.5181 1.5212 1.4974 0.8232 0.8267 0.8209 2014-09-11 1.2917 1.2952 1.2897 107.09 107.199 106.643 0.9361 0.9376 0.9337 1.622 1.627 1.6186 1.1049 1.1059 1.0938 0.7963 0.7978 0.7948 138.341 138.522 137.739 1.2092 1.2105 1.2089 0.9091 0.9218 0.9089 173.704 174.12 172.786 114.396 114.475 113.839 1.5184 1.5224 1.516 0.8171 0.8223 0.8162 2014-09-12 1.2949 1.2979 1.2909 107.314 107.396 107.016 0.9339 0.9368 0.9321 1.6258 1.6274 1.6205 1.1089 1.1098 1.1029 0.7965 0.7982 0.7942 138.967 139.155 138.29 1.2093 1.2104 1.2084 0.9047 0.9108 0.9031 174.474 174.515 173.707 114.903 115.015 114.347 1.5184 1.5231 1.5148 0.8147 0.8196 0.8143 2014-09-15 1.2939 1.2979 1.2909 107.174 107.367 107.011 0.9353 0.9373 0.9315 1.6231 1.6278 1.6221 1.105 1.1099 1.1036 0.797 0.7984 0.7945 138.67 139.185 138.471 1.2102 1.2113 1.2089 0.9031 0.9049 0.8984 173.958 174.63 173.85 114.575 115.06 114.445 1.5182 1.5229 1.5156 0.8174 0.8181 0.8124 2014-09-16 1.2962 1.2995 1.2922 107.16 107.332 106.811 0.9326 0.9363 0.9301 1.6275 1.6311 1.6162 1.0972 1.1072 1.097 0.7963 0.801 0.7958 138.901 138.97 138.529 1.2088 1.2107 1.2081 0.9092 0.9112 0.8989 174.409 174.466 172.995 114.903 114.946 114.489 1.5178 1.519 1.5095 0.8198 0.823 0.8146 2014-09-17 1.2879 1.2981 1.2875 108.313 108.346 107.105 0.9405 0.9407 0.9323 1.6263 1.6358 1.625 1.0999 1.1002 1.0927 0.7918 0.797 0.7913 139.502 139.641 138.78 1.2113 1.2116 1.2083 0.8971 0.9087 0.8966 176.168 176.22 174.157 115.157 115.311 114.749 1.5297 1.5306 1.5165 0.8095 0.8198 0.8095 2014-09-18 1.2918 1.293 1.2834 108.751 108.959 108.376 0.9339 0.9433 0.9335 1.6375 1.6409 1.6247 1.0947 1.1024 1.0929 0.7888 0.7914 0.7854 140.501 140.523 139.318 1.2068 1.2114 1.2066 0.8983 0.8997 0.8928 178.089 178.37 176.225 116.415 116.444 115.084 1.5295 1.5381 1.5251 0.8145 0.8156 0.8079 2014-09-19 1.2836 1.2929 1.283 108.958 109.46 108.595 0.9404 0.9409 0.9335 1.631 1.6525 1.6297 1.0949 1.098 1.0887 0.787 0.7876 0.781 139.861 141.223 139.685 1.2071 1.2075 1.2065 0.8933 0.8994 0.8921 177.706 180.71 177.559 115.857 117.01 115.736 1.5334 1.5455 1.5322 0.8133 0.8173 0.8111 2014-09-22 1.2844 1.2868 1.2816 108.792 109.194 108.668 0.9403 0.9421 0.9368 1.6358 1.6366 1.6289 1.1034 1.1037 1.0927 0.7851 0.7876 0.7845 139.735 140.204 139.636 1.2077 1.2078 1.2063 0.8878 0.895 0.8853 177.964 178.355 177.546 115.692 116.167 115.65 1.5381 1.5395 1.5324 0.8128 0.817 0.8099 2014-09-23 1.2857 1.2901 1.2843 108.887 108.993 108.255 0.939 0.9403 0.9354 1.6401 1.6416 1.6303 1.1068 1.1083 1.0984 0.7839 0.789 0.7838 140 140.22 139.276 1.2074 1.2081 1.2066 0.8846 0.8927 0.8832 178.571 178.74 176.649 115.941 116.17 115.321 1.5401 1.5407 1.531 0.807 0.8146 0.8046 2014-09-24 1.2786 1.2864 1.2774 108.987 109.02 108.462 0.9449 0.9455 0.9389 1.6342 1.6413 1.6328 1.106 1.1122 1.1054 0.7823 0.7851 0.7813 139.353 139.894 139.005 1.2081 1.2083 1.207 0.8879 0.8897 0.884 178.112 178.439 177.644 115.342 115.858 115.105 1.5441 1.5458 1.5386 0.8074 0.8094 0.8045 2014-09-25 1.2749 1.2783 1.2698 108.65 109.372 108.525 0.9467 0.9515 0.9453 1.6316 1.6342 1.6276 1.1096 1.1127 1.1059 0.7813 0.783 0.7785 138.529 139.703 138.438 1.207 1.2089 1.2067 0.8786 0.8881 0.8774 177.284 178.497 177.143 114.755 115.58 114.691 1.5446 1.5508 1.5429 0.7926 0.8076 0.7913 2014-09-26 1.2681 1.2761 1.2677 109.303 109.539 108.48 0.9514 0.9521 0.946 1.6246 1.6333 1.6238 1.1157 1.1169 1.1091 0.7806 0.7823 0.78 138.611 139.086 138.387 1.2066 1.2075 1.2066 0.8766 0.8813 0.8748 177.573 178.105 177.156 114.88 115.205 114.662 1.5456 1.5476 1.5427 0.7867 0.7956 0.7862 2014-09-29 1.269 1.2715 1.2664 109.45 109.74 109.13 0.951 0.9532 0.9489 1.6247 1.6274 1.6215 1.1149 1.1178 1.1131 0.781 0.783 0.78 138.9 139.13 138.58 1.2068 1.2074 1.2062 0.8724 0.8765 0.8684 177.84 178.18 177.23 115.07 115.26 114.8 1.5452 1.5469 1.5417 0.7769 0.7869 0.7709 2014-09-30 1.2629 1.2702 1.2571 109.685 109.848 109.187 0.9548 0.9597 0.95 1.6208 1.6287 1.6166 1.1207 1.1219 1.1133 0.7791 0.7817 0.7767 138.513 138.914 137.949 1.2058 1.2073 1.2053 0.8747 0.8768 0.8694 177.781 178.11 177.37 114.869 115.08 114.35 1.5476 1.553 1.5438 0.7797 0.783 0.7739 2014-10-01 1.2615 1.264 1.2584 109.06 110.09 108.99 0.9566 0.9596 0.9546 1.6182 1.6252 1.6162 1.1169 1.1223 1.1163 0.7795 0.7796 0.7767 137.58 138.81 137.49 1.2067 1.2081 1.2053 0.8734 0.8749 0.8663 176.48 178.13 176.38 114.01 115.06 113.95 1.548 1.5536 1.547 0.7805 0.786 0.7761 2014-10-02 1.2669 1.2699 1.2614 108.39 109.12 108.01 0.9539 0.9581 0.9518 1.6141 1.625 1.6113 1.1157 1.1178 1.1072 0.7848 0.7858 0.779 137.3 137.72 136.88 1.2086 1.2091 1.2068 0.8805 0.8827 0.873 174.95 176.65 174.33 113.6 114.08 113.29 1.5399 1.55 1.5378 0.7898 0.7928 0.7767 2014-10-03 1.251 1.2672 1.25 109.739 109.902 108.372 0.9676 0.9684 0.9537 1.5975 1.6159 1.5952 1.1257 1.127 1.1156 0.7831 0.7861 0.782 137.285 137.881 137.117 1.2105 1.2112 1.2084 0.8673 0.8806 0.8643 175.309 175.905 174.982 113.406 114.06 113.352 1.5457 1.5465 1.5376 0.7768 0.7904 0.7738 2014-10-06 1.2645 1.2675 1.2509 108.823 109.852 108.657 0.9589 0.9689 0.9568 1.6078 1.6099 1.5953 1.1129 1.1265 1.1112 0.7865 0.7874 0.7829 137.62 137.772 137.051 1.2127 1.2138 1.2107 0.876 0.8784 0.8653 174.95 175.438 174.477 113.476 113.615 113.105 1.5419 1.5469 1.54 0.7843 0.7867 0.7715 2014-10-07 1.2678 1.2682 1.2584 107.951 109.233 107.823 0.9561 0.9625 0.9556 1.6104 1.6129 1.6027 1.1165 1.1196 1.1132 0.7872 0.7873 0.7837 136.856 137.766 136.565 1.2121 1.214 1.2105 0.8817 0.8834 0.8727 173.858 175.145 173.702 112.903 113.61 112.615 1.5398 1.5469 1.5394 0.784 0.7873 0.7783 2014-10-08 1.2721 1.2749 1.2623 108.273 108.742 107.757 0.9532 0.9601 0.9511 1.6153 1.617 1.6032 1.1113 1.121 1.1099 0.7876 0.79 0.786 137.745 137.938 136.662 1.2126 1.2135 1.2115 0.883 0.8846 0.8734 174.87 174.905 173.449 113.585 113.761 112.726 1.5396 1.542 1.5355 0.7886 0.7914 0.7784 2014-10-09 1.2681 1.2792 1.2664 107.944 108.317 107.531 0.9547 0.9559 0.9469 1.6112 1.6227 1.6105 1.1163 1.1175 1.1079 0.787 0.7895 0.7855 136.891 137.873 136.654 1.2106 1.2128 1.2089 0.8771 0.8898 0.8765 173.928 175.005 173.589 113.059 113.73 112.851 1.5383 1.5403 1.5342 0.785 0.7974 0.7845 2014-10-10 1.2613 1.2716 1.2609 107.761 108.154 107.624 0.9586 0.9593 0.9527 1.6051 1.6135 1.6009 1.1211 1.1222 1.1161 0.7857 0.7895 0.7854 135.918 137.075 135.907 1.209 1.2116 1.2085 0.8694 0.8785 0.8688 172.94 174.001 172.745 112.411 113.15 112.42 1.5386 1.5389 1.5318 0.7812 0.7878 0.7801 2014-10-13 1.2693 1.2699 1.2621 107.098 107.607 107.064 0.9523 0.9576 0.9512 1.6071 1.6126 1.6051 1.1197 1.122 1.1176 0.7896 0.79 0.7853 135.948 136.303 135.555 1.2087 1.2091 1.2075 0.877 0.8787 0.8652 172.14 173.025 172.133 112.464 112.835 112.137 1.5305 1.5392 1.5288 0.7896 0.7897 0.7796 2014-10-14 1.2657 1.2749 1.264 107.001 107.311 106.673 0.9537 0.9555 0.9482 1.5908 1.608 1.5898 1.1303 1.1313 1.1188 0.7956 0.7961 0.7906 135.436 136.55 135.04 1.2071 1.2092 1.2071 0.8706 0.8813 0.8694 170.208 172.48 169.935 112.191 112.97 111.833 1.5172 1.5291 1.5167 0.7833 0.7917 0.7821 2014-10-15 1.2802 1.2887 1.2625 106.12 107.496 105.2 0.9424 0.9562 0.9361 1.5962 1.6069 1.5875 1.1265 1.1386 1.1227 0.802 0.8046 0.7936 135.852 136.062 135.139 1.2065 1.208 1.2061 0.8811 0.886 0.8676 169.372 171.15 168.029 112.595 112.729 112.024 1.5042 1.5217 1.4994 0.7983 0.7995 0.7807 2014-10-16 1.2796 1.2845 1.2706 106.398 106.404 105.506 0.9434 0.9491 0.9401 1.6077 1.6086 1.5942 1.1253 1.1361 1.1227 0.7959 0.803 0.7947 136.153 136.288 134.146 1.2073 1.2078 1.2057 0.876 0.8814 0.8687 171.072 171.075 168.472 112.768 112.865 111.238 1.5168 1.5174 1.5037 0.794 0.7997 0.7887 2014-10-17 1.2761 1.2837 1.2744 106.872 106.894 106.136 0.9461 0.9475 0.9406 1.6095 1.6126 1.603 1.1275 1.1277 1.1209 0.7928 0.7981 0.7925 136.374 136.717 135.759 1.2074 1.2078 1.2069 0.8764 0.8812 0.8734 171.995 172.025 170.207 112.947 113.227 112.446 1.5228 1.5238 1.5127 0.7926 0.7968 0.7878 2014-10-20 1.2808 1.2817 1.2732 106.8 107.392 106.784 0.9422 0.948 0.9415 1.6175 1.6179 1.608 1.128 1.1293 1.1251 0.7918 0.793 0.7904 136.79 137.014 136.279 1.2067 1.2079 1.206 0.88 0.8801 0.8747 172.753 173.002 172.235 113.35 113.507 112.94 1.5239 1.5264 1.5209 0.7978 0.7981 0.7916 2014-10-21 1.2722 1.284 1.2716 106.9 107.01 106.25 0.9485 0.9488 0.9398 1.6116 1.6185 1.6115 1.1226 1.1296 1.1204 0.7893 0.7942 0.7878 136 136.9 135.7 1.2068 1.2074 1.2063 0.8777 0.8833 0.876 172.29 172.87 171.8 112.68 113.43 112.47 1.5288 1.5317 1.5195 0.7953 0.8035 0.7946 2014-10-22 1.2642 1.274 1.2637 107.165 107.374 106.792 0.9537 0.9542 0.9473 1.6051 1.6131 1.6011 1.1241 1.1293 1.1185 0.7876 0.7926 0.7873 135.491 136.204 135.47 1.2059 1.2072 1.2059 0.8776 0.8815 0.8746 172.015 172.605 171.079 112.358 112.856 112.307 1.5309 1.5321 1.5223 0.7926 0.7991 0.7924 2014-10-23 1.265 1.2677 1.2614 108.175 108.352 107.108 0.9537 0.956 0.9518 1.6022 1.606 1.5995 1.123 1.1264 1.1207 0.7894 0.7917 0.787 136.844 137.006 135.21 1.2064 1.207 1.2056 0.8754 0.8806 0.8749 173.311 173.665 171.714 113.418 113.514 112.125 1.5281 1.5326 1.5242 0.781 0.7879 0.781 2014-10-24 1.2668 1.2696 1.2635 108.09 108.3 107.79 0.9516 0.9546 0.9498 1.6084 1.6099 1.6017 1.1231 1.1242 1.1194 0.7875 0.7901 0.7871 136.93 137.08 136.5 1.2061 1.2068 1.2057 0.8801 0.8824 0.8719 173.85 174.02 172.98 113.52 113.66 113.17 1.5312 1.5322 1.5264 0.7856 0.7881 0.7806 2014-10-27 1.2706 1.2723 1.2666 107.74 108.367 107.608 0.9488 0.9521 0.9477 1.6126 1.6147 1.608 1.1238 1.1255 1.1213 0.7879 0.7894 0.7862 136.886 137.42 136.593 1.2056 1.2068 1.2053 0.8803 0.8824 0.8789 173.728 174.33 173.4 113.541 113.93 113.287 1.53 1.5338 1.5285 0.7893 0.7903 0.7847 2014-10-28 1.2736 1.2765 1.2685 108.135 108.172 107.697 0.9469 0.9511 0.9446 1.6136 1.6182 1.6088 1.1172 1.1253 1.1166 0.7893 0.7901 0.7872 137.721 137.798 136.883 1.2061 1.2066 1.2056 0.886 0.8882 0.8796 174.485 174.745 173.705 114.181 114.221 113.512 1.5279 1.5321 1.5263 0.7926 0.7958 0.7884 2014-10-29 1.2644 1.2771 1.2633 108.843 108.946 107.944 0.9538 0.9548 0.9442 1.6008 1.6161 1.6007 1.12 1.1225 1.112 0.7898 0.7912 0.7887 137.618 138.035 137.421 1.206 1.2063 1.2056 0.8791 0.8911 0.878 174.237 174.687 174.006 114.109 114.435 113.967 1.5269 1.5289 1.5241 0.7834 0.7977 0.7824 2014-10-30 1.2613 1.2639 1.2548 109.228 109.464 108.751 0.9556 0.9611 0.9543 1.6006 1.6038 1.5952 1.1183 1.1223 1.1163 0.788 0.7904 0.786 137.77 138.064 137.046 1.2055 1.2065 1.2054 0.8832 0.884 0.8756 174.83 175.162 173.998 114.279 114.507 113.663 1.5297 1.5337 1.5258 0.7841 0.786 0.7767 2014-10-31 1.253 1.2616 1.2486 112.258 112.475 109.178 0.9623 0.9663 0.9558 1.5995 1.6011 1.5943 1.1272 1.1332 1.1183 0.7833 0.7886 0.7824 140.667 140.707 137.684 1.2058 1.2069 1.2054 0.8801 0.8845 0.8765 179.57 179.6 174.679 116.652 116.689 114.205 1.5393 1.5418 1.5291 0.7796 0.788 0.7776 2014-11-03 1.2489 1.2514 1.244 113.791 114.213 112.573 0.965 0.9691 0.9635 1.5982 1.6023 1.5927 1.1361 1.1377 1.1264 0.7813 0.7836 0.78 142.129 142.561 140.403 1.2052 1.2065 1.2052 0.8687 0.8761 0.8679 181.87 182.525 179.672 117.91 118.228 116.455 1.5424 1.5455 1.5386 0.7719 0.7793 0.7698 2014-11-04 1.2549 1.2577 1.2482 113.602 114.044 113.171 0.9599 0.9664 0.958 1.5997 1.6016 1.5966 1.1399 1.1427 1.1338 0.7844 0.7854 0.7813 142.558 142.618 141.704 1.2046 1.2062 1.2044 0.8738 0.8749 0.8646 181.726 182.155 181.135 118.331 118.387 117.568 1.5356 1.5431 1.5341 0.7781 0.7788 0.7711 2014-11-05 1.248 1.2567 1.2458 114.718 114.842 113.419 0.9643 0.9661 0.9584 1.5972 1.6022 1.5869 1.1395 1.1467 1.1371 0.7813 0.7864 0.7809 143.159 143.45 142.36 1.2035 1.2046 1.2033 0.8591 0.8762 0.8565 183.235 183.443 181.528 118.945 119.196 118.204 1.5403 1.5418 1.531 0.7737 0.7843 0.7685 2014-11-06 1.2378 1.2533 1.2376 115.13 115.516 114.064 0.9726 0.9729 0.9603 1.5837 1.6002 1.5834 1.1423 1.1444 1.138 0.7816 0.7864 0.78 142.52 144.223 142.192 1.2041 1.2058 1.2032 0.8565 0.8627 0.8554 182.326 184.325 181.876 118.35 119.788 118.12 1.5404 1.5447 1.5317 0.7691 0.7759 0.7669 2014-11-07 1.2453 1.247 1.2358 114.585 115.585 114.257 0.9662 0.9741 0.9651 1.5876 1.5886 1.5791 1.1331 1.1448 1.1313 0.7843 0.7858 0.7813 142.706 143.051 142.26 1.2033 1.2047 1.203 0.8635 0.8657 0.8541 181.932 182.865 181.235 118.587 118.8 118.225 1.5339 1.5418 1.5316 0.7749 0.7768 0.7661 2014-11-10 1.242 1.251 1.2419 114.879 114.908 113.862 0.9681 0.9684 0.9617 1.5846 1.5917 1.5846 1.1375 1.1385 1.13 0.7838 0.7862 0.7828 142.7 142.9 142.096 1.2025 1.2037 1.2022 0.8613 0.8683 0.8609 182.051 182.254 181.088 118.651 118.763 118.145 1.534 1.5361 1.5298 0.7742 0.7823 0.774 2014-11-11 1.2479 1.2499 1.2395 115.381 116.103 114.639 0.9642 0.97 0.9625 1.592 1.5945 1.5836 1.1326 1.1402 1.1318 0.7837 0.7848 0.7822 143.985 144.336 142.591 1.2033 1.2034 1.2021 0.87 0.8719 0.8591 183.692 184.038 181.775 119.651 119.964 118.541 1.5351 1.5372 1.533 0.7794 0.7842 0.7713 2014-11-12 1.2431 1.2498 1.242 115.572 116.009 114.885 0.967 0.968 0.9623 1.5785 1.594 1.5776 1.131 1.1359 1.128 0.7874 0.789 0.7802 143.673 144.701 143.355 1.2021 1.2039 1.2018 0.8715 0.8745 0.8665 182.438 184.666 181.98 119.505 120.237 119.223 1.5265 1.5411 1.5237 0.7873 0.7906 0.78 2014-11-13 1.2482 1.2492 1.2427 115.679 115.882 115.312 0.9628 0.9674 0.9623 1.5715 1.5781 1.5695 1.1368 1.1374 1.1299 0.7942 0.7946 0.7881 144.401 144.591 143.573 1.202 1.2025 1.2017 0.8717 0.8764 0.8672 181.81 182.784 181.554 120.138 120.297 119.44 1.5132 1.5255 1.5126 0.7889 0.7928 0.7842 2014-11-14 1.2525 1.2546 1.2399 116.31 116.825 115.728 0.959 0.9689 0.9574 1.5672 1.5712 1.5593 1.1278 1.1393 1.1265 0.7992 0.8 0.7935 145.676 145.841 144.309 1.2013 1.2024 1.2011 0.8755 0.8773 0.8649 182.288 182.663 181.61 121.26 121.411 120.061 1.503 1.5149 1.5015 0.7911 0.7939 0.7824 2014-11-17 1.2452 1.2578 1.2445 116.432 117.052 115.46 0.9648 0.9655 0.9553 1.5641 1.5736 1.562 1.1301 1.1328 1.1269 0.796 0.8003 0.7955 144.975 146.532 144.794 1.2014 1.2018 1.2011 0.8711 0.8796 0.8696 182.11 183.384 181.108 120.669 121.968 120.54 1.509 1.5103 1.5013 0.7917 0.7975 0.7901 2014-11-18 1.2534 1.2545 1.2444 116.913 117.048 116.344 0.9583 0.9655 0.9575 1.5634 1.5679 1.5631 1.1301 1.1324 1.1259 0.8017 0.802 0.7956 146.535 146.701 145.159 1.2012 1.2017 1.201 0.8728 0.8746 0.8683 182.782 183.334 182.258 121.984 122.14 120.836 1.498 1.5098 1.4978 0.793 0.7974 0.791 2014-11-19 1.2538 1.26 1.2512 117.98 118.079 116.819 0.9582 0.9601 0.9532 1.567 1.5721 1.559 1.1349 1.1359 1.1295 0.8001 0.804 0.7989 147.93 148.125 146.376 1.2014 1.2026 1.2008 0.8615 0.8721 0.8602 184.887 185.019 182.539 123.121 123.326 121.854 1.5016 1.5035 1.4943 0.7856 0.7925 0.7839 2014-11-20 1.2545 1.2575 1.2505 118.016 118.977 117.744 0.9579 0.9606 0.9553 1.5695 1.5737 1.5632 1.1305 1.1369 1.1292 0.7992 0.8027 0.7974 148.053 149.135 147.888 1.2018 1.2025 1.2007 0.8628 0.8641 0.8567 185.216 186.127 184.908 123.187 124.157 123.051 1.5034 1.5067 1.4966 0.7873 0.7882 0.7807 2014-11-21 1.2387 1.2568 1.2375 117.77 118.368 117.357 0.9699 0.9709 0.9564 1.5649 1.5714 1.5626 1.1238 1.1326 1.1192 0.7916 0.8003 0.7907 145.881 148.436 145.685 1.2016 1.2033 1.2015 0.8662 0.8722 0.8606 184.269 185.7 183.984 121.395 123.47 121.209 1.5179 1.52 1.5024 0.7879 0.7946 0.7848 2014-11-24 1.2439 1.2445 1.2361 118.262 118.483 117.583 0.9666 0.973 0.9664 1.5707 1.5715 1.5629 1.1294 1.1312 1.1225 0.7919 0.7935 0.7903 147.106 147.326 145.592 1.2024 1.2031 1.2018 0.8614 0.87 0.8603 185.752 186.01 184.063 122.341 122.505 121.075 1.5182 1.5218 1.5154 0.7862 0.7911 0.7847 2014-11-25 1.2477 1.2487 1.2402 117.93 118.579 117.692 0.9637 0.9698 0.9635 1.5711 1.5736 1.5649 1.1259 1.1317 1.123 0.7941 0.7943 0.7918 147.145 147.398 146.306 1.2025 1.2033 1.2023 0.8531 0.8619 0.8514 185.293 186.079 184.535 122.358 122.565 121.647 1.5141 1.519 1.5141 0.7813 0.7866 0.7766 2014-11-26 1.2508 1.2532 1.2444 117.728 117.981 117.441 0.9611 0.9666 0.9595 1.5798 1.5806 1.568 1.1234 1.1297 1.1228 0.7917 0.795 0.7896 147.258 147.417 146.502 1.2022 1.2031 1.2017 0.8551 0.8565 0.848 185.99 186.108 184.783 122.477 122.63 121.806 1.5184 1.5231 1.512 0.788 0.7893 0.7804 2014-11-27 1.2474 1.2524 1.2465 117.756 117.883 117.241 0.9635 0.9644 0.9599 1.5724 1.5826 1.5717 1.1346 1.1355 1.1234 0.7932 0.7943 0.7907 146.884 147.266 146.429 1.2019 1.2026 1.2018 0.8547 0.8615 0.853 185.155 185.941 185.025 122.21 122.49 121.82 1.515 1.5204 1.5133 0.7864 0.7926 0.7858 2014-11-28 1.2441 1.249 1.2427 118.662 118.765 117.698 0.9657 0.9671 0.9622 1.5626 1.5739 1.5615 1.143 1.1444 1.1329 0.7961 0.797 0.7914 147.638 147.974 146.734 1.2015 1.2024 1.2011 0.8504 0.8548 0.8486 185.42 185.92 185.233 122.862 123.188 122.118 1.5091 1.5187 1.5074 0.7847 0.7868 0.7827 2014-12-01 1.2475 1.2507 1.242 118.342 119.144 117.877 0.9643 0.9688 0.9616 1.5738 1.5764 1.5586 1.1325 1.1459 1.1314 0.7925 0.7977 0.7923 147.62 148.16 147.092 1.2029 1.204 1.2021 0.8506 0.8532 0.8418 186.22 186.34 185.052 122.71 123.135 122.301 1.5176 1.5182 1.5087 0.7879 0.7911 0.7778 2014-12-02 1.2379 1.2483 1.2377 119.263 119.287 118.14 0.9725 0.973 0.9629 1.5637 1.5743 1.5632 1.1405 1.1424 1.1316 0.7916 0.7941 0.791 147.63 148.195 147.463 1.2039 1.2047 1.2028 0.8446 0.8542 0.8433 186.496 186.929 186.04 122.622 123.089 122.502 1.5208 1.522 1.5163 0.7802 0.789 0.7785 2014-12-03 1.2313 1.2391 1.2301 119.808 119.865 119.132 0.9773 0.9783 0.9716 1.5685 1.5719 1.562 1.1365 1.1418 1.1345 0.785 0.792 0.7833 147.52 147.918 147.02 1.2035 1.2042 1.2027 0.8405 0.8467 0.8389 187.93 188.191 186.282 122.56 122.845 122.226 1.533 1.536 1.5201 0.7757 0.7808 0.7738 2014-12-04 1.2378 1.2456 1.2283 119.83 120.252 119.34 0.9712 0.9796 0.965 1.5672 1.5726 1.5644 1.1382 1.1397 1.134 0.7896 0.7922 0.784 148.3 148.952 147.297 1.2024 1.204 1.202 0.8382 0.8429 0.8356 187.78 188.235 187.615 123.254 123.891 122.444 1.5236 1.5354 1.5174 0.7779 0.7822 0.773 2014-12-05 1.2289 1.2393 1.2271 121.42 121.688 119.706 0.9781 0.9799 0.9703 1.5579 1.5695 1.5571 1.1429 1.1476 1.1378 0.7888 0.7924 0.7851 149.215 149.515 148.232 1.2021 1.203 1.202 0.8328 0.8393 0.8315 189.156 189.709 187.301 124.131 124.34 123.314 1.5238 1.5319 1.5177 0.7713 0.7784 0.77 2014-12-08 1.2318 1.2344 1.2247 120.549 121.847 120.205 0.9759 0.9818 0.9739 1.5653 1.5679 1.5541 1.1479 1.1486 1.1427 0.7869 0.7902 0.7845 148.494 149.785 148.19 1.2022 1.203 1.2019 0.8294 0.8324 0.826 188.701 189.69 188.441 123.515 124.54 123.265 1.5276 1.5326 1.5221 0.766 0.7704 0.7624 2014-12-09 1.2367 1.2448 1.2292 119.694 121.002 117.941 0.9719 0.9778 0.9654 1.5662 1.5717 1.5627 1.1435 1.1501 1.1397 0.7896 0.793 0.7863 148.035 148.878 146.807 1.2019 1.2025 1.2015 0.8295 0.8371 0.8224 187.464 189.212 185.202 123.149 123.833 122.17 1.5221 1.5294 1.5154 0.7674 0.7762 0.7608 2014-12-10 1.2443 1.2447 1.2362 117.972 119.917 117.757 0.9668 0.9723 0.9667 1.5713 1.5719 1.5648 1.1479 1.1502 1.1435 0.7918 0.7923 0.7885 146.786 148.27 146.51 1.2031 1.2035 1.2017 0.8316 0.8348 0.8265 185.368 187.831 184.981 122.001 123.36 121.771 1.5192 1.5246 1.5182 0.7792 0.7822 0.7662 2014-12-11 1.2385 1.2495 1.237 119.25 119.556 117.443 0.9698 0.971 0.9628 1.5713 1.5757 1.5653 1.1533 1.155 1.1446 0.7881 0.7954 0.7879 147.679 148.06 146.43 1.2011 1.2038 1.2011 0.8258 0.8376 0.8215 187.368 187.758 184.984 122.956 123.27 121.7 1.5239 1.5248 1.5105 0.7805 0.7871 0.7779 2014-12-12 1.2458 1.2485 1.2385 118.615 119.206 118.055 0.964 0.9699 0.9619 1.572 1.5746 1.5695 1.1571 1.1591 1.1516 0.7923 0.794 0.7874 147.775 148.177 146.956 1.201 1.2013 1.2009 0.8253 0.8299 0.8227 186.46 187.36 185.613 123.026 123.37 122.36 1.5155 1.5255 1.5125 0.7776 0.784 0.7758 2014-12-15 1.2441 1.2483 1.2415 117.593 119.06 117.568 0.9652 0.9674 0.9622 1.5652 1.5747 1.5601 1.1651 1.1658 1.1549 0.7947 0.7972 0.7907 146.299 148.28 146.271 1.201 1.2014 1.201 0.8219 0.8268 0.8202 184.04 187.052 183.85 121.816 123.42 121.791 1.5108 1.5192 1.5065 0.774 0.7793 0.7728 2014-12-16 1.25 1.257 1.2434 117.141 118.01 115.572 0.9607 0.9658 0.9554 1.573 1.5785 1.5613 1.1635 1.1672 1.1607 0.7946 0.8007 0.7935 146.442 147.026 144.967 1.2009 1.2014 1.2008 0.8212 0.8274 0.82 184.262 185.093 181.642 121.934 122.412 120.718 1.5111 1.5135 1.5 0.7783 0.7849 0.7721 2014-12-17 1.2343 1.2516 1.2321 118.68 118.9 116.3 0.9728 0.9746 0.9595 1.5576 1.5754 1.5541 1.1642 1.1671 1.1561 0.7924 0.7954 0.791 146.5 146.77 145.35 1.2009 1.2011 1.2007 0.8129 0.8236 0.8108 184.88 185.03 183.15 122 122.22 121.04 1.5151 1.5181 1.5098 0.7699 0.7802 0.7687 2014-12-18 1.2283 1.2353 1.2266 118.77 119.31 118.262 0.98 0.9848 0.9712 1.5669 1.5677 1.555 1.1592 1.1648 1.157 0.7839 0.7926 0.7836 145.894 146.74 145.6 1.2038 1.2097 1.2001 0.8159 0.8203 0.8117 186.101 186.728 184.436 121.184 122.19 120.626 1.5356 1.5369 1.515 0.7753 0.7763 0.7681 2014-12-19 1.2225 1.2302 1.222 119.565 119.623 118.824 0.9841 0.9846 0.9785 1.5636 1.5682 1.5606 1.1606 1.1634 1.1567 0.7818 0.786 0.7813 146.18 146.74 145.94 1.2032 1.2048 1.2026 0.8144 0.8192 0.8123 186.951 187.25 186.05 121.465 121.851 121.222 1.539 1.54 1.5318 0.7749 0.7796 0.7737 2014-12-22 1.2218 1.2273 1.2217 119.978 120.016 119.316 0.9848 0.985 0.9805 1.5574 1.5665 1.5574 1.1643 1.1646 1.1579 0.7844 0.786 0.7821 146.603 147.119 145.963 1.2033 1.2039 1.2025 0.8132 0.8173 0.8129 186.843 187.548 186.519 121.822 122.25 121.296 1.5337 1.5386 1.531 0.7726 0.777 0.7715 2014-12-23 1.2175 1.2246 1.2165 120.74 120.814 119.973 0.9875 0.9886 0.9826 1.5509 1.5608 1.5487 1.1624 1.1667 1.1599 0.785 0.787 0.7838 147.009 147.133 146.715 1.2023 1.2039 1.2022 0.8089 0.8144 0.8089 187.23 187.483 186.498 122.25 122.326 121.927 1.5314 1.535 1.5286 0.7698 0.7756 0.7695 2014-12-24 1.2193 1.222 1.2169 120.448 120.8 120.281 0.9859 0.9883 0.9841 1.5557 1.5561 1.5505 1.163 1.1641 1.1591 0.7836 0.7866 0.7835 146.875 147.14 146.447 1.2023 1.2029 1.2023 0.8107 0.8124 0.8097 187.399 187.47 186.642 122.146 122.36 121.78 1.534 1.5347 1.5287 0.772 0.7736 0.7703 2014-12-25 1.2239 1.2245 1.2188 120.105 120.503 120.004 0.9798 0.9869 0.9801 1.5571 1.5575 1.5537 1.162 1.163 1.1612 0.7859 0.7866 0.7837 146.97 147.1 146.621 1.2006 1.2029 1.199 0.812 0.8128 0.8105 187.08 187.47 186.67 122.18 122.56 121.907 1.5275 1.5346 1.5263 0.7725 0.7743 0.7724 2014-12-26 1.2178 1.2226 1.2169 120.388 120.464 120.111 0.9875 0.9884 0.9837 1.5553 1.5568 1.5538 1.1624 1.163 1.1603 0.7828 0.7855 0.7821 146.598 147.062 146.487 1.2028 1.2029 1.202 0.8115 0.8132 0.8106 187.257 187.451 186.88 121.86 122.311 121.824 1.5362 1.5378 1.5303 0.7758 0.7763 0.7722 2014-12-29 1.2153 1.2221 1.2143 120.72 120.74 120.18 0.9897 0.9908 0.9844 1.551 1.5586 1.5508 1.1635 1.1648 1.1605 0.7835 0.7853 0.782 146.72 147.22 146.51 1.203 1.2035 1.2026 0.8132 0.8162 0.8111 187.24 187.8 187.06 121.99 122.4 121.81 1.5351 1.538 1.5319 0.7789 0.7799 0.7744 2014-12-30 1.2153 1.2187 1.2124 119.537 120.71 118.867 0.9893 0.992 0.9868 1.5553 1.5573 1.5501 1.1603 1.1651 1.1597 0.7813 0.7844 0.7811 145.298 146.74 144.769 1.2024 1.2033 1.2022 0.8179 0.8203 0.8122 185.917 187.29 184.975 120.827 121.97 120.403 1.5387 1.5392 1.5331 0.7824 0.7848 0.7771 2014-12-31 1.2098 1.217 1.2097 119.8 119.94 119.25 0.9942 0.9944 0.988 1.5583 1.562 1.555 1.1607 1.1628 1.1565 0.7763 0.7817 0.776 144.93 145.58 144.82 1.2029 1.2031 1.2019 0.8173 0.8216 0.8158 186.67 187 185.72 120.49 121.05 120.46 1.5493 1.5497 1.5382 0.78 0.7847 0.7792 LaplacesDemon/data/demonsessions.txt0000644000176200001440000000154415144316355017337 0ustar liggesusersAfrica Americas Asia Europe Oceania Not.Set 201301 5 250 80 200 16 12 201302 22 455 118 290 34 18 201303 27 1143 287 826 59 49 201304 98 1332 402 976 136 24 201305 62 1171 398 1051 124 19 201306 78 1201 427 972 150 32 201307 51 1322 588 1133 146 24 201308 67 1319 531 1078 190 21 201309 75 1860 695 1293 239 26 201310 70 2475 657 1757 250 19 201311 103 3058 893 2184 249 43 201312 112 2697 956 1902 165 55 201401 158 2947 1114 2730 207 24 201402 133 3683 1084 2815 282 12 201403 185 4732 1337 3306 400 18 201404 201 4956 1523 3320 357 28 201405 172 4321 1610 3728 486 26 201406 124 3578 1467 3221 465 21 201407 189 3313 1158 2655 328 23 201408 164 3552 1194 2496 547 16 201409 148 4674 1486 3100 474 19 201410 147 5817 1697 3951 516 26 201411 215 6649 2039 4639 542 46 201412 156 5619 1987 3828 303 37 201501 206 5364 1910 4561 344 26 201502 224 7069 1823 4607 442 15 LaplacesDemon/NAMESPACE0000755000176200001440000002265315144316355014222 0ustar liggesusersimport(parallel) export(ABB, AcceptanceRate, as.covar, as.indicator.matrix, as.initial.values, as.inverse, as.parm.matrix, as.parm.names, as.positive.definite, as.positive.semidefinite, as.ppc, as.symmetric.matrix, BayesFactor, BayesianBootstrap, BayesTheorem, BigData, Blocks, BMK.Diagnostic, burnin, caterpillar.plot, CenterScale, cloglog, Combine, cond.plot, Consort, Cov2Cor, Cov2Prec, CovEstim, CSF, dalaplace, dallaplace, daml, dbern, dcat, dcrmrf, ddirichlet, deburn, delicit, de.Finetti.Game, dgpd, dgpois, dhalfcauchy, dhalfnorm, dhalft, dhs, dhuangwand, dhuangwandc, dhyperg, dinvbeta, dinvchisq, dinvgamma, dinvgaussian, dinvmatrixgamma, dinvwishart, dinvwishartc, dlaplace, dlaplacem, dlaplacep, dlasso, dllaplace, dlnormp, dmatrixgamma, dmatrixnorm, dmvc, dmvcc, dmvcp, dmvcpc, dmvl, dmvlc, dmvn, dmvnc, dmvnp, dmvnpc, dmvpe, dmvpec, dmvpolya, dmvt, dmvtc, dmvtp, dmvtpc, dnorminvwishart, dnormlaplace, dnormm, dnormp, dnormv, dnormwishart, dpareto, dpe, dsdlaplace, dsiw, dslaplace, dStick, dst, dstp, dtrunc, dwishart, dwishartc, dyangberger, dyangbergerc, dzellner, ESS, elicit, extrunc, GaussHermiteCubeRule, GaussHermiteQuadRule, Gelfand.Diagnostic, Gelman.Diagnostic, Geweke.Diagnostic, GIV, Hangartner.Diagnostic, Heidelberger.Diagnostic, Hermite, Hessian, IAT, Importance, interval, invcloglog, invlogit, invloglog, is.amodal, is.appeased, is.bayesfactor, is.bayesian, is.bimodal, is.blocks, is.bmk, is.constant, is.constrained, is.data, is.demonoid, is.demonoid.hpc, is.demonoid.ppc, is.demonoid.val, is.hangartner, is.heidelberger, is.importance, is.iterquad, is.iterquad.ppc, is.juxtapose, is.laplace, is.laplace.ppc, is.miss, is.model, is.multimodal, is.pmc, is.pmc.ppc, is.pmc.val, is.positive.definite, is.positive.semidefinite, is.posteriorchecks, is.proper, is.raftery, is.rejection, is.sensitivity, is.square.matrix, is.stationary, is.symmetric.matrix, is.trimodal, is.unimodal, is.vb, is.vb.ppc, IterativeQuadrature, Jacobian, joint.density.plot, joint.pr.plot, Juxtapose, KLD, KS.Diagnostic, LaplaceApproximation, LaplacesDemon, LaplacesDemon.hpc, LaplacesDemon.RAM, Levene.Test, LML, logadd, logdet, logit, loglog, LossMatrix, lower.triangle, LPL.interval, MCSE, MCSS, MinnesotaPrior, MISS, Mode, Model.Spec.Time, Modes, PMC, PMC.RAM, PosteriorChecks, Prec2Cov, palaplace, pallaplace, partial, ppareto, pbern, phalfcauchy, phalfnorm, phalft, plaplace, plaplacem, plaplacep, pllaplace, plotMatrix, plotSamples, plnormp, pnormm, pnormp, pnormv, ppe, prec2sd, prec2var, psdlaplace, pslaplace, pst, pstp, ptrunc, p.interval, qalaplace, qallaplace, qbern, qcat, qhalfcauchy, qhalfnorm, qhalft, qlaplace, qlaplacep, qllaplace, qlnormp, qnormp, qnormv, qpareto, qpe, qsdlaplace, qslaplace, qst, qstp, qtrunc, Raftery.Diagnostic, ralaplace, rallaplace, raml, rbern, rcat, rcrmrf, rdirichlet, read.matrix, RejectionSampling, rgpd, rhalfcauchy, rhalfnorm, rhalft, rhs, rhuangwand, rhuangwandc, rinvbeta, rinvchisq, rinvgamma, rinvgaussian, rinvwishart, rinvwishartc, rlaplace, rlaplacem, rlaplacep, rlasso, rllaplace, rlnormp, rmatrixnorm, rmvc, rmvcc, rmvcp, rmvcpc, rmvl, rmvlc, rmvn, rmvnc, rmvnp, rmvnpc, rmvpe, rmvpec, rmvpolya, rmvt, rmvtc, rmvtp, rmvtpc, rnorminvwishart, rnormlaplace, rnormm, rnormp, rnormv, rnormwishart, rpareto, rpe, rsdlaplace, rsiw, rslaplace, rst, rStick, rstp, rtrunc, rwishart, rwishartc, rzellner, sd2prec, sd2var, SensitivityAnalysis, server_Listening, SIR, SparseGrid, Stick, Thin, TransitionMatrix, tr, upper.triangle, Validate, VariationalBayes, vartrunc, var2prec, var2sd, WAIC, .colVars, .iqagh, .iqaghsg, .iqcagh, .laaga, .labfgs, .labhhh, .lacg, .ladfp, .lahar, .lahj, .lalbfgs, .lalm, .lanm, .lanr, .lapso, .larprop, .lasgd, .lasoma, .laspg, .lasr1, .latr, .mcmcadmg, .mcmcafss, .mcmcagg, .mcmcahmc, .mcmcaies, .mcmcam, .mcmcamm, .mcmcamm.b, .mcmcamwg, .mcmccharm, .mcmcdemc, .mcmcdram, .mcmcdrm, .mcmcess, .mcmcgibbs, .mcmcgg, .mcmcggcp, .mcmcggcpp, .mcmcggdp, .mcmcggdpp, .mcmcharm, .mcmchmc, .mcmchmcda, .mcmcim, .mcmcinca, .mcmcmala, .mcmcmcmcmc, .mcmcmtm, .mcmcmwg, .mcmcnuts, .mcmcohss, .mcmcram, .mcmcrdmh, .mcmcrefractive, .mcmcrj, .mcmcrss, .mcmcrwm, .mcmcsamwg, .mcmcsgld, .mcmcslice, .mcmcsmwg, .mcmcthmc, .mcmctwalk, .mcmcuess, .mcmcusamwg, .mcmcusmwg, .rowVars, .vbsalimans2) S3method("plot","bmk") S3method("plot","demonoid") S3method("plot","demonoid.hpc") S3method("plot","demonoid.ppc") S3method("plot","importance") S3method("plot","iterquad") S3method("plot","iterquad.ppc") S3method("plot","juxtapose") S3method("plot","laplace") S3method("plot","laplace.ppc") S3method("plot","miss") S3method("plot","pmc") S3method("plot","pmc.ppc") S3method("plot","vb") S3method("plot","vb.ppc") S3method("predict","demonoid") S3method("predict","iterquad") S3method("predict","laplace") S3method("predict","pmc") S3method("predict","vb") S3method("print","demonoid") S3method("print","heidelberger") S3method("print","iterquad") S3method("print","laplace") S3method("print","miss") S3method("print","pmc") S3method("print","raftery") S3method("print","vb") S3method("summary","demonoid.ppc") S3method("summary","iterquad.ppc") S3method("summary","laplace.ppc") S3method("summary","miss") S3method("summary","pmc.ppc") S3method("summary","vb.ppc") importFrom("grDevices", "col2rgb", "colorRampPalette", "dev.off", "heat.colors", "palette", "pdf", "rgb") importFrom("graphics", "abline", "axis", "barplot", "boxplot", "dotchart", "hist", "image", "layout", "legend", "lines", "panel.smooth", "par", "plot", "plot.new", "plot.window", "points", "polygon", "rect", "segments", "smoothScatter", "strwidth", "symbols", "text") importFrom("stats", "ARMAacf", "Gamma", "acf", "aggregate", "approx", "ar", "ar.yw", "as.dist", "chisq.test", "complete.cases", "cor", "cov", "cov.wt", "cutree", "dbeta", "dbinom", "density", "dexp", "dgamma", "dist", "dnorm", "ecdf", "fft", "glm", "hclust", "integrate", "ks.test", "lm", "lowess", "median", "optim", "optimize", "pbinom", "pgamma", "pnorm", "predict", "pt", "qbinom", "qf", "qgamma", "qnorm", "qt", "quantile", "rbeta", "rbinom", "rchisq", "residuals", "rexp", "rgamma", "rmultinom", "rnorm", "rt", "runif", "sd", "spline", "start", "ts", "uniroot", "var", "rlnorm") importFrom("utils", "capture.output", "count.fields", "head", "object.size", "tail") LaplacesDemon/CHANGELOG0000755000176200001440000011517315144343775014223 0ustar liggesusers2026-02-15 Fixed documentation bugs: github.com/LaplacesDemonR/LaplacesDemon/pull/48 replaced class(x) == "class" with inherits(x, "class") Also accepted: https://github.com/LaplacesDemonR/LaplacesDemon/pull/49 https://github.com/LaplacesDemonR/LaplacesDemon/pull/35 2021-06-04 README uses more neutral language for package history. 2020-01-16 Used temporary file for Big Data example. 2020-01-16 Fix to: https://github.com/LaplacesDemonR/LaplacesDemon/issues/17 2019-12-13 Added seed to dzellner() example (for identifying CRAN MKL Issue) 2019-12-13 Fix to: https://github.com/LaplacesDemonR/LaplacesDemon/issues/15 2018-06-23 Corrected out-of-sync LaplacesDemon-package.Rd 2017-12-18 Various bug fixes: https://github.com/LaplacesDemonR/LaplacesDemon/issues/5 https://github.com/LaplacesDemonR/LaplacesDemon/issues/6 https://github.com/LaplacesDemonR/LaplacesDemon/issues/7 https://github.com/LaplacesDemonR/LaplacesDemon/pull/8 https://github.com/LaplacesDemonR/LaplacesDemon/issues/9 https://github.com/LaplacesDemonR/LaplacesDemon/issues/10 https://github.com/LaplacesDemonR/LaplacesDemon/pull/12 https://github.com/LaplacesDemonR/LaplacesDemon/pull/13 2017-04-01 Distributions: Corrected dhalft distribution which did not integrate to 1 (Thanks to Daniel Heck and Quentin F. Gronau). 2015-03-25 Distributions: Corrected Yang-Burger to Yang-Berger, as well as eigenvalue part of density 2015-03-22 Distributions: Added Generalized Pareto 2015-03-19 Distributions: Added Yang-Burger 2015-03-18 Examples: Added Variable Selection: LASSO 2015-03-17 LaplacesDemon: Added Debug argument 2015-03-16 LICENSE: Updated year 2015-03-16 interval: Now handles infinite values, from Richard Hermanson on GitHub, Pull request 21 2015-03-16 Distributions: Added rzellner 2015-03-14 Distributions: Added Huang-Wand, Inverse Matrix Gamma, Matrix Gamma, and Scaled Inverse Wishart 2015-03-13 Distributions: Added LASSO and Normal-Laplace 2015-03-13 Examples: Added Multivariate Poisson Regression and PVAR(p) 2015-03-13 Data: Added demonsessions 2015-03-10 Distributions: Added Laplace Mixture 2015-03-10 Distributions: Added Asymmetric Multivariate Laplace 2015-03-10 LaplacesDemon: Allow different order of Specs, by Richard Hermanson on Github, Pull request 17 2015-03-09 Consort: Added missing commas in AMWG suggestion, by Richard Hermanson on Github, Pull request 15 2015-03-08 Added Hangartner.Diagnostic, is.hangartner, and TransitionMatrix 2015-03-07 Examples: Upgraded VAR(p)-GARCH(1,1)-M to asymmetric BEKK 2015-03-06 Examples: Added VARMA(p,q) - SSVS, and VAR(p) - SVSS 2015-03-05 LaplacesDemon: AFSS is now prevented from incomplete end-of-chain adaptations 2015-03-04 Distributions: Added Normal-Inverse-Wishart and Normal-Wishart 2015-03-03 Examples: Re-introduced Exploratory Cluster Analysis and the Infinite Mixture Model 2015-03-02 Distributions: Added Matrix Normal 2015-02-28 Distributions: Fixed bug reported by Jarrod Hadfield, j.hadfield@ed.ac.uk, where dmvl returns non-finite results when x and mu are identical, due to division by zero. Zeroes are replaced with 1e-300. 2015-02-20 Examples: Added VAR(p)-GARCH(1,1)-M 2015-02-18 Data: Added demonchoice, demonfx, and demontexas 2015-02-16 Distributions: Changed dhs and rhs from one paper to another 2015-02-11 LaplacesDemon: Fixed bug in blocked RWM 2015-02-10 Distributions: Fixed bug reported by Cajo ter Braak, cajo.terbraak@wur.nl, where dinvchisq returns nothing 2015-02-08 LaplacesDemon: Added the AFSS algorithm 2015-02-01 Distributions: Fixed bug in rinvgamma 2015-01-30 LaplacesDemon: Added specification m to AHMC, HMC, and THMC 2015-01-29 LaplacesDemon: Added specification B to MWG 2015-01-28 LaplacesDemon: Added specifications B and n to AMWG 2015-01-27 Distributions: Fixed bug in rslaplace 2015-01-22 LaplacesDemon: Added specifications B, Bounds, and Type to Slice 2014-11-11 LaplacesDemon: Added specifications B and n to RAM 2014-11-11 Distributions: Fixed bug reported by Francisco Rubio, Francisco.Rubio@warwick.ac.uk, where ppe returned 0 when q=0. 2014-10-26 LaplacesDemon: Fixed bug reported by Christoph Kurz, kurz@outlook.com, where NUTS produced an error regarding Mo0. 2014-08-26 LaplaceApproximation: Fixed bug reported by Aaron Robotham, aaron.robotham@uwa.edu.au, where a summary said "Mean" rather than "Mode". 2014-08-09 Examples: Changed the Multivariate Binary Probit example from using a Cholesky decomposition to a correlation matrix. 2014-06-25 GIV: Forced IV to be a vector for identical() 2014-06-23 Fixed bug reported by David Ramsey, David.Ramsey@depi.vic.gov.au, regarding clusterExport, which affected BigData, PMC, predict.demonoid, predict.iterquad, predict.laplace, predict.pmc, predict.vb, RejectionSampling, SIR 2014-06-20 Added MinnesotaPrior 2014-06-20 Combine: Fixed bug with Covar in blocked samplers 2014-06-20 Fixed bug reported by David Ramsey, David.Ramsey@depi.vic.gov.au, regarding acf on small samples. 2014-06-18 Added logdet 2014-06-16 LaplacesDemon: Added the pCN algorithm 2014-06-05 Fixed bug reported by Francois Brunetti, f.a.brunetti@free.fr, in which Data$n vs. Data[["n"]] could refer to different names. 2014-06-02 LaplacesDemon: Added Lmax to NUTS 2014-05-31 LaplacesDemon: Added blocks to UESS 2014-05-30 LaplacesDemon: Fixed bug with AMM blocks 2014-05-28 Consort: The worst mixing chain is named when ESS < 100 2014-05-25 LaplacesDemon: Fixed bug with ADMG 2014-05-24 Distributions: Inf prevented in rinvgamma 2014-05-23 LaplacesDemon: UESS may now be non-adaptive 2014-05-21 Distributions: Sped up rcat 2014-05-21 LaplacesDemon: warnings are now treated as errors and rejected 2014-05-21 LaplaceApproximation, LaplacesDemon, and VariationalBayes: Warning when LP differs and parameters are constant 2014-05-19 Matrices: Added .colVars and .rowVars 2014-05-19 LaplacesDemon: OHSS may now be non-adaptive 2014-05-17 LaplacesDemon: Ensured minimum tuning and diag(Covar) 2014-05-17 LaplacesDemon: Replaced some sample with sample.int 2014-05-16 LaplacesDemon: RAM no longer has Periodicity specification 2014-05-15 Namespace: Exported .vbsalimans2 2014-05-14 Namespace: Exported IQ, LA, and MCMC algorithms 2014-05-08 deburn: Fixed bug with Thinned.Samples 2014-05-08 dmvnp, dmvnpc: Changed log(2) + log(pi) to log(2*pi) 2014-05-06 Replaced many ifelse with which 2014-05-06 MISS: Removed the ESS algorithm 2014-05-05 LaplacesDemon: Fixed bug with OHSS 2014-05-04 LaplacesDemon: Added Gibbs 2014-05-03 PosteriorChecks: Added ISM (Independent Samples per Minute) 2014-05-01 Combine: Fixed bug when Covar is a vector 2014-04-29 Combine: Fixed bug where Periodicity no longer exists now 2014-04-29 LaplacesDemon: Fixed bug with MALA, major revision 2014-04-27 LaplacesDemon: Fixed bug with RAM proposals 2014-04-25 Vignette Examples: Added Exploratory Ordinal Factor Analysis (EOFA) 2014-04-21 BayesianBootstrap: Added example of marginal posterior covariance 2014-04-20 LaplaceApproximation: Added the DFP and SR1 algorithms 2014-04-20 LaplaceApproximation: Revised the BFGS and BHHH algorithms 2014-04-19 CovEstim: Added the Sandwich estimator as a method 2014-04-18 plot.demonoid: Changed colors to transparent for diminishing adapt. 2014-04-10 LaplacesDemon: Added the MTM algorithm 2014-04-09 Levene.Test: Changed colors to transparent colors 2014-04-09 plot.demonoid.hpc: Changed colors to transparent colors 2014-04-07 LaplacesDemon: Added the MCMCMC algorithm 2014-04-06 LaplacesDemon: Added the RDMH algorithm 2014-04-05 Vignette Examples: Added Multiple Discrete-Continuous Choice (MDCC) 2014-03-26 LaplacesDemon: Added the OHSS, Refractive, RSS, and UESS algorithms 2014-03-25 Added deburn 2014-03-14 Vignette Examples: Added Latent Dirichlet Allocation (LDA) 2014-03-14 Added RejectionSampling and is.rejection 2014-03-13 Added WAIC 2014-03-13 LaplacesDemon: Reduced number of chol() evals in some samplers 2014-03-11 Added dcrmrf and rcrmrf 2014-03-05 Added Heidelberger.Diagnostic and is.heidelberger 2014-03-05 Added is.raftery and print.heidelberger 2014-03-04 LML: Added the GD method 2014-03-03 Vignette Examples: Added Change Point Regression 2014-03-02 LaplacesDemon: Added Specs to output 2014-03-02 LaplacesDemon: Removed Adaptive, DR, and Periodicity from output 2014-02-25 Vignette Examples: Added Hidden Markov Model 2014-02-09 dmvnp: Sped up by inverting the Cholesky, rather than Omega 2014-02-06 Added VariationalBayes, plot.vb, plot.vb.ppc, and predict.vb 2014-02-06 Added print.vb and summary.vb.ppc 2013-11-11 as.parm.names: Added the ability to omit missing elements 2013-11-07 LaplacesDemon: Added the AGG algorithm 2013-11-05 Vignette Examples: rewrote CCA, ECA, FMM, IMM, and SSVS for discrete parameters 2013-11-03 Added rStick 2013-11-03 LaplacesDemon: GG now accepts discrete parameters with dparm 2013-11-03 LaplacesDemon: GG now allows a unique Grid per parameter 2013-11-03 Vignette Examples: Removed grep from Model functions 2013-10-29 LaplaceApproximation: Added the SPG algorithm 2013-10-19 Added Hermite 2013-10-17 as.covar: added class iterquad 2013-10-17 as.initial.values: added class iterquad 2013-10-17 caterpillar.plot: added class iterquad 2013-10-17 Added is.iterquad and is.iterquad.ppc 2013-10-17 Added plot.iterquad, plot.iterquad.ppc, and predict.iterquad 2013-10-17 Added print.iterquad and summary.iterquad.ppc 2013-10-17 Added IterativeQuadrature 2013-10-17 Added GaussHermiteCubeRule and GaussHermiteQuadRule 2013-10-12 Added SparseGrid 2013-10-12 LaplaceApproximation: Added the BFGS algorithm 2013-10-06 CITATION has been updated from CRAN to bayesian-inference.com 2013-09-19 LaplacesDemon: Added the GG algorithm 2013-09-14 Vignette Examples: Added Linear Regression with Zellner's g-Prior 2013-09-13 Added dhyperg and dzellner for Zellner's g-prior 2013-09-13 rdirichlet: Expanded alpha from vector to matrix, if desired 2013-09-12 LaplaceApproximation: Default method changed from LM to CG 2013-09-09 LaplaceApproximation: Added the CG algorithm 2013-09-08 LaplaceApproximation: Fixed bug with LM and NR 2013-09-07 LaplaceApproximation: Added the BHHH algorithm 2013-09-07 LaplaceApproximation: Added the CovEst argument 2013-09-07 Added CovEstim 2013-09-07 plot.laplace: Fixed bug with Parms when not converged 2013-09-05 LaplacesDemon: Fixed bug with ADMG 2013-09-03 LaplacesDemon: Added the MALA algorithm 2013-09-02 Added plotSamples 2013-09-01 plot.demonoid.ppc: Changed time-series plots to have shading 2013-09-01 plot.laplace.ppc: Changed time-series plots to have shading 2013-09-01 plot.pmc.ppc: Changed time-series plots to have shading 2013-08-31 LaplaceApproximation: Fixed bug reported by David Marino, davidmarino838@gmail.com, in which m.old was not updated (in case of a failure with m.new) in the LBFGS algorithm. 2013-08-17 LaplacesDemon: Added the ADMG algorithm 2013-08-14 Added Blocks and is.blocks 2013-08-14 LaplacesDemon: Added specification B to HARM for blocking 2013-08-14 LaplacesDemon: Added specification B to RWM for blocking 2013-08-04 Distributions: Added Normal Mixture 2013-08-04 Consort: Added abs. posterior1 correlation for componentwise 2013-08-04 Vignette Examples: Added Quantile Regression 2013-08-03 Vignette Examples: Added Binary Robit and Binomial Robit 2013-07-31 Added AcceptanceRate 2013-07-30 Added Raftery.Diagnostic and print.raftery 2013-07-29 Added plot.miss, print.miss, and summary.miss 2013-07-27 Added MISS and is.miss 2013-07-23 ABB: Fixed bug that caused the loss of 1 imputed value 2013-07-21 LaplacesDemon: Added the ESS algorithm 2013-07-19 hpc_server and LaplacesDemon: Silvere Vialet-Chabrand, silvere@vialet-chabrand.com, updated INCA with global adaptive scaling (Andrieu et al, 2008) to share the acceptance rate among chains 2013-07-14 Added Jacobian 2013-07-14 Hessian: Added Richardson extrapolation per numDeriv package 2013-07-14 partial: Added Richardson extrapolation per numDeriv package 2013-07-14 LaplaceApproximation: Default method changed from LBFGS to LM 2013-07-14 Added cond.plot 2013-07-14 Vignette Examples: Added Variable Selection: Horseshoe 2013-07-14 Distributions: Added Horseshoe 2013-07-13 Software License: Changed from GPL-2 to MIT 2013-07-13 LaplaceApproximation: Added the LM algorithm 2013-07-13 LaplaceApproximation: Added the PSO algorithm 2013-07-13 LaplaceApproximation: Added the SGD algorithm 2013-07-13 LaplaceApproximation: Added the TR algorithm 2013-07-13 LaplaceApproximation: Changed LML method to LME 2013-07-13 LML: Added Covar 2013-07-13 LML: Removed LME2 and renamed LME1 to LME 2013-07-11 Distributions: Added Generalized Poisson 2013-07-07 read.matrix: Added sampling from big data 2013-07-07 BigData: Added parallel processing 2013-07-07 BigData: changed to open connection and scan from read.csv 2013-07-06 LaplacesDemon: Added the SGLD algorithm 2013-06-30 LaplaceApproximation: Added the HJ and NR algorithms 2013-06-29 LaplaceApproximation: Added parallel processing of SIR 2013-06-29 SIR: Added parallel processing 2013-06-29 Added BigData 2013-06-26 Added is.sensitivity 2013-06-26 Added SensitivityAnalysis 2013-06-25 PMC: Added parallel processing 2013-06-24 Importance: Added parallel processing 2013-06-24 predict.demonoid: Added parallel processing 2013-06-24 predict.laplace: Added parallel processing 2013-06-24 predict.ppc: Added parallel processing 2013-06-23 Vignette Examples: Added Ridge Regression 2013-05-17 Mode: Fixed bug with mode of discrete vectors, reported by Chris Campell, ccampbell@mango-solutions.com 2013-04-20 LaplacesDemon.hpc: Added MPI support and logging, thanks to Mathias Moser, matmoser@wu.ac.at 2013-04-20 LaplacesDemon: Added logging, thanks to Mathias Moser, matmoser@wu.ac.at 2013-02-16 Added LossMatrix 2013-02-15 LaplaceApproximation: Added the SOMA algorithm 2013-02-14 LaplaceApproximation: Added the NM algorithm 2013-02-13 LaplaceApproximation: Added the HAR algorithm 2013-02-13 LaplaceApproximation: Revised AGA with Robbins-Monro 2013-02-12 Added BMK.Diagnostic and plot.bmk 2013-02-07 LaplacesDemon: Added the AIES algorithm 2013-02-07 LaplacesDemon: Added optional adaptivity to CHARM and HARM 2013-01-27 LaplacesDemon: Covariance matrices are now created only when required to minimize RAM for models with thousands of parameters 2013-01-26 LaplacesDemon: Added the DEMC algorithm 2013-01-25 LaplacesDemon: Many thanks to Bilal Barakat, bilal.barakat@oeaw.ac.at, for reporting an inefficient use of RAM regarding un-thinned samples, which is now more efficient 2013-01-21 LaplacesDemon: Added specification (B) to AMM for blocking 2013-01-19 LML: Fixed bug reported by Bilal Barakat, bilal.barakat@oeaw.ac.at 2013-01-14 Vignette Examples: Added Time Varying AR(1) with Chebyshev Series 2013-01-11 LaplacesDemon.hpc: Silvere fixed bug with >2 cores reported by Eric Brown, eric.c.brown@mac.com 2013-01-10 Vignette Examples: Reintroduced Penalized Spline Regression 2013-01-09 LaplacesDemon: Fixed bug with Monitor in NUTS reported by Eric Brown, eric.c.brown@mac.com 2012-12-26 LaplacesDemon: Added the Slice algorithm 2012-12-26 LaplacesDemon: Sped up thinning by replacing rbind, thanks to Stefan Humer, shumer@wu.ac.at 2012-12-10 Vignette Examples: Reintroduced Ordinal Probit 2012-12-04 Added server_Listening: This is not called by the user, but is for INCA, authored by Silvere Vialet-Chabrand, silvere@vialet-chabrand.com 2012-12-04 LaplacesDemon.hpc: Added functionality for the INCA algorithm, authored by Silvere Vialet-Chabrand, silvere@vialet-chabrand.com 2012-12-04 LaplacesDemon: Added the INCA algorithm, authored by Silvere Vialet-Chabrand, silvere@vialet-chabrand.com 2012-12-04 DESCRIPTION: Added ByteCompile: TRUE 2012-11-30 LaplacesDemon: Added the IM algorithm 2012-11-28 p.interval: now plots disjoint HPD intervals 2012-11-28 dmvl, dmvlc, rmvl, rmvlc: Fixed bug reported by Thomas Almer, tom.almer@gmail.com. 2012-11-27 BayesianBootstrap: Fixed bug and expanded to statistics, with the help of Bogumil Kaminski, bkamins@sgh.waw.pl 2012-11-16 Vignette Examples: Fixed bug with ordinal logit 2012-11-15 p.interval: Fixed bug with multimodal intervals 2012-11-10 Email Address: Changed to software@bayesian-inference.com 2012-11-10 URL: changed to http://www.bayesian-inference.com/software 2012-11-09 as.initial.values: Now returns a matrix for demonoid.hpc 2012-11-09 LaplacesDemon.hpc: Dispersed initial values are now allowed, solution provided by Silvere Vialet-Chabrand, silvere@vialet-chabrand.com 2012-11-06 dtrunc: Fixed bug reported by Bilal Barakat, bilal.barakat@oeaw.ac.at 2012-11-02 summary.demonoid.ppc: Corrected a discrepancy between L-criterions 2012-11-02 summary.laplace.ppc: Corrected a discrepancy between L-criterions 2012-11-02 summary.pmc.ppc: Corrected a discrepancy between L-criterions 2012-10-21 BayesTheorem: Fixed bug with vector checks 2012-10-15 plot.demonoid: Now delimits trace plot y-axis for componentwise LP 2012-10-13 Added qcat 2012-10-05 Added Gelfand.Diagnostic 2012-10-04 Geweke.Diagnostic: Warning due to too small sample replaced with fail 2012-09-28 Vignette Examples: Added Variable Selection, RJ 2012-09-26 LaplacesDemon: Added the RJ algorithm 2012-09-25 Vignette Examples: Removed Penalized Reg. and Ordinal Probit 2012-09-24 Vignette Examples: Added Linear Reg. with Missing Response via ABB 2012-09-23 Vignette Examples: Contingency table revised 2012-09-22 Vignette Tutorial: HARM becomes the recommended beginning MCMC alg. 2012-09-21 dinvgaussian: Fixed bug 2012-09-17 Vignette Examples: SSVS has delta specified differently 2012-09-16 LaplacesDemon: Added CHARM and HARM algorithms 2012-09-15 Vignette Examples: Multivariate Laplace Regression uses Cholesky 2012-09-15 dmvpe, dmvpec: Fixed bug with Sigma, thanks to Olga Usuga 2012-09-06 Vignette Examples: Changed specification of BAL 2012-09-03 Added joint.pr.plot 2012-08-29 Added ABB 2012-08-28 Vignette Examples: Fixed bug with DC.MNP, MNP, and MBP 2012-08-28 BayesianBootstrap: Fixed bug when X is a vector 2012-08-08 Added is.pmc.val 2012-08-08 Validate: Added class pmc.val 2012-08-07 plotMatrix: Fixed bug with label size when circle=TRUE 2012-08-07 joint.density.plot: Changed color ramp 2012-08-05 Vignette Examples: Added PGF 2012-08-04 GIV: Added the PGF argument 2012-08-03 Added dinvbeta, rinvbeta 2012-08-02 Added rmvpe 2012-08-01 LaplacesDemon.RAM: added Summary1 2012-07-30 Added PMC.RAM 2012-07-29 Vignette Examples: adapted many examples to Cholesky parameterization 2012-07-28 ddirichlet, dhalfcauchy, dinvwishart: now calculated as log-density 2012-07-28 dlaplacep, dmvc, dmvcp, dmvnp, dmvt: now calculated as log-density 2012-07-28 dmvtp, dpareto, dpe, dsdlaplace: now calculated as log-density 2012-07-28 dslaplace, dwishart: now calculated as log-density 2012-07-27 interval: added the reflect argument 2012-07-26 Added dmvcc, dmvcpc, dmvlc, dmvnc, dmvnpc, dmvpec, dmvtc 2012-07-26 Added rmvcc, rmvcpc, rmvlc, rmvnc, rmvnpc, rmvpec, rmvtc 2012-07-26 Added dinvwishartc, dwishartc, rinvwishartc, rwishartc 2012-07-25 rmvn: Fixed bug affecting rmvc, rmvcp, rmvl, rmvn, rmvnp, rmvt, rmvtp 2012-07-19 Added plotMatrix 2012-07-18 LaplacesDemon: Added 2 algorithms: HMCDA and NUTS 2012-07-17 Vignette Examples: Added Linear Regression with Power Priors 2012-07-16 Importance: Added BPIC 2012-07-16 summary.demonoid.ppc, ...laplace.ppc, ...pmc.ppc: Added BPIC 2012-07-16 predict.demonoid, predict.laplace, predict.ppc: Added BPIC 2012-07-16 Added is.constant 2012-07-15 logadd: Expanded to add or subtract vectors 2012-07-14 dst, rst: Improved calculations, oddly enough, avoiding dt and rt 2012-07-13 plot.demonoic.ppc, plot.laplace.ppc, plot.pmc.ppc: Changed Fitted 2012-07-12 DESCRIPTION: Changed package title and description 2012-07-11 Vignette Examples: Fixed bug with mu and ppc 2012-07-11 Vignette Tutorial: Fixed bug reported by Kodi Arfer with mu and ppc 2012-07-10 summary.demonoid.ppc, summary.laplace.ppc, summary.pmc.ppc: Added PPL 2012-07-09 Added as.covar, mainly due to multiple PMC matrices 2012-07-08 as.initial.values, BayesFactor: includes pmc objects 2012-07-08 caterpillar.plot, is.proper, Levene.Test: includes pmc objects 2012-07-08 Importance and LPL.interval: includes pmc objects 2012-07-08 PosteriorChecks and Validate: includes pmc objects 2012-07-07 Added is.pmc, is.pmc.ppc 2012-07-06 Added PMC, plot.pmc, predict.pmc, print.pmc, summary.pmc.ppc 2012-07-03 Added as.ppc, is.demonoid.val, and Validate 2012-07-02 Added BayesianBootstrap 2012-06-30 Added is.proper 2012-06-29 Vignette Bayesian Inference: Added WIP and Reference Prior sections 2012-06-28 Vignette Examples: Fixed bug with MNL, used K, not J 2012-06-27 Added LPL.interval 2012-06-26 Added logadd 2012-06-25 joint.density.plot: Added Trace argument 2012-06-24 plot.demonoid.ppc, plot.laplace.ppc: Residuals now look caterpillarish 2012-06-23 Vignette Tutorial: Changed to t-walk, added HPC section 2012-06-22 Added read.matrix 2012-06-21 Added is.data and is.model 2012-06-20 Added Thin 2012-06-19 AMWG, SAMWG, USAMWG: Sped up by replacing ifelse with which 2012-06-18 LaplacesDemon: Added 3 algorithms: AHMC, HMC, and THMC 2012-06-17 Added Juxtapose, is.juxtapose, and plot.juxtapose 2012-06-16 Added is.bayesfactor, is.importance, and is.ppc 2012-06-15 Added LaplacesDemon.RAM to estimate MB in required RAM 2012-06-14 plot.demonoid.ppc, plot.laplace.ppc: Fixed bug with Jarque-Bera 2012-06-13 Fixed bug with twalk regarding secondary parameter vector 2012-06-12 Vignette Examples: Moved Initial Values AFTER the Model 2012-06-11 caterpillar.plot: Added plot for class demonoid.hpc 2012-06-10 GIV: Fixed bug when model function causes an error 2012-06-09 LaplacesDemon: Sped up twalk by reducing Model calls 2012-06-08 keywords: redid as index entries 2012-06-07 LaplacesDemon: Fixed bug with twalk, so Adaptive = Iter. + 1 2012-06-06 Added plot.demonoid.hpc 2012-06-05 Added LaplacesDemon.hpc for high performance computing 2012-06-04 Email Address: Changed back to statisticat@gmail.com 2012-06-03 LaplacesDemon: Added the t-walk algorithm 2012-06-03 caterpillar.plot: Expanded to accept a generic matrix 2012-06-02 p.interval: Added MM for multi-modal probability intervals 2012-05-30 Added p.interval, which replaces HPD 2012-05-29 rmvl: Fixed bug 2012-05-08 Consort: Fixed object reference bug for diminishing adaptation 2012-04-24 plot.demonoid.ppc and plot.laplace.ppc: Added Mardia plots 2012-04-23 plot.demonoid.ppc and plot.laplace.ppc: Added Jarque-Bera plots 2012-04-22 Added Levene.Test 2012-04-21 plot.demonoid.ppc and plot.laplace.ppc: Added Residual Density plots 2012-04-20 Distributions: Added Skew Discrete Laplace 2012-04-19 Vignette Examples: Added Infinite Mixture Model 2012-04-18 plot.demonoid.ppc and plot.laplace.ppc: Added DW plots 2012-04-17 Vignette Examples: Added Exploratory Cluster Analysis (ECA) 2012-04-17 Vignette Examples: Renamed Cluster Analysis to CCA 2012-04-15 Stick: Added a truncated stick-breaking function for DPs 2012-04-15 Distributions: Added dStick for stick-breaking 2012-04-10 summary.demonoid.ppc: Added MASE, MSE, and Quadratic Loss 2012-04-10 summary.demonoid.ppc: Added Quadratic Utility, and RMSE 2012-04-10 summary.laplace.ppc: Added MASE, MSE, and Quadratic Loss 2012-04-10 summary.laplace.ppc: Added Quadratic Utility, and RMSE 2012-04-10 plot.demonoid.ppc and plot.laplace.ppc: Added ECDF plots 2012-04-06 Vignette Examples: Added State Space Model (SSM), Local Linear Trend 2012-04-06 Vignette Examples: Added State Space Model (SSM), Local Level 2012-04-06 Vignette Examples: Changed DLM and Stochastic Volatility to SSMs 2012-04-01 Added IAT 2012-03-31 Vignette Examples: Added Stochastic Volatility 2012-03-30 Vignette Examples: Updated DLM and DFA to include Dyn 2012-03-29 : USAMWG and USMWG for SSMs 2012-03-28 Vignette Examples: Added Spatial Autoregression (SAR) 2012-03-27 LaplacesDemon: Added 2 algorithms: SAMWG and SMWG for SSMs 2012-03-26 Vignette Examples: Added Hierarchical Bayesian 2012-03-25 Consort: Changed the Demonic Suggestions due to a new MCMC alg 2012-03-19 Vignette Tutorial: Added a Sampler Selection section 2012-03-18 LaplacesDemon: Added the RAM algorithm 2012-03-17 LaplacesDemon: Redesigned arguments to make it modular for more algs. 2012-03-12 Vignette Examples: expanded Linear Regression with Full Missingness 2012-03-11 summary.demonoid.ppc: Allow missing values for L, S.L., and Discrep 2012-03-11 summary.laplace.ppc: Allow missing values for L, S.L., and Discrep 2012-03-10 Vignette Examples: Added STARMA(1,1) 2012-03-09 LaplacesDemon: Changed MWG and AWMG to random-scan 2012-03-06 LaplaceApproximation and SIR: Document sample size vs. parm. correl. 2012-03-04 Vignette Examples: Added Negative Binomial Regression 2012-03-03 Vignette Examples: Added TARCH(1) 2012-02-26 Vignette Examples: Added Ordinal Logit and Ordinal Probit 2012-02-23 logit and log-log functions no longer require vector arguments 2012-02-21 Distributions: Made rcat faster by using rmultinom 2012-02-16 Vignette Examples: Added Variable Selection, BAL (Lasso) 2012-02-11 Vignette Examples: ARCH models updated 2012-02-02 plot.demonoid.ppc and plot.laplace.ppc: Fitted now has na.rm=TRUE 2012-01-05 interval: Expanded to include arrays 2011-12-30 Vignette Examples: Fixed bugs in Mixed Logit and ZIP 2011-12-29 Vignette Examples: Vectorized Penalized Spline Regression 2011-12-22 Vignette Examples: Added LSTAR 2011-12-21 Vignette Examples: Added Approximate Dynamic Factor Analysis (ADFA) 2011-12-20 Vignette Examples: Added Dynamic Factor Analysis (DFA) 2011-12-19 Vignette Examples: Vectorized Factor Regression, and fixed bug 2011-12-18 Vignette Examples: Vectorized Confirmatory Factor Analysis 2011-12-17 Vignette Examples: Vectorized Exploratory Factor Analysis 2011-12-06 SIR: Prevent infinite weights 2011-12-03 Added plot.importance 2011-12-01 CITATION now includes citations for vignettes 2011-11-26 Added GIV 2011-11-26 OnLoad: Included version number 2011-11-23 Vignette Examples: Changed sigma in Kriging, Predictive Process 2011-11-22 LaplacesDemon: MCSE with method IMPS becomes default 2011-11-21 Consort: Changed the Demonic Suggestions due to new MCMC algs 2011-11-20 Added partial and Hessian 2011-11-19 LML: Added the HME method, changed defaults for LA and LD 2011-11-18 LML: Fixed major bug between LL and LP 2011-11-17 caterpillar.plot: Added posterior samples due to SIR from LA 2011-11-16 plot.laplace: Added posterior samples due to SIR 2011-11-15 PosteriorChecks: Added Burn-In and posterior LA samples 2011-11-14 LaplaceApproximation: Added posterior samples with sir=TRUE 2011-11-13 LaplaceApproximation: Deprecated the CG method 2011-11-12 LaplaceApproximation: Added algorithms LBFGS and Rprop 2011-11-11 LaplaceApproximation: Sped up AGA with efficient coding 2011-11-10 LaplacesDemon: Added 3 MCMC algorithms - AMM, AMWG, and MWG 2011-11-09 LaplacesDemon: Sped up MCMC algorithms with efficient coding 2011-11-08 Added Model.Spec.Time 2011-11-07 Added SIR for sampling importance resampling 2011-11-06 Added de.Finetti.Game 2011-11-05 Added burnin 2011-11-04 Added KS.Diagnostic 2011-11-03 Added MCSS 2011-11-02 Added Elicitation 2011-11-01 Added Importance 2011-10-31 Added CSF and additional MCSE methods 2011-10-30 Added BayesTheorem and more Mode functions 2011-10-29 Vignette Examples: Added Covariance Separation Strategy 2011-10-28 Made LML public and added methods LME2 and NSIS 2011-10-27 Added Gelman.Diagnostic, renamed indmat to as.indicator.matrix 2011-10-26 Added as.initial.values and as.inverse 2011-10-26 parm.names: Converted to as.parm.names, added arrays 2011-10-25 Added is.appeased, is.demonoid, is.laplace, is.stationary 2011-10-24 Distributions: Added Inverse-Chi-Squared and Pareto 2011-10-23 Added is.positive.definite and is.positive.semidefinite 2011-10-23 Added is.square.matrix, is.symmetric.matrix, and tr (trace) 2011-10-23 Added lower.triangle and upper.triangle 2011-10-22 Distributions: Added Log-Normal with precision parameterization 2011-10-21 Distributions: Added Multivariate Cauchy with precision param. 2011-10-20 Distributions: Added Multivariate Cauchy 2011-10-19 Distributions: Added Multivariate Polya 2011-10-18 Distributions: Added Skew-Laplace 2011-10-17 Distributions: Added Power Exponential 2011-10-16 Distributions: Added Asymmetric Log-Laplace 2011-10-15 Distributions: Added Log-Laplace 2011-10-14 Distributions: Added Student t with precision param. 2011-10-13 Distributions: Added Laplace with precision parameterization 2011-10-12 Distributions: Added Multivariate t with precision param. 2011-10-11 Distributions: Added Multivariate Laplace 2011-10-10 Distributions: Added Multivariate Power Exponential 2011-10-09 Distributions: Added Multivariate Normal with precision param. 2011-10-08 Added as.parm.matrix to prepare matrices in a model spec. 2011-10-07 Added as.positive.definite and as.positive.semidefinite 2011-10-06 Precision: Added elementary functions for precision conversions 2011-10-05 Distributions: Added the normal with variance parameterization 2011-10-04 Distributions: Added the asymmetric Laplace 2011-10-03 Added KLD for Kullback-Leibler Divergence 2011-10-03 Distributions: Added the half-normal 2011-10-02 Documentation: Added LaTeX math formulas throughout 2011-10-02 Vignette Examples: Added Multivariate Binary Probit 2011-10-01 Vignette Examples: Added Multivariate Regression 2011-09-30 Vignette Examples: Added Inverse Gaussian Regression 2011-09-29 plot.laplace.ppc: Added 2 multivariate residual plots 2011-09-29 plot.demonoid.ppc: Added 2 multivariate residual plots 2011-09-28 plot.laplace.ppc: Bug fixed with ylim in multivariate plots 2011-09-28 plot.demonoid.ppc: Bug fixed with ylim in multivariate plots 2011-09-27 Distributions: Added dinvgaussian, rinvgaussian, and rcat 2011-09-26 summary.laplace.ppc: Added 4 discrepancies 2011-09-26 summary.demonoid.ppc: Added 4 discrepancies 2011-09-25 cloglog, invcloglog, invloglog, and loglog added 2011-09-24 PosteriorChecks added 2011-09-24 summary.laplace.ppc: Added Chi-Square, Kurtosis, and Skewness 2011-09-24 summary.demonoid.ppc: Added Chi-Square, Kurtosis, and Skewness 2011-09-23 summary.laplace.ppc: Added L-criterion and S.L 2011-09-23 summary.demonoid.ppc: Added L-criterion and S.L 2011-09-22 Vignette Examples: Added Threshold Autoregression (TAR) 2011-09-21 Vignette Examples: Added Beta-Binomial 2011-09-20 Vignette Examples: Added Mixture Model, Poisson-Gamma 2011-09-19 Vignette Examples: Added Gamma Regression 2011-09-18 Vignette Examples: Survival Analysis renamed to Proportional Hazards 2011-09-17 Vignette Examples: Added Weighted Regression 2011-09-16 Vignette Examples: Added Conditional Predictive Ordinate (CPO) 2011-09-15 Vignette Examples: Added Approximate Bayesian Computation (ABC) 2011-09-14 caterpillar.plot: Now allows plotting of only 1 parameter 2011-09-14 plot.laplace.ppc: Added 14 plot styles 2011-09-13 plot.demonoid.ppc: Added 14 plot styles 2011-09-11 Vignette Examples: Added Koyck Distributed Lag 2011-09-11 Vignette Examples: Added Factor Regression 2011-09-10 Vignette Examples: Added Penalized Spline Regression 2011-09-10 Vignette Examples: Added Polynomial Regression 2011-09-09 LaplaceApproximation: Added test of each matrix rank with QR in Data. 2011-09-08 LaplacesDemon: Added test of each matrix rank with QR in Data. 2011-09-07 plot.demonoid: fixed bug with Parms argument 2011-09-06 Vignette Examples: Added Space-Time, Dynamic 2011-09-05 Vignette Examples: Added Kriging, Predictive Process 2011-09-02 logit function updated from scalars to vectors 2011-09-01 Vignette Examples: Updated Separable Space-Time to half-Cauchy 2011-08-28 Vignette Examples: Added Geographically Weighted Regression 2011-08-27 Vignette Examples: Added ARCH-M, GARCH-M, and Simultaneous Equations 2011-08-26 Vignette Examples: Added GARCH(1,1) 2011-08-25 Vignette Examples: Added MANCOVA 2011-08-24 Vignette Examples: Added MANOVA 2011-08-23 Vignette Examples: Added Frequentist Linear Regression 2011-08-21 Vignette Examples: Added Finite Mixture Model 2011-08-15 Added Combine 2011-08-12 LaplaceApproximation: Added wrapper to optim for CG 2011-08-07 Vignette Examples: Corrected epsilon in ARCH(1,1) 2011-08-03 Vignette Examples: Added Exponential Smoothing 2011-07-27 plot.demonid, plot.laplace, caterpillar.plot: Improved grep 2011-07-26 Vignette Examples: Added Beta Regression 2011-07-25 LaplacesDemon: Corrected error preventing multivariate updating 2011-07-25 Vignette Examples: Added ARMA(1,1) 2011-07-25 Vignette Examples: Added ARCH(1,1) 2011-07-24 LaplacesDemon: Only estimates LML when algorithm is random-walk 2011-07-24 LaplacesDemon: Added note to screen when estimating LML 2011-07-18 Vignette Examples: Added Vector Autoregression, VAR(1) 2011-07-13 Vignette Examples: Added Dicrete Choice, Multinomial Probit 2011-07-12 Included more else and else ifs with if() for efficiency 2011-07-10 Vignette Examples: Added Multinomial Probit 2011-07-09 summary.laplace.ppc: Included Categorical argument 2011-07-09 summary.demonoid.ppc: Included Categorical argument 2011-07-09 LaplaceApproximation and LML: Replaced () and x^2 with {} and x*x 2011-07-08 Distributions: Replace x^2 with x*x for speed where possible 2011-07-08 Distributions: Replaced () with {} for speed where possible 2011-07-08 Distributions: Laplace return() bug fixed 2011-07-07 Distributions: dmvn is corrected and expanded 2011-07-06 Vignette Examples: Added ANCOVA 2011-07-06 Vignette Examples: Changed nonsensible min(grep...:max(grep code 2011-07-05 Vignette Examples: Variable Selection error corrected 2011-07-05 Changed %*% to crossprod() or tcrossprod() for small speed gains 2011-07-04 Distributions: Added dcat for density of categorical distribution 2011-07-03 Vignette Examples: Added Discrete Choice, Mixed Logit 2011-07-02 Vignette Examples: Added Discrete Choice, Conditional Logit 2011-07-01 Vignette Examples: Added paragraph about statistical notation 2011-06-30 Vignette Examples: Added Cluster Analysis 2011-06-29 Replaced many apply functions with rowSums, colMeans, etc. 2011-06-28 Vignette Examples: Added Revision, Normal 2011-06-27 Distributions: 'Vectorized' dmvn and dmvt 2011-06-26 LaplaceApproximation and LaplacesDemon: Suggestion about loops 2011-06-25 LaplaceApproximation and LaplacesDemon: Warning for multiple LPs 2011-06-18 Added indmat function 2011-06-15 Vignette Examples: Added ANOVA, Two-Way 2011-06-09 predict.demonoid now warns about use of non-stationary samples 2011-06-08 Distributions: Added the half-t 2011-06-03 Distributions: Added the half-Cauchy 2011-04-09 Email Address: Changed to laplacesdemon@statisticat.com 2011-04-07 Vignette Examples: Added Robust Regression 2011-04-05 Distributions: Added the 3-parameter Student t 2011-04-04 plot.demonoid and plot.laplace: Changed Parms argument with grep 2011-04-02 Vignette Examples: Added Survival Analysis 2011-04-01 Vignette Examples: Added Space-Time, Nonseparable 2011-03-31 Vignette Examples: Added Space-Time, Separable 2011-03-30 Vignette Examples: Added Kriging 2011-03-29 Vignette Examples: Added CAR, Poisson 2011-03-28 Vignette Examples: Changed Panel, Autoregressive Poisson 2011-03-27 predict.demonoid: Fixed bug with non-stationary samples 2011-03-26 Vignette Examples: Added Panel, Autoregressive Poisson 2011-03-25 Vignette Examples: Added Multinomial Logit, Nested 2011-03-24 Vignette Examples: Added Binary Probit and Binomial Logit 2011-03-23 Added interval function 2011-03-20 Vignette Examples: Added Variable Selection 2011-03-19 Vignette Examples: Added Factor Analysis, Confirmatory 2011-03-18 Vignette Examples: Added ANOVA, One-Way 2011-03-17 parm.names function added 2011-03-16 Vignette Examples: Added Contingency Table 2011-03-15 BayesFactor: Included posterior probability of each model 2011-03-14 Added Cov2Cor 2011-03-13 Vignette Examples: Added Linear Regression, Multilevel 2011-03-12 Vignette Examples: Added Factor Analysis, Exploratory 2011-03-11 Vignette Examples: Omega and S changed in SUR 2011-03-09 Consort: Bug fix since Rec.Status was continuous in some cases 2011-03-08 Vignette Examples: Added Linear Regression with Full Missingness 2011-03-07 Vignette Examples: Added Linear Regression with Missing Response 2011-03-06 BayesFactor extended to more than two model comparisons 2011-03-05 LaplacesDemon now estimates LML (log-marginal likelihood) 2011-03-03 Vignette Examples: Added Zero-Inflated Poisson (ZIP) 2011-03-02 Distributions: dmvn requires vectors for x and mu 2011-02-27 LaplacesDemon single-component updating replaces independent 2011-02-25 Distributions: MVN is improved 2011-02-24 LaplaceApproximation: Corrected typo in error message 2011-02-21 plot.demonoid: now also plots proposal variance changes 2011-02-18 Changed Proposal Shrinkage and Scale 2011-02-17 Corrected typos in documentation 2011-02-13 Added test statistics included in summary.(class).ppc 2011-02-12 Added BayesFactor 2011-02-11 Added Monitor names 2011-02-09 Added plot.laplace.ppc and summary.laplace.ppc 2011-02-08 Added Predict.laplace, print.laplace, and plot.laplace 2011-02-07 Added joint.density.plot, logit, and Mode functions 2011-02-06 Caterpillar Plot included 2011-02-05 Added CenterScale for centering and scaling variables 2011-02-04 Added LaplaceApproximation 2011-02-03 Distributions: Added Bernoulli and truncated 2011-02-02 Vignette Examples: Corrected off-diagonal asymmetry in SUR 2011-01-31 Vignette Examples: Added Seemingly Unrelated Regression (SUR) 2011-01-30 Consort: Adaptive, Periodicity suggestions include Acc. Rate 2011-01-29 Initial Values: Missings are set to zero 2011-01-28 Vignette Examples: Corrected Typos 2011-01-27 Removed Software License 2011-01-26 Vignette Examples: Added Binomial Probit and Multinomial Logit 2011-01-25 Distributions: Added invwishart, mvt, and wishart 2011-01-24 Distributions: Added dirichlet, invgamma, laplace, mvn 2011-01-23 Vectorized some loops and increased speed 2011-01-22 Logo replacement: the horned-Theta 2011-01-21 Vignette Examples: Added Binary Logit, DLM, and Laplace Reg. 2011-01-20 Parameter constraints included 2011-01-18 Vignette style changes 2011-01-17 Logo adoption: the pitchfork-psi 2011-01-16 Vignette included: Examples 2011-01-12 Vignette included: BayesianInference 2011-01-11 Refined the LaplacesDemon Tutorial vignette 2011-01-09 Renamed the ESS function 2011-01-08 Vignette included: LaplacesDemon Tutorial 2011-01-07 Corrected typos 2011-01-06 Added summary.demonoid.ppc and plot.demonoid.ppc functions 2011-01-03 First appeared on CRAN, as the 2,768th package 2010-12-30 Added a predict.demonoid function 2010-12-29 Added plot.demonoid and print.demonoid functions 2010-12-28 Consort: Demonic Suggestions has expanded dramatically 2010-12-25 Version Nomenclature changes to Year-Month-Day (10.12.24) 2010-12-24 The LaplacesDemon package was first put together 2010-12-13 Project Laplace's Demon began, and LaplacesDemon was written LaplacesDemon/LICENSE0000755000176200001440000000030515145051160013765 0ustar liggesusersLaplacesDemon Package: YEAR: 2010-2015 COPYRIGHT HOLDER: Statisticat, LLC TR method in LaplaceApproximation function is derived from trust::trust: YEAR: 2005 COPYRIGHT HOLDER: Charles J. Geyer LaplacesDemon/inst/0000755000176200001440000000000015145054161013740 5ustar liggesusersLaplacesDemon/inst/CITATION0000755000176200001440000000353115144344565015113 0ustar liggesusersif(!exists('meta') || is.null(meta)) meta <- packageDescription("LaplacesDemon") year <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date) vers <- paste("R package version", meta$Version) author <- "Statisticat, LLC." #as.personList(meta$Author) url <- "https://web.archive.org/web/20150206004624/http://www.bayesian-inference.com/software" citHeader(sprintf("To cite package '%s' in publications use:", meta$Package)) bibentry(bibtype ="Manual", author = author, year = year, title =sprintf("%s: %s", meta$Package, meta$Title), note = vers, url = url, publisher = "Bayesian-Inference.com", textVersion = sprintf("%s (%s). %s: %s. Bayesian-Inference.com. %s. [%s]", author, year, meta$Package, meta$Title, vers, url), header = "Technical documentation:" ) bibentry(bibtype ="Manual", author = author, year = year, title = vign <- "Bayesian Inference", note = vers, url = url, publisher = "Bayesian-Inference.com", textVersion = sprintf("%s (%s). %s. Bayesian-Inference.com. %s. [%s]", author, year, vign, vers, url), header = "Vignette(s):" ) bibentry(bibtype ="Manual", author = author, year = year, title = vign <- "LaplacesDemon Examples", note = vers, url = url, publisher = "Bayesian-Inference.com", textVersion = sprintf("%s (%s). %s. Bayesian-Inference.com. %s. [%s]", author, year, vign, vers, url), header = "Vignette(s):" ) bibentry(bibtype ="Manual", author = author, year = year, title = vign <- "LaplacesDemon Tutorial", note = vers, url = url, publisher = "Bayesian-Inference.com", textVersion = sprintf("%s (%s). %s. Bayesian-Inference.com. %s. [%s]", author, year, vign, vers, url), header = "Vignette(s):" ) LaplacesDemon/inst/doc/0000755000176200001440000000000015145054161014505 5ustar liggesusersLaplacesDemon/inst/doc/BayesianInference.Stex0000755000176200001440000024062015144316355020740 0ustar liggesusers\documentclass[nojss]{jss} %% need no \usepackage{Sweave.sty} \usepackage{amsmath,mathrsfs} %\VignetteIndexEntry{Bayesian Inference} %\VignettePackage{LaplacesDemon} %\VignetteDepends{LaplacesDemon} \author{Statisticat, LLC} \title{\includegraphics[height=1in,keepaspectratio]{LDlogo} \\ Bayesian Inference} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Statisticat LLC} %% comma-separated \Plaintitle{Bayesian Inference} %% without formatting \Shorttitle{Bayesian Inference} %% a short title (if necessary) \Abstract{The Bayesian interpretation of probability is one of two broad categories of interpretations. Bayesian inference updates knowledge about unknowns, parameters, with information from data. The \pkg{LaplacesDemon} package is a complete environment for Bayesian inference within \proglang{R}, and this vignette provides an introduction to the topic. This article introduces Bayes' theorem, model-based Bayesian inference, components of Bayesian inference, prior distributions, hierarchical Bayes, conjugacy, likelihood, numerical approximation, prediction, Bayes factors, model fit, posterior predictive checks, and ends by comparing advantages and disadvantages of Bayesian inference.} \Keywords{Bayesian, LaplacesDemon, LaplacesDemonCpp, R} \Plainkeywords{bayesian, laplacesdemon, laplacesdemoncpp, r} %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2011} %% \Submitdate{2011-01-18} %% \Acceptdate{2011-01-18} \Address{ Statisticat, LLC\\ Farmington, CT\\ E-mail: is defunct\\ URL: \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index} } %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} \begin{document} This article is an introduction to Bayesian inference for users of the \pkg{LaplacesDemon} package \citep{r:laplacesdemon} in \proglang{R} \citep{rdct:r}, often referred to as LD. \pkg{LaplacesDemonCpp} is an extension package that uses \proglang{C++}. A formal introduction to \pkg{LaplacesDemon} is provided in an accompanying vignette entitled ``\pkg{LaplacesDemon} Tutorial''. Merriam-Webster defines `Bayesian' as follows \begin{quote} \textbf{Bayesian} : being, relating to, or involving statistical methods that assign probabilities or distributions to events (as rain tomorrow) or parameters (as a population mean) based on experience or best guesses before experimentation and data collection and that apply Bayes' theorem to revise the probabilities and distributions after obtaining experimental data. \end{quote} In statistical inference, there are two broad categories of interpretations of probability: Bayesian inference and frequentist inference. These views often differ with each other on the fundamental nature of probability. Frequentist inference loosely defines probability as the limit of an event's relative frequency in a large number of trials, and only in the context of experiments that are random and well-defined. Bayesian inference, on the other hand, is able to assign probabilities to any statement, even when a random process is not involved. In Bayesian inference, probability is a way to represent an individual's degree of belief in a statement, or given evidence. Within Bayesian inference, there are also different interpretations of probability, and different approaches based on those interpretations. The most popular interpretations and approaches are objective Bayesian inference \citep{berger06} and subjective Bayesian inference \citep{anscombe63, goldstein06}. Objective Bayesian inference is often associated with \citet{bayes63}, \citet{laplace14}, and \citet{jeffreys61}. Subjective Bayesian inference is often associated with \citet{ramsey26}, \citet{definetti31}, and \citet{savage54}. The first major event to bring about the rebirth of Bayesian inference was \citet{definetti37}. Differences in the interpretation of probability are best explored outside of this article\footnote{If these terms are new to the reader, then please do not focus too much on the words `objective' and `subjective', since there is a lot of debate over them. For what it's worth, \textit{Statisticat, LLC}, the provider of this \proglang{R} package entitled \pkg{LaplacesDemon}, favors the `subjective' interpretation.}. This article is intended as an approachable introduction to Bayesian inference, or as a handy summary for experienced Bayesians. It is assumed that the reader has at least an elementary understanding of statistics, and this article focuses on applied, rather than theoretical, material. Equations and statistical notation are included, but it is hopefully presented so the reader does not need an intricate understanding of solving integrals, for example, but should understand the basic concept of integration. Please be aware that it is difficult to summarize Bayesian inference in such a short article. In which case, consider \citet{robert07} for a more thorough and formal introduction. \section{Bayes' Theorem} \label{bayestheorem} Bayes' theorem shows the relation between two conditional probabilities that are the reverse of each other. This theorem is named after Reverend Thomas Bayes (1701-1761), and is also referred to as Bayes' law or Bayes' rule \citep{bayes63}\footnote{\citet{stigler83} suggests the earliest discoverer of Bayes' theorem was Nicholas Saunderson (1682-1739), a blind mathematician/optician, who at age 29 became the Lucasian Professor of Mathematics at Cambridge. This position was previously held by Isaac Newton.}. Bayes' theorem expresses the conditional probability, or `posterior probability', of an event $A$ after $B$ is observed in terms of the `prior probability' of $A$, prior probability of $B$, and the conditional probability of $B$ given $A$. Bayes' theorem is valid in all common interpretations of probability. The two (related) examples below should be sufficient to introduce Bayes' theorem. \subsection{Bayes' Theorem, Example 1} \label{bayestheorem1} Bayes' theorem provides an expression for the conditional probability of $A$ given $B$, which is equal to \begin{equation} \label{bayestheorem} \Pr(A | B) = \frac{\Pr(B | A)\Pr(A)}{\Pr(B)} \end{equation} For example, suppose one asks the question: what is the probability of going to Hell, conditional on consorting (or given that a person consorts) with Laplace's Demon\footnote{This example is, of course, intended with humor.}. By replacing $A$ with $Hell$ and $B$ with $Consort$, the question becomes $$\Pr(\mathrm{Hell} | \mathrm{Consort}) = \frac{\Pr(\mathrm{Consort} | \mathrm{Hell}) \Pr(\mathrm{Hell})}{\Pr(\mathrm{Consort})}$$ Note that a common fallacy is to assume that $\Pr(A | B) = \Pr(B | A)$, which is called the conditional probability fallacy. \subsection{Bayes' Theorem, Example 2} \label{bayestheorem2} Another way to state Bayes' theorem is $$\Pr(A_i | B) = \frac{\Pr(B | A_i)\Pr(A_i)}{\Pr(B | A_i)\Pr(A_i) +...+ \Pr(B | A_n)\Pr(A_n)}$$ Let's examine our \textit{burning} question, by replacing $A_i$ with Hell or Heaven, and replacing $B$ with Consort \begin{itemize} \item $\Pr(A_1) = \Pr(\mathrm{Hell})$ \item $\Pr(A_2) = \Pr(\mathrm{Heaven})$ \item $\Pr(B) = \Pr(\mathrm{Consort})$ \item $\Pr(A_1 | B) = \Pr(\mathrm{Hell} | \mathrm{Consort})$ \item $\Pr(A_2 | B) = \Pr(\mathrm{Heaven} | \mathrm{Consort})$ \item $\Pr(B | A_1) = \Pr(\mathrm{Consort} | \mathrm{Hell})$ \item $\Pr(B | A_2) = \Pr(\mathrm{Consort} | \mathrm{Heaven})$ \end{itemize} Laplace's Demon was conjured and asked for some data. He was glad to oblige. \textbf{Data} \begin{itemize} \item 6 people consorted out of 9 who went to Hell. \item 5 people consorted out of 7 who went to Heaven. \item 75\% of the population goes to Hell. \item 25\% of the population goes to Heaven. \end{itemize} Now, Bayes' theorem is applied to the data. Four pieces are worked out as follows \begin{itemize} \item $\Pr(\mathrm{Consort} | \mathrm{Hell}) = 6/9 = 0.666$ \item $\Pr(\mathrm{Consort} | \mathrm{Heaven}) = 5/7 = 0.714$ \item $\Pr(\mathrm{Hell})$ = 0.75 \item $\Pr(\mathrm{Heaven})$ = 0.25 \end{itemize} Finally, the desired conditional probability $\Pr(\mathrm{Hell} | \mathrm{Consort})$ is calculated using Bayes' theorem \begin{itemize} \item $\Pr(\mathrm{Hell} | \mathrm{Consort}) = \frac{0.666(0.75)}{0.666(0.75) + 0.714(0.25)}$ \item $\Pr(\mathrm{Hell} | \mathrm{Consort}) = 0.737$ \end{itemize} The probability of someone consorting with Laplace's Demon and going to Hell is 73.7\%, which is less than the prevalence of 75\% in the population. According to these findings, consorting with Laplace's Demon does not increase the probability of going to Hell. With that in mind, please continue\dots \section{Model-Based Bayesian Inference} \label{modelbasedbayes} The basis for Bayesian inference is derived from Bayes' theorem. Here is Bayes' theorem, equation \ref{bayestheorem}, again $$\Pr(A | B) = \frac{\Pr(B | A)\Pr(A)}{\Pr(B)}$$ Replacing $B$ with observations $\textbf{y}$, $A$ with parameter set $\Theta$, and probabilities $\Pr$ with densities $p$ (or sometimes $\pi$ or function $f$), results in the following $$ p(\Theta | \textbf{y}) = \frac{p(\textbf{y} | \Theta)p(\Theta)}{p(\textbf{y})}$$ where $p(\textbf{y})$ will be discussed below, p($\Theta$) is the set of prior distributions of parameter set $\Theta$ before $\textbf{y}$ is observed, $p(\textbf{y} | \Theta)$ is the likelihood of $\textbf{y}$ under a model, and $p(\Theta | \textbf{y})$ is the joint posterior distribution, sometimes called the full posterior distribution, of parameter set $\Theta$ that expresses uncertainty about parameter set $\Theta$ after taking both the prior and data into account. Since there are usually multiple parameters, $\Theta$ represents a set of $j$ parameters, and may be considered hereafter in this article as $$\Theta = \theta_1,...,\theta_j$$ The denominator $$p(\textbf{y}) = \int p(\textbf{y} | \Theta)p(\Theta) d\Theta$$ defines the ``marginal likelihood'' of $\textbf{y}$, or the ``prior predictive distribution'' of $\textbf{y}$, and may be set to an unknown constant $\textbf{c}$. The prior predictive distribution\footnote{The predictive distribution was introduced by \citet{jeffreys61}.} indicates what $\textbf{y}$ should look like, given the model, before $\textbf{y}$ has been observed. Only the set of prior probabilities and the model's likelihood function are used for the marginal likelihood of $\textbf{y}$. The presence of the marginal likelihood of $\textbf{y}$ normalizes the joint posterior distribution, $p(\Theta | \textbf{y})$, ensuring it is a proper distribution and integrates to one. By replacing $p(\textbf{y})$ with $\textbf{c}$, which is short for a `constant of proportionality', the model-based formulation of Bayes' theorem becomes $$p(\Theta | \textbf{y}) = \frac{p(\textbf{y} | \Theta)p(\Theta)}{\textbf{c}}$$ By removing $\textbf{c}$ from the equation, the relationship changes from 'equals' ($=$) to 'proportional to' ($\propto$)\footnote{For those unfamiliar with $\propto$, this symbol simply means that two quantities are proportional if they vary in such a way that one is a constant multiplier of the other. This is due to the constant of proportionality $\textbf{c}$ in the equation. Here, this can be treated as `equal to'.} \begin{equation} \label{jointposterior} p(\Theta | \textbf{y}) \propto p(\textbf{y} | \Theta)p(\Theta) \end{equation} This form can be stated as the unnormalized joint posterior being proportional to the likelihood times the prior. However, the goal in model-based Bayesian inference is usually not to summarize the unnormalized joint posterior distribution, but to summarize the marginal distributions of the parameters. The full parameter set $\Theta$ can typically be partitioned into $$\Theta = \{\Phi, \Lambda\}$$ where $\Phi$ is the sub-vector of interest, and $\Lambda$ is the complementary sub-vector of $\Theta$, often referred to as a vector of nuisance parameters. In a Bayesian framework, the presence of nuisance parameters does not pose any formal, theoretical problems. A nuisance parameter is a parameter that exists in the joint posterior distribution of a model, though it is not a parameter of interest. The marginal posterior distribution of $\phi$, the parameter of interest, can simply be written as $$p(\phi | \textbf{y}) = \int p(\phi, \Lambda | \textbf{y}) d\Lambda$$ In model-based Bayesian inference, Bayes' theorem is used to estimate the unnormalized joint posterior distribution, and finally the user can assess and make inferences from the marginal posterior distributions. \section{Components of Bayesian Inference} \label{components} The components\footnote{In Bayesian decision theory, an additional component exists \citep[p. 53]{robert07}, the loss function, $\mathrm{L}(\Theta, \Delta)$.} of Bayesian inference are \begin{enumerate} \item $p(\Theta)$ is the set of prior distributions for parameter set $\Theta$, and uses probability as a means of quantifying uncertainty about $\Theta$ before taking the data into account. \item $p(\textbf{y} | \Theta)$ is the likelihood or likelihood function, in which all variables are related in a full probability model. \item $p(\Theta | \textbf{y})$ is the joint posterior distribution that expresses uncertainty about parameter set $\Theta$ after taking both the prior and the data into account. If parameter set $\Theta$ is partitioned into a single parameter of interest $\phi$ and the remaining parameters are considered nuisance parameters, then $p(\phi | \textbf{y})$ is the marginal posterior distribution. \end{enumerate} \section{Prior Distributions} \label{priordistributions} In Bayesian inference, a prior probability distribution, often called simply the prior, of an uncertain parameter $\theta$ or latent variable is a probability distribution that expresses uncertainty about $\theta$ before the data are taken into account\footnote{One so-called version of Bayesian inference is `empirical Bayes', which sounds enticing because anything `empirical' seems desirable. However, empirical Bayes is a term for the use of data-dependent priors, where the prior is first modeled usually with maximum likelihood and then used in the Bayesian model. This is an undesirable double-use of the data and is most problematic with small sample sizes \citep{berger06}. It also seems to violate the elementary concept that a prior probability distribution expresses uncertainty about $\theta$ \textit{before} the data are taken into account. It has been claimed that ``empirical Bayes methods are not Bayesian'' \citep{bernardo08}.}. The parameters of a prior distribution are called hyperparameters, to distinguish them from the parameters ($\Theta$) of the model. When applying Bayes' theorem, the prior is multiplied by the likelihood function and then normalized to estimate the posterior probability distribution, which is the conditional distribution of $\Theta$ given the data. Moreover, the prior distribution affects the posterior distribution. Prior probability distributions have traditionally belonged to one of two categories: informative priors and uninformative priors. Here, four categories of priors are presented according to information\footnote{`Information' is used loosely here to describe either the prior information from personal beliefs or informational-theoretic content.} and the goal in the use of the prior. The four categories are informative, weakly informative, least informative, and uninformative. \subsection{Informative Priors} \label{informativepriors} When prior information is available about $\theta$, it should be included in the prior distribution of $\theta$. For example, if the present model form is similar to a previous model form, and the present model is intended to be an updated version based on more current data, then the posterior distribution of $\theta$ from the previous model may be used as the prior distribution of $\theta$ for the present model. In this way, each version of a model is not starting from scratch, based only on the present data, but the cumulative effects of all data, past and present, can be taken into account. To ensure the current data do not overwhelm the prior, \citet{ibrahim00} introduced the power prior. The power prior is a class of informative prior distribution that takes previous data and results into account. If the present data is very similar to the previous data, then the precision of the posterior distribution increases when including more and more information from previous models. If the present data differs considerably, then the posterior distribution of $\theta$ may be in the tails of the prior distribution for $\theta$, so the prior distribution contributes less density in its tails. Hierarchical Bayes is also a popular way to combine data sets. Sometimes informative prior information is not simply ready to be used, such as when it resides in another person, as in an expert. In this case, their personal beliefs about the probability of the event must be elicited into the form of a proper probability density function. This process is called prior elicitation. \subsection{Weakly Informative Priors} \label{wips} Weakly Informative Prior (WIP) distributions use prior information for regularization\footnote{The definition of regularization is to introduce additional information in order to solve an ill-posed problem or to prevent overfitting.} and stabilization, providing enough prior information to prevent results that contradict our knowledge or problems such as an algorithmic failure to explore the state-space. Another goal is for WIPs to use less prior information than is actually available. A WIP should provide some of the benefit of prior information while avoiding some of the risk from using information that doesn't exist. WIPs are the most common priors in practice, and are favored by subjective Bayesians. Selecting a WIP can be tricky. WIP distributions should change with the sample size, because a model should have enough prior information to learn from the data, but the prior information must also be weak enough to learn from the data. Following is an example of a WIP in practice. It is popular, for good reasons, to center and scale all continuous predictors \citep{gelman08}. Although centering and scaling predictors is not discussed here, it should be obvious that the potential range of the posterior distribution of $\theta$ for a centered and scaled predictor should be small. A popular WIP for a centered and scaled predictor may be $$\theta \sim \mathcal{N}(0, 10000)$$ where $\theta$ is normally-distributed according to a mean of 0 and a variance of 10,000, which is equivalent to a standard deviation of 100, or precision of 1.0E-4. In this case, the density for $\theta$ is nearly flat. Nonetheless, the fact that it is not perfectly flat yields good properties for numerical approximation algorithms. In both Bayesian and frequentist inference, it is possible for numerical approximation algorithms to become stuck in regions of flat density, which become more common as sample size decreases or model complexity increases. Numerical approximation algorithms in frequentist inference function as though a flat prior were used, so numerical approximation algorithms in frequentist inference become stuck more frequently than numerical approximation algorithms in Bayesian inference. Prior distributions that are not completely flat provide enough information for the numerical approximation algorithm to continue to explore the target density, the posterior distribution. After updating a model in which WIPs exist, the user should examine the posterior to see if the posterior contradicts knowledge. If the posterior contradicts knowledge, then the WIP must be revised by including information that will make the posterior consistent with knowledge \citep{gelman08}. A popular objective Bayeisan criticism against WIPs is that there is no precise, mathematical form to derive the optimal WIP for a given model and data. \subsubsection{Vague Priors} \label{vaguepriors} A vague prior, also called a diffuse prior\footnote{Some sources refer to diffuse priors as flat priors.}, is difficult to define, after considering WIPs. The first formal move from vague to weakly informative priors is \citet{lambert05}. After conjugate priors were introduced \citep{raiffa61}, most applied Bayesian modeling has used vague priors, parameterized to approximate the concept of uninformative priors (better considered as least informative priors, see section \ref{lips}). For more information on conjugate priors, see section \ref{conjugacy}. Typically, a vague prior is a conjugate prior with a large scale parameter. However, vague priors can pose problems when the sample size is small. Most problems with vague priors and small sample size are associated with scale, rather than location, parameters. The problem can be particularly acute in random-effects models, and the term random-effects is used rather loosely here to imply exchangeable\footnote{For more information on exchangeability, see \url{https://web.archive.org/web/20150418134644/http://www.bayesian-inference.com/exchangeability}.}, hierarchical, and multilevel structures. A vague prior is defined here as usually being a conjugate prior that is intended to approximate an uninformative prior (or actually, a least informative prior), and without the goals of regularization and stabilization. \subsection{Least Informative Priors} \label{lips} The term `Least Informative Priors', or LIPs, is used here to describe a class of prior in which the goal is to minimize the amount of subjective information content, and to use a prior that is determined solely by the model and observed data. The rationale for using LIPs is often said to be `to let the data speak for themselves'. LIPs are favored by objective Bayesians. \subsubsection{Flat Priors} \label{flatpriors} The flat prior was historically the first attempt at an uninformative prior. The unbounded, uniform distribution, often called a flat prior, is $$\theta \sim \mathcal{U}(-\infty, \infty)$$ where $\theta$ is uniformly-distributed from negative infinity to positive infinity. Although this seems to allow the posterior distribution to be affected soley by the data with no impact from prior information, this should generally be avoided because this probability distribution is improper, meaning it will not integrate to one since the integral of the assumed $p(\theta)$ is infinity (which violates the assumption that the probabilities sum to one). This may cause the posterior to be improper, which invalidates the model. Reverend Thomas Bayes (1701-1761) was the first to use inverse probability \citep{bayes63}, and used a flat prior for his billiard example so that all possible values of $\theta$ are equally likely \textit{a priori} \citep[p. 34-36]{gelman04}. Pierre-Simon Laplace (1749-1827) also used the flat prior to estimate the proportion of female births in a population, and for all estimation problems presented or justified as a reasonable expression of ignorance. Laplace's use of this prior distribution was later referred to as the `principle of indifference' or `principle of insufficient reason', and is now called the flat prior \citep[p. 39]{gelman04}. Laplace was aware that it was not truly uninformative, and used it as a LIP. Another problem with the flat prior is that it is not invariant to transformation. For example, a flat prior on a standard deviation parameter is not also flat for its variance or precision. \subsubsection{Hierarchical Prior} \label{hierarchicalpriors} A hierarchical prior is a prior in which the parameters of the prior distribution are estimated from data via hyperpriors, rather than with subjective information \citep{gelman08}. Parameters of hyperprior distributions are called hyperparameters. Subjective Bayesians prefer the hierarchical prior as the LIP, and the hyperparameters are usually specified as WIPs. Hierarchical priors are presented later in more detail in the section entitled `Hierarchical Bayes'. \subsubsection{Jeffreys Prior} \label{jeffreysprior} Jeffreys prior, also called Jeffreys rule, was introduced in an attempt to establish a least informative prior that is invariant to transformations \citep{jeffreys61}. Jeffreys prior works well for a single parameter, but multi-parameter situations may have inappropriate aspects accumulate across dimensions to detrimental effect. \subsubsection{MAXENT} \label{maxent} A MAXENT prior, proposed by \citet{jaynes68}, is a prior probability distribution that is selected among other candidate distributions as the prior of choice when it has the maximum entropy (MAXENT) in the considered set, given constraints on the candidate set. More entropy is associated with less information, and the least informative prior is preferred as a MAXENT prior. The principle of minimum cross-entropy generalizes MAXENT priors from mere selection to updating the prior given constraints while seeking the maximum, possible entropy. \subsubsection{Reference Priors} \label{referencepriors} Introduced by \citet{bernardo79}, reference priors do not express personal beliefs. Instead, reference priors allow the data to dominate the prior and posterior \citep{berger09}. Reference priors are estimated by maximizing the expected intrinsic discrepancy between the posterior distribution and prior distribution. This maximizes the expected posterior information about $\textbf{y}$ when the prior density is $p(\textbf{y})$. In some sense, $p(\textbf{y})$ is the `least informative' prior about $\textbf{y}$ \citep{bernardo05b}. Reference priors are often the objective prior of choice in multivariate problems, since other rules (e.g., Jeffreys rule) may result in priors with problematic behavior. When reference priors are used, the analysis is called reference analysis, and the posterior is called the reference posterior. Subjective Bayesian criticisms of reference priors are that the concepts of regularization and stabilization are not taken into account, results that contradict knowledge are not prevented, a numerical approximation algorithm may become stuck in low-probability or flat regions, and it may not be desirable to let the data speak fully. \subsection{Uninformative Priors} \label{uninformativepriors} Traditionally, most of the above descriptions of prior distributions were categorized as uninformative priors. However, uninformative priors do not truly exist \citep{irony97}, and all priors are informative in some way. Traditionally, there have been many names associated with uninformative priors, including diffuse, minimal, non-informative, objective, reference, uniform, vague, and perhaps weakly informative. \subsection{Proper and Improper Priors} \label{properpriors} It is important for the prior distribution to be proper. A prior distribution, $p(\theta)$, is improper\footnote{Improper priors were introduced in \citet{jeffreys61}.} when $$\int p(\theta) d\theta = \infty$$ As noted previously, an unbounded uniform prior distribution is an improper prior distribution because $p(\theta) \propto 1$, for $-\infty < \theta < \infty$. An improper prior distribution can cause an improper posterior distribution. When the posterior distribution is improper, inferences are invalid, it is non-integrable, and Bayes factors cannot be used (though there are exceptions). To determine the propriety of a joint posterior distribution, the marginal likelihood must be finite for all $\textbf{y}$. Again, the marginal likelihood is $$p(\textbf{y}) = \int p(\textbf{y} | \Theta) p(\Theta) d\Theta$$ Although improper prior distributions can be used, it is good practice to avoid them. \section{Hierarchical Bayes} \label{hierarchicalbayes} Prior distributions may be estimated within the model via hyperprior distributions, which are usually vague and nearly flat. Parameters of hyperprior distributions are called hyperparameters. Using hyperprior distributions to estimate prior distributions is known as hierarchical Bayes. In theory, this process could continue further, using hyper-hyperprior distributions to estimate the hyperprior distributions. Estimating priors through hyperpriors, and from the data, is a method to elicit the optimal prior distributions. One of many natural uses for hierarchical Bayes is multilevel modeling. Recall that the unnormalized joint posterior distribution (equation \ref{jointposterior}) is proportional to the likelihood times the prior distribution $$p(\Theta | \textbf{y}) \propto p(\textbf{y} | \Theta)p(\Theta)$$ The simplest hierarchical Bayes model takes the form $$p(\Theta, \Phi | \textbf{y}) \propto p(\textbf{y} | \Theta)p(\Theta | \Phi)p(\Phi)$$ where $\Phi$ is a set of hyperprior distributions. By reading the equation from right to left, it begins with hyperpriors $\Phi$, which are used conditionally to estimate priors $p(\Theta | \Phi)$, which in turn is used, as per usual, to estimate the likelihood $p(\textbf{y} | \Theta)$, and finally the posterior is $p(\Theta, \Phi | \textbf{y})$. \section{Conjugacy} \label{conjugacy} When the posterior distribution $p(\Theta | \textbf{y})$ is in the same family as the prior probability distribution $p(\Theta)$, the prior and posterior are then called conjugate distributions, and the prior is called a conjugate prior for the likelihood\footnote{The conjugate prior approach was introduced in \citet{raiffa61}.}. For example, the Gaussian family is conjugate to itself (or self-conjugate) with respect to a Gaussian likelihood function: if the likelihood function is Gaussian, then choosing a Gaussian prior for the mean will ensure that the posterior distribution is also Gaussian. All probability distributions in the exponential family have conjugate priors. See \citet{robert07} for a catalog. Although the gamma distribution is the conjugate prior distribution for the precision of a normal distribution \citep{spiegelhalter03}, $$\tau \sim \mathcal{G}(0.001, 0.001),$$ better properties for scale parameters are yielded with the non-conjugate, proper, half-Cauchy\footnote{The half-t distribution is another option.} distribution, with a general recommendation of scale=25 for a weakly informative scale parameter \citep{gelman06}, $$\sigma \sim \mathcal{HC}(25)$$ $$\tau = \sigma^{-2}$$ When the half-Cauchy is unavailable, a uniform distribution is often placed on $\sigma$ in hierarchical Bayes when the number of groups is, say, at least five, $$\sigma \sim \mathcal{U}(0, 100)$$ $$\tau = \sigma^{-2}$$ Conjugacy is mathematically convenient in that the posterior distribution follows a known parametric form \citep[p. 40]{gelman04}. It is obviously easier to summarize a normal distribution than a complex, multi-modal distribution with no known form. If information is available that contradicts a conjugate parametric family, then it may be necessary to use a more realistic, inconvenient, prior distribution. The basic justification for the use of conjugate prior distributions is similar to that for using standard models (such as the binomial and normal) for the likelihood: it is easy to understand the results, which can often be put in analytic form, they are often a good approximation, and they simplify computations. Also, they are useful as building blocks for more complicated models, including many dimensions, where conjugacy is typically impossible. For these reasons, conjugate models can be good starting points \citep[p. 41]{gelman04}. Nonconjugate prior distributions can make interpretations of posterior inferences less transparent and computation more difficult, though this alternative does not pose any conceptual problems. In practice, for complicated models, conjugate prior distributions may not even be possible \citep[p. 41-42]{gelman04}. When conjugate distributions are used, a summary statistic for a posterior distribution of $\theta$ may be represented as $t(\textbf{y})$ and said to be a sufficient statistic \citep[p. 42]{gelman04}. When nonconjugate distributions are used, a summary statistic for a posterior distribution is usually not a sufficient statistic. A sufficient statistic is a statistic that has the property of sufficiency with respect to a statistical model and the associated unknown parameter. The quantity $t(\textbf{y})$ is said to be a sufficient statistic for $\theta$, because the likelihood for $\theta$ depends on the data $\textbf{y}$ only through the value of $t(\textbf{y})$. Sufficient statistics are useful in algebraic manipulations of likelihoods and posterior distributions. \section{Likelihood} \label{likelihood} In order to complete the definition of a Bayesian model, both the prior distributions and the likelihood\footnote{Ronald A. Fisher, a prominent frequentist, introduced the term likelihood in 1921 \citep{fisher21}, though the concept of likelihood was used by Bayes and Laplace. Fisher's introduction preceded a series of the most influential papers in statistics (mostly in 1922 and 1925), in which Fisher introduced numerous terms that are now common: consistency, efficiency, estimation, information, maximum likelihood estimate, optimality, parameter, statistic, sufficiency, and variance. He was the first to use Greek letters for unknown parameters and Latin letters for the estimates. Later contributions include F statistics, design of experiments, ANOVA, and many more.} must be approximated or fully specified. The likelihood, likelihood function, or $p(\textbf{y} | \Theta)$, contains the available information provided by the sample. The likelihood is $$p(\textbf{y} | \Theta) = \prod^n_{i=1} p(\textbf{y}_i | \Theta)$$ The data $\textbf{y}$ affects the posterior distribution $p(\Theta | \textbf{y})$ only through the likelihood function $p(\textbf{y} | \Theta)$. In this way, Bayesian inference obeys the likelihood principle, which states that for a given sample of data, any two probability models $p(\textbf{y} | \Theta)$ that have the same likelihood function yield the same inference for $\Theta$. For more information on the likelihood principle, see section \ref{lprinciple}. \subsection{Terminology: From Inverse Probability to Bayesian Probability} \label{terminology} A gambler's dispute in 1654 led to the creation of a mathematical theory of probability by two famous French mathematicians, Blaise Pascal and Pierre de Fermat. Reverend Thomas Bayes (1701-1761) discovered Bayes' theorem, published posthumously in 1763, in which he was the first to use inverse probability \citep{bayes63}. `Inverse probability' refers to assigning a probability distribution to an unobserved variable, and is in essence, probability in the opposite direction of the usual sense. For example, the probability of obtaining heads on the next coin flip in a Bayesian context would be the predicted probability, $p(\textbf{y}^{new} | \textbf{y}, \theta)$, but to estimate this predicted probability, the probability distribution of $\theta$ must first be estimated, using coin toss data $\textbf{y}$ to estimate the parameter $\theta$ by the likelihood function $p(\textbf{y} | \theta)$, which contains the likelihood $p(\theta | \textbf{y})$, where $\theta$ is estimated from the data, $\textbf{y}$. Therefore, the data, $\textbf{y}$, is used to estimate the most probable $\theta$ that would lead to a data-generating process for $\textbf{y}$. Unaware of Bayes, Pierre-Simon Laplace (1749-1827) independently developed Bayes' theorem and first published his version in 1774, eleven years after Bayes, in one of Laplace's first major works \citep[p. 366-367]{laplace74}. In 1812, Laplace (1749-1827) introduced a host of new ideas and mathematical techniques in his book, \emph{Theorie Analytique des Probabilites} \citep{laplace12}. Before Laplace, probability theory was solely concerned with developing a mathematical analysis of games of chance. Laplace applied probabilistic ideas to many scientific and practical problems. Then, in 1814, Laplace published his ``Essai philosophique sur les probabilites'', which introduced a mathematical system of inductive reasoning based on probability \citep{laplace14}. In it, the Bayesian interpretation of probability was developed independently by Laplace, much more thoroughly than Bayes, so some ``Bayesians'' refer to Bayesian inference as Laplacian inference. The term ``inverse probability'' appears in an 1837 paper of Augustus De Morgan \citep{demorgan37}, in reference to Laplace's method of probability \citep{laplace74, laplace12}, though the term ``inverse probability'' does not occur in these works. Bayes' theorem has been referred to as ``the principle of inverse probability''. Terminology has changed, so that today, Bayesian probability (rather than inverse probability) refers to assigning a probability distribution to an unobservable variable. The ``distribution'' of an unobserved variable given data is the likelihood function (which is not a distribution), and the distribution of an unobserved variable, given both data and a prior distribution, is the posterior distribution. The term ``Bayesian'', which displaced ``inverse probability'', was in fact introduced by Ronald A. Fisher as a derogatory term. In modern terms, given a probability distribution $p(\textbf{y} | \theta)$ for an observable quantity $\textbf{y}$ conditional on an unobserved variable $\theta$, the ``inverse probability'' is the posterior distribution $p(\theta | \textbf{y})$, which depends both on the likelihood function (the inversion of the probability distribution) and a prior distribution. The distribution $p(\textbf{y} | \theta)$ itself is called the direct probability. However, $p(\textbf{y} | \theta)$ is also called the likelihood function, which can be confusing, seeming to pit the definitions of probability and likelihood against each other. A quick introduction to the likelihood principle follows, and finally all of the information on likelihood comes together in the section entitled ``Likelihood Function of a Parameterized Model''. \subsection{The Likelihood Principle} \label{lprinciple} An informal summary of the likelihood principle may be that inferences from data to hypotheses should depend on how likely the actual data are under competing hypotheses, not on how likely imaginary data would have been under a single ``null'' hypothesis or any other properties of merely possible data. Bayesian inferences depend only on the probabilities assigned due to the observed data, not due to other data that might have been observed. A more precise interpretation may be that inference procedures which make inferences about simple hypotheses should not be justified by appealing to probabilities assigned to observations that have not occurred. The usual interpretation is that any two probability models with the same likelihood function yield the same inference for $\theta$. Some authors mistakenly claim that frequentist inference, such as the use of maximum likelihood estimation (MLE), obeys the likelihood, though it does not. Some authors claim that the largest contention between Bayesians and frequentists regards prior probability distributions. Other authors argue that, although the subject of priors gets more attention, the true contention between frequentist and Bayesian inference is the likelihood principle, which Bayesian inference obeys, and frequentist inference does not. There have been many frequentist attacks on the likelihood principle, and have been shown to be poor arguments. Some Bayesians have argued that Bayesian inference is incompatible with the likelihood principle on the grounds that there is no such thing as an isolated likelihood function \citep{bayarri87}. They argue that in a Bayesian analysis there is no principled distinction between the likelihood function and the prior probability function. The objection is motivated, for Bayesians, by the fact that prior probabilities are needed in order to apply what seems like the likelihood principle. Once it is admitted that there is a universal necessity to use prior probabilities, there is no longer a need to separate the likelihood function from the prior. Thus, the likelihood principle is accepted `conditional' on the assumption that a likelihood function has been specified, but it is denied that specifying a likelihood function is necessary. Nonetheless, the likelihood principle is seen as a useful Bayesian weapon to combat frequentism. Following are some interesting qutoes from prominent statisticians: \begin{quote} ``Using Bayes' rule with a chosen probability model means that the data $\textbf{y}$ affect posterior inference 'only' through the function $p(\textbf{y} | \theta)$, which, when regarded as a function of $\theta$, for fixed $\textbf{y}$, is called the `likelihood function'. In this way Bayesian inference obeys what is sometimes called the `likelihood principle', which states that for a given sample of data, any two probability models $p(\textbf{y} | \theta)$ that have the same likelihood function yield the same inference for $\theta$'' \citep[p. 9]{gelman04}.\\ ``The likelihood principle is reasonable, but only within the framework of the model or family of models adopted for a particular analysis'' \citep[p. 9]{gelman04}.\\ Frequentist ``procedures typically violate the likelihood principle, since long-run behavior under hypothetical repetitions depends on the entire distribution $p(\textbf{y} | \theta)$, $\textbf{y} \in \textbf{Y}$ and not only on the likelihood'' \citep[p. 454]{bernardo00}.\\ There is ``a general fact about the mechanism of parametric Bayesian inference which is trivially obvious; namely `for any specified $p(\theta)$, if the likelihood functions $p_1(\textbf{y}_1 | \theta), p_2(\textbf{y}_2 | \theta)$ are proportional as functions of $\theta$, the resulting posterior densities for $\theta$ are identical'. It turns out...that many non-Bayesian inference procedures do not lead to identical inferences when applied to such proportional likelihoods. The assertion that they `should', the so-called `Likelihood Principle', is therefore a controversial issue among statisticians. In contrast, in the Bayesian inference context...this is a straightforward consequence of Bayes' theorem, rather than an imposed `principle' '' \citep[p. 249]{bernardo00}.\\ ``Although the likelihood principle is implicit in Bayesian statistics, it was developed as a separate principle by Barnard \citep{Barnard49}, and became a focus of interest when Birnbaum (1962) showed that it followed from the widely accepted sufficiency and conditionality principles'' \citep[p. 250]{bernardo00}.\\ ``The likelihood principle, by itself, is not sufficient to build a method of inference but should be regarded as a minimum requirement of any viable form of inference. This is a controversial point of view for anyone familiar with modern econometrics literature. Much of this literature is devoted to methods that do not obey the likelihood principle...'' \citep[p. 15]{rossi05}.\\ ``Adherence to the likelihood principle means that inferences are `conditional' on the observed data as the likelihood function is parameterized by the data. This is worth contrasting to any sampling-based approach to inference. In the sampling literature, inference is conducted by examining the sampling distribution of some estimator of $\theta$, $\hat{\theta} = f(\textbf{y})$. Some sort of sampling experiment results in a distribution of $\textbf{y}$ and therefore, the estimator is viewed as a random variable. The sampling distribution of the estimator summarizes the properties of the estimator `prior' to observing the data. As such, it is irrelevant to making inferences given the data we actually observe. For any finite sample, this dinstinction is extremely important. One must conclude that, given our goal for inference, sampling distributions are simply not useful'' \citep[p. 15]{rossi05}. \end{quote} \subsection{Likelihood Function of a Parameterized Model} \label{likelihoodfunction} In non-technical parlance, ``likelihood'' is usually a synonym for ``probability'', but in statistical usage there is a clear distinction: whereas ``probability'' allows us to predict unknown outcomes based on known parameters, ``likelihood'' allows us to estimate unknown parameters based on known outcomes. In a sense, likelihood can be thought a reversed version of conditional probability. Reasoning forward from a given parameter $\theta$, the conditional probability of $\textbf{y}$ is the density $p(\textbf{y} | \theta)$. With $\theta$ as a parameter, here are relationships in expressions of the likelihood function $$\mathscr{L}(\theta | \textbf{y}) = p(\textbf{y} | \theta) = f(\textbf{y} | \theta)$$ where $\textbf{y}$ is the observed outcome of an experiment, and the likelihood ($\mathscr{L}$) of $\theta$ given $\textbf{y}$ is equal to the density $p(\textbf{y} | \theta)$ or function $f(\textbf{y} | \theta)$. When viewed as a function of $\textbf{y}$ with $\theta$ fixed, it is not a likelihood function $\mathscr{L}(\theta | \textbf{y})$, but merely a probability density function $p(\textbf{y} | \theta)$. When viewed as a function of $\theta$ with $\textbf{y}$ fixed, it is a likelihood function and may be denoted as $\mathscr{L}(\theta | \textbf{y})$, $p(\textbf{y} | \theta)$, or $f(\textbf{y} | \theta)$\footnote{Note that $\mathscr{L}(\theta | \textbf{y})$ is not the same as the probability that those parameters are the right ones, given the observed sample.}. For example, in a Bayesian linear regression with an intercept and two independent variables, the model may be specified as $$\textbf{y}_i \sim \mathcal{N}(\mu_i, \sigma^2)$$ $$\mu_i = \beta_1 + \beta_2\textbf{X}_{i,1} + \beta_3\textbf{X}_{i,2}$$ The dependent variable $\textbf{y}$, indexed by $i=1,...,n$, is stochastic, and normally-distributed according to the expectation vector $\mu$, and variance $\sigma^2$. Expectation vector $\mu$ is an additive, linear function of a vector of regression parameters, $\beta$, and the design matrix \textbf{X}. Since $\textbf{y}$ is normally-distributed, the probability density function (PDF) of a normal distribution will be used, and is usually denoted as $$f(\textbf{y}) = \frac{1}{\sqrt{2\pi}\sigma}\exp[(-\frac{1}{2}\sigma^2)(\textbf{y}_i-\mu_i)^2]; \quad \textbf{y} \in (-\infty, \infty)$$ By considering a conditional distribution, the record-level likelihood in Bayesian notation is $$p(\textbf{y}_i | \Theta) = \frac{1}{\sqrt{2\pi}\sigma}\exp[(-\frac{1}{2}\sigma^2)(\textbf{y}_i-\mu_i)^2]; \quad \textbf{y} \in (-\infty, \infty)$$ In both theory and practice, and in both frequentist and Bayesian inference, the log-likelihood is used instead of the likelihood, on both the record- and model-level. The model-level product of record-level likelihoods can exceed the range of a number that can be stored by a computer, which is usually affected by sample size. By estimating a record-level log-likelihood, rather than likelihood, the model-level log-likelihood is the sum of the record-level log-likelihoods, rather than a product of the record-level likelihoods. $$\log[p(\textbf{y} | \theta)] = \sum^n_{i=1} \log[p(\textbf{y}_i | \theta)]$$ rather than $$p(\textbf{y} | \theta) = \prod^n_{i=1} p(\textbf{y}_i | \theta)$$ As a function of $\theta$, the unnormalized joint posterior distribution is the product of the likelihood function and the prior distributions. To continue with the example of Bayesian linear regression, here is the unnormalized joint posterior distribution $$p(\beta, \sigma^2 | \textbf{y}) = p(\textbf{y} | \beta, \sigma^2)p(\beta_1)p(\beta_2)p(\beta_3)p(\sigma^2)$$ More usually, the logarithm of the unnormalized joint posterior distribution is used, which is the sum of the log-likelihood and prior distributions. Here is the logarithm of the unnormalized joint posterior distribution for this example $$\log[p(\beta, \sigma^2 | \textbf{y})] = \log[p(\textbf{y} | \beta, \sigma^2)] + \log[p(\beta_1)] + \log[p(\beta_2)] + \log[p(\beta_3)] + \log[p(\sigma^2)]$$ The logarithm of the unnormalized joint posterior distribution is maximized with numerical approximation. \section{Numerical Approximation} \label{numericalapproximation} The technical problem of evaluating quantities required for Bayesian inference typically reduces to the calculation of a ratio of two integrals \citep[p. 339]{bernardo00}. In all cases, the technical key to the implementation of the formal solution given by Bayes' theorem is the ability to perform a number of integrations \citep[p. 340]{bernardo00}. Except in certain rather stylized problems, the required integrations will not be feasible analytically and, thus, efficient approximation strategies are required. There are too many different types of numerical approximation algorithms in Bayesian inference to cover in any detail in this article. An incomplete list of broad categories of Bayesian numerical approximation may include Approximate Bayesian Computation (ABC), Importance Sampling, Iterative Quadrature, Laplace Approximation, Markov chain Monte Carlo (MCMC), and Variational Bayes (VB). For more information on algorithms in \pkg{LaplacesDemon}, see the accompanying vignette entitled ``\pkg{LaplacesDemon} Tutorial''. Approximate Bayesian Computation (ABC), also called likelihood-free estimation, is a family of numerical approximation techniques in Bayesian inference. ABC is especially useful when evaluation of the likelihood, $p(\textbf{y} | \Theta)$ is computationally prohibitive, or when suitable likelihoods are unavailable. As such, ABC algorithms estimate likelihood-free approximations. ABC is usually faster than a similar likelihood-based numerical approximation technique, because the likelihood is not evaluated directly, but replaced with an approximation that is usually easier to calculate. The approximation of a likelihood is usually estimated with a measure of distance between the observed sample, $\textbf{y}$, and its replicate given the model, $\textbf{y}^{rep}$, or with summary statistics of the observed and replicated samples. Importance Sampling is a method of estimating a distribution with samples from a different distribution, called the importance distribution. Importance weights are assigned to each sample. The main difficulty with importance sampling is in the selection of the importance distribution. Importance sampling is the basis of a wide variety of algorithms, some of which involve the combination of importance sampling and Markov chain Monte Carlo. There are also many variations of importance sampling, including adaptive importance sampling, and parametric and nonparametric self-normalized importance sampling. Population Monte Carlo (PMC) is based on adaptive importance sampling. Iterative quadrature is a traditional approach to evaluating integrals. Multidimensional quadrature, often called cubature, performs well, but is limited usually to ten or fewer parameters. Componentwise quadrature may be applied to any model regardless of dimension, but estimates only variance, rather than covariance. Bayesian quadrature typically uses adaptive Gauss-Hermite quadrature, which assumes the marginal posterior distributions are normally-distrubted. Under this assumption, the conditional mean and conditional variance of each distribution is adapted each iteration according to the evaluation of samples determined by quadrature rules. Laplace Approximation dates back to \citet{laplace74, laplace14}, and is used to approximate the posterior moments of integrals. Specifically, the posterior mode is estimated for each parameter, assumed to be unimodal and Gaussian. As a Gaussian distribution, the posterior mean is the same as the posterior mode, and the variance is estimated. Laplace Approximation is a family of deterministic algorithms that usually converge faster than MCMC, and just a little slower than Maximum Likelihood Estimation (MLE) \citep{azevedo94}. Laplace Approximation shares many limitations of MLE, including asymptotic estimation with respect to sample size. MCMC algorithms originated in statistical physics and are now used in Bayesian inference to sample from probability distributions by constructing Markov chains. In Bayesian inference, the target distribution of each Markov chain is usually a marginal posterior distribution, such as each parameter $\theta$. Each Markov chain begins with an initial value and the algorithm iterates, attempting to maximize the logarithm of the unnormalized joint posterior distribution and eventually arriving at each target distribution. Each iteration is considered a state. A Markov chain is a random process with a finite state-space and the Markov property, meaning that the next state depends only on the current state, not on the past. The quality of the marginal samples usually improves with the number of iterations. A Monte Carlo method is an algorithm that relies on repeated pseudo-random sampling for computation, and is therefore stochastic (as opposed to deterministic). Monte Carlo methods are often used for simulation. The union of Markov chains and Monte Carlo methods is called MCMC. The revival of Bayesian inference since the 1980s is due to MCMC algorithms and increased computing power. The most prevalent MCMC algorithms may be the simplest: random-walk Metropolis and Gibbs sampling. There are a large number of MCMC algorithms, and further details on MCMC are best explored outside of this article. VB is a family of algorithms within variational inference. VB are deterministic optimization algorithms that approximate the posterior with a distribution. Each marginal posterior distribution is estimated with an approximating distribution. VB usually converges faster than MCMC. VB shares many limitations of MLE, including asymptotic estimation with respect to sample size. \section{Prediction} \label{prediction} The ``posterior predictive distribution'' is either the replication of $\textbf{y}$ given the model (usually represented as $\textbf{y}^{rep}$), or the prediction of a new and unobserved $\textbf{y}$ (usually represented as $\textbf{y}^{new}$ or $\textbf{y}'$), given the model. This is the likelihood of the replicated or predicted data, averaged over the posterior distribution $p(\Theta | \textbf{y})$ $$p(\textbf{y}^{rep} | \textbf{y}) = \int p(\textbf{y}^{rep} | \Theta)p(\Theta | \textbf{y}) d\Theta$$ or $$p(\textbf{y}^{new} | \textbf{y}) = \int p(\textbf{y}^{new} | \Theta)p(\Theta | \textbf{y}) d\Theta$$ If $\textbf{y}$ has missing values, then the missing $\textbf{y}$s can be estimated with the posterior predictive distribution\footnote{The predictive distribution was introduced by \citet{jeffreys61}.} as $\textbf{y}^{new}$ from within the model. For the linear regression example, the integral for prediction is $$p(\textbf{y}^{new} | \textbf{y}) = \int p(\textbf{y}^{new} | \beta,\sigma^2)p(\beta,\sigma^2 | \textbf{y}) d\beta d\sigma^2$$ The posterior predictive distribution is easy to estimate $$\textbf{y}^{new} \sim \mathcal{N}(\mu, \sigma^2)$$ where $\mu$ = \textbf{X}$\beta$, and $\mu$ is the conditional mean, while $\sigma^2$ is the residual variance. \section{Bayes Factors} \label{bayesfactors} Introduced by Harold Jeffreys, a `Bayes factor' is a Bayesian alternative to frequentist hypothesis testing that is most often used for the comparison of multiple models by hypothesis testing, usually to determine which model better fits the data \citep{jeffreys61}. Bayes factors are notoriously difficult to compute, and the Bayes factor is only defined when the marginal density of $\textbf{y}$ under each model is proper. However, Bayes factors are easy to approximate with the Laplace-Metropolis Estimator \citep{kass95, lewis97}\footnote{A Bayes factor may be estimated with the \code{BayesFactor} function in \pkg{LaplacesDemon} to compare multiple models that were fit with the \code{LaplaceApproximation} or \code{LaplacesDemon} functions. See the \code{BayesFactor} function for the interpretation of a Bayes factor regarding strength of evidence.}. Hypothesis testing with Bayes factors is more robust than frequentist hypothesis testing, since the Bayesian form avoids model selection bias, evaluates evidence in favor the null hypothesis, includes model uncertainty, and allows non-nested models to be compared (though of course the model must have the same dependent variable). Also, frequentist significance tests become biased in favor of rejecting the null hypothesis with sufficiently large sample size. The Bayes factor for comparing two models may be approximated as the ratio of the marginal likelihood of the data in model 1 and model 2. Formally, the Bayes factor in this case is $$B = \frac{p(\textbf{y}|\mathcal{M}_1)}{p(\textbf{y}|\mathcal{M}_2)} = \frac{\int p(\textbf{y}|\Theta_1,\mathcal{M}_1)p(\Theta_1|\mathcal{M}_1)d\Theta_1}{\int p(\textbf{y}|\Theta_2,\mathcal{M}_2)p(\Theta_2|\mathcal{M}_2)d\Theta_2}$$ where $p(\textbf{y}|\mathcal{M}_1)$ is the marginal likelihood of the data in model 1. The Bayes factor, $B$, is the posterior odds in favor of the hypothesis divided by the prior odds in favor of the hypothesis, where the hypothesis is usually $\mathcal{M}_1 > \mathcal{M}_2$. Put another way, \begin{center} (Posterior model odds) = (Bayes factor) x (prior model odds) \end{center} For example, when $B=2$, the data favor $\mathcal{M}_1$ over $\mathcal{M}_2$ with 2:1 odds. In a non-hierarchical model, the marginal likelihood may easily be approximated with the Laplace-Metropolis Estimator for model $m$ as $$p(\textbf{y}|m) = (2\pi)^{d_m/2}|\Sigma_m|^{1/2}p(\textbf{y}|\Theta_m,m)p(\Theta_m|m)$$ where $d$ is the number of parameters and $\Sigma$ is the inverse of the negative of the Hessian matrix of second derivatives. \citet{lewis97} introduce the Laplace-Metropolis method of approximating the marginal likelihood in MCMC, though it naturally works with Laplace Approximation as well. For a hierarchical model that involves both fixed and random effects, the Compound Laplace-Metropolis Estimator must be used. Gelman finds Bayes factors generally to be irrelevant, because they compute the relative probabilities of the models conditional on one of them being true. Gelman prefers approaches that measure the distance of the data to each of the approximate models \citep[p. 180]{gelman04}. However, \citet{kass95} explain that ``the logarithm of the marginal probability of the data may also be viewed as a predictive score. This is of interest, because it leads to an interpretation of the Bayes factor that does not depend on viewing one of the models as `true'''. Three of many possible alternatives are to use \begin{enumerate} \item pseudo Bayes factors (PsBF) based on a ratio of pseudo marginal likelihoods (PsMLs) \item Deviance Information Criterion (DIC) \item Widely Applicable Information Criterion (WAIC) \end{enumerate} DIC is the most popular method of assessing model fit and comparing models, though Bayes factors are better, when appropriate, because they take more into account. WAIC is a newer criterion. \section{Model Fit} \label{modelfit} In Bayesian inference, the most common method of assessing the goodness of fit of an estimated statistical model is a generalization of the frequentist Akaike Information Criterion (AIC). The Bayesian method, like AIC, is not a test of the model in the sense of hypothesis testing, though Bayesian inference has Bayes factors for such purposes. Instead, like AIC, Bayesian inference provides a model fit statistic that is to be used as a tool to refine the current model or select the better-fitting model of different methodologies. To begin with, model fit can be summarized with deviance, which is defined as -2 times the log-likelihood \citep[p. 180]{gelman04}, such as $$D(\textbf{y},\Theta) = -2\log[p(\textbf{y} | \Theta)]$$ Just as with the likelihood, $p(\textbf{y} | \Theta)$, or log-likelihood, the deviance exists at both the record- and model-level. Due to the development of \proglang{BUGS} software \citep{gilks94}, deviance is defined differently in Bayesian inference than frequentist inference. In frequentist inference, deviance is -2 times the log-likelihood ratio of a reduced model compared to a full model, whereas in Bayesian inference, deviance is simply -2 times the log-likelihood. In Bayesian inference, the lowest expected deviance has the highest posterior probability \citep[p. 181]{gelman04}. It is possible to have a negative deviance. Deviance is derived from the likelihood, which is derived from probability density functions (PDF). Evaluated at a certain point in parameter space, a PDF can have a density larger than 1 due to a small standard deviation or lack of variation. Likelihoods greater than 1 lead to negative deviance, and are appropriate. On its own, the deviance is an insufficient model fit statistic, because it does not take model complexity into account. The effect of model fitting, pD, is used as the `effective number of parameters' of a Bayesian model. The sum of the differences between the posterior mean of the model-level deviance and the deviance at each draw $i$ of $\theta_i$ is the pD. A related way to measure model complexity is as half the posterior variance of the model-level deviance, known as pV \citep[p. 182]{gelman04} $$\mathrm{pV} = \mathrm{var}(D) / 2$$ The effect of model fitting, pD or pV, can be thought of as the number of `unconstrained' parameters in the model, where a parameter counts as: 1 if it is estimated with no constraints or prior information; 0 if it is fully constrained or if all the information about the parameter comes from the prior distribution; or an intermediate value if both the data and the prior are informative \citep[p. 182]{gelman04}. Therefore, by including prior information, Bayesian inference is more efficient in terms of the effective number of parameters than frequentist inference. Hierarchical, mixed effects, or multilevel models are even more efficient regarding the effective number of parameters. Model complexity, pD or pV, should be positive. Although pV must be positive since it is related to variance, it is possible for pD to be negative, which indicates one or more problems: log-likelihood is non-concave, a conflict between the prior and the data, or that the posterior mean is a poor estimator (such as with a bimodal posterior). The sum of both the mean model-level deviance and the model complexity (pD or pV) is the Deviance Information Criterion (DIC), a model fit statistic that is also an estimate of the expected loss, with deviance as a loss function \citep{spiegelhalter98, spiegelhalter02}. DIC is $$\mathrm{DIC} = \bar{D} + \mathrm{pV}$$ DIC may be compared across different models and even different methods, as long as the dependent variable does not change between models, making DIC the most flexible model fit statistic. DIC is a hierarchical modeling generalization of the Akaike Information Criterion (AIC) and Bayesian Information Criterion (BIC). Like AIC and BIC, it is an asymptotic approximation as the sample size becomes large. DIC is valid only when the joint posterior distribution is approximately multivariate normal. Models should be preferred with smaller DIC. Since DIC increases with model complexity (pD or pV), simpler models are preferred. It is difficult to say what would constitute an important difference in DIC. Very roughly, differences of more than 10 might rule out the model with the higher DIC, differences between 5 and 10 are substantial, but if the difference in DIC is, say, less than 5, and the models make very different inferences, then it could be misleading just to report the model with the lowest DIC. The Widely Applicable Information Criterion (WAIC) is an information criterion that is more fully Bayesian than DIC. WAIC is more difficult to calculate because the record-level log-likelihood is required over numerous samples. However, when available, the result more closely resembles leave-one-out cross-validation (LOO-CV). The Bayesian Predictive Information Criterion (BPIC) was introduced as a criterion of model fit when the goal is to pick a model with the best out-of-sample predictive power \citep{ando07}. BPIC is a variation of DIC where the effective number of parameters is 2pD (or 2pV). BPIC may be compared between $\textbf{y}^{new}$ and $\textbf{y}^{holdout}$, and has many other extensions, such as with Bayesian Model Averaging (BMA). \section{Posterior Predictive Checks} \label{ppc} Comparing the predictive distribution $\textbf{y}^{rep}$ to the observed data $\textbf{y}$ is generally termed a ``posterior predictive check''. This type of check includes the uncertainty associated with the estimated parameters of the model, unlike frequentist statistics. Posterior predictive checks (via the predictive distribution) involve a double-use of the data, which violates the likelihood principle. However, arguments have been made in favor of posterior predictive checks, provided that usage is limited to measures of discrepancy to study model adequacy, not for model comparison and inference \citep{meng94}. Gelman recommends at the most basic level to compare $\textbf{y}^{rep}$ to $\textbf{y}$, looking for any systematic differences, which could indicate potential failings of the model \citep[p. 159]{gelman04}. It is often first recommended to compare graphical plots, such as the distribution of $\textbf{y}$ and $\textbf{y}^{rep}$. There are many posterior predictive checks that are not included in this article, but an introduction to a selection of them appears below. \subsection{Bayesian p-values} \label{bayesianpvalues} A Bayesian form of p-value may be estimated with a variety of test statistics \citep{gelman96a}. Usually the minimum or maximum observed $\textbf{y}$ is compared to the minimum or maximum $\textbf{y}^{rep}$. A Bayesian p-value is one of several ways to report discrepancies between $\textbf{y}$ and $\textbf{y}^{rep}$. Frequentist p-values have many problems, but here it will only be noted that the frequentist p-value estimates $p(\mathrm{data} | \mathrm{hypothesis})$, while in this case the Bayesian form estimates $p(\mathrm{hypothesis} | \mathrm{data})$. The frequentist estimates the wrong probability, because the frequentist is forced to consider the parameters to be fixed and the data random, projecting long-run frequencies of what should happen with future, repeated sampling of similar data, given a fixed parameter, or in this case hypothesis. Even the term hypothesis testing suggests you want to test the hypothesis given the data, not the data given the hypothesis\footnote{Numerous problems with frequentist p-values, confidence intervals, point estimates, and hypothesis testing are worth exploring, but not detailed in this article.}. \subsection{Chi-Square} \label{chisquare} \citet[p. 175]{gelman04} suggest an omnibus test such as the following $\chi^2$ $$\chi^2_i = \frac{(\textbf{y}_i - \frac{\sum^T_{t=1} \textbf{y}^{rep}_{i,t}}{T})^2}{\mathrm{var}(\textbf{y}^{rep}_{i,1:T})},$$ over records $i=1,\dots,N$ and posterior samples $t=1,\dots,T$. The sum of $\chi^2_i$ over records $i=1,\dots,N$ is an overall goodness of fit measure on the data set. Larger values of $\chi^2_i$ indicate a worse fit for each record. An alternative $\chi^2$ test is $$p(\chi^{2rep}_{i,1:T} > \chi^{2obs}_{i,1:T})$$ where a worse fit is indicated as $p$ approaches zero or one, and it is common to consider records with a poor fit to be outside the 95\% probability interval. To continue $$\chi^{2obs}_{i,1:T} = \frac{[\textbf{y}_i - E(\textbf{y}_i)]^2}{E(\textbf{y}_i)}$$ and $$\chi^{2rep}_{i,1:T} = \frac{[\textbf{y}^{rep}_{i,1:T} - E(\textbf{y}^{rep}_i)]^2}{E(\textbf{y}^{rep}_i)}$$ Newer forms of $\chi^2$ tests have been proposed in the literature, and are best explored elsewhere. \subsection{Conditional Predictive Ordinate} \label{cpo} Although the full predictive distribution $p(\textbf{y}^{rep} | \textbf{y})$ is useful for prediction, its use for model-checking is questionable because of the double-use of the data, and causes predictive performance to be overestimated. The leave-one-out cross-validation predictive density has been proposed \citep{geisser79}. This is also known as the Conditional Predictive Ordinate or CPO \citep{gelfand96}. The CPO is $$p(\textbf{y}_i | \textbf{y}_{[i]}) = \int p(\textbf{y}_i |\Theta)p(\Theta | \textbf{y}_{[i]})d\Theta$$ where $\textbf{y}_i$ is each instance of an observed $\textbf{y}$, and $\textbf{y}_{[i]}$ is $\textbf{y}$ without the current observation $i$. The CPO is easy to calculate with MCMC or PMC numerical approximation. By considering the inverse likelihood across $T$ iterations, the CPO for each individual $i$ is $$\mathrm{CPO}_i = \frac{1}{T^{-1} \displaystyle\sum^T_{t=1} p(\textbf{y}_i | \Theta_t)^{-1}}$$ The CPO is a handy posterior predictive check because it may be used to identify outliers, influential observations, and for hypothesis testing across different non-nested models. However, it may be difficult to calculate with latent mixtures. The CPO expresses the posterior probability of observing the value (or set of values) of $\textbf{y}_i$ when the model is fitted to all data except $\textbf{y}_i$, with a larger value implying a better fit of the model to $\textbf{y}_i$, and very low CPO values suggest that $\textbf{y}_i$ is an outlier and an influential observation. A Monte Carlo estimate of the CPO is obtained without actually omitting $\textbf{y}_i$ from the estimation, and is provided by the harmonic mean of the likelihood for $\textbf{y}_i$. Specifically, the $CPO_i$ is the inverse of the posterior mean of the inverse likelihood of $\textbf{y}_i$. The CPO is connected with the frequentist studentized residual test for outlier detection. Data with large studentized residuals have small CPOs and will be detected as outliers. An advantage of the CPO is that observations with high leverage will have small CPOs, independently of whether or not they are outliers. The Bayesian CPO is able to detect both outliers and influential points, whereas the frequentist studentized residual is unable to detect high-leverage outliers. Inverse-CPOs (ICPOs) larger than 40 can be considered as possible outliers, and higher than 70 as extreme values \citep[p. 376]{ntzoufras09}. Congdon recommends scaling CPOs by dividing each by its individual maximum (after the posterior mean) and considering observations with scaled CPOs under 0.01 to be outliers \citep{congdon05}. The range in scaled CPOs is useful as an indicator of a good-fitting model. The sum of the logged CPOs can be an estimator for the logarithm of the marginal likelihood\footnote{Exercise extreme caution when approximating the marginal likelihood from CPOs, or use a method with better repute, such as the Laplace-Metropolis Estimator or importance sampling.}, sometimes called the log pseudo marginal likelihood (LPsML). A ratio of PsMLs is a surrogate for the Bayes factor, sometimes known as the pseudo Bayes factor (PsBF). In this way, non-nested models may be compared with a hypothesis test to determine the better model, if one exists, based on leave-one-out cross-validation. \subsection{Predictive Concordance} \label{predictiveconcordance} \citet{gelfand96} suggests that any $\textbf{y}_i$ that is in either 2.5\% tail area of $\textbf{y}^{rep}_i$ should be considered an outlier. For each $i$, I am calling this the predictive quantile (PQ), which is calculated as $$\mathrm{PQ}_i = p(\textbf{y}^{rep}_i > \textbf{y}_i)$$ and is somewhat similar to the Bayesian p-value. The percentage of $\textbf{y}_i$s that are not outliers is called the `Predictive Concordance'. \citet{gelfand96} suggests the goal is to attempt to achieve 95\% predictive concordance. In the case of, say 80\% predictive concordance, the discrepancy between the model and data is undesirable because the model does not fit the data well and many outliers have resulted. On the other hand, if the predictive concordance is too high, say 100\%, then overfitting may have occurred, and it may be worth considering a more parsimonious model. Kernel density plots of each $\textbf{y}^{rep}_i$ distribution are useful in this case with the actual $\textbf{y}_i$ included as a vertical bar to show its position. \subsection{L-criterion} \label{lcriterion} \citet{laud95} introduced the L-criterion as one of three posterior predictive checks for model, variable, and transformation selection. The L-criterion is a posterior predictive check that is widely applicable and easy to apply. It is a sum of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The L-criterion measures model performance with a combination of how close its predictions are to the observed data and variability of the predictions. Better models have smaller values of L. L is measured in the same units as the response variable, and measures how close the data vector $\textbf{y}$ is to the predictive distribution. In addition to the value of L, there is a value for $S_L$, which is the calibration number of L, and is useful in determining how much of a decrease is necessary between models to be noteworthy. The L-criterion is $$\mathrm{L} = \sum^N_{i=1} \sqrt{\mathrm{var}(\textbf{y}^{rep}_{i,1:T}) + (\textbf{y}_i - \frac{\sum^T_{t=1} \textbf{y}^{rep}_{i,t}}{T})^2},$$ over $t=1,\dots,T$ posterior samples. The calibration number, $S_L$, is the standard deviation of L over records $i=1,\dots,N$. \citet{gelfand98} introduced Posterior Predictive Loss (PPL). This posterior predictive check for model comparison may be viewed as an extension to the L-criterion in which a weight $k$ is applied to the accuracy (fit) component. \section{Advantages Of Bayesian Inference Over Frequentist Inference} \label{advantages} Following is a short list of advantages of Bayesian inference over frequentist inference. \begin{itemize} \item Bayesian inference allows informative priors so that prior knowledge or results of a previous model can be used to inform the current model. \item Bayesian inference can avoid problems with model identification by manipulating prior distributions (usually in complex models). Frequentist inference with any numerical approximation algorithm does not have prior distributions, and can become stuck in regions of flat density, causing problems with model identification. \item Bayesian inference considers the data to be fixed (which it is), and parameters to be random because they are unknowns. Frequentist inference considers the unknown parameters to be fixed, and the data to be random, estimating not based on the data at hand, but the data at hand plus hypothetical repeated sampling in the future with similar data. ``The Bayesian approach delivers the answer to the right question in the sense that Bayesian inference provides answers conditional on the observed data and not based on the distribution of estimators or test statistics over imaginary samples not observed'' \citep[p. 4]{rossi05}. \item Bayesian inference estimates a full probability model. Frequentist inference does not. There is no frequentist probability distribution associated with parameters or hypotheses. \item Bayesian inference estimates $p(\mathrm{hypothesis} | \mathrm{data})$. In contrast, frequentist inference estimates $p(\mathrm{data} | \mathrm{hypothesis})$. Even the term 'hypothesis testing' suggests it should be the hypothesis that is tested, given the data, not the other way around. \item Bayesian inference has an axiomatic foundation \citep{cox46} that is uncontested by frequentists. Therefore, Bayesian inference is coherent to a frequentist, but frequentist inference is incoherent to a Bayesian. \item Bayesian inference has a decision theoretic foundation \citep{bernardo00,robert07}. The purpose of most of statistical inference is to facilitate decision-making \citep[p. 51]{robert07}. The optimal decision is the Bayesian decision. \item Bayesian inference includes uncertainty in the probability model, yielding more realistic predictions. Frequentist inference does not include uncertainty of the parameter estimates, yielding less realistic predictions. \item Bayesian inference is consistent with much of philosophy of science regarding epistemology, where knowledge cannot be built entirely through experimentation, but requires prior knowledge \cite[p. 510]{robert07}. Elsewhere, it has been suggested that the best choice for philosophy of science is through Bayesian inference. \item Bayesian inference may use DIC to compare models with different methods including hierarchical models, where frequentist model fit statistics cannot compare different methods or hierarchical models. \item Bayesian inference obeys the likelihood principle. Frequentist inference, including Maximum Likelihood Estimation (MLE) and the General Method of Moments (GMM) or Generalized Estimating Equations (GEE), violates the likelihood principle. ``The likelihood principle, by itself, is not sufficient to build a method of inference but should be regarded as a minimum requirement of any viable form of inference. This is a controversial point of view for anyone familiar with modern econometrics literature. Much of this literature is devoted to methods that do not obey the likelihood principle...'' \citep[p. 15]{rossi05}. \item Bayesian inference safeguards against overfitting by integrating over model parameters. While Bayesian inference is not immune to overfitting, overfitting is largely a frequentist problem. \item Bayesian inference uses observed data only. Frequentist inference uses both observed data and future data that is unobserved and hypothetical. \item Bayesian inference uses prior distributions, so more information is used and 95\% probability intervals of posterior distributions should be narrower than 95\% confidence intervals of frequentist point-estimates. \item Bayesian inference uses probability intervals (quantile-based, highest posterior density, or preferably lowest posterior loss) to state the probability that $\theta$ is between two points. Frequentist inference uses confidence intervals, which must be interpreted with probability of zero or one that $\theta$ is in the region, and the frequentist never knows whether it is or is not, but can only say that if 100 repeated samples were drawn in the future, that it would be in the region for 95 samples. \item Bayesian inference via MCMC or PMC algorithms allows more complicated models that frequentists are unable to estimate. \item Bayesian inference via MCMC has a theoretic guarantee that the MCMC algorithm will converge if run long enough. Frequentist inference with Maximum Likelihood Estimation (MLE) has no guarantee of convergence. \item Bayesian inference via MCMC or PMC is unbiased with respect to sample size and can accommodate any sample size no matter how small. Frequentist inference becomes more biased as sample size decreases from infinity, and is often wildly biased with small samples, so minimum sample size is an issue. Conversely, frequentist inference with large sample sizes biases p-values to indicate that insignificant effects are significant. \item Bayesian inference via MCMC or PMC uses exact estimation with respect to sample size. Frequentist inference uses approximate estimation that relies on asymptotic theory. \item Bayesian inference with correlated predictors sometimes allows the hyperparameters to be distributed multivariate-normal, therefore including such correlation into the MCMC or PMC algorithm to improve estimation. Frequentist inference does not use prior distributions, so confidence intervals are wider and less certain with correlated predictors. \item Bayesian inference with proper priors is immune to singularities and near-singularities with matrix inversions, unlike frequentist inference. \end{itemize} \section{Advantages Of Frequentist Inference Over Bayesian Inference} \label{disadvantages} Following is a short list of advantages of frequentist inference over Bayesian inference. \begin{itemize} \item Frequentist models are perceived to handle large data sets, while Bayesian models via MCMC have traditionally been restricted to small sample sizes, and Laplace Approximation is similar to the frequentist method in that it is known to be able to handle large data sets. This reputation is no longer true for MCMC. Samplers in \code{LaplacesDemon} do not usually loop through records and can handle large data sets. But most importantly, algorithms now exist (and are available here) that enable fast Bayesian inference with big data. \item Frequentist models are usually much easier to prepare because many things do not need to be specified, such as prior distributions, initial values for numerical approximation, and usually the likelihood function. Most frequentist methods have been standardized to ``procedures'' where less knowledge and programming are required, and in many cases the user can just click on a few things and not really know what they are doing. Garbage in, garbage out. \item Frequentist models optimized with MLE have much shorter run-times than Bayesian models via MCMC or PMC. This is not a difference between frequentist and Bayesian methods, but is due to optimization vs. sampling algorithms. MCMC has a longer run-time, whether it is Bayesian or frequentist. Laplace Approximation uses optimization algorithms, and yields run-times similar to frequentist MLE. If frequentist MLE and Bayesian Laplace Approximation seem to have very different run-times, it is probably due to differences between a method-specific algorithm vs. a general-purpose algorithm. \end{itemize} As they say, it pays to go Bayes. \bibliography{References} \end{document} LaplacesDemon/inst/doc/LaplacesDemonTutorial.Stex0000755000176200001440000034562115144316355021630 0ustar liggesusers\documentclass[nojss]{jss} %% need no \usepackage{Sweave.sty} \usepackage{amsmath} %\VignetteIndexEntry{LaplacesDemon Tutorial} %\VignettePackage{LaplacesDemon} %\VignetteDepends{LaplacesDemon} \author{Statisticat, LLC} \title{\includegraphics[height=1in,keepaspectratio]{LDlogo} \\ \pkg{LaplacesDemon}: A Complete Environment for Bayesian Inference within \proglang{R}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Statisticat} %% comma-separated \Plaintitle{LaplacesDemon: A Complete Environment for Bayesian Inference within R} %% without formatting \Shorttitle{LaplacesDemon} %% a short title (if necessary) \Abstract{ \pkg{LaplacesDemon}, also referred to as LD, is a contributed \proglang{R} package for Bayesian inference, and is freely available at \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/indexe}. The user may build any kind of probability model with a user-specified model function. The model may be updated with iterative quadrature, Laplace Approximation, MCMC, PMC, or variational Bayes. After updating, a variety of facilities are available, including MCMC diagnostics, posterior predictive checks, and validation. Hopefully, \pkg{LaplacesDemon} is generalizable and user-friendly for Bayesians, especially Laplacians. } \Keywords{Bayesian, Big Data, High Performance Computing, HPC, Importance Sampling, Iterative Quadrature, Laplace Approximation, LaplacesDemon, LaplacesDemonCpp, Markov chain Monte Carlo, MCMC, Metropolis, Optimization, Parallel, PMC, R, Rejection Sampling, Variational Bayes} \Plainkeywords{bayesian, big data, high performance computing, hpc, importance sampling, iterative quadrature, laplace approximation, laplacesdemon, laplacesdemoncpp, markov chain monte carlo, mcmc, metropolis, optimization, parallel, pmc, r, rejection sampling, variational bayes} %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2011} %% \Submitdate{2011-01-18} %% \Acceptdate{2011-01-18} \Address{ Statisticat, LLC\\ Hot Springs, SD\\ E-mail: defunct\\ URL: \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index} } %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} \begin{document} Bayesian inference is named after Reverend Thomas Bayes (1701-1761) for developing Bayes' theorem, which was published posthumously after his death \citep{bayes63}. This was the first instance of what would be called inverse probability\footnote{`Inverse probability' refers to assigning a probability distribution to an unobserved variable, and is in essence, probability in the opposite direction of the usual sense. Bayes' theorem has been referred to as ``the principle of inverse probability''. Terminology has changed, and the term `Bayesian probability' has displaced `inverse probability'. The adjective ``Bayesian'' was introduced by R. A. Fisher as a derogatory term.}. Unaware of Bayes, Pierre-Simon Laplace (1749-1827) independently developed Bayes' theorem and first published his version in 1774, eleven years after Bayes, in one of Laplace's first major works \citep[p. 366--367]{laplace74}. In 1812, Laplace introduced a host of new ideas and mathematical techniques in his book, \emph{Theorie Analytique des Probabilites} \citep{laplace12}. Before Laplace, probability theory was solely concerned with developing a mathematical analysis of games of chance. Laplace applied probabilistic ideas to many scientific and practical problems. Although Laplace is not the father of probability, Laplace may be considered the father of the field of probability. In 1814, Laplace published his ``Essai Philosophique sur les Probabilites'', which introduced a mathematical system of inductive reasoning based on probability \citep{laplace14}. In it, the Bayesian interpretation of probability was developed independently by Laplace, much more thoroughly than Bayes, so some ``Bayesians'' refer to Bayesian inference as Laplacian inference. This is a translation of a quote in the introduction to this work: \begin{quote} ``We may regard the present state of the universe as the effect of its past and the cause of its future. An intellect which at a certain moment would know all forces that set nature in motion, and all positions of all items of which nature is composed, if this intellect were also vast enough to submit these data to analysis, it would embrace in a single formula the movements of the greatest bodies of the universe and those of the tiniest atom; for such an intellect nothing would be uncertain and the future just like the past would be present before its eyes'' \citep{laplace14}. \end{quote} The `intellect' has been referred to by future biographers as Laplace's Demon. In this quote, Laplace expresses his philosophical belief in hard determinism and his wish for a computational machine that is capable of estimating the universe. This article is an introduction to an \proglang{R} \citep{rdct:r} package called \pkg{LaplacesDemon} \citep{r:laplacesdemon}, which was designed without consideration for hard determinism, but instead with a lofty goal toward facilitating high-dimensional Bayesian (or Laplacian) inference\footnote{Even though the \pkg{LaplacesDemon} package is dedicated to Bayesian inference, frequentist inference may be used instead with the same functions by omitting the prior distributions and maximizing the likelihood.}, posing as its own intellect that is capable of impressive analysis. The \pkg{LaplacesDemon} \proglang{R} package is often referred to as LD. This article guides the user through installation, data, specifying a model, initial values, updating a numerical approximation algorithm, summarizing and plotting output, posterior predictive checks, general suggestions, discusses independence and observability, high performance computing, covers details of the algorithms, and introduces \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index}. Herein, it is assumed that the reader has basic familiarity with Bayesian inference, numerical approximation, and \proglang{R}. If any part of this assumption is violated, then suggested sources include the vignette entitled ``Bayesian Inference'' that comes with the \pkg{LaplacesDemon} package, \citet{robert07}, and \citet{crawley07}. \section{Installation} \label{installation} To obtain the \pkg{LaplacesDemon} package, simply download the source code from \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/softwaredownload}, open \proglang{R}, and install the \pkg{LaplacesDemon} package from source: %%\SweaveOpts{echo=TRUE,results=verbatim,fig=FALSE} \begin{Scode}{eval=FALSE} install.packages(pkgs="path/LaplacesDemon_ver.tar.gz", repos=NULL, type="source") \end{Scode} where \code{path} is a path to the zipped source code, and \code{_ver} is replaced with the latest version found in the name of the downloaded file. A goal in developing the \pkg{LaplacesDemon} package was to minimize reliance on other packages or software. Therefore, the usual \code{dep=TRUE} argument does not need to be used, because the \pkg{LaplacesDemon} package does not depend on anything other than base \proglang{R} and its \pkg{parallel} package. \pkg{LaplacesDemonCpp} is an extension package that uses \proglang{C++}, and imports these packages: \pkg{parallel}, \pkg{Rcpp}, and \pkg{RcppArmadillo}. This tutorial introduces only \pkg{LaplacesDemon}, but the use of \pkg{LaplacesDemonCpp} is identical. Once installed, simply use the \code{library} or \code{require} function in \proglang{R} to activate the \pkg{LaplacesDemon} package and load its functions into memory: \begin{Scode} library(LaplacesDemon) \end{Scode} \section{Data} \label{data} The \pkg{LaplacesDemon} package requires data that is specified in a list\footnote{Though most \proglang{R} functions use data in the form of a data frame, \pkg{LaplacesDemon} uses one or more numeric matrices in a list. It is much faster to process a numeric matrix than a data frame in iterative estimation.}. As an example, there is a data set called \code{demonsnacks} that is provided with the \pkg{LaplacesDemon} package. For no good reason, other than to provide an example, the log of \code{Calories} will be fit as an additive, linear function of the log of some of the remaining variables. Since an intercept will be included, a vector of 1's is inserted into design matrix \textbf{X}. \begin{Scode} data(demonsnacks) N <- nrow(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) J <- ncol(X) for (j in 2:J) {X[,j] <- CenterScale(X[,j])} mon.names <- "LP" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \end{Scode} There are J=\Sexpr{J} independent variables (including the intercept), one for each column in design matrix \textbf{X}. However, there are \Sexpr{J+1} parameters, since the residual variance, $\sigma^2$, must be included as well. Each parameter must have a name specified in the vector \code{parm.names}, and parameter names must be included with the data. This is using a function called \code{as.parm.names}. Also, note that each predictor has been centered and scaled, as per \citet{gelman08}. A \code{CenterScale} function is provided to center and scale predictors\footnote{Centering and scaling a predictor is \code{x.cs <- (x - mean(x)) / (2*sd(x))}.}. \code{PGF} is an optional, but highly recommended, user-specified function. PGF stands for Parameter-Generating Function, and is used by the \code{GIV} function, where GIV stands for Generating Initial Values. Although the \code{PGF} is not technically data, it is most conveniently placed in the list of data. When \code{PGF} is not specified and \code{GIV} is used, initial values are generated randomly without respect to prior distributions. To see why \code{PGF} was specified as it was, consider the following sections on specifying a model and initial values. \section{Specifying a Model} \label{specification} The \pkg{LaplacesDemon} package is capable of estimating any Bayesian model for which the likelihood is specified\footnote{Examples of more than 100 Bayesian models may be found in the ``Examples'' vignette that comes with the \pkg{LaplacesDemon} package. Likelihood-free estimation is also possible by approximating the likelihood, such as in Approximate Bayesian Computation (ABC).}. To use the \pkg{LaplacesDemon} package, the user must specify a model. Let's consider a linear regression model, which is often denoted as: $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ The dependent variable, $\textbf{y}$, is normally distributed according to expectation vector $\mu$ and scalar variance $\sigma^2$, and expectation vector $\mu$ is equal to the inner product of design matrix \textbf{X} and transposed parameter vector $\beta$. For a Bayesian model, the notation for the residual variance, $\sigma^2$, has often been replaced with the inverse of the residual precision, $\tau^{-1}$. Here, $\sigma^2$ will be used. Prior probabilities are specified for $\beta$ and $\sigma$ (the standard deviation, rather than the variance): $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ Each of the $J$ $\beta$ parameters is assigned a vague\footnote{`Traditionally, a vague prior would be considered to be under the class of uninformative or non-informative priors. 'Non-informative' may be more widely used than 'uninformative', but here that is considered poor English, such as saying something is `non-correct' when there's a word for that \dots `incorrect'. In any case, uninformative priors do not actually exist \citep{irony97}, because all priors are informative in some way. These priors are being described here as vague, but not as uninformative.} prior probability distribution that is normally-distributed according to $\mu=0$ and $\sigma^2=1000$. The large variance or small precision indicates a lot of uncertainty about each $\beta$, and is hence a vague distribution. The residual standard deviation $\sigma$ is half-Cauchy-distributed according to its hyperparameter, scale=25. When exploring new prior distributions, the user is encouraged to use the \code{is.proper} function to check for prior propriety. To specify a model, the user must create a function called \code{Model}. Here is an example for a linear regression model written in \proglang{R} code\footnote{A model specification function for the \pkg{LaplacesDemon} or \pkg{LaplacesDemonCpp} packages may be written and compiled in a faster language, such as in \proglang{C++} via the \pkg{Rcpp} package family.}: \begin{Scode} Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- dnormv(beta, 0, 1000, log=TRUE) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(beta, Data$X) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + sum(beta.prior) + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } \end{Scode} A numerical approximation algorithm iteratively maximizes the logarithm of the unnormalized joint posterior density as specified in this \code{Model} function. In Bayesian inference, the logarithm of the unnormalized joint posterior density is proportional to the sum of the log-likelihood and logarithm of the prior densities: $$\log[p(\Theta|\textbf{y})] \propto \log[p(\textbf{y}|\Theta)] + \log[p(\Theta)]$$ where $\Theta$ is a set of parameters, $\textbf{y}$ is the data, $\propto$ means `proportional to'\footnote{For those unfamiliar with $\propto$, this symbol simply means that two quantities are proportional if they vary in such a way that one is a constant multiplier of the other. This is due to an unspecified constant of proportionality in the equation. Here, this can be treated as `equal to'.}, $p(\Theta|\textbf{y})$ is the joint posterior density, $p(\textbf{y}|\Theta)$ is the likelihood, and $p(\Theta)$ is the set of prior densities. During each iteration in which a numerical approximation algorithm is maximizing the logarithm of the unnormalized joint posterior density, two arguments are passed to \code{Model}: \code{parm} and \code{Data}, where \code{parm} is short for the set of parameters, and \code{Data} is a list of data. These arguments are specified in the beginning of the function: \code{Model <- function(parm, Data)} Then, the \code{Model} function is evaluated and the logarithm of the unnormalized joint posterior density is calculated as \code{LP}, and returned in a list called \code{Modelout}, along with the deviance (\code{Dev}), a vector (\code{Monitor}) of any variables desired to be monitored in addition to the parameters, $\textbf{y}^{rep}$ (\code{yhat}) or replicates of $\textbf{y}$, and the parameter vector \code{parm}. All arguments must be returned. Even if there is no desire to observe the deviance and any monitored variable, a scalar must be placed in the second position of the \code{Modelout} list, and at least one element of a vector for a monitored variable. This can be seen in the end of the function: \code{LP <- LL + sum(beta.prior) + sigma.prior} \\ \code{Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP,} \\ \hspace*{0.27 in} \code{yhat=rnorm(length(mu), mu, sigma), parm=parm)} \\ \code{return(Modelout)} The rest of the function specifies the parameters, log of the prior densities, and calculates the log-likelihood. Since design matrix \textbf{X} has J=\Sexpr{J} column vectors (including the intercept), there are \Sexpr{J} \code{beta} parameters and a \code{sigma} parameter for the residual standard deviation. Since a vector of parameters called \code{parm} is passed to \code{Model}, the function needs to know which parameter is associated with which element of \code{parm}. For this, the vector \code{beta} is declared, and then each element of \code{beta} is populated with the value associated in the corresponding element of \code{parm}. Above, the \code{grep} function was used to populate \code{pos.beta} and \code{pos.sigma}, which indicate the positions of $\beta$ and $\sigma$. These positions are stored in the list of data, and used in the \code{Model} function to extract the appropriate parameters from vector \code{parm}: \code{beta <- parm[Data$pos.beta} \\ \code{sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf)} \\ \code{parm[Data$pos.sigma] <- sigma} The $\sigma$ parameter must be positive-only, and so it is constrained to be positive in the \code{interval} function. The algorithm, outside of the \code{Model} function needs to be aware that $\sigma$ has been constrained, so the \code{parm} vector is updated with the constrained value. The user does not have to constrain parameters in this way. For example, an alternative is to reparameterize to real values, such as with a logarithm, in this case. If the user does not constrain or reparameterize a parameter that is not on the real line, then the algorithm will be unaware, and probably attempt a value outside of realistic bounds, such as a negative standard deviation in this example. To work with the log of the prior densities and according to the assigned names of the parameters and hyperparameters, they are specified as follows: \code{beta.prior <- dnormv(beta, 0, 1000, log=TRUE)} \\ \code{sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE)} In the above example, the residual standard deviation \code{sigma} receives a half-Cauchy distributed prior of the form: $$\sigma \sim \mathcal{HC}(25)$$ Finally, everything is put together to calculate \code{LP}, the logarithm of the unnormalized joint posterior density. The expectation vector \code{mu} is the inner product of the design matrix, \code{Data$X}, and the transpose of the vector \code{beta}. Expectation vector \code{mu}, vector \code{Data$y}, and scalar \code{sigma} are used to estimate the sum of the log-likelihoods, where: $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ and as noted before, the logarithm of the unnormalized joint posterior density is: $$\log[p(\Theta|\textbf{y})] \propto \log[p(\textbf{y}|\Theta)] + \log[p(\Theta)]$$ \code{mu <- tcrossprod(Data$X, t(beta))} \\ \code{LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)} \\ \code{LP <- LL + sum(beta.prior) + sigma.prior} In retrospect, the \code{PGF} function was specified so that when the list of data is passed to it, it generates and returns an initial value for each of the \code{beta} parameters, as well as one for the \code{sigma} parameter. Specifying the model in the \code{Model} function is the most involved aspect for the user of the \pkg{LaplacesDemon} package. But this package has been designed so it is also incredibly flexible, allowing a wide variety of Bayesian models to be specified. \section{Initial Values} \label{initialvalues} Each numerical approximation algorithm in the \pkg{LaplacesDemon} package requires a vector of initial values for the parameters. Each initial value is a starting point for the estimation of a parameter. In this example, there are \Sexpr{J+1} parameters. The order of the elements of the vector of initial values must match the order of the parameters associated with each element of \code{parm} passed to the \code{Model} function. With no prior knowledge, it is a good idea to randomize each initial value, such as with the \code{GIV} function (which stands for ``generate initial values''). When all initial values are set to zero for MCMC, the \code{LaplacesDemon} function optimizes initial values using a spectral projected gradient algorithm in the \code{LaplaceApproximation} function. Laplace Approximation is asymptotic with respect to sample size, so it is inappropriate in this example with a sample size of \Sexpr{N} and \Sexpr{J+1} parameters. MCMC will not use Laplace Approximation when the sample size is not at least five times the number of parameters. \begin{Scode} Initial.Values <- c(rep(0,J), 1) \end{Scode} \section{Numerical Approximation} \label{numericalapproximation} Compared to specifying the model in the \code{Model} function, updating a model is easy. Since pseudo-random numbers are involved, it's a good idea to set a `seed' for pseudo-random number generation, so results can be reproduced. Pick any number you like, but there's only one number appropriate for a demon\footnote{Demonic references are used only to add flavor to the software and its use, and in no way endorses beliefs in demons. This specific pseudo-random seed is often referred to, jokingly, as the `demon seed'.}: \begin{Scode} set.seed(666) \end{Scode} The \pkg{LaplacesDemon} package offers a wide variety of numerical approximation algorithms. Details may be found below in section \ref{details}, and also in the appropriate function documentation. If the user is new to Bayesian inference, then the best suggestion may be to consider Laplace Approximation with the \code{LaplaceApproximation} function when sufficient sample size is available, or MCMC with the \code{LaplacesDemon} function otherwise. This guideline is too simple, but serves as a place to start. For this example, the \code{LaplacesDemon} function will be used. As with any \proglang{R} package, the user can learn about a function by using the \code{help} function and including the name of the desired function. To learn the details of the \pkg{LaplacesDemon} function, enter: \begin{Scode}{eval=false} help(LaplacesDemon) \end{Scode} Here is one of many possible ways to begin: \begin{Scode}{eval=false} Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, Covar=NULL, Iterations=1000, Status=100, Thinning=1, Algorithm="AFSS", Specs=list(A=500, B=NULL, m=100, n=0, w=1)) \end{Scode} In this example, an output object called \code{Fit} will be created as a result of using the \pkg{LaplacesDemon} function. \code{Fit} is an object of class \code{demonoid}, which means that since it has been assigned a customized class, other functions have been custom-designed to work with it. The above example specifies the AFSS algorithm for updating. This example tells the \pkg{LaplacesDemon} function to maximize the first component in the list output from the user-specified \code{Model} function, given a data set called \code{Data}, and according to several settings. \begin{itemize} \item The \code{Initial.Values} argument requires a vector of initial values for the parameters. \item The \code{Covar=NULL} argument indicates that a user-specified variance vector or covariance matrix has not been supplied. AFSS requires proposal covariance, and when not specified, will begin with a scaled identity matrix. \item The \code{Iterations=1000} argument indicates that the \code{LaplacesDemon} function will update 1,000 times before completion. \item The \code{Status=100} argument indicates that a status message will be printed to the \proglang{R} console every 100 iterations. \item The \code{Thinning=1} argument indicates that only ever $K$th iteration will be retained in the output, and in this case, every iteration will be retained. See the \code{Thin} function for more information on thinning. \item The \code{Algorithm} argument requires the abbreviated name of the MCMC algorithm in quotes. \item Finally, the \code{Specs} argument contains specifications for each algorithm named in the \code{Algorithm} argument. The \code{AFSS} algorithm has several specifications. The \code{A} specification indicates at which iteration adaptation will stop, and it is arbitrarily set here so that it adapts for the first half, and is non-adaptive in the second half. The \code{B} specification is for blockwise sampling, which is not performed here. The \code{m} specification indicates the maximum number of steps when searching for the slice interval. The \code{n} specification is set to zero and indicates the number of previous adaptive iterations. The \code{w} specification is the step-size, which is adapted in this algorithm. \end{itemize} By running\footnote{This is ``turning the Bayesian crank'', as Dennis Lindley used to say.} the \code{LaplacesDemon} function, the following output was obtained: \begin{Scode} Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, Covar=NULL, Iterations=1000, Status=100, Thinning=1, Algorithm="AFSS", Specs=list(A=500, B=NULL, m=100, n=0, w=1)) \end{Scode} \code{LaplacesDemon} finished quickly, though it had a small data set (N=\Sexpr{NROW(X)}), few parameters (K=\Sexpr{J+1}), and the model was very simple. The output object, \code{Fit}, was created as a list. As with any \proglang{R} object, use \code{str()} to examine its structure: \begin{Scode}{eval=false} str(Fit) \end{Scode} To access any of these values in the output object \code{Fit}, simply append a dollar sign and the name of the component. For example, here is how to access the observed acceptance rate: \begin{Scode} Fit$Acceptance.Rate \end{Scode} \subsection{Warnings} \label{warnings} During updating in \code{LaplacesDemon}, warnings are converted to errors, and the proposal is rejected. Warnings may appear due to checks before updating, or summarizing after updating, but not during updating. If chains appear to have numerous rejections after trying a variety of samplers, then the model specification function may be producing warnings with certain configurations of parameters. If warnings continue to occur, then the priors or parameterization should be considered. An example is when a scale parameter for the posterior predictive distribution is allowed to be too small or large. \section{Summarizing Output} \label{summarizingoutput} The output object, \code{Fit}, has many components. The (copious) contents of \code{Fit} can be printed to the screen with the usual \proglang{R} functions: \begin{Scode}{eval=false} Fit print(Fit) \end{Scode} While a user is welcome to continue this \proglang{R} convention, the \pkg{LaplacesDemon} package adds another feature below the \code{print} function output in the \code{Consort} function. But before describing the additional feature, the results are obtained as: \begin{Scode} Consort(Fit) \end{Scode} Several components are labeled as \code{NOT SHOWN HERE}, due to their size, such as the covariance matrix \code{Covar} or the stationary posterior samples \code{Posterior2}. As usual, these can be printed to the screen by appending a dollar sign, followed by the desired component, such as: \begin{Scode}{eval=false} Fit$Posterior2 \end{Scode} Although a lot can be learned from the above output, notice that it completed \Sexpr{Fit$Iterations} iterations of \Sexpr{J+1} variables in \Sexpr{round(Fit$Minutes,2)} minutes. Of course this was fast, since there were only \Sexpr{NROW(X)} records, and the form of the specified model was simple. In \proglang{R}, there is usually a \code{summary} function associated with each class of output object. The \code{summary} function usually summarizes the output. For example, with frequentist models, the \code{summary} function usually creates a table of parameter estimates, complete with p-values. Since this is not a frequentist package, p-values are not part of any table with the \code{LaplacesDemon} function, and the marginal posterior distributions of the parameters and other variables have already been summarized in \code{Fit}, there is no point to have an associated \code{summary} function. Going one more step toward useability, the \code{Consort} function of \pkg{LaplacesDemon} allows the user to consort with Laplace's Demon about the output object. The additional feature is a second section called \code{Demonic Suggestion}. The \code{Demonic Suggestion} is a very helpful section of output. When the \pkg{LaplacesDemon} package was developed initially in late 2010, there were not to my knowledge any tools of Bayesian inference that make suggestions to the user. Before making its \code{Demonic Suggestion}, Laplace's Demon considers and presents five conditions: the algorithm, acceptance rate, Monte Carlo standard error (MCSE), effective sample size (ESS), and stationarity. In addition to these conditions, there are other suggested values, such as a recommended number of iterations or values for the \code{Periodicity} and \code{Status} arguments. The suggested value for \code{Status} is seeking to print a status message every minute when the expected time is longer than a minute, and is based on the time in minutes it took, the number of iterations, and the recommended number of iterations. In the above output, Laplace's Demon is appeased. However, if any of these five conditions is unsatisfactory, then Laplace's Demon is not appeased, and suggests it should continue updating, and that the user should copy, paste, and execute its suggested \proglang{R} code. Here are the criteria it measures against. The final algorithm must be non-adaptive, so that the Markov property holds (this is covered in section \ref{markovchainproperties}). The acceptance rate of most algorithms is considered satisfactory if it is within the interval [15\%, 50\%]\footnote{While \citet{spiegelhalter03} recommend updating until the acceptance rate is within the interval [20\%, 40\%], and \citet{roberts01} suggest [10\%, 40\%], the interval recommended here is [15\%,50\%]. HMC and Refractive must be in the interval [60\%, 70\%].}. LMC or MALA must be in the interval [40\%, 80\%], and others (AFSS, AGG, ESS, GG, OHSS, SGLD, Slice, and UESS) have an acceptance rate of 100\%. For more information on acceptance rates, see the \code{AcceptanceRate} function. MCSE is considered satisfactory for each target distribution if it is less than 6.27\% of the standard deviation of the target distribution. This allows the true mean to be within 5\% of the area under a Gaussian distribution around the estimated mean. ESS is considered satisfactory for each target distribution if it is at least 100, which is usually enough to describe 95\% probability intervals. And finally, each variable must be estimated as stationary. In this example, notice that all criteria have been met: MCSEs are sufficiently small, ESSs are sufficiently large, and all parameters were estimated to be stationary. Although the algorithm adapted in the first half, it was non-adaptive in the second half of the run, the Markov property holds, so let's look at some plots. \section{Plotting Output} \label{plottingoutput} The \pkg{LaplacesDemon} package has a \code{plot.demonoid} function to enable its own customized plots with \code{demonoid} objects. The variable \code{BurnIn} (below) may be left as it is so it will show only the stationary samples (samples that are no longer trending), or set equal to zero so that all samples can be plotted. In this case, only samples are considered that were generated while the algorithm was non-adaptive, so \code{BurnIn=500}. The \code{plot} function also enables the user to specify whether or not the plots should be saved as a .pdf file, and allows the user to select the parameters to be plotted. For example, \code{Parms=c("beta[1]","beta[2]")} would plot only the first two regression effects, and \code{Parms=NULL} will plot everything. \begin{Scode} \end{Scode} \begin{Scode}{eval=false} plot(Fit, BurnIn=500, MyData, PDF=FALSE, Parms=NULL) \end{Scode} %% Control graphic size, default width=0.8 \setkeys{Gin}{width=0.5\textwidth} \begin{figure} \begin{center} \begin{Scode}{label=fig1,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(3,3)) BurnIn <- 500 for (j in 1:3){ plot((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], type="l", xlab="Thinned Samples", ylab="Value", main=MyData$parm.names[j]) panel.smooth((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], pch="") plot(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), xlab="Value", main=MyData$parm.names[j]) polygon(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], plot=FALSE) se <- 1/sqrt(length(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=MyData$parm.names[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } \end{Scode} \end{center} \caption{Plots of Marginal Posterior Samples} \end{figure} \begin{figure} \begin{center} \begin{Scode}{label=fig2,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(3,3)) for (j in 4:5){ plot((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], type="l", xlab="Thinned Samples", ylab="Value", main=MyData$parm.names[j]) panel.smooth((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], pch="") plot(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), xlab="Value", main=MyData$parm.names[j]) polygon(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], plot=FALSE) se <- 1/sqrt(length(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=MyData$parm.names[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } plot((BurnIn+1):length(Fit$Deviance), Fit$Deviance[(BurnIn+1):length(Fit$Deviance)], type="l", xlab="Thinned Samples", ylab="Value", main="Deviance") panel.smooth((BurnIn+1):length(Fit$Deviance), Fit$Deviance[(BurnIn+1):length(Fit$Deviance)], pch="") plot(density(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)]), xlab="Value", main="Deviance") polygon(density(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)], plot=FALSE) se <- 1/sqrt(length(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main="Deviance", xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) \end{Scode} \end{center} \caption{Plots of Marginal Posterior Samples} \end{figure} \begin{figure} \begin{center} \begin{Scode}{label=fig3,fig=TRUE,echo=FALSE,width=6,height=4} par(mfrow=c(2,3)) JJ <- NCOL(Fit$Monitor); nn <- NROW(Fit$Monitor) for (j in 1:JJ){ plot((BurnIn+1):nn, Fit$Monitor[(BurnIn+1):nn,j], type="l", xlab="Thinned Samples", ylab="Value", main=MyData$mon.names[j]) panel.smooth((BurnIn+1):nn, Fit$Monitor[(BurnIn+1):nn,j], pch="") plot(density(Fit$Monitor[(BurnIn+1):nn,j]), xlab="Value", main=MyData$mon.names[j]) polygon(density(Fit$Monitor[(BurnIn+1):nn,j]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Monitor[(BurnIn+1):nn,j], plot=FALSE) se <- 1/sqrt(length(Fit$Monitor[(BurnIn+1):nn,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=MyData$mon.names[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } \end{Scode} \end{center} \caption{Plots of Marginal Posterior Samples} \end{figure} There are three plots for each parameter, the deviance, and each monitored variable (which in this example are \code{LP} and \code{sigma}). The leftmost plot is a trace-plot, showing the history of the value of the parameter according to the iteration. The middlemost plot is a kernel density plot. The rightmost plot is an ACF or autocorrelation function plot, showing the autocorrelation at different lags. The chains look stationary (do not exhibit a trend), the kernel densities look Gaussian, and the ACF's show low autocorrelation. The Hellinger distances between batches of chains can be plotted with \begin{Scode}{eval=false} plot(BMK.Diagnostic(Fit$Posterior1[501:1000,])) \end{Scode} \begin{figure} \begin{center} \begin{Scode}{label=fig4,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(1,1)) plot(BMK.Diagnostic(Fit$Posterior1[501:1000,])) \end{Scode} \end{center} \caption{Hellinger Distances} \end{figure} These distances occur in the interval $[0,1]$, and lower (darker) is better. The \code{LaplacesDemon} function considers any Hellinger distance greater than 0.5 to indicate non-stationarity and non-convergence. This plot is useful for quickly finding problematic parts of chains. All Hellinger distances here are acceptably small (dark). Another useful plot is called the caterpillar plot, which plots a horizontal representation of three quantiles (2.5\%, 50\%, and 97.5\%) of each selected parameter from the posterior samples summary. The caterpillar plot will attempt to plot the stationary samples first (\code{Fit$Summary2}), but if stationary samples do not exist, then it will plot all samples (\code{Fit$Summary1}). Here, only the first four parameters are selected for a caterpillar plot: \begin{Scode}{eval=false} caterpillar.plot(Fit, Parms="beta") \end{Scode} \begin{figure} \begin{center} \begin{Scode}{label=fig5,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(1,1)) caterpillar.plot(Fit, Parms=1:4) \end{Scode} \end{center} \caption{Caterpillar Plot} \end{figure} If all is well, then the Markov chains should be studied with MCMC diagnostics (such as visual inspections with the \code{CSF} or Cumulative Sample Function), and finally, further assessments of model fit should be estimated with posterior predictive checks, showing how well (or poorly) the model fits the data. When the user is satisfied, the \code{BayesFactor} function may be useful in selecting the best model, and the marginal posterior samples may be used for inference. \section{Posterior Predictive Checks} \label{ppc} A posterior predictive check is a method to assess discrepancies between the model and the data \citep{gelman96a}. To perform posterior predictive checks with the the \pkg{LaplacesDemon} package, simply use the \code{predict} function: \begin{Scode} Pred <- predict(Fit, Model, MyData, CPUs=1) \end{Scode} This creates \code{Pred}, which is an object of class \code{demonoid.ppc} (where ppc is short for posterior predictive check). \code{Pred} is a list that contains three components: \code{y}, \code{yhat}, and \code{Deviance} (though the \code{LaplaceApproximation} output differs a little). If the data set that was used to estimate the model is supplied in \code{predict}, then replicates of \code{y} (also called $\textbf{y}^{rep}$) are estimated. If, instead, a new data set is supplied in \code{predict}, then new, unobserved instances of \code{y} (called $\textbf{y}^{new}$) are estimated. Note that with new data, a \code{y} vector must still be supplied, and if unknown, can be set to something sensible such as the mean of the \code{y} vector in the model. The \code{predict} function calls the \code{Model} function once for each set of stationary samples in \code{Fit\$Posterior2}. When there are few discrepancies between \code{y} and $\textbf{y}^{rep}$, the model is considered to fit well to the data. Parallel processing is enabled when multiple CPUs exist and are specified. Since \code{Pred\$yhat} is a large (39 x 1000) matrix, let's look at the summary of the posterior predictive distribution: \begin{Scode} summary(Pred, Discrep="Chi-Square") \end{Scode} The \code{summary.demonoid.ppc} function returns a list with 5 components when \code{y} is continuous (different output occurs for categorical dependent variables when given the argument \code{Categorical=TRUE}): \begin{itemize} \item \code{BPIC} is the Bayesian Predictive Information Criterion of \citet{ando07}. BPIC is a variation of the Deviance Information Criterion (DIC) that has been modified for predictive distributions. For more information on DIC, see the accompanying vignette entitled ``Bayesian Inference''. \item \code{Concordance} is the predictive concordance of \citet{gelfand96}, that indicates the percentage of times that \code{y} was within the 95\% probability interval of \code{yhat}. A goal is to have 95\% predictive concordance. For more information, see the accompanying vignette entitled ``Bayesian Inference''. In this case, roughly \Sexpr{round(summary(Pred)$Concordance*100,0)}\% of the time, \code{y} is within the 95\% probability interval of \code{yhat}. These results suggest that the model should be attempted again under different conditions, such as using different predictors, or specifying a different form to the model. \item \code{Discrepancy.Statistic} is a summary of a specified discrepancy measure. There are many options for discrepancy measures that may be specified in the \code{Discrep} argument. In this example, the specified discrepancy measure was the $\chi^2$ test in \citet[p. 175]{gelman04}, and higher values indicate a worse fit. \item \code{L-criterion} is a posterior predictive check for model and variable selection that measures the distance between $\textbf{y}$ and $\textbf{y}^{rep}$, providing a criterion to be minimized \citep{laud95}. \item The last part of the summarized output reports \code{y}, information about the distribution of \code{yhat}, and the predictive quantile (\code{PQ}). The mean prediction of \code{y[1]}, or $\textbf{y}^{rep}_1$, given the model and data, is \Sexpr{round(summary(Pred)$Summary[1,2],3)}. Most importantly, \code{PQ[1]} is \Sexpr{round(summary(Pred)$Summary[1,7],3)}, indicating that \Sexpr{round(summary(Pred)$Summary[1,7]*100,1)}\% of the time, \code{yhat[1,]} was greater than \code{y[1]}, or that \code{y[1]} is close to the mean of \code{yhat[1,]}. Contrast this with the 6th record, where \code{y[6]}=\Sexpr{round(summary(Pred)$Summary[6,1],3)} and \code{PQ[6]}=\Sexpr{round(summary(Pred)$Summary[6,7],3)}. Therefore, \code{yhat[6,]} was not a good replication of \code{y[6]}, because the distribution of \code{yhat[6,]} is almost always greater than \code{y[6]}. While \code{y[1]} is within the 95\% probability interval of \code{yhat[1,]}, \code{yhat[6,]} is above \code{y[6]} \Sexpr{round(summary(Pred)$Summary[6,7]*100,1)}\% of the time, indicating a strong discrepancy between the model and data, in this case. \end{itemize} There are also a variety of plots for posterior predictive checks, and the type of plot is controlled with the \code{Style} argument. Many styles exist, such as producing plots of covariates and residuals. The last component of this summary may be viewed graphically as posterior densities. Rather than observing plots for each of \Sexpr{NROW(Pred$yhat)} records or rows, only the first 9 densities will be shown here: \begin{Scode}{eval=false} plot(Pred, Style="Density", Rows=1:9) \end{Scode} \begin{figure} \begin{center} \begin{Scode}{label=fig6,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(3,3)) for (j in 1:9){ plot(density(Pred$yhat[j,]), xlab="Value", main=paste("Post. Pred. Plot of yhat[", j, ",]", sep=""), sub="Black=Density, Red=y") polygon(density(Pred$yhat[j,]), col="black", border="black") abline(v=Pred$y[j], col="red") } \end{Scode} \end{center} \caption{Posterior Predictive Densities} \end{figure} Among many other options, the fit may be observed: \begin{Scode}{eval=false} plot(Pred, Style="Fitted") \end{Scode} \begin{figure} \begin{center} \begin{Scode}{label=fig7,fig=TRUE,echo=FALSE,width=6,height=6} par(mfrow=c(1,1)) temp <- summary(Pred, Quiet=TRUE)$Summary plot(temp[,1], temp[,5], pch=16, cex=0.75, ylim=c(min(temp[,c(1,4:6)], na.rm=TRUE), max(temp[,c(1,4:6)], na.rm=TRUE)), xlab="y", ylab="yhat", main="Fitted") for (i in 1:length(y)) { lines(c(temp[i,1], temp[i,1]), c(temp[i,4], temp[i,6]))} panel.smooth(temp[,1], temp[,5], pch=16, cex=0.75) \end{Scode} \end{center} \caption{Posterior Predictive Fit} \end{figure} This plot shows a poor fit between the dependent variable and its expectation, and model revision should be considered. The \code{Importance} function is not presented here in detail, but may be a useful way to assess variable importance, which is defined here as the impact of each variable on $\textbf{y}^{rep}$, when the variable is removed (or set to zero). Variable importance consists of differences in model fit or discrepancy statistics, showing how well the model fits the data with each variable removed. This information may be used for model revision, or presenting the relative importance of variables. These posterior predictive checks indicate that there is plenty of room to improve this model. \section{General Suggestions} \label{generalsuggestions} Following are general suggestions on how best to use the \pkg{LaplacesDemon} package: \begin{itemize} \item As suggested by \citet{gelman08}, continuous predictors should be centered and scaled. Here is an explicit example in \proglang{R} of how to center and scale a single predictor called \code{x}: \code{x.cs <- (x - mean(x)) / (2*sd(x))}. However, it is instead easier to use the \code{CenterScale} function provided in \pkg{LaplacesDemon}. \item Do not forget to reparameterize any bounded parameters in the \code{Model} function to be real-valued in the \code{parm} vector, and this is a good time to check for prior propriety with the \code{is.proper} function. \item If sufficient sample size is available, begin with a deterministic numerical approximation algorithm such as Laplace Approximation or variational Bayes. \item MCMC and PMC are stochastic methods of numerical approximation, and as such, results may differ with each run due to the use of pseudo-random number generation. It is good practice to set a seed so that each update of the model may be reproduced. Here is an example in \proglang{R}: \code{set.seed(666)}. \item Rather than specify the final, intended model in the \code{Model} function, start by specifying the simplest possible form. Rather than beginning with actual data, start by simulating data given specified parameters. Update the simple model on simulated data and verify that the algorithm converges to the correct target distributions. One by one, add components to the model specification, simulate more complicated data, update, verify, and progress toward the intended model. If using MCMC during this phase, then use the \code{Juxtapose} function to compare the inefficiency of several MCMC algorithms (via integrated autocorrelation time or \code{IAT}), and use this information to select the least inefficient algorithm for your particular model. When confident the model is specified correctly and with informed algorithmic selection, finally use actual data, but with few iterations, such as \code{Iterations=20}. \item After studying MCMC updates with few iterations, the first ``actual'' update should be long enough that proposals are accepted (the acceptance rate is not zero), adaptation begins to occur (if used), and that enough iterations occur after the first adaptation to allow the user to study the adaptation (assuming an adaptive algorithm is used). \item Depending on the model specification function, data, and intended iterations, it is a good idea to use the \code{LaplacesDemon.RAM} function to estimate the amount of random-access memory (RAM) that \code{LaplacesDemon} will use. If \code{LaplacesDemon} uses more RAM than the computer has available, then the computer will crash. This can be used to estimate the maximum number of iterations or thinned samples for a particular model and data set on a given computer. \item Once the final, intended model has begun (finally!), the mixing of the chains should be observed after a larger trial run, say, arbitrarily, for 10,000 iterations. If the chains do not mix as expected, then try a different algorithm, either one suggested by the \code{Consort} function (such as when diminishing adaptation is violated), or use the next least inefficient algorithm as indicated previously in the \code{Juxtapose} function. \item When speed is a concern, such as with complex models, there may be things in the \code{Model} function that can be commented out, such as sometimes calculating \code{yhat}. The model can be updated without some features, that can be un-commented and used for posterior predictive checks. By commenting out things that are strictly unnecessary to updating, the model will update more quickly. Other helpful hints for speed are found in the documentation for the \code{Model.Spec.Time} function. \item If the numerical approximation algorithm is exploring areas of the state space that the user knows \textit{a priori} should not be explored, then the parameters may be constrained in the \code{Model} function before being passed back to the numerical approximation function. Simply change the parameter of interest as appropriate and place the constrained value back in the \code{parm} vector. \item For MCMC, \code{Demonic Suggestion} is intended as an aid, not an infallible replacement for critical thinking. As with anything else, its suggestions are based on assumptions, and it is the responsibility of the user to check those assumptions. For example, the \code{BMK.Diagnostic} may indicate stationarity (lack of a trend) when it does not exist. Or, the \code{Demonic Suggestion} may indicate that the next update may need to run for a million iterations in a complex model, requiring weeks to complete. \item If an adaptive MCMC algorithm is used, then use a two-phase approach, where the first phase consists of using an adaptive algorithm to achieve stationary samples that seem to have converged to the target distributions (convergence can never be determined with MCMC, but some instances of non-convergence can be observed). Once it is believed that convergence has occurred, use a non-adaptive algorithm. The final samples should again be checked for signs of non-convergence. If satisfactory, then the non-adaptive algorithm should have estimated the logarithm of the marginal likelihood (LML). This is most easily checked with the \code{is.proper} function, which considers the joint posterior distribution to be proper if it can verify that the LML is finite. \item The desirable number of final, thinned samples for inference depends on the required precision of the inferential goal. A good, general goal is to end up with 1,000 thinned samples \citep[p. 295]{gelman04}, where the ESS is at least 100 (and more is desirable). See the \code{ESS} function for more information. \item Disagreement exists in MCMC literature as to whether to update one, long chain \citep{geyer92, geyer11}, or multiple, long chains with different, randomized initial values \citep{gelman92}. Multiple chains are enabled with an extension function called \code{LaplacesDemon.hpc}, which uses parallel processing. The \code{Gelman.Diagnostic} function may be used to compare multiple chains. Samples from multiple chains may be put together with the \code{Combine} function. \item After a deterministic numerical approximation algorithm has converged, consider following it up with a stochastic numerical approximation algorithm such as MCMC, if practical. When MCMC seems to have converged, consider updating the model again, this time with Population Monte Carlo (PMC). PMC may improve the model fit obtained with MCMC, and should reduce the variance of the marginal posterior distributions, which is desirable for predictive modeling. \item After a model has been updated, consider posterior predictive checks and any necessary model revisions. Afterward, consider updating a model with different prior distributions and compare results with the \code{BayesFactor} and \code{SensitivityAnalysis} functions, as well as comparing posterior predictive checks. Consider applying the model to different data sets and using the \code{Validate} function. Consider beyond the model how decision theory applies to the problem. Finally, make inferences, given the model and data. \end{itemize} \section{Independence and Observability} \label{independence} The \pkg{LaplacesDemon} package was designed with independence and observability in mind. By independence, it is meant that a goal was to minimize dependence on other software. The \pkg{LaplacesDemon} package requires only base \proglang{R}, and the \pkg{parallel} package bundled with it. The variety of packages makes \proglang{R} extremely attractive. However, depending on multiple packages can be problematic when different packages have functions with the same name, or when a change is made in one package, but other packages do not keep pace, and the user is dependent on packages being in sync. By avoiding dependencies on packages that are not in or accompanying base \proglang{R}, the \pkg{LaplacesDemon} package is attempting to be consistent and dependable for the user. For example, common MCMC diagnostics and probability distributions (such as Dirichlet, multivariate normal, Wishart, and many others, as well as truncated forms of distributions) in Bayesian inference have been included in the \pkg{LaplacesDemon} package so the user does not have to load numerous \proglang{R} packages, except of course for exotic distributions that have not been included. \pkg{LaplacesDemonCpp} is an optional extension package that uses \proglang{C++}, and is not an independent package in the sense that it imports \pkg{parallel}, but also \pkg{Rcpp} and \pkg{RcppArmadillo}. Once obtained and activated, its use is seamless to a \pkg{LaplacesDemon} user. \pkg{LaplacesDemonCpp} is a stand-alone replacement of \pkg{LaplacesDemon}, and is currently in development. By observability, it is meant that the base \pkg{LaplacesDemon} package is written entirely in \proglang{R}. Certain functions could be sped up in another language such as \proglang{C++}, but this may prevent some \proglang{R} users from understanding the code. The base \pkg{LaplacesDemon} package is intended to be open and accessible. The optional \pkg{LaplacesDemonCpp} package is available for faster computations via \proglang{C++}. If a user desires speed and is familiar with a faster language, then the user is encouraged to program the model specification function in the faster language. See the documentation for the \code{Model.Spec.Time} function for more information. Observability also enables users to investigate or customize functions in the \pkg{LaplacesDemon} package. To access any function, simply enter the function name and press enter. For example, to print the source code for the \code{LaplacesDemon} function to the \proglang{R} console, simply enter: \begin{Scode}{eval=false} LaplacesDemon \end{Scode} Most undocumented, internal-only functions are exported in the namespace and have an alias in the LaplacesDemon-package.Rd file. \pkg{LaplacesDemon} seeks to provide a complete, Bayesian environment within \proglang{R}. Independence from other software facilitates dependability, and its open code makes it easier for a user to investigate and customize. \section{High Performance Computing} \label{hpc} High performance computing (HPC) is a broad term that can mean many different things. The \pkg{LaplacesDemon} package currently uses the term HPC to refer to two topics: big data and parallel processing. \subsection{Big Data} There are several definitions for big data. Here, big data is defined as data that is too big for the computer memory (RAM). The \code{BigData} function enables updating a Bayesian model with big data by reading in and processing smaller batches or chunks of data and performing a user-specified function on the batch before combining and outputing the result, so the entire data set does not consume RAM. \code{BigData} is also parallelized. The \code{read.matrix} function allows sampling from big data. Finally, the Stochastic Gradient Descent (SGD) algorithm (see \ref{sgd}) in \code{LaplaceApproximation} and the Stochastic Gradient Langevin Dynamics (SGLD) algorithm in \code{LaplacesDemon} are designed specifically for use with big data. \subsection{Parallel Processing} Parallel processing occurs when software is designed to simultaneously use multiple central processing units (CPUs). The motherboard of a computer may contain multiple CPUs, such as a quad-core contains four, and this is called a multicore computer. Several computers may be linked together with network communication, forming what is called a computer cluster. The \pkg{LaplacesDemon} package has several functions that optionally take advantage of multicore computers or may utilize large computer clusters. In the context of MCMC, there are three approaches to parallelization that are avilable in \pkg{LaplacesDemon}: parallel approximation within a chain, parallel sets of independent chains, and parallel sets of interactive chains. There are more parallelized functions in \pkg{LaplacesDemon} in addition to MCMC. \subsection{Iterative Quadrature} \label{paraquad} The \code{IterativeQuadrature} function provides several numerical integration algorithms, and each may be parallelized. At each iteration, the conditional density is evaluated at several nodes, and this processing may take advantage of multiple CPUs. For more information, see \ref{iterativequadrature}. \subsection{Parallel Approximation within a Chain} \label{parapprox} The Griddy-Gibbs (GG) sampler of \citet{ritter92}, Adaptive Griddy-Gibbs (AGG), and Multiple-Try Metropolis (MTM) of \citet{liu00} are examples of algorithms in which an approximation is made within a chain, and the approximation may be parallelized. \subsection{Parallel Sets of Independent Chains} \label{indchains} The \code{LaplacesDemon} function is extended with the \code{LaplacesDemon.hpc} function for the parallel processing of multiple chains on different central processing units (CPUs). This requires a minimum of two additional arguments: \code{Chains} to specify the number of parallel chains, and \code{CPUs} to specify the number of CPUs. The \code{LaplacesDemon.hpc} function allows the parallelization of most MCMC algorithms in the \code{LaplacesDemon} function. An example of using \code{LaplacesDemon.hpc} is to simultaneously update three independent chains as an aid to checking MCMC convergence, as Gelman recommends \citep{gelman92}. Aside from aiding convergence, another benefit of parallelization is that more posterior samples are updated in the same time-frame as a non-parallel implementation. A multicore computer, such as a quad-core, will yield more posterior samples (which is valuable only if it converges, because it does not process more iterations), but a supercomputing environment or large computer cluster will yield many orders more. If multiple CPUs are available, then it only makes sense to use them...all. It is important to note that \code{Status} messages do not print to the console during parallel processing with \code{LaplacesDemon.hpc}, and should alternately be directed by the user to a log file with the \code{LogFile} argument, if desired. The \code{LaplacesDemon.hpc} function sends the information associated with each chain as well as the \code{LaplacesDemon} function to each CPU. The \code{LaplacesDemon} function may very well return status messages, but the \code{LaplacesDemon.hpc} function is unaware. After updating a model with \code{LaplacesDemon.hpc}, the \code{plot} function may be applied so that multiple chains may be viewed simultaneously, and this is helpful when comparing samplers for a specific model. If this looks good, then the \code{Gelman.Diagnostic} function may be applied to assess convergence. Otherwise, the \code{as.initial.values} function may be used to extract the latest values from the chains and use these to begin the next update. Once results seem acceptable, the \code{Combine} function may be used to combine the posterior samples of multiple chains into one \code{demonoid} object, from which the remaining facilities of the \pkg{LaplacesDemon} package are available. The Metropolis-Coupled Markov Chain Monte Carlo (MCMCMC) algorithm of \citet{geyer91} is an example of an MCMC algorithm in which multiple chains are updated in parallel, but in \code{LaplacesDemon}, not \code{LaplacesDemon.hpc}. \subsection{Parallel Sets of Interactive Chains} \label{intchains} Parallel sets of independent chains should each run as efficiently as a traditional single set of chains. However, independent chains cannot benefit from the fact that there are other chains, while each chain is running. They are independent of each other. In contrast, parallel sets of interactive chains are able to learn from each other through interaction. In the \pkg{LaplacesDemon} package, some of these algorithms are called with the \code{LaplacesDemon} function, and some with the \code{LaplacesDemon.hpc} function. The Interchain Adaptation (INCA) algorithm \citep{craiu09, solonen12} performs Adaptive Metropolis (AM) with parallel chains that share the adaptive component, and this sharing speeds convergence. Whenever the chains are specified to adapt, adaptation is performed by pooling the historical covariance matrix across all parallel chains, and then returns the combined result to all chains. Network communication time slows the adaptation, but once returned to each CPU, chains iterate at their usual speed. This algorithm must be used with the \code{LaplacesDemon.hpc} function, and there is not an un-parallelized form of it. The Affine-Invariant Ensemble Sampler (AIES) of \citep{goodman10} must be used with the \code{LaplacesDemon} function, and is available in either a parallelized or un-parallelized form. A large, even number of parallel chains (or walkers) are grouped into two batches, and each iteration, each chain moves in relation to a randomly selected chain (walker) in the other batch. Since these interactive chains interact each iteration, computer network communication is frequent, and this communication may be much slower than processing with one CPU. However, in a large-scale computing environment and when a \code{Model} function is not trivial to evaluate, this form of parallelization can result in very early convergence. \subsection{Population Monte Carlo} The \code{PMC} function has been parallelized at each iteration to speed up the evaluation of the model specification function over numerous importance samples. \subsection{Predict Functions} The predict functions (\code{predict.demonoid}, \code{predict.laplace}, \code{predict.pmc}) have been parallelized to speed up the prediction, or scoring, of larger data sets or when models have many posterior samples. The \code{Importance} function, which extensively uses predict functions, has also been parallelized. \subsection{Model Specification Function} A user may have a model with a model specification function that is computationally expensive, and may write their own parallelization code to speed up its processing by breaking down challenging computations and sending them to separate CPUs. \subsection{Parallelization Details} Parallelization is enabled by the \pkg{parallel} package that comes with base \proglang{R}. Parallelization is accomplished by default with socket-transport functions derived from the \pkg{snow} package, which is an acronym for a Simple Network of Workstations. Alternatively, Message Passing Interface (MPI) may be used. SNOW is more general, being cross-platform, and works on multicore computers, computer clusters, and supercomputers. More performance may be found with MPI, but it is more specialized. \code{LaplacesDemon.hpc} was reported to have been used successfully on a cluster with over 200 nodes. \section{Details} \label{details} The \pkg{LaplacesDemon} package uses five broad types of numerical approximation algorithms: Importance Sampling (IS), Iterative Quadrature, Laplace Approximation, Markov chain Monte Carlo (MCMC), and Variational Bayes (VB). Approximate Bayesian Computation (ABC) may be estimated within each. These numerical approximation algorithms are introduced below. \subsection{Approximate Bayesian Computation} \label{abc} Approximate Bayesian Computation (ABC), also called likelihood-free estimation, is a family of numerical approximation techniques in Bayesian inference. ABC is especially useful when evaluation of the likelihood, $p(\textbf{y} | \Theta)$ is computationally prohibitive, or when suitable likelihoods are unavailable. As such, ABC algorithms estimate likelihood-free approximations. ABC is usually faster than a similar likelihood-based numerical approximation technique, because the likelihood is not evaluated directly, but replaced with an approximation that is usually easier to calculate. The approximation of a likelihood is usually estimated with a measure of distance between the observed sample, $\textbf{y}$, and its replicate given the model, $\textbf{y}^{rep}$, or with summary statistics of the observed and replicated samples. See the accompanying vignette entitled ``Examples'' for an example. \subsection{Importance Sampling} \label{importancesampling} Importance Sampling (IS) is a method of estimating a distribution with samples from a different distribution, called the importance distribution. Importance weights are assigned to each sample. The main difficulty with IS is in the selection of the importance distribution. IS dates back at least to the 1950s, including iterative IS. IS is the basis of a wide variety of algorithms, some of which involve the combination of IS and Markov chain Monte Carlo (MCMC). There are also many variations of IS, including adaptive IS, and parametric and nonparametric self-normalized IS (SNIS). Some popular algorithms, or families of algorithms, that include IS are Particle Filtering, Population Monte Carlo (PMC), and Sequential Monte Carlo (SMC). \subsubsection{Population Monte Carlo} \label{pmc} Population Monte Carlo (PMC) uses adaptive IS, and the proposal or importance distribution is a multivariate Gaussian \citep{cappe04}, or a mixture of multivariate Gaussian distributions \citep{cappe08, wraith09}. \pkg{LaplacesDemon} uses the version presented in the appendix of \citet{wraith09}. At each iteration, the importance distribution of $N$ samples and $M$ mixture components is adapted. Parallel processing is available. Compared with Markov chain Monte Carlo (MCMC), very few iterations are required, convergence and ergodicity are not problems, posterior samples are independent, and PMC lends itself well to parallelization. However, PMC requires much more prior information about the model (better initial values and proposal covariance matrix) than MCMC, and becomes harder to apply as the number of variables increases. Amazingly, PMC may improve the model fit obtained with MCMC, and should reduce the variance of the marginal posterior distributions. This reduction in variance is desirable for predictive modeling. Therefore, it is recommended that a model is attempted to be updated with PMC after the model seems to have converged with MCMC. \subsection{Iterative Quadrature} \label{iterativequadrature} Quadrature is a historical term in mathematics that means determining area. Mathematicians of ancient Greece, according to the Pythagorean doctrine, understood determination of area of a figure as the process of geometrically constructing a square having the same area (squaring). Thus the name quadrature for this process. In medieval Europe, quadrature meant the calculation of area by any method. With the invention of integral calculus, quadrature has been applied to the computation of a univariate definite integral. Numerical integration is a broad family of algorithms for calculating the numerical value of a definite integral. Numerical quadrature is a synonym for quadrature applied to one-dimensional integrals. Multivariate quadrature, also called cubature, is the application of quadrature to multidimensional integrals. A quadrature rule is an approximation of the definite integral of a function, usually stated as a weighted sum of function values at specified points within the domain of integration. The specified points are referred to as abscissae, abscissas, integration points, or nodes, and have associated weights. The calculation of the nodes and weights of the quadrature rule differs by the type of quadrature. There are numerous types of quadrature algorithms. Bayesian forms of quadrature usually use Gauss-Hermite quadrature \citep{naylor82}, and placing a Gaussian Process on the function is a common extension \citep{ohagan91,rasmussen03} that is called `Bayesian Quadrature'. Often, these and other forms of quadrature are also referred to as model-based integration. Gauss-Hermite quadrature uses Hermite polynomials to calculate the rule. However, there are two versions of Hermite polynomials, which result in different kernels in different fields. In physics, the kernel is $\exp(-x^2)$, while in probability the kernel is $\exp(-x^2/2)$. The weights are a normal density. If the parameters of the normal distribution, $\mu$ and $\sigma^2$, are estimated from data, then it is referred to as adaptive Gauss-Hermite quadrature, and the parameters are the conditional mean and conditional variance. Outside of Gauss-Hermite quadrature, adaptive quadrature implies that a difficult range in the integrand is subdivided with more points until it is well-approximated. Gauss-Hermite quadrature performs well when the integrand is smooth, and assumes normality or multivariate normality. Adaptive Gauss-Hermite quadrature has been demonstrated to outperform Gauss-Hermite quadrature in speed and accuracy. A goal in quadrature is to minimize integration error, which is the error between the evaluations and the weights of the rule. Therefore, a goal in Bayesian Gauss-Hermite quadrature is to minimize integration error while approximating a marginal posterior distribution that is assumed to be smooth and normally-distributed. This minimization often occurs by increasing the number of nodes until a change in mean integration error is below a tolerance, rather than minimizing integration error itself, since the target may be only approximately normally distributed, or minimizing the sum of integration error, which would change with the number of nodes. To approximate integrals in multiple dimensions, one approach applies $N$ nodes of a univariate quadrature rule to multiple dimensions (using the \code{GaussHermiteCubeRule} function for example) via the product rule, which results in many more multivariate nodes. This requires the number of function evaluations to grow exponentially as dimension increases. Multidimensional quadrature is usually limited to less than ten dimensions, both due to the number of nodes required, and because the accuracy of multidimensional quadrature algorithms decreases as the dimension increases. Three methods may overcome this curse of dimensionality in varying degrees: componentwise quadrature, sparse grids, and Monte Carlo. Componentwise quadrature is the iterative application of univariate quadrature to each parameter. It is applicable with high-dimensional models, but sacrifices the ability to calculate the conditional covariance matrix, and calculates only the variance of each parameter. Sparse grids were originally developed by Smolyak for multidimensional quadrature. A sparse grid is based on a one-dimensional quadrature rule. Only a subset of the nodes from the product rule is included, and the weights are appropriately rescaled. Although a sparse grid is more efficient because it reduces the number of nodes to achieve the same accuracy, the user must contend with increasing the accuracy of the grid, and it remains inapplicable to high-dimensional integrals. Monte Carlo is a large family of sampling-based algorithms. \citet{ohagan87} asserts that Monte Carlo is frequentist, inefficient, regards irrelevant information, and disregards relevant information. Quadrature, he maintains \citep{ohagan92}, is the most Bayesian approach, and also the most efficient. In high dimensions, he concedes, a popular subset of Monte Carlo algorithms is currently the best for cheap model function evaluations. These algorithms are called Markov chain Monte Carlo (MCMC). High-dimensional models with expensive model evaluation functions, however, are not well-suited to MCMC. A large number of MCMC algorithms is available in the \code{LaplacesDemon} function. Following are some reasons to consider iterative quadrature rather than MCMC. Once an MCMC sampler finds equilibrium, it must then draw enough samples to represent all targets. Iterative quadrature does not need to continue drawing samples. Multivariate quadrature is consistently reported as more efficient than MCMC when its assumptions hold, though multivariate quadrature is limited to small dimensions. High-dimensional models therefore default to MCMC, between the two. Componentwise quadrature algorithms like CAGH, however, may also be more efficient with clock-time than MCMC in high dimensions, especially against componentwise MCMC algorithms. Another reason to consider iterative quadrature are that assessing convergence in MCMC is a difficult topic, but not for iterative quadrature. A user of iterative quadrature does not have to contend with effective sample size and autocorrelation, assessing stationarity, acceptance rates, diminishing adaptation, etc. Stochastic sampling in MCMC is less efficient when samples occur in close proximity (such as when highly autocorrelated), whereas in quadrature the nodes are spread out by design. In general, the conditional means and conditional variances progress smoothly to the target in multidimensional quadrature. For componentwise quadrature, movement to the target is not smooth, and often resembles a Markov chain or optimization algorithm. Iterative quadrature is often applied after \code{LaplaceApproximation} to obtain a more reliable estimate of parameter variance or covariance than the negative inverse of the \code{Hessian} matrix of second derivatives, which is suitable only when the contours of the logarithm of the unnormalized joint posterior density are approximately ellipsoidal \citep{naylor82}. \subsubsection{Adaptive Gauss-Hermite} \label{agh} The Adaptive Gauss-Hermite (AGH) algorithm is the \citet{naylor82} algorithm. The AGH algorithm uses multivariate quadrature with the physicist's (not the probabilist's) kernel. There are four algorithm specifications: \code{N} is the number of univariate nodes, \code{Nmax} is the maximum number of univariate nodes, \code{Packages} accepts any package required for the model function when parallelized, and \code{Dyn.libs} accepts dynamic libraries for parallelization, if required. The number of univariate nodes begins at $N$ and increases by one each iteration. The number of multivariate nodes grows quickly with $N$. \citet{naylor82} recommend beginning with as few nodes as $N=3$. Any of the following events will cause $N$ to increase by 1 when $N$ is less than \code{Nmax}: \begin{itemize} \item All LP weights are zero (and non-finite weights are set to zero) \item $\mu$ does not result in an increase in LP \item All elements in $\Sigma$ are not finite \item The square root of the sum of the squared changes in $\mu$ is less than or equal to the \code{Stop.Tolerance} \end{itemize} Tolerance includes two metrics: change in mean integration error and change in parameters. Including the change in parameters for tolerance was not mentioned in \citet{naylor82}. \citet{naylor82} consider a transformation due to correlation. This is not included here. The AGH algorithm does not currently handle constrained parameters, such as with the \code{interval} function. If a parameter is constrained and changes during a model evaluation, this changes the node and the multivariate weight. This is currently not corrected. An advantage of AGH over componentwise adaptive quadrature is that AGH estimates covariance, where a componentwise algorithm ignores it. A disadvantage of AGH over a componentwise algorithm is that the number of nodes increases so quickly with dimension, that AGH is limited to small-dimensional models. \subsubsection{Adaptive Gauss-Hermite Sparse Grid} \label{aghsg} The Adaptive Gauss-Hermite Sparse Grid (AGHSG) algorithm is the \citet{naylor82} algorithm applied to a sparse grid, rather than a traditional multivariate quadrature rule. This is identical to the AGH algorithm above, except that a sparse grid replaces the multivariate quadrature rule. The sparse grid reduces the number of nodes. The cost of reducing the number of nodes is that the user must consider the accuracy, $K$. There are four algorithm specifications: \code{K} is the accuracy (as a positive integer), \code{Kmax} is the maximum accuracy, \code{Packages} accepts any package required for the model function when parallelized, and \code{Dyn.libs} accepts dynamic libraries for parallelization, if required. These arguments represent accuracy rather than the number of univariate nodes, but otherwise are similar to the AGH algorithm. \subsubsection{Componentwise Adaptive Gauss-Hermite} \label{cagh} The Componentwise Adaptive Gauss-Hermite (CAGH) algorithm is a componentwise version of the adaptive Gauss-Hermite quadrature of \citet{naylor82}. Each iteration, each marginal posterior distribution is approximated sequentially, in a random order, with univariate quadrature. The conditional mean and conditional variance are also approximated each iteration, making it an adaptive algorithm. There are four algorithm specifications: \code{N} is the number of nodes, \code{Nmax} is the maximum number of nodes, \code{Packages} accepts any package required for the model function when parallelized, and \code{Dyn.libs} accepts dynamic libraries for parallelization, if required. The number of nodes begins at $N$. All parameters have the same number of nodes. Any of the following events will cause $N$ to increase by 1 when $N$ is less than \code{Nmax}, and these conditions refer to all parameters (not individually): \begin{itemize} \item Any LP weights are not finite \item All LP weights are zero \item $\mu$ does not result in an increase in LP \item The square root of the sum of the squared changes in $\mu$ is less than or equal to the \code{Stop.Tolerance} \end{itemize} It is recommended to begin with \code{N=3} and set \code{Nmax} between 10 and 100. As long as CAGH does not experience problematic weights, and as long as CAGH is improving LP with $\mu$, the number of nodes does not increase. When CAGH becomes either universally problematic or universally stable, then $N$ slowly increases until the sum of both the mean integration error and the sum of the squared changes in $\mu$ is less than the \code{Stop.Tolerance} for two consecutive iterations. If the highest LP occurs at the lowest or highest node, then the value at that node becomes the conditional mean, rather than calculating it from all weighted samples; this facilitates movement when the current integral is poorly centered toward a well-centered integral. If all weights are zero, then a random proposal is generated with a small variance. Tolerance includes two metrics: change in mean integration error and change in parameters, as the square root of the sum of the squared differences. When a parameter constraint is encountered, the node and weight of the quadrature rule is recalculated. An advantage of CAGH over multidimensional adaptive quadrature is that CAGH may be applied in large dimensions. Disadvantages of CAGH are that only variance, not covariance, is estimated, and ignoring covariance may be problematic. \subsection{Laplace Approximation} \label{laplaceapproximation} The Laplace Approximation or Laplace Method is a family of asymptotic techniques used to approximate integrals. Laplace's method seems to accurately approximate unimodal posterior moments and marginal posterior distributions in many cases. Since it is not applicable in all cases, it is recommended here that Laplace Approximation is used cautiously in its own right, or preferably, it is used before MCMC. After introducing the Laplace Approximation \citep[p. 366--367]{laplace74}, a proof was published later \citep{laplace14} as part of a mathematical system of inductive reasoning based on probability. Laplace used this method to approximate posterior moments. Since its introduction, the Laplace Approximation has been applied successfully in many disciplines. In the 1980s, the Laplace Approximation experienced renewed interest, especially in statistics, and some improvements in its implementation were introduced \citep{tierney86, tierney89}. Only since the 1980s has the Laplace Approximation been seriously considered by statisticians in practical applications. There are many variations of Laplace Approximation, with an effort toward replacing Markov chain Monte Carlo (MCMC) algorithms as the dominant form of numerical approximation in Bayesian inference. The run-time of Laplace Approximation is a little longer than Maximum Likelihood Estimation (MLE), usually shorter than variational Bayes, and much shorter than MCMC \citep{azevedo94}. The speed of Laplace Approximation depends on the optimization algorithm selected, and typically involves many evaluations of the objective function per iteration (where an MCMC algorithm with a multivariate proposal usually evaluates once per iteration), making many MCMC algorithms faster per iteration. The attractiveness of Laplace Approximation is that it typically improves the objective function better than iterative quadrature, MCMC, and PMC when the parameters are in low-probability regions. Laplace Approximation is also typically faster than MCMC and PMC because it is seeking point-estimates, rather than attempting to represent the target distribution with enough simulation draws. Laplace Approximation extends MLE, but shares similar limitations, such as its asymptotic nature with respect to sample size and that marginal posterior distributions are Gaussian. \citet{bernardo00} note that Laplace Approximation is an attractive family of numerical approximation algorithms, and will continue to develop. \code{LaplaceApproximation} seeks a global maximum of the logarithm of the unnormalized joint posterior density. The approach differs by \code{Method}. The \code{LaplacesDemon} function uses the \code{LaplaceApproximation} algorithm to optimize initial values and save time for the user. Most optimization algorithms assume that the logarithm of the unnormalized joint posterior density is defined and differentiable\footnote{When the joint posterior is not differentiable, and should be, it has probably encountered an area of flat density. It is recommended that WIPs are used for regularization. For more information on WIPs, see the accompanying vignette entitled ``Bayesian Inference''.}. Some methods calculate an approximate gradient for each initial value as the difference in the logarithm of the unnormalized joint posterior density due to a slight increase in the parameter. The user may select from numerous optimization algorithms: \subsubsection{Adaptive Gradient Ascent} \label{aga} With adaptive gradient ascent, the direction and distance for each parameter is proposed based on an approximate truncated graident and an adaptive step size. The step size parameter, which is often plural and called rate parameters in other literature, is adapted each iteration with the univariate version of the Robbins-Monro stochastic approximation in \citet{garthwaite10}. The step size shrinks when a proposal is rejected and expands when a proposal is accepted. Gradient ascent is criticized for sometimes being relatively slow when close to the maximum, and its asymptotic rate of convergence is inferior to other methods. However, compared to other popular optimization algorithms such as Newton-Raphson, an advantage of the gradient ascent is that it works in infinite dimensions, requiring only sufficient computer memory. Although Newton-Raphson converges in fewer iterations, calculating the inverse of the negative Hessian matrix of second-derivatives is more computationally expensive and subject to singularities. Therefore, gradient ascent takes longer to converge, but is more generalizable. \subsubsection{BFGS} \label{bfgs} The Broyden-Fletcher-Goldfarb-Shanno (BFGS) algorithm was proposed independently by \citet{broyden70}, \citet{fletcher70}, \citet{goldfarb70}, and \citet{shanno70}. BFGS may be the most efficient and popular quasi-Newton optimiziation algorithm. As a quasi-Newton algorithm, the Hessian matrix is approximated using rank-one updates specified by (approximate) gradient evaluations. Since BFGS is very popular, there are many variations of it. This is a version by Nash that has been adapted from the Rvmmin package, and is used in the \code{optim} function of base R. The approximate Hessian is not guaranteed to converge to the Hessian. When BFGS is used, the approximate Hessian is not used to calculate the final covariance matrix. \subsubsection{BHHH} \label{bhhh} The BHHH algorithm of \citet{berndt74} is a quasi-Newton method that includes a step-size parameter, partial derivatives, and an approximation of a covariance matrix that is calculated as the inverse of the sum of the outer product of the gradient (OPG), calculated from each record. The OPG method becomes more costly with data sets with more records. Since partial derivatives must be calculated per record of data, the list of data has special requirements with this method, and must include design matrix \textbf{X}, and dependent variable \textbf{y} or \textbf{Y}. Records must be row-wise. An advantage of BHHH over NR (see below) is that the covariance matrix is necessarily positive definite, and gauranteed to provide an increase in LP each iteration (given a small enough step-size), even in convex areas. The covariance matrix is better approximated with larger data sample sizes, and when closer to the maximum of LP. Disadvantages of BHHH include that it can give small increases in LP, especially when far from the maximum or when LP is highly non-quadratic. \subsubsection{Conjugate Gradient} \label{cg} Conjugate gradient (CG) is a family of algorithms that uses partial derivatives, but does not use the Hessian matrix or any approximation of it. CG usually requires more iterations to reach convergence than other algorithms that use the Hessian or an approximation. However, since the Hessian becomes computationally expensive as the dimension of the model grows, CG is applicable to large dimensional models. CG was originally developed by \citet{hestenes52}. The version here is a nonlinear CG method. \subsubsection{Davidon-Fletcher-Powell} \label{dfp} The Davidon-Fletcher-Powell (DFP) algorithm was the first popular, multidimensional, quasi-Newton optimization algorithm. The DFP update of an approximate Hessian matrix maintains symmetry and positive-definiteness. The approximate Hessian is not guaranteed to converge to the Hessian. When DFP is used, the approximate Hessian is not used to calculate the final covariance matrix. Although DFP is very effective, it was superseded by the BFGS algorithm. \subsubsection{Hit-And-Run} \label{har} This version of the Hit-And-Run (HAR) algorithm makes multivariate proposals and uses an adpative length parameter. The length parameter is adapted each iteration with the univariate version of the Robbins-Monro stochastic approximation in \citet{garthwaite10}. The length shrinks when a proposal is rejected and expands when a proposal is accepted. This is the same algorithm as the HARM or Hit-And-Run Metropolis MCMC algorithm with adaptive length, except that a Metropolis step is not used. \subsubsection{Hooke-Jeeves} \label{hj} The Hooke-Jeeves algorithm \citep{hooke61} is a derivative-free, direct search method. Each iteration involves two steps: an exploratory move and a pattern move. The exploratory move explores local behavior, and the pattern move takes advantage of pattern direction. It is sometimes described as a hill-climbing algorithm. If the solution improves, it accepts the move, and otherwise rejects it. Step size decreases with each iteration. The decreasing step size can trap it in local maxima, where it gets stuck and convergences erroneously. Users are encouraged to attempt again after what seems to be convergence, starting from the latest point. Although getting stuck at local maxima can be problematic, the Hooke-Jeeves algorithm is also attractive because it is simple, fast, does not depend on derivatives, and is otherwise relatively robust. \subsubsection{Levenberg-Marquardt} \label{levenberg} Also known as the Levenberg-Marquardt Algorithm (LMA) or the Damped Least-Squares (DLS) method, Levenberg-Marquardt (LM) is a trust region (not to be confused with TR below) optimization algorithm that minimizes nonlinear least squares, and has been adapted here to maximize LP. LM uses partial derivatives and approximates the Hessian with outer-products. It is suitable for nonlinear optimization up to a few hundred parameters, but loses its efficiency in larger problems due to matrix inversion. LM is considered between the Gauss-Newton algorithm and gradient descent. When far from the solution, LM moves slowly like gradient descent, but is guaranteed to converge. When LM is close to the solution, LM becomes a damped Gauss-Newton method. \subsubsection{Limited-Memory BFGS} \label{lmbfgs} The limited-memory BFGS (Broyden-Fletcher-Goldfarb-Shanno) algorithm is a quasi-Newton optimization algorithm that compactly approximates the Hessian matrix. Rather than storing the dense Hessian matrix, L-BFGS stores only a few vectors that represent the approximation. This algorithm is better suited for large-scale models than the BFGS algorithm. When (\code{method="LBFGS"}) for \code{LaplaceApproximation}, \code{method="L-BFGS-B"} is called in the \code{optim} function of base \proglang{R}. \subsubsection{Nelder-Mead} \label{nm} The Nelder-Mead algorithm \citep{nelder65} is a derivative-free, direct search method that is known to become inefficient in large-dimensional problems. As the dimension increases, the search direction becomes increasingly orthogonal to the steepest ascent (usually descent) direction. However, in smaller dimensions it is a popular algorithm. At each iteration, three steps are taken to improve a simplex: reflection, extension, and contraction. \subsubsection{Newton-Raphson} \label{nr} The Newton-Raphson optimization algorithm, also known as Newton's Method, uses derivatives and a Hessian matrix. The algorithm is included for its historical significance, but is known to be problematic when starting values are far from the targets, and calculating and inverting the Hessian matrix can be computationally expensive. As programmed here, when the Hessian is problematic, it tries to use only the derivatives, and when that fails, a jitter is applied. Newton-Raphson should not be the first choice of the user, and BFGS should always be preferred. \subsubsection{Particle Swarm Optimization} \label{pso} Of numerous Particle Swarm Optimization (PSO) algorithms, the Standard Particle Swarm Optimization 2007 (SPSO 07) algorithm is used here. A swarm of particles is moved according to velocity, neighborhood, and the best previous solution. The neighborhood for each particle is a set of informing particles. PSO is derivative-free. \subsubsection{Resilient Backpropagation} \label{resilientbackprop} ``Rprop'' stands for resilient backpropagation. In Rprop, the approximate gradient is taken for each parameter in each iteration, and its sign is compared to the approximate gradient in the previous iteration. A weight element in a weight vector is associated with each approximate gradient. A weight element is multiplied by 1.2 when the sign does not change, or by 0.5 if the sign changes. The weight vector is the step size, and is constrained to the interval [0.001, 50], and initial weights are 0.0125. This is the resilient backpropagation algorithm, which is often denoted as the ``Rprop-'' algorithm of \citet{riedmiller94}. \subsubsection{Self-Organizing Migration Algorithm} \label{soma} The Self-Organizing Migration Algorithm (SOMA) of \citet{zelinka04}, as used here, moves a population of ten particles or individuals in the direction of the best particle, the leader. The leader does not move in each iteration, and a line-search is used for each non-leader, up to three times the difference in parameter values between each non-leader and leader. This algorithm is derivative-free and often considered in the family of evolution algorithms. Numerous model evaluations are performed per non-leader per iteration. \subsubsection{Spectral Projected Gradient} \label{spg} The Spectral Projected Gradient (SPG) algorithm is a non-monotone algorithm that is suitable for high-dimensional models. The approximate gradient is used, but the Hessian matrix is not. SPG is the default algorithm for the \code{LaplaceApproximation} function. \subsubsection{Stochastic Gradient Descent} \label{sgd} The stochastic gradient descent (SGD) algorithm, here, is designed only for big data. Traditional optimization algorithms require the entire data set to be included in the model evaluation each iteration. In contrast, SGD reads and processes only a small, randomly selected batch of records each iteration. In addition to saving computation time, the entire data set does not need to be loaded into memory at once. In this version of SGD, a multivariate proposal is used, and it is merely the vector of current values plus a step size times the gradient. SGD requires five objects in the \code{Data} list: \code{epsilon} or $\epsilon$ is the step size as a scalar, \code{file} is a quoted name of a .csv file that is the big data set, \code{Nr} is the number of rows in the big data set, \code{Nc} is the number of columns in the big data set, and \code{size} is the number of rows to be read and processed each iteration. Since SGD, as implemented here, is designed for big data, the entire data set is not included in the \code{Data} list, but one small batch must be included and named \code{X}. All data must be included. For example, both the dependent variable \textbf{y} and design matrix \textbf{X} in linear regression are included. The requirement for the small batch to be in \code{Data} is so that numerous checks may be passed after \code{LaplaceApproximation} is called and before the SGD algorithm begins. Each iteration, SGD uses the \code{scan} function, without headers, to read a random block of rows from, say, \code{X.csv}, stores it in \code{Data$X}, and passes it to the \code{Model} specification function. The \code{Model} function must differ from the other examples found in this package in that multiple objects, such as \code{X} and \code{y} must be read from \code{Data$X}, where usually there is both \code{Data$X} and \code{Data$y}. The user tunes SGD with step size $\epsilon$ via \code{Data$epsilon}. The step size must be scalar and remain in the interval (0,1). When $\epsilon = 0$, SGD is reduced to zero, the algorithm will not move, and false convergence occurs. When $\epsilon$ is too large, degenerate results occur. A good recommendation seems to be to begin with $\epsilon$ set to \code{1/Nr}. The user may perform several short runs, and experimenting with adjusting \code{Data$epsilon}. At least \code{Nr / size} iterations are suggested. \subsubsection{Symmetric Rank-One} \label{srone} The Symmetric Rank-One (SR1) algorithm is a quasi-Newton optimization algorithm, and the Hessian matrix is approximated, often without being positive-definite. At the posterior modes, the true Hessian is usually positive-definite, but this is often not the case during optimization when the parameters have not yet reached the posterior modes. Other restrictions, including constraints, often result in the true Hessian being indefinite at the solution. For these reasons, SR1 often outperforms BFGS. The approximate Hessian is not guaranteed to converge to the Hessian. When SR1 is used, the approximate Hessian is not used to calculate the final covariance matrix. \subsubsection{Trust Region} \label{trust} The Trust Region (TR) algorithm of \citet{nocedal99} attempts to reach its objective in the fewest number of iterations, is therefore very efficient, as well as safe. The efficiency of TR is attractive when model evaluations are expensive.The Hessian is approximated each iteration, making TR best suited to models with small to medium dimensions, say up to a few hundred parameters. \subsubsection{Afterward} \label{afterward1} After \code{LaplaceApproximation} finishes, due either to early convergence or completing the number of specified iterations, it approximates the Hessian matrix of second derivatives (by default, but the user has other options), and attempts to calculate the covariance matrix by taking the inverse of the negative of this matrix. If successful, then this covariance matrix may be passed to \code{IterativeQuadrature}, \code{LaplacesDemon}, or \code{PMC}, and the diagonal of this matrix is the variance of the parameters. If unsuccessful, then a scaled identity matrix is returned, and each parameter's variance will be 1. \subsection{Markov Chain Monte Carlo} \label{mcmc} Markov chain Monte Carlo (MCMC) algorithms are also called samplers. There are a large number of MCMC algorithms, too many to review here. Popular families (which are often non-distinct) include Gibbs sampling, Metropolis-Hastings, slice sampling, Hamiltonian Monte Carlo, and many others. Though the name is misleading, Metropolis-within-Gibbs (MWG) was developed first \citep{metropolis53}, and Metropolis-Hastings was a generalization of MWG \citep{hastings70}. All MCMC algorithms are known as special cases of the Metropolis-Hastings algorithm. Regardless of the algorithm, the goal in Bayesian inference is to maximize the unnormalized joint posterior distribution and collect samples of the target distributions, which are marginal posterior distributions, later to be used for inference. The most generalizable MCMC algorithm is the Metropolis-Hastings (MH) generalization of the MWG algorithm. The MH algorithm extended MWG to include asymmetric proposal distributions. For years, the main disadvantage of the MWG algorithms was that the proposal variance (see below) had to be tuned manually, and therefore other MCMC algorithms have become popular because they do not need to be tuned. Gibbs sampling became popular for Bayesian inference, though it requires conditional sampling of conjugate distributions, so it is precluded from non-conjugate sampling in its purest form. Gibbs sampling also suffers under high correlations \citep{gilks96}. Due to these limitations, Gibbs sampling is less generalizable than RWM, though RWM and other algorithms are not immune to problems with correlation. The Griddy-Gibbs sampler evaluates a grid of proposals and approximates the conditional distribution, which enables non-conjugate sampling. Componentwise slice sampling is a special case of Gibbs sampling that samples a distribution by sampling uniformly from the region under the plot of its density function, and is more appropriate with bounded distributions that cannot approach infinity, though the improved slice sampler of \citet{neal03} is available here. \subsubsection{Blockwise Sampling} \label{block} Usually, there is more than one target distribution, in which case it must be determined whether it is best to sample from target distributions individually, in groups, or all at once. Block updating refers to splitting a multivariate vector into groups called blocks, and each block is sampled separately. A block may contain one or more parameters. Parameters are usually grouped into blocks such that parameters within a block are as correlated as possible, and parameters between blocks are as independent as possible. This strategy retains as much of the parameter correlation as possible for blockwise sampling, as opposed to componentwise sampling where parameter correlation is ignored. The \code{PosteriorChecks} function can be used on the output of previous runs to find highly correlated parameters, and the \code{Blocks} function may be used to create blocks based on posterior correlation. Advantages of blockwise sampling are that a different MCMC algorithm may be used for each block (or parameter, for that matter), creating a more specialized approach (though different algorithms by block are not supported here), the acceptance of a newly proposed state is likely to be higher than sampling from all target distributions at once in high dimensions, and large proposal covariance matrices can be reduced in size, which is most helpful again in high dimensions. Disadvantages of blockwise sampling are that correlations probably exist between parameters between blocks, and each block is updated while holding the other blocks constant, ignoring these correlations of parameters between blocks. Without simultaneously taking everything into account, the algorithm may converge slowly or never arrive at the proper solution. However, there are instances when it may be best when everything is not taken into account at once, such as in state-space models. Also, as the number of blocks increases, more computation is required, which slows the algorithm. In general, blockwise sampling allows a more specialized approach at the expense of accuracy, generalization, and speed. Blockwise sampling is offered in the following algorithms: Adaptive Metropolis-within-Gibbs (AMWG), Adaptive-Mixture Metropolis (AMM), Automated Factor Slice Sampler (AFSS), Elliptical Slice Sampler (ESS), Hit-And-Run Metropolis (HARM), Metropolis-within-Gibbs (MWG), Random-Walk Metropolis (RWM), Robust Adaptive Metropolis (RAM), and the Univariate Eigenvector Slice Sampler (UESS). \subsubsection{Markov Chain Properties} \label{markovchainproperties} This tutorial introduces only briefly the basics of Markov chain properties. A Markov chain is Markovian when the current iteration depends only on the previous iteration. Many (but not all) adaptive algorithms are merely chains but not Markov chains when the adaptation is based on the history of the chains, not just the previous iteration. A Markov chain is said to be aperiodic when it is not repeating a cycle. A Markov chain is considered irreducible when it is possible to go from any state to any other state, though not necessarily in one iteration. A Markov chain is said to be recurrent if it will eventually return to a given state with probability 1, and it is positive recurrent if the expected return time is finite, and null recurrent otherwise. The ergodic theorem states that a Markov chain is ergodic when it is aperiodic, irreducible, and positive recurrent. The non-Markovian chains of an adaptive algorithm that adapt based on the history of the chains should have two conditions: containment and diminishing adaptation. Containment is difficult to implement and is not currently programmed into \pkg{LaplacesDemon}. The condition of diminishing adaptation is fulfilled when the amount of adaptation diminishes with the length of the chain. Diminishing adaptation can be achieved when the proposal variances become smaller or by decreasing the probability of performing adaptations with more iterations \citep{roberts07}. Trace-plots of the output of the \code{LaplacesDemon} function automatically include plots of the absolute differences in proposal variance with each adaptation for adaptive algorithms, and the \code{Consort} function will try to suggest a different adaptive algorithm when these absolute differences are not trending downward. Descriptions of the MCMC algorithms in the \pkg{LaplacesDemon} package are available online at \url{https://web.archive.org/web/20150227012508/http://www.bayesian-inference.com/mcmc}. \subsubsection{Sampler Selection} \label{samplerselection} The optimal sampler differs for each problem, and it is recommended that the \code{Juxtapose} function is used to help select the least inefficient MCMC algorithm. Nonetheless, some general observations here may be helpful to a user attempting to select the most appropriate sampler for a given model. Suggestions in this section have been reached by attempting to compare all samplers on most models in the accompanying ``Examples'' vignette. Comparisons consisted of \begin{itemize} \item diminishing adaptation, if applicable \item how many iterations it took the sampler to seem to converge \item how many minutes it took the sampler to seem to converge \item how quickly the sampler improved in the beginning \item \code{Juxtapose} results based on integrated autocorrelation time (\code{IAT}) \item mixing of the chains \item whether or not the sampler arrived at the correct solution \end{itemize} When the user is ready to select a general-purpose sampler, the best place to begin is with the AFSS algorithm. This is not to say that AFSS is the best sampler and everything else pales by comparison. Instead, AFSS is a great sampler with which to start in the general case, and for beginners. Although AFSS has several algorithm specifications, the default specifications are suitable for many cases. A new user should not begin to learn AFSS and this package with a complicated and high-dimensional model. When this is necessary, the user of AFSS will need to learn how to create blocks of parameters and a list of proposal covariance matrices. In smaller cases, more suitable to learning, the user should not generally have to adjust the \code{m} or \code{w} specifications, and need only learn \code{A} and \code{n}. A new user should begin with \code{A=Inf} and \code{n=0}, and use code provided by the \code{Consort} function for the next run. When the user is satified that equilibrium is reached, then another run should be made without adaptation: \code{A=0}. Models with multimodal marginal posterior distributions are potentially troublesome for any numerical approximation algorithm, though MCMC may be better suited in general. It is best to begin either with MCMCMC or RDMH. Alternatives include AFSS, AGG, CHARM, GG, HARM, RAM, Slice, THMC, or t-walk. The MCMCMC and RDMH algorithms have demonstrated remarkable performance with multimodal distributions. The use of parallel chains in MCMCMC increases the chances that different chains may settle on different modes. Parallel chains from other parallelized algorithms may be helpful in finding multiple modes, but when the chains are combined with the \code{Combine} function for inference, each mode probably is not represented in a proportion correct for the distribution. Consider updating the model with PMC, with multiple mixture components, after MCMC is finished. Unlike MCMC with parallel chains, the proportion of each mode will be correctly represented with PMC. Models with discrete parameters currently require either the AGG, GG, or Slice algorithms, or converting the discrete parameters to continuous parameters so that any MCMC algorithm may be used. This is performed via the continuous relaxation of a Markov random field (MRF), as in \citet{zhang12}. For more information, see the \code{dcrmrf} and \code{rcrmrf} functions. Models with big data sets, too big for memory, may use the SGLD algorithm, the \code{BigData} function, or opt for alternative methods suggested in the details of the documentation for the \code{BigData} function. Regardless of the model or algorithm, parallel chains are recommended in general, provided the user has multiple CPUs and enough random-access memory (RAM). However, it is best to begin with a single chain, until the user is confident in the model specification. Parallel chains produce more posterior samples upon convergence than single chains in roughly the same amount of time, and may facilitate the discovery of multimodal marginal posterior distributions that would otherwise have been overlooked. Although algorithms may update independently in parallel, there are several that learn from other parallel updates, such as AIES and INCA. The \code{Demonic Suggestion} section of output from the \code{Consort} function also attempts to help the user to select a sampler. There are exceptions to each of these suggestions above. In some cases, a particular algorithm will fail to update for a given example. Hopefully this section assists the user in selecting a sampler. \subsubsection{Afterward} \label{afterward} Once the model is updated with the \code{LaplacesDemon} function, the \code{BMK.Diagnostic} function is applied to 10 batches of the thinned samples to assess stationarity (or lack of trend). When all parameters are estimated as stationary beyond a given iteration, the previous iterations are suggested to be considered as burn-in and discarded. The importance of Monte Carlo Standard Error (MCSE) is debated \citep{gelman04,jones06}. It is included in posterior summaries of \code{LaplacesDemon}, and is one of five main criteria as a stopping rule to appease Laplace's Demon. MCSE has been shown to be a better stopping rule than MCMC diagnostics \citep{jones06}. \pkg{LaplacesDemon} provides a \code{MCSE} function that allows three methods of estimation: sample variance, batch means \citep{jones06}, and Geyer's method \citep{geyer92}. The user is encouraged to explore MCMC diagnostics (also called convergence diagnostics). The \pkg{LaplacesDemon} package offers \code{AcceptanceRate}, the \code{BMK.Diagnostic}, a Cumulative Sample Function (\code{CSF}), Effective Sample Size (\code{ESS}), \code{Gelfand.Diagnostic}, \code{Gelman.Diagnostic}, \code{Geweke.Diagnostic}, \code{Heidelberger.Diagnostic}, Integrated Autocorrelation Time (\code{IAT}), the Kolmogorov-Smirnov test (\code{KS.Diagnostic}), Monte Carlo Standard Error (\code{MCSE}), \code{Raftery.Diagnostic}, and both the \code{plot} and \code{PosteriorChecks} functions include multiple diagnostics. \subsection{Variational Bayes} \label{variationalbayes} Variational Bayes (VB) is a family of numerical approximation algorithms that is a subset of variational inference algorithms, or variational methods. Some examples of variational methods include the mean-field approximation, loopy belief propagation, tree-reweighted belief propagation, and expectation propagation (EP). Variational inference for probabilistic models was introduced in the field of machine learning, influenced by statistical physics literature. A VB algorithm deterministically estimates the marginal posterior distributions (target distributions) in a Bayesian model with approximated distributions by minimizing the Kullback-Leibler Divergence (\code{KLD}) between the target and its approximation. The complicated posterior distribution is approximated with a simpler distribution. The simpler, approximated distribution is called the variational approximation, or approximation distribution, of the posterior. The term variational is derived from the calculus of variations, and regards optimization algorithms that select the best function (which is a distribution in VB), rather than merely selecting the best parameters. VB algorithms often use Gaussian distributions as approximating distributions. In this case, both the mean and variance of the parameters are estimated. Usually, a VB algorithm is slower to convergence than a Laplace Approximation algorithm, and faster to convergence than a Monte Carlo algorithm such as Markov chain Monte Carlo (MCMC). VB often provides solutions with comparable accuracy to MCMC in less time. Though Monte Carlo algorithms provide a numerical approximation to the exact posterior using a set of samples, VB provides a locally-optimal, exact analytical solution to an approximation of the posterior. VB is often more applicable than MCMC to big data or large-dimensional models. Since VB is deterministic, it is asymptotic and subject to the same limitations with respect to sample size as Laplace Approximation. However, VB estimates more parameters than Laplace Approximation, such as when Laplace Approximation optimizes the posterior mode of a Gaussian distribution, while VB optimizes both the Gaussian mean and variance. Traditionally, VB algorithms required customized equations. The \code{VariationalBayes} function uses general-purpose algorithms. A general-purpose VB algorithm is less efficient than an algorithm custom designed for the model form. However, a general-purpose algorithm is applied consistently and easily to numerous model forms. \subsubsection{Salimans2} The \code{Salimans2} algorithm is the second algorithm of \citet{salimans13} is used. This requires the gradient and Hessian, which is more efficient with a small number of parameters as long as the posterior is twice differentiable. The step size is constant. This algorithm is suitable for marginal posterior distributions that are Gaussian and unimodal. A stochastic approximation algorithm is used in the context of fixed-form VB, inspired by considering fixed-form VB to be equivalent to performing a linear regression with the sufficient statistics of the approximation as independent variables and the unnormalized logarithm of the joint posterior density as the dependent variable. The number of requested iterations should be large, since the step-size decreases for larger requested iterations, and a small step-size will eventually converge. A large number of requested iterations results in a smaller step-size and better convergence properties, so hope for early convergence. However convergence is checked only in the last half of the iterations after the algorithm begins to average the mean and variance from the samples of the stochastic approximation. The history of stochastic samples is returned. \section{Bayesian-Inference.com} \label{bayesianinferencecom} Many additional resources may be found at \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index}, as well as other places online: \begin{itemize} %\item A Bayesian forum is available at \url{http://www.bayesian-inference.com/forum} to discuss all things Bayesian, including \pkg{LaplacesDemon}. \item Bayesian information is being compiled under \url{https://web.archive.org/web/20150206004608/http://www.bayesian-inference.com/bayesian}. %\item Bayesian news is aggregated daily as ``The Bayesian Bulletin'': \url{http://www.bayesian-inference.com/newsbayesian}. %\item Consulting services are available here: \url{http://www.bayesian-inference.com/consulting}. \item C++ examples of model functions: \url{https://web.archive.org/web/20140513065103/http://www.bayesian-inference.com/cpp/LaplacesDemonExamples.txt}. \item MCMC algorithms are described at \url{https://web.archive.org/web/20150430054005/http://www.bayesian-inference.com/mcmc}. \item Merchandise may be found at \url{http://www.zazzle.com/statisticat}, such as \pkg{LaplacesDemon} t-shirts, coffee mugs, and more. \item \pkg{LaplacesDemon} and \pkg{LaplacesDemonCpp} development is public and occurs at \url{https://github.com/LaplacesDemonR/LaplacesDemon} and \url{https://github.com/LaplacesDemonR/LaplacesDemonCpp}, respectively. %\item \pkg{LaplacesDemon} screencasts are available at \url{http://www.bayesian-inference.com/softwarescreencasts}. %\item \pkg{LaplacesDemon} updates are announced at \url{https://plus.google.com/+Bayesian-inference}. %\item Opinion polls for Bayesian inference and \pkg{LaplacesDemon} are here: \url{http://www.bayesian-inference.com/polls}. %\item Technical support services are available at \url{http://www.bayesian-inference.com/support}. \item And, the home of \pkg{LaplacesDemon} is \url{https://web.archive.org/web/20150430054143/http://www.bayesian-inference.com/software}. \end{itemize} \section{Conclusion} \label{conclusion} The \pkg{LaplacesDemon} package is a significant contribution toward Bayesian inference in \proglang{R}. In turn, contributions toward the development of \pkg{LaplacesDemon} are welcome. Please visit \url{https://github.com/LaplacesDemonR} to contribute to development or report software bugs by opening an issue. \bibliography{References} \end{document} LaplacesDemon/inst/doc/BayesianInference.pdf0000644000176200001440000077010015145054161020557 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4820 /Filter /FlateDecode /N 87 /First 738 >> stream x\[sȶ~?BogvB}횢$0$\N82oulٲ.Gԭ^}uK*.)W-tp0>*R+6,PxFz]]h)qo mh+(`k]H^X.LV8[HYX%:+sYaw4tq@dD(1L8 #76i\;.'0i\0iL4bxZ -i޼,4 K'14d h~ G Kki.p18+d7d%/P( *8JY9zs$dpkY c- "gZ - 0D'-Q3`4\ EX40!JK [TI̛d@wG\dg05QG=D\\( o0=̃-M@\"H>r~`'ռwћӂ=d\?==΋jV`tECu2 zV-jc Ryb4Pܿ{}p3L`9ƹpVkusPyZۣ޼*~:䒄Ɓ8_#?>:MO'ӋYO$|".('\l??׸mt8_ߖy:j8Nb@ۦtrqӯ0_/'?^!%73g7'\GU=! !„<'79i$tYY%fg*Ic7s#]T*WsU99rS?@sGEnӐ$,eD$%@Ǔ9M=S ԫNtPiD:5 $(&A1 IɣσcCMH&(6ADyOϫ1Ƨ3P;FL`M0eVzO3EZVʹ颹zilN~iM\?^=lWH{ݿߜּJL,)AA5P1(Q=(co'u 67"\ǿ7dtKzYِF슍> _3qMplf_h6~bs6V>W  9qѨa; =X+csqRbᨂ'b,zֻ: a,d8A "sFټ .noC<J4A1fUd)-y<8{yvD#d`<. I8a#DK4vѴ[DSA,Od !?>X7 ̦_lcúhY!hqzX>iU}jk8ݲ.:nWD爽e/Dc! XC-8654JCm:wpӮLIU<ifknVm3׮-̫Uёه0,0qe<<ޣ .̐x3F!teZL-XGAMmRdztNM0L)8<#"Jh@ƥ>+nqt/4qr= q8)u!@g:f_A^xQl5O̺>A6}#c'dRw+|gixFcg[5q)~$z>' B 83tJHrY;\;۪ v|7 O5MU:.X zZeY9Zfc0rrrMy -ڭ"+"nu\G[2"dl#QSc)R{\/&H8BXjbbׄK};If7fBUjiceW!߮X(CyXH`gPݟW=SK*dՂF&LAN~n=[tvU\HdzQMs#Zx# ZS"߁D5/7= |HZx]J"ʒqK !C_J( :1yVR%0gs21W2:9 U)ə/B97sG}jKv6{gvWnTkg;m҈>ƑvMaB6? nB^J!AcV4HOQZ,A $k^HΫ}Mk[h NjZutUݻk[㜎_FōFVQ]y=e4rY00oeȂ[~HrE>|;tқ_&3u.mwNK7\yv+olSE:ו+K:6.G.k#.Q!YO!8҂tQ@K>"SLn:iG21>_OFԬ5۫;iԡ]{`oy䌮Gt&~z^A k/UL[ƭZgV>)|맜DJ+ (13ofz:L)iby6 *XPXz A2Lح*-[ Y[oWsewV^[G{*{Y;/  w'_=Mڬn[Z\nQgf m)M_DJjIJ/u:S.yKZ92OYG(O5𑤐@-TL8OQIlMuq-#sK{YX9B׀C>í\s:L]F|/IM7kݺrus#˰w~و_[V!7m`)]¶sfQ_xo+ݷjQ戺-Ү-j?o;h6}˕1_㰊aƀ$mO9m.Rh;ImG`+\oNy6D@׺h~FBlj'go^۳xɜlc5zŮm>m'P-e+I6N֫ɛ隡 -}dޤc^jP6& ҴPJI '%Jnebe{j޷$ԓ|iŞiJErs򌜑 y^rZ\F{qm[>~jBVjԜ(&Ͳ+ uli|IKI{&IiKZk[ gxi蝀CUidp6$ƗBq*k- 7aUiT9JJ_}6QUYWr'9CZ#'.i9RVjf2rƣ=`2鵛"MXnܔn÷@nӺ-ZRW^z{PZ.hX/'M ׬5ܵ;xu!k[]n9E͂>e%e?zL?#F݆Hl;`0J Xw\|%vtOi_3S:/{%FLLrD*p<;l~U'Wl6?"$+7/V"(4;-cEPL!Л+?F\!3T-$y#; u8>?N#J4($= ;(>nɱ `?2p^/򛞴 88Ft=4I/{dۄޢ/f"nM^HfIb3eQou̢3Iy^o{-['$fn`GL6 擂DjޣW+TxuCqF͆z]_\P xi }'y^$endstream endobj 89 0 obj << /Subtype /XML /Type /Metadata /Length 1720 >> stream GPL Ghostscript 10.05.1 bayesian, laplacesdemon, laplacesdemoncpp, r 2026-02-17T12:00:49Z 2026-02-17T12:00:49Z 2026-02-17T12:00:49Z LaTeX with hyperref Bayesian InferenceStatisticat LLC endstream endobj 90 0 obj << /Type /ObjStm /Length 3248 /Filter /FlateDecode /N 87 /First 792 >> stream x[[o}c\qCNEYT^uC΅:\&-H$<A&d%'^ƊVQh 蔄謕GQZ NH|`qb1;N|yTppB1MZ c#$ \&1$ :8amnzǏa#QF`6$KarWo&P)#Š1CZDiiP&#b 91%!NsK. -B)1Č9Rڱ@(p#  ]_R [=gY?V^3XRY ódMg%AZ"{/ g-$~""zȌdLaqФ3̸gLQk_>L,Z,n6[6%,|;j6>!x֡{Ci#)Aϻ7Mm/^-o: tyj{Չ.K9)a!p4 R}+&P@{4v >|*vȡN#>Oྺ~Qi ;|;9i{}S 4pуd rT&ҕ>?T^o>9=Vg[O.kMΔU/ &"d¿Hǡ;Qq`s\Z12x{̙ Ʈ[i:&›-y 9sQdQq4Wxx|Ƽs2$^y(+ϛXfJ'OxdR /PC/Ӹ+e\b#[ɳ(>I$4w8ǡ R97Ca(2;)1t9R9%n41O#h.8;E_]rH{7:> NXk}`;Nn{<3띾 iS4m ٴ nUj*1)lt> m /KB&~sJq虻Z6F=pp=OnCKK >vݴ9&yYS(٧i42XiHX\F\ɟT~Iu,3ɉ\_UI:5$eفx/vY\HfYD kA GZ)*bY$>ٚ/m}a\7Y$;)fn+<<;Iaa8qc f<iֆAȘډ%Sgs(pهf ?CKH)6 VM}.^}٫&9V2s6}ݹv*V!琒 N<Ut6IRvqgqrxG Z&kڐ^xyфg,V *t`A]Q7m! e^ ć6=/B&ZΏ=A<-%jf$B1`m'xt2ͭ{順P7hBͷkns`13LQT6{+iZbn8M=Σ.G*GS}f3Gy]Oxgf޼g}s}}EwS?Djgd:/Н7C3<\:INu 9W.koЋ\#5ǯ# ($Wp`Q,hˬ~<\mkOVs~_#,G74J)IeVQG w-ɆH;xwEgV݄9_WWMen|dp\L2ײGRZr}\e;T\AO H}\p5=6$oyl-GdCJwQ#E/r ){p>Io}Uդ ]dI 0!S( ;/ǻzըmLN,푝D~F8pyK5< 5}m5]=;n3򆭣#/CaZX%.uPfD4g"3k8 #|<BBC<6$sxEd0HcP~GŦI[ m^g[ s;Gͩ;/rs]puY%Rhѕ/PeR؏7Z,aݢ.nu1L52(fqD\DiL@:XK,ShQǡYD^`kgA-,s#JoDZq;oLρQRpՊ} QF5ן[(cR[Du qf5qh jTЎF+T l :"xu).|D/>D[\p  O7M`)0ܯ:05ϭD.7]N^~ӳxyvn~ֽ[i7W[qbYo_%?Y^zW܉7Id4X0`~=W_89qJX)DrDr¢ds*sN=-\[e~]<[X,nqxX/eO? G?ŧ} y7竫.o}|&o˫W\\m6X&Smy[?)Z1UG:_Q}w|>)^pendstream endobj 178 0 obj << /Type /ObjStm /Length 3916 /Filter /FlateDecode /N 87 /First 816 >> stream x[r7}߯cR[o[TY;Gr)? EjI*4 EZt)r.@wtG?pLb65ΆIᨢeRk <&3E`܅T03MMȈfifFJ .4=̨T1cE HO"j`V #$Y\bH9\fc))p3x朗 Aye=zJ,%cH ͂7A)c:c&= NPLj)"**%Xԩ,*bQ*,ZaсKcTa@!JaBZqe=oВI)Љy `2b&TP)P+@c@]\ PҢ@T!Q[M7H\zS БfR@J-0,0>T>LT>@meч)U6ɤ7<3 DS/iAl#LSG=>tޡhhb gUw1~8NtˆEN?h Q0.|`u9 ,>&q0jɧrZ%Hx;h>z~=.?TeDp~OCΤ:tć's>H3a[|lZp{CE>>9χTOT&m ~*ȯWgtKgtKggyt'lqK'&i2&i2&i26iOU5qHAy!=2,ÇiP=xU^O^?_ӫrI褺c' od^?^鴺~_5cIMthTiG?{OFp']U?Li ZE6eꀸ۳i"H/>ڭ0̉fnK~u7 2$SLWu7I5$h&՟HIUŧGOƣUe^6m]@v˶ .Eź?xL6eujUYikc Q[m^d5'^xl:LZ-z6>$l4@`q&cp'\œoܡ~‚%ea-JkvyHR[qe4Fk-k<[V㣷LJo;pҟ? -VQ3R$+l?!~ɒJ/QBwYt;n۪Lֱ6.XÙ-`j ]@.Z ;eb[Yb 5hH +eA85wXsCqi8K /?X].E8W)bs ϧ/f 45eM?ܚ- Ҧ R$@`"`$dvwQB56Km$r\Ayv?7moڔ~//vk g%QnÊNRc̚ UA{h }ng+vHr=y'_ WT"7GoHe ^ J- ` ž$eGCe w#3/l vPc("u,,9ߋ:SC`.) Q@FAi ܌6 #neD)f7 ּJ 7xecd`)@}~> &65դ=K+f(q;T|c71rЍLK|PycF :yL⣃|K[xs`6V;M "-V/viK)fEAi{PΤZr×oymjnV\jxoTr+I PUt#>gvt[v\%2qq@y-NmL\:w[UuKw/vqj\8PTnXa7ȓ &_r.)knB4)|FaW{a+O9r]%f3d̜]0[BkNMR8(pr0:iӮ:` &"^XX9d!'KPWE #XU |gD(tܑ/KYRD 1+K5~vS[ʫZW%cm %V9v٤U{զ$),]dbEFQP Z5W@"N0O] \V}3F(lΌ67mMFiG;SP)C@J uVs)tgl"NBAWa4AP. ?8q.Ǖ) 唌=$4:H*Q^]AVu۝4t)͘B$B\ҹ`uЍ^ yg^G5[ԙ0ʄnfgvZۓ/U>m% RUzO2xm̏:ZblE}:sP'/Y; H]Tds[>m,И')O%良>=mw.'oLK#4ZS{kS_bJd7H)-5h{8 K iV) өIya6_4ęPxX=knEUxQ)V@5v koa8O Fk%VeꜲ1Ƅ%.r )gXg6h͈SR_CT)٤hk&5 \6YO{vA̜8b?"x]#FċWYJ;KA)"@ډ|ų GmՍiBvl G6lFLw^XZ{ӱ: ]7)v1,[I> |Iɜ}9ʄR6>\U:s3aœ4ϛ^H؞BZ.ƈe؄K~ݭv Cam -`^*@ XB3,kvwڲi,SLRHAi#FÄӺ~qVE'rjYԞVV"֐>,qDDC2m!-3A Ks}[e}P(ͻZwM88R~ G~ͷK1XW\_w3bӻ8}u/'gzS?j:YQ{WX #é*8+?W~9|^TjثWzW*{--&@shNsgJb@ 寊wH4tX"/.#.թgi9;z &`1ۛҺJ8[M2DduS#F{j,Ttk-p^endstream endobj 266 0 obj << /Type /ObjStm /Length 2716 /Filter /FlateDecode /N 87 /First 799 >> stream x[k_-R|\ q. o-AYOBZc%ο95J2G!yxy߼v1)\ʕdTU xQ{dFaWR6L%pxQZ\[2FÒ˄.Iم)r樼JȮ|p* |`])1UQExw")MK.7YI6X%E v< q aW!EPBЙTkA0AoJ֩dq ?}$+ꨨR$RI|STr 0 rŌ%*ǮIU1i˪JA!r~_a[]}>V;|U1<UꯗWgs^>}f?uטo_t)('N1[Zimhmlmjmnmѷm>~=1A҃w=lۧmmӵ}O\ktsm>v.ߤ+}O>}ۧoqyEaxa@lkAl Z~ a p ,>f=k`TImK8Pf$H7Q BK3o av..Qza}.ϼsVSyȩfFKن{%PFs ֐n&HoI8m1+--pG[ A[l^;Ua95}E*,&W,4w+8ay4 TnUEݨkUbZ۪UIV}'NZEiU m |?k:Z/&iP& 71Bs>qZ! 8t`zCL\%7$dD9s6X_zlUEX(!/F@ gXf4'K8ߒY65sVab׳0q'OA8-6 r7];~7Q9:E(&7w@cB@ ,ϵP@IJ-& 7+ng 2Z,b*T^_9|bsX4~Y,-W틧!0 .Ϻ3O'endstream endobj 354 0 obj << /Type /ObjStm /Length 2955 /Filter /FlateDecode /N 87 /First 803 >> stream x[[o[7~_]9Co@Q &X{׵ӦiskKYIHnbNpndsJ+뼢dPeE72">HIFs⭢h^2+cs $&eth>2@3j8%@J$h"I˨XsGTl4%6aDԊ3HFhEUNY9"LrF^9r ,&&YYy-m(Ϥ$3XbO 'yО Dbf4YYk" MђrHSi`b jcš, hg"e2*9?`0JQ``Zp`oH-_/N奟SNN+a|X\Xc>(&5vҊ5 | *""l kX=%K^~5%5,iZiiZ!C 5Tb0N,ZgIn˔~9Lz9jcw4q?. tE g(n{7+Y񧯓/&IH skgE3+UmN0?/~ՠ[qCےKVБNG:ѕҗ0#fжR]&2+<{relܖTJSJ[J.+_A7퉹Bd9-\ C5Җ8S38KViE"𶀷-mᴍ+PQv3 ূ ~*P\JWU8O-|=ꍛ<>~q?^cϛ .+U^ /^G]0e2e*:NPz&`!_}`wiQ?N> By0o>󮫭.9'мR16ޗMsW!y}QZ{شGَ>u ~h^rE_wl`˛Ibpu`L}_pHIs2;:ǟB9C='ZTM}[4tK)$q OX%Y;;oƟ@Җû,a~A¤& $,e w% K<˥i[)xy=8m1ei9}4}lFE謙r \8ۊş^_K@%RFn]! F-1a#';YŒ*9A J{F]@ͰP(ghuۦ$q<\CT n![8Έ:BcwxP2=IWwZaS9a~͂`7m ún;蔭BNp WNflU@d2OE fS|V_pO<7 84wˉ4mxm:DmiEǷQKJKKۅ:{canVyNPnjɐ4%[MHT$3G18q5eXX^8O|p%к .$Yn8-Hce,^]q jzInzY7vpteh2 'E+i'$r т( 7CKH*i֘*ʩY(5#~S[8 =t .o'K.u!zPN|-yke.U1!}!sSlgVn m;EbaP]!bpi/~V $,ɍ3ꢔ 0O4ԵwvPl A(nR7![.=e[.9Q4v[il-Lڻ8z}7f\.4\ͥ[* &yS͖iWfڐd`>.vy^Yw!$krRχ;I޶:M/77MՓ;I?,R~CSMY3x̶msk3< E( KHR\Qng"UlV;Y*=a4.'If/W~UJPz>F %X =+HSpc.+ 7>ӼGj ;=S1A CPu9ғ cp0Spl+yYH@|*VP~jp]ǃkFqQvQ 1,^JfJV3eڒ#00y)(*ceSA^3,}CI< NsNaivU]gnv^\C9q\E&KlEp 9>uT_RSp%G^ݔ>w qw;HoSa;6؇Oͨȍ-_5n7Zendstream endobj 442 0 obj << /Filter /FlateDecode /Length 5547 >> stream x\Ys9~_ Ѭ)nC_3=m7i!Y"eo@(iIԄ:$2_&M-& loWN77WiS&+"&^LquPfr#T[zqK|*aWo嘮ʇoG%bgZ&y+ƙ}?!Z#Mw^U~wmfw'EN41CppmWpK|HyWM__LM킟8)ak$]s˗R%R*46'kW[%ʵMi<2ˆEܵp%{wP ?I/z/%ZhOX Ϋ퇳M$̑F$HR;U 7[JkAQ  Twޅ6SAҼ3j'k 2U5@X7B<K4G8ܓFO`qP8GKv7Q6#Cm*Hy73ӟZX؉|)?Rwz+F՝wK5硫lqW7%Hzj lp&/?wImሰLA$J}!T*O"=OݪDpF1Zˏյ+ϞZU:h `.>S,xVvF:ч+ S j + XJ:[.840w.@.XbQΗg tO\ eBm1  {@#v z}$B d͓}D#d0B_p %K0NʠXaؑ|ɘsC_J?Fh"m$A+^›ZEov H0*/:6H5wWi/AF"pҪjUe2(Ο S0_]~iWXd~u[r]° Pb%"U4I|Cp !؋=k@ɡlX#} VzOo1+C5lg W mʕ pzC-(tGSݕِ4i"i*@UXar[,]ߤ*e1Pg#/ΐEmXHf$-mZ@|9?Rż`%GCbU%:?Qd۾[aL)J q*>ƃe暎֞*HQʫAv"ȗF "X, 2еW-a]72*;8jϺȂ8E̩ _2/;Uxj=sƣQ$\@9aL`#,!Q/E`FJ*fJ;z2V7+$mو]qJ/ΟTa().lxyO~}B z0` Dp]LiE •6- !,:ѡ.XzZj1B~anWw9.ǫelT,B|x%0@ݪ,dE\%[<~@{ Y%b q,u͑qA a|t48y>5iDөIsA.)?\Rզ73R ԅ= J='+ Q pq ,x7v7V7'U &\,;.En<`X{v/=dUXH 茫nNT (Yf:f1-nL{ԥW7D)I;P oF37or̿ u۶=3v -J\i#7$}qb(Fz)r6/{`]njm"ձ!"ɻBxHA[m7_ '.xbLgha:q>k7ɱ?l2ͪNW4T+}xox;vc>8`q`slzrXs~w2ή 5j]sxX *BpSMMS{PcL턏ԩ /J 拽NFZ6&+BA2kR/1p+ڮL/q"Rajma/d3}m6L하tS+xvA E!L/; l7t. ˞'Z.\̱:q BGI9Wq߇quۓ WY4%]⌓G_:? ([tÃ/zJuҊ! "1 n@Wȕh럤n|Ij;?Ṅ<8FCލeA6+L"{JxW ׈pVpNب809Ljylf:1u=}O&.VxdZvxs{u:j]tmzY6$i$8s Z[ýVԥQ9n Fsʓ3iumThEWh}~Jo_|>lHL"Gwzy Qp{yݕKgöܥo1,TB0#RuLA#" l5W,3݊G EČw7{ %$}V!Rɍ ˓AT8`(\0pLsk"bWyF;ft^U+MP8bI[usD3׋4HV2 8KMdcE/Nd FuxNMfwp*9ay0Zbj L+RnWn9 @)>>YOLcl[ZG 1;JnMiehݳup꬚v|$vq~a)1>I-~DbLP6oZZc^AiA+ebtDeSN56mzOYn$..lb/zB7bc(4v{Vd㵎Šr9Hκlm̪f٧fP4b}cXrZčde&ר4d7#s5(A ʐ5Qu+*p:~~΀ ZC *C ?QYP}"i 4>OSx_EH ;Ӄ 6eŶ ^}3gg2h ^!Vy.slrC| uˆXt9g+l|{rVgi.$2ȼ sn q݁=G!HP|a)qG6xV@6I^c !f n4Пip /7'--|=a.O!ʆ*?uy*0**H-ي_єd5gr)b<^ދZf׉~q̦# >ZсҪ s2폛h:Zb$8iHUdM֋LL&c~ߦg #y4&M6~DWbfi2#npmc(JNs&E6Z+Mm'ŞA`8/ MjVqkF_o`LeMmZF v`joSLa(0:fVNuHM,*t= QlNG+8|Ƀ0fⱉC] 8TB}̐kJ-%&)Pv9>1]Pmx)tr3X@g[3+.Ds^Rxͳ.D&Qq.!U<[2\/vd#Bs" /1 KS#rq}I)l]SؙHJm:|sx˨ [A "о W(Ņgh0?oO7c?h[v 65nS+[c&<7,:l0X;L˱&4T*"G072W#y DS%Nl}[)~[_^m`إLQь?m?Kd|"` f!ԝ&Z,k.O1+Olj~;|؞h~W 7-ܲ0گm;8= T'p.1!, p@ @UEI["嚠2in+VfvHOlՂo8'y&r;#Es- pF-2|Nѹko?PDm=Qv]6<*(@Ŭ;1jjżRTٔ{q;vЙU[9SXn^&Z0^_V|`{vo Yԇ7TȬ<y6F쮥H,;v=ݎ)g@jNp*#.zK~6O@ʝ7zuo\2`$12;G4_od|M7""D4?>;ݎf->lJ6[ "Zw풏mD͊Baml ĪSl§U1nI8~dvs4d@_>OYh?z:z*wG絩~WTy\ێ& P$-CoJ; *Hl}/]wl٪mW?endstream endobj 443 0 obj << /Filter /FlateDecode /Length 4058 >> stream x[Iܶ)9ۇhhb'r$ωr<pԳ=ߧDO!@PWESE7_A:!?k\_ Eϛ+*Z9`@NZ; gb|\fyԍqꖦctz4U3Um&WuusپYꟉԱ KkL\\`n艶S37:z%Q .aha.4~pZO&Hk/DbZpUDT~ݛay3βŬK|m[\! p(VtKp-R 0k[eB/^mi -= ba(6-ڴ6u?-U xbfAiR{d >O$n&ޔ|u6—%V:{˂gKP0XLH&6QU7AX]\*0!k +%^//m1my{aJVm#ҩKZ6 u]Ww_OvCиqK$YL]FZC)R{!,i820)X LٹJ5AS|:0.O s_pJbÁ06- JZ_^w3k*Y^lʟYN/)sjjfF|w9y97ŜS1r?MGKJ{GJQCCUj )Ȏcje>t7טHF(;Z-2Jx o|l ?Vgx\U{ALJͤi9 ^4i[GrRX ʼ7sZ01ye"rYIxYZ !`da12 fAVxdRA\)]#bVC*K "w-Vc4 ytX¼0y'NLшeOԐ5$ċw*Ch# ŷĒQce~Tv&(t0KHp-IbZBfyGe3m3 ͌ Pz;,(q0ZĀ֫ Yt !be SMP|+>!$*M#oD>._/""u=X[u*u.[0˼c.%AhUF#ͥJ5[SZ,iD)XJ%P=h W\KѶ鲤hY:րHbTN֑kMW"&'S=m5QX#2q]a^gpvV0  ,t&Em^U@ w?.i )zG߳wA pz$,XI% A Y87r(P\N9f^ZUE'$[gXod|j䴋*⩑NFBЋ|=0Q_0ZpzQh/=3pÊLk%RU1!i1ISYyvj&ܒz+TfCawy~sT㸘N~J˘.cu)S<-禦ND1DyG9f8t '.m;28uաCin (<Ï-)?`%O&f  I9>GԥK#:&  H]nZ7i,z)ZYv"jVϗbCB0>P?$3О]p0gMvR⌕vʽS2zjEvOh&)T<]T i F @ [0MVt= g,Y?w,@Lͫ~NpiBEWi䗨q*[ XuJ~HNxDt8Ά1Q ؈ u]>ep*!GaRYn[vFD ]rKK>j+rϘ7V!(F2BNtGjV ?n qDxF:`@hҸt!AN  ÉG? ᮿyt!p:9Ʋ,Æ9!04جXFYDKYm( Vtb[9r 6y!b-">VǦ&7z?>a2u~"P&p)x~zFf A@"kq@Zz>+mbZa'Dүрq7ԎFV3֔GT .:aǫ+~Eiyҧ܎ʰ!~e9^nxrc| 6{,Y(Bxڟ: sH@ct/Y#oa?ey֜#RDwrL3is ,UnӎۜV7bY3Cc$zl w &pwH) B 嶨߷ԛWa0\*_۠{?D^qq[r,nO4m>r#Գp,.9*.NrҔFO2Be+ |leRM/ L .[ V:S{:~BgѳӳDj.q~t6P'KWxMƺU2p>6g>QuR '͂/Boendstream endobj 444 0 obj << /Filter /FlateDecode /Length 527 >> stream x];nPD{;)ޏ 1$GC)3#;EK`$!Onw5e~ڜeuf6aw ~P{~[Mu0mX^Զ4eW鿯x<>mPǢi[\Ak V-] vA<0E3Z  3F #9x,#C B? h 2Q D&*#De2T"@d2RLF  Èah2i4ih2i4ih2i4is ⵝR]bb.f'dv𺘝^١ͥΩ.`"d#h#599599599599`"d#h#ЃB ;s -..-..-..-..-..577577577577577577Q.U0Y0Q.U0Y0Q.UW#}cr?N8e$ʻ :endstream endobj 445 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5911 >> stream xXXTֽ+v# zl(6nbEJ/ :2.UH%A,1wKԘ}bK4f_< `b| ~r{G˜c$I^!#>:54h锃h+{{K›̡:5ꥵn.]D6dZ躨0_ v99:;;n09^C#B:zn`hZ? Pk=Xn7sEnuU0̄)!SC~FsYg"]VnZy>n~ . 2tӈFx; Ӈeܘ~|?3Bf3Y82Tf 3,e3Øe f8813,f63Ìb23.hƕtb:3]n%39Ӄb'cpDjƌe^IJlwZG445WbeY;v77឴m"xutxSNQweC ]nXZV O쾪r|S[[l}ftb4t]:_ˀISCd6uhwMh5Q$7kfІ&%&F࢔h9#BhVr)d爓PZ@5eZ\x9*Xk޹ɜ~xfD)Jp%J i3?yNMs/谝L&m7Wg`\uV%밇kpF?HpM~ac{I6~{t~{Qјd<^R;(XN>c4^ g^MZC]V ..f>R3q5bO ;b6v*G2fT_҃X=#ph)@8"'== _Ň4Ԭ 5m WaQrŤ:iS F㒶ĀZ'Ē!D1s~O ,So<;yU  aK y0yYSl'HCq \bgP"Fo9ch+ZThwp9 [7ψqJQTp![>+o؃9W,>$`w?13nĚWr:-Vb/S5C9B܄qm'Å8V<@Az%ɁoŬG):UޅKiodڢLET,g>~ Kg}?&}H@Cd)xQ5m[psA[g9<~ 'MȬ3bђbбN]gſiZ%r/ D:aٓLOuX%5Xp"#WrWy].ʟYQ:+pT=!FIFyqK&9ڙPBFѨcZŨAy)4`XDXt" 8Doh}汾t)R# @x(%^JYJh"B 2fޮ{}Hz 7X1]//հ%x=O RJXlyL c[9;xA-v61d?k!EfYQe]DFnF_mD ^0JM m[1ؖK4f鎕&R<㣷GۨV:πu>2ppzYK@+5'%!JnRVEm :BxrH. 9deͿPM>fʦvI`/=^A95bjqRҺmN,sa(=@@-SuԟQ Cjfc %dm$ZP(M9Гw@HV WU840ؑGɣ _6_[HWEթ3%P QU[nQ1(e&+ I+06P4Ċ$lG},]RMG qVtn'ؔBjBBqRƒ̣78PPE"O~X:p*P&quu3^nk?O,ld/?8/L;&ڠ2~ִXhNho6<{HfN_ Q\&a h[c'}W\ZYW-{WYx=9]]/sZ&_E&=`IfcgI%p2ati)gޱW蘽Λ[/W X7@m@MOqI>Du\.>$2һz`qu g>X *btkŚD]L\V#媾 Y5s*{{lmj綊P䔪l$QT킮#zcVo)dee,+rm׊6iL,FϱR.ng,S"rA+?,r[>Vؑ+*%a~_Kd.cbiCC`]t$,P@I;?J1Xkn$oB Ҏ{k̼gq T6C&'$s F_32,zmzpo 64q{B\md`.*Y^~7%|Q9\i눞l^vDi!zjN[(hzB9P"L&(JsDt/5Ս%}'dZR~`פ@{Ȣ v_ZOD4S &Khkp+[fѪ_+hqb6`g΅ZƵv.s7NŴrpC^flUQb5H9 &s#lHLU L1',P; B8қ8=0w3Ce!A4Ɂ0Z.c쿸Mɚb)<*zYf-g aGJZ!FXSMpպ5eG+ rSR]hq34qtbcRw>=bHRHp-'ڀ5k AZEI=u"[M;_9x]0I ` ѨFuny.r -[#"ńӰwFmp>xiP g! d Tdoj*(LKMHel45zϣMQr m KE=RҸmٮ[%.}]n'6hawXsǹCT * JiL)QiOV*H0n.f8mK͡({ؽƒ =vAlGGE,)~",,|ݚv(8Kn]HIiB]eH8'V_]EqnS*dh}{¨f']0fVQ xd/a?^(ަz&i0MP=({jte(-lyJOdDbT8s@!5)\CѼU%2G0xK5 9v{^l{RA,ol[)pa:h1qjw,kyFO.b6)H=%L}RfSS=- 8 .>.9ӸPodj֗D- vqUvH 'bx<.嫑y&1FYjf9Q\pa5ak6:η|CnC~WCIH, H}v '„sN'[ p28xsj*qZT˺&k9i Kfi39/Y*r4YA2:HoFe9;҄y Cs-tęT ,j$GoW4j9㣞{}j?|ý^O$f\#%AT޿Ԩ7rR. vZGdM_ ¦ to#&"iv hqҀnawZ2ܕ_I6a:(LƎu_^B@\SozJH-*jf]IMf|I_5;Hg! ;Ϟ}/YNx`k@?COB$f IӳbSa|k3زTzjo<8v AY[{oWkʅ٢[ڕ-3Z`a0c$}RzZ֭Rdg%3R:vbyendstream endobj 446 0 obj << /Filter /FlateDecode /Length 326 >> stream x];n0D{B7Џ\ڀi\$\@V S,}fvCxz9i+uN㔇UmMZ{EӖÔqM~)k|,Z_)̓^>o-u ÿpq)2u8D8;,uD]d D(!2` pg ptXY 5p8\gzh> stream xe Tgǫ*(JVۨ([ą< +"" 6vmAVe h,"[\qLD1dF'3-L59wsRP#(B16dEhA)Y$9BoD3lpl68bX؁Q('/NIޑ-azl__:_S/MJLOJTG'ǩSLɔSR1 џnUlUP]V*lک~W(XaɎ1ٱ}gΚ=gޛOQPDj5ZK¨ j1ZB-Sc({ʑr8ʙq JQLvR#G06[mGnA|LY$1X7zdȲQ3GKvI_mS)Kd*4NaH2x8P?~vqi,VT]1Jlo/t az=߃Yǒ'Y4ئuDxEU'.F!µJd uzO Hb$PanAZaɄN:5Aۧ3-t"E;tj|7ĩ )_p!Uf`j."ͩu!ʃsa0u |HWؕL L-X ޗ 7RW'8>3Ð鑬@ә wXɆ8H4,-6|Lq U79zp.,;+^ ֊ F jq%?.GMxu#2WZAj)4R |RE[M+|⏵~]p<8I ^ @SQ'a-o1JVtr3qp)9usU} " WQb|N̷J)+d,pF.CB`Tr5ਉŵuZYMk<%g<Fa(Ӹ}p,~"F"/sT? UЬ"ṓf5E g\4 MEr43: *t|F&mHLCn 9R_[w U*<4.-.9fs~,+X´Ϸ^큌Y*c5E4OTE5H rvUȭ*# 1WD8mRj0jhM6%/7Kj̞LoNLIΊcn>uE$isYɎ);*r@g@t.܏}}n)+Bn k7t*n]v>1-]#p$x,%n~gȖY3[ ($.(ѹ9= XuYP[_26&-cM0%^V@KEVKx2֜9#qsqVϛZttI!]i޻?_9g޴y$'wLo2]1s=]G/^>Dhm;p.8pY|%rےq|G#T*w@ ?jecu`ܒR;z <`'j;ǟD*F7d8 , ֗|Iu1f+ToR[dtBj85~P G(m?AF/Di>Ӣ?a0߇Kn KlHÙ=q:g)oY#Kʜ(ԟǍ_QyL_3|Upm@x}Zy`sTW=Z]\rLKqksQ/Xwa93mtg9;Σ+3E-ͣګvɥ3tcOfri綢T&6tv6}{$璃 ^&ߤߓRUijE^S; 9u,:^>@o eF:ʓ(z'{K2J VC'2HW|S]]R\Y->weedFl Sإנx9ΛΗ_40w ȵ{1`#翊Oܳ>& Eօ<m E,T8q~6%F&'9)pŘ`qh4?7'tj襇?178>mXE#:^N_WxUdygNqY,!b `qQ[A6l+Pe:]쩝'/ 2g>$m_7UHd+帥G!=Ze.nIh,.1ig'.4PQendstream endobj 448 0 obj << /Filter /FlateDecode /Length 630 >> stream x]=n@D{7~,n\$\" S,}fFvCxD|ce;ݺynzږk{?\i cgu~.ӷϥux}zk>pi>/2:mmq]m2oG<ʌ0Wԡ* W{\Q*~8>TwXUAݹ*T[UPj AXǪ*d.VTc~BB~BB>/R(T(/R(T(SUP'cUP)2*4*kUP1̣ߤ`T0 |QoR0*M FI`7) &ߤ`T0 |Qi#FȰi#F9Q1k2dWu:\]N_pu:}._u|W7@v TU*@ RBTAQ*H QD! U(D.BT!*,Z!B`  VX Bp+\!Z!B5M| הo7M&\SI߄k7pM&})ߤo5M|q!uuuڶG> stream xyw\, ;,jfwco(^@"E^D`) ˾Kua)`DI4F,AM,9C4o>139syejBD"+m|}&k \LX5 {#cO%6 d5qIcǒ3­捳Zgղq+Y %wZrrqwruZvbvklGӾ^(jy-_(pqВ!B9w^k*ծkֺXi{c>+0~I:m6{xs5ZM͠Skj-5Qpj5FRQj4G6Qfj5B->Qj 5ZJMQj5ZIMVQө7՝zPTOʚMSR%R%,~Tj%hj'Յu}@ِLp굨dIxtiLiRC~a*t鲵]v}۔nmUݟ^ϐ{{Isyԯ>M`;-=I,oֿpC^d_(F+U@j4f6䋡P[4#|QMX&*ju˅ӫ!2MYZ 9IijUB$vnAy#ZmћzmV8,HND -m7`0ʐ` 2Ewzd7sdr\V}9zflixW]dGZ[|W2x̋YKh{%,! 3=26D h-٫WlXSf8QYգ/F I B>D {[jgzK/z A<[e.Iɖm(8e8]=\˽3P_V`NPmÀ pdm]P,4DK'w9Xo 5j̑6聾P-_aqWKGp_īLr[tSnIO@/~D,M{囧a1"FvE$jWfق 3dkRZ5EӸ%ZiDhOD2gkE72uAzt]`>8tGJA8\Pky{PCqkH5~i0ݘTE%x.KLAe1n0vtF!9++A7BRIo4.D٠@v4C_\ ө`u,':#n"eUÃf`0ƽ:6콄D-b.Թ䃾DbHS&&Btڵn`W)xvh*Viϑ194[rFQ~_dH:6=8FK!BQLSmWMwS=2(ftJD~yd}qӬ]B1iiUǪNui6v:}x%z)n݀ZdG癉B,(,[9f0`unOp=Ăk2l!{^|(ho3ʿ.zYg(`e|Tӕ ̠Q/lbn42(w0BweyZ>ݦ2BFЂ6h(nBYI4%4fY ŏgYSFT N@$P.+]|O[|({K~h!)ګaHxI'<B['e)8Z:ESi:X&4ߒ݆Bcv5K^=¡Ä@8|`Dz7~}YT I{xR1S@o1R%ґPtQ`,9VƟRtE"hQ tԆlYKr'dlOdDDt)?:ϸ>Y)\R8SKP"ŰC̫o#HD-#P  n;6ofƢKwWg'l**jeUs܎ Wzzzܝ`;#U|pGX< #K.~IcT{LS3J wNd8}/GKuz _ ~DLNDA,Dk?|1-%QmBYA蔡=Ͷ7L̳yT-KA. C=++?[ް^%ۖZ$GE#JP-SR-!//XHsISتh5GV2Րf5I!@TZN֟K_|=\̉ YOHդgR hI|*rm"wi3uS`|%Gݡک{#]w9/iӗ`FHie>=MB9Pڬg;m\3eh(?%:ߴ H"Hw=^$jiBo:t>Q;,eHO5Q^dg,(l>SWP~6D_ I{5R:'YEPPR={+lϺCsKY):{hU1V{ӊqN2oiot}lSY TY6mk7Mt_! A9Qt՚( HIESjh(rL*I%1$SvB KҨWHę{UA;09KWA$<\HA>i2D=|-}]m]=-v%풸 4UDseH`F+mm%xVՈlXqi<1яGV_ A8ޫeH1 tLW76q<_:-VcbA֞Ԕ-V%9uv]uE^*|^I\"Ygٿ1cƱH⋔&puyҍڑNx9[gb: 5I'QTv HN?%fX(NJ6k=Ǖ4^<*HR5JNL|9^`O l$;ߢNâ׀vܑbFh4$k4I)ed&x򞺘b)I GyTQii 뚬6b%z$n('.n/ <7ٽ1ڮ] ltv/Mbu|WmߪRi4ħ$d wJr#A={'T&,=s1vmyseC_Ȁ MO]\J; >/BbTE>>>eUUeeU] :VV-42Fb5IA1\ŕˊlag஫Vd`C jhFbݒ݄_nqF#yN<%̆an9f =뒃?T_O0ӳe+cm;`1GEx *\K?]>*5p-hD-́N=wߗb~Z_ΓΪW2+OOaQLsi#%=#O~ɛn?g~ GlewqKIaWh\pW&pzFnR$B= 1C͏iZ,}z̷3^bjC6RDU\_$'Uvuh%DPΰ-mkI>Q!7""qi:}j2_[8 mĶ@HK9#;Wkv=")%)G!S#RV\R:NCCoh873hAN+.23~ &kԕE7֎$?~ycd䌃 I'ŋ]7n eh"{՝(kR4ޫl!OFG>?a\+g!bV[`.7ۈ:\UyG.2w_>? +96fpH[|xrNXH<с+9iw Ug 6'XC-ca8ɞL܇/F!N qkOxq>.,)4Dd.Epy:3Dž웶Y]k}fK~Ef?4.͎-qm{BsӦnϖds7̘2rʰ#ްʲ}uO^1S4O1Eyl 0uX' GߍDΗ4m.;^?`zUciHFlQ[(#`x] p摒rjhY`H*3yŶ~ovr>ϤF$ĕW%}i&]SZ`ӴY4"g/#QC6 g/_2bD3/#֥> eLB|ݴxU{#sOX@y'D*fb,]n&XL<, 6{>\ Lj>M61ԯAGly9)%7yl!Kdo㑘Zx+0wgid#9&B"XC!uPš?U=逪(dki@n֖3ع%uMU[ġNR "'j[֞:k$&>)~L[o4GC=rSV]%P .^ %~>LȌ~vca-iA.ɯ;fdzP\ l!iB&8gj73w!Snj/ۑQྂ)_>jPV[6 OVAuto.N(4N[7c>USRuθendstream endobj 450 0 obj << /Filter /FlateDecode /Length 239 >> stream x]n!{787'q(J"o=;EF]T򦻏/t%6H_蚋s؞$nxJ;u0Q^}˕b[RrJwՏ{⒞OD2Nd 89pb N @;1p rVvv"̈,:ZD@bLN󰌁Qr"8ͽã5*W[˅~SRck{endstream endobj 451 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1460 >> stream x}iLTW 3 P7O\h*FtEdsuPa?3eq">mX5IcllZ*%.I%ڇhRpϽ)Eؕ5I͙skRӷ Gi1Mt /KǠFS Ms[regdsCZiOC9bL ]ʜ-mf&>95#ɘƛ|L551QkmlR5dnIZjܬH*LPkPJKSK)%ŔJQmL4e):@~6Aӂ1q>Kc_qr0aɑ&\|lu+UF T@_KgSZd phq{e=>~~h@ '<&j\2L~>Sfݘizsz$pԡSpZC&X $õ*?oP+y)wj-) OZ9/|IGoq> stream x]=n@{7I $ȥAEn",0}e]n~[3/>R_ʹOs|۰oO~/שoXa}sۖ> L[ BbL1c*Xtmqb} X߅DpBp"8w!8B] APP0( BBA@H(( S`WB] *'XNP9rń jB_NˉHLωR%K `0L&RI\ 0 K&p)$`&EZ ~ݸftOuyu[ t `endstream endobj 453 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6374 >> stream xYxg!,EJHG)$4tL!!ƽ [U$[m4WuY !,)@i[n6K;/Kmv+?e{ιwQ@ iԔ(ٓ ϊJN 8(C >o>dL„'u} dK5iI Y3-\x|3V/!*F)M%a3fI͈KJ?cgvl1#t]a;.~ VVI[bfhֺ9r6Foʏ=iNR7꺰txF\I>Kms/?;r쉒mLސ3&*||7=4硤D343'~?]x^\9=B*[ ph""rrAѪ[GO4X6d%)/1@ZPRHk &R|M Fy"LPn2R [Py|=3UOb4 0)uZm@e F{=]s';=/?<9 %OɋQlg.vm4z,Tǽ@6L%grz%ڠeuHTšJ[:X ʖkټ_C+!5'͵P>$ .?R54!ne^@ErNMPA_D R'iա8:F,4NF>(/`E9ؠ$h34ƿ/~هQ(8sۨ#}m}*SFJ+M[K{y1?ȥ͟{1*"n2wO4"aktׅc<޼/  '+F fXg1h@UBmZֶ= y)+}Q( c]: _O޸eϠYГQ<$]'+PXK^4o5[l[o}92!IF)Ff פҼh BfbYI Ƣ5a7mwZ1Kh7XV[>f Orx4ͥI:2#2d7ۊo9#gG6{Ϲ]Əm' 0f}*W6Syچv$M/CߺzG|'6#D߈}?אз_# fzw8&F*-靯 q<~=]Mt #>dYRYbelmۆHB'-r\ /[unPV:N Zi{o{2 K fjO%nCM#Psgk6y-Th0.Te_Giá*A&GK~gDko,BDC4ɤY[ th2Qu(kBHDŐAYP4@OՀh+5J 68|K8s71|ħ6'[NNV[nr#ׇķAbf)JT1RБ G^c`ˌg>E4/};B|.Btw0~8(ōSrXn3%d TtQV4~8-T:f,@,30E]F#+'L&ɢYyЏuyЂk'0ASBOUюTk>j*uQR: IH'ŸRԬza)M{mrzqԂ-gAw 2̍{t--%I HH"T+ Wr.rC%fk; EPM^dPFT9Hr- /^@!+~ۙhWwЎLO l`rchGsiP%^IuY l%fv Ӡf}t"薨5\gE]h L⠥H?r(i9'uȳ\B,v\N|6HjPҘ4q 1UI Itiu?e` ҇hæflo $ZbP~F;;gRE;6%MeCy~?8K] jO$/UȈ _4\2&OF.HhTfަߜb3ӊbUN.9+{tGkk=U눶[]z~MĐ~ /ťj 6m0]6-`rc!gG:Zp i:@fx#!v` eg_ }ž NWi>b7cvNm]Ra-$/ {ɅesD's"? -ޟ@{9otpsZk1YW#90ֻz9yC52MFv>OS%/)wVmttH${Rcf[jS mn=Y(=^;iNC{:<P!$X*B@oC宜*'VK7?Ơ }-.*)t` ͯUnt- D㒆xC`-t[D_P(WowjoTѝD㩁o4U-KrE٭k2z 1o4 ;踤i6jqL12U'Q9IS0E@Y8$Fqٵqd.snhڧ,8w2WѿQb h~(P_\ ;k ?q SF$jZ;8spx/vʁI|Fх? @S7XlVo__g\I u6覻q u?`'~ʭ4zw.c(5Ehi,-ߠz`D›ܱmpldg!O[ZG"x&4rDG?U:BԆڻ\y25Wnmwr[L 9VߪrV׺+]u޷9MUm5mG.omJ'=Ч=w/ :>ҟf*NP;R@0Mm\=Hsu^3wWY}7^xL?Ij ~@G`I9t\AA>%_SĔU{EGNYuAzfwvj/^ Z]Rd{B-WZ&Ib3A5[m@}7M;sS?D7B'pEƦFw^pp 'su?Aeed<:ey8=nRIl}ofj&_Г"&K+rZڼmЂ6_,@\C0;QZ4=m^%79ϒЙ ڠ_9tU:gSlQЏ#)sLjcYKP,lpri`;y Uqd4:͵H dIĒŘ[R%AKy̅ feRȆb ?f7h*}hToT3\Q•+19ܮ~a7煨}8:-JQ '`BǺkTeg2 }%b0Ti dP)8E2Fv`5؁)Tz x 7x6Y6䜙$HVrTa `,]U跾wF֏~f'ƼKU}][%4$piW1n&8U4*~ІwE/ctK HEO޼/zlh3uޱh RWmqp+sЮ( (머Q(T=(q'NcB=h|`w@[n#k+b39%|8./wCvp÷[ (#MOٟ^Umo~慇ISՁg5rJ-R@QaF,VhC۵fe hd.@1$#sqkQ7 SK+@ʯ G88BB?;yy6*>݊&x}hHFǮ[k챎dPaR6'nB >" 1Ƭxm?i>bC5a4Sa@Yf(IY-bK( M9tɲ9aTDZTfTx2ab(57Wh6hm(hfª?v Aﷹ^jOV&hq/5z<91Ȥh T)w`mP*XTC|i4~~>~Z|(DhiIMa]*Nչx~>Kr*ujJuVV!W#UhFm݃ Ͽ+Pƾ] &e2B18p2՚:C Nè?-iM g ::"7B )rzm27Y-d[j٨_wSklVN xL[jq nQekäaGb3ӧ J\'I%%K*r;m-jO7 !Vw8r?+N'v.ŏYEXjbǷƅ2MgܙԸ;S'p؍⯃f ݕwhN HRendstream endobj 454 0 obj << /Filter /FlateDecode /Length 2741 >> stream xYKsܸ=Ԝv"tIIkGryq\)oh$1ZH} q68@}|_?_e۽8xwp+xf/'S'dc2KfNFmf*H,RD4˸ddVeQ'S)%my =k״ѯp`8_w/vJZc/jD*gG@7~c [&S+$(iثYb-g; FPs1:$6Wbʵpq҄KfCh??fYΎۢcc`bO8x0ZeAog8'ޠ6T*M;Cj\nAI<$ u+RԴM 6T*de^y[,aVH)-ځ50ކ!0Y5=-iXZJ:0jU<boEK:ea}~/ irP5wXKF< Vkg(_~ƈ#T4'2zNmqPӰQ=ycwZyk['54R LH52,eNYq8hx (kRGN<Bm E6Da.hbܫv_)Ecb+Y12]i]c-2ncLCHH.m~/$ ,,Hg2ENxdN%dɂeP~{L/Î*oM@! TD?oχ O1d9Ŭpu{!t.zWLJMfqtakU##C6Ih,e};'0K0Nk*yVTVc714§r/zX<^fc|0M]T=씽~%Fgr6 *e{L@ W AMxR(N`s"|\c Hm b*KeFM0v`?ػ{/0{?C?D#G}>:F^ J* dFAS #qi;Z g7ς*F+IVH(2xkiT&g=Ws^ī螮dCƢr&XF9WkF(ޟcuH \?,jVmG J[W%ѝ"D7nٮx*Ƣ|Fx9CF*rW?pI! zYFR|L$u_o.zjZ$h]0fm#5o+єhmmaNqTG#̠^ [t6^'x2P;Y99,@׏q,4  BH]~߱4D A`arE^:]-KMsv+"H~ht Rw<Z޴A1ڵҡNdz8hfJmi Ә:IjrQADP{DpԤ>5m-uxn. yEZSԀfQndMv^.^ xʻqF];䁖CBM IЬ}:?d(MU%%EwA޾ 5 .X~h(rjOZ! }9$eTf]D ^:ۛsU?rrz+"N2.8-*\4U"g} ޜ8K7^TLŵzH"YL o] ]PgK̳. 14*QuϊOUlp,>BQY_"C7P5`Fsr/(?&~,7TuiuChbo>b#`_kYwk ݆ LR)c$Ip-`/|IɾP$HbsOQ'F@(I+ slRET:>G^(#>_2Voowiq|\M{0SIz苧֩_Hx&M!`=Ґ/'p"7˃Us~*@CT kX;$vpl%^y[ |DJOv:g>mD7q*77A;3vhۇ g7'Wђ&n27t!<9rvW6tn ]Ĵ-} d>گ"~>tLv%43XנNɍ \tKv89@W h\c!%煄 m옗e|oA{YH?.:aၨ鮘 LvKD510BDW> stream xZKs6tE fK`.[-b;$[e֌$f28őTm`_w_v>pbti)/Y|ruBL*o ?_|`g< ix^uW_L7˭&S)%{?`p U v('Lٟ"ZyȪrW)/^MT7 <'dj"+`g񐷟&Sas|SWfLGDX؝{%KFI\W* ;\Uu(`'-~.Z+o~¢T& qXlTJ! Vn(-;wd.-,FQmU6.B|_ݦҚ,`g.VN Zb)QYQ,d 3'Yf th&"n3 MTDL~U.3ZfOOmuc^¶\Wa0Ş$\b`sB1XƳld"ei kMɾ: e۵~R ֯ 4\֟n#uunWKB7\A&^=!} %؛9$c<./Ȳ H)̓AHEH㌰)H#Z|'`qa`1A.`B%;1t<*;Szܵnsm%Kb^&MW7naUQ)&lxlYի˦]V7qAq:/~?mۦ qwR`e Nm26i6 Q~$.Fٛ 9QmU$\B/ɥ8_ū( 6Pgr5pZF1Bx}PfadN"7`}/G; AV=yn5؂!-3㣠F@kK.,5 .lJS68iOQ\[yC؊Pdc`8NV3`պpMNiiN{2|vc{(vpg`OIdy7O4=y;uDHb([1#ぢF =X3v_%1Z4ϵb/#p< Gz ]b Bjs)5_@ayKu5Fk6=tQW7G A2DW2DjȔn3 }!u 1V B+92#[E- 8R} 8ݶZa,6C\=HA6v_8y4Z?p-W#``:a@'7߬_8+2Mjg Aj* j*xwxo N ?°˛ad>_ wQ[2ϻ{^̈́خKѐ@1mT}͓7O%€]C_{jwς3[b V밵WhuffV_ԫqsqb< .HY}>GN$1&˦n-c!JRLzauPQRs 9E`-F[o@m4 EnLoC2P."ӡ^]ʧ͗K c`YN]H}M\dw~skiܰt0^X\>e KdKԁi4gqiWj i`6a,#Il\묫IAs8>q^6~{01QwlhdmJo$߳=V ;P;^bWP'ZW1||܋@qmaxNu\﫵\nZMX' ?-#Pz:yb]?'(A5z0\^ywCm(Yku.r̍<*Mnn{1 Hkqx)8&ak0!cIjv4bld;f_!̄B0kBAMbPPTd/5vF /IMhwOҏ<V~ %r au/ƮILM}k,R-a]T/ ̶A ek!G` ɺ!5м.s Sǟ`GxlYa\tQfOhd_ %)W*Q[qjXN7ZvUwxՕ΋S"K]tS4>AO"$ې]htt7 4ߞM:MFbTq7eK FiuʩR2rGѺ"Z5+Ո42JRz^~R Xa9\4ȤR<0-]997i[}Ë`wvvKζJ$mIq@zosuI?$TH N2߲莢:P)UsTۇj[x8xKzS=[RY5ǚ>|s%@ѷl> ol&_?b/I"Wn=y{^Si._jgD`à+G&1gUQ6R =0WMLqQUiaJ"$%{j~gC0>heI[KO'!(T֮rM en9M8sMu%Qa<,{CmuEuԜy?8/uf:? CMX iWm e=CcWncLGgxl*~7t!ΥS-ix\uRQ$굆dԓ>x'r$'cVΘ2IuS 뽑(&yXӿPu.5浼+!yOM6'OOMYr`T-D|h+ݗ7nZ%ӈwu;UY dcg:*WY䓣m4b z{U!鷒$tDfU&aCcN@%s̵#8B{J,`m{ x^{T8 Eyh /C@,  D M!Bt!sJ/ӌr6Oɠlͮrh2ISp/=@]>#ox<#T켕/ҙ5^h:WW^{0YvD@j.k; u]{^s> ,j plvLkh pXg֜pp7$kL7x-#tV-f! Z(h-)r otlvܧ<{M> b6>hI1*MőhMwCQlM J4{,I \<4|eo@DQI5RIv#ᄫGNβ. a)D>zl !6eKZ:F]azL`{Q×网l`jxe4&> stream x];0 = CB^`a!!uPQ(vvۧ8TFIY<cR}GreUm.__5 `}tVk哝#;ť;1 5-|FC'тh5H5 a !$Ď q\d@B\1 ! ۵iƤ."&[޲nendstream endobj 459 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1564 >> stream x]{Tecl5`~ 6ˌ`& a^Sn lcns2t"0.S!Py;JyKx,2y=)}yy?|y9 p>פֿW-PAZϏп,OJXV7( |S~ѭ} psj*"!>v~Al]!1UK^AS9ILR%h~|Oba*~{vil6~.{?<&v+ZN&ÎvC.xMGS]= ?hʫ7CnA~!T14_p_z B'*7Bar qQǟш ?}l~TXLl ʡumg1%[.8!=m63uqhRMB^tZWfWVю"NjX'{)ё!5} hC]Jiէks|!>$s$NWopY 3hA 0$  t6.ft*> oϮ,6K B4.RǛ{kdž{m_#bӄhD. c>U&3(JPXAcGk v~"q\~sbꊂ-ِ_Uf]VTX;N݃37:86CJQ6>kK:VK$gHluZ5촂M@JdrNjFc/GcH7bTL9& x.cn鵣Z:/@ 7+6RRs@syOc)Bc h/}~ ~ f6@!uk";AM]x:ȇo:Z*2)6L.3dG5Naokw5UjZe%7ī{cG|쓉$wtW0=@އ%4z-b#'<:Y ;G@CL8apAٕ[SUdOR4]qܒ<;s~aFаncZ ETg6\> stream x]n0D{}E.&פH,(NqY"wgǧ_OrmKyv^iϽvotvZT5k->󍟇zxI餿ۥr6[m!yQoǣ7D4BЗ@]D<եO; B8V"gK8x)ΥPQ]r]rȘ\rxr HME5c$LFBF$5JldiB!cSΨ@dLɔ*9B"'SVƬ 9Bb|& F gYȴ[Vter(c, ܭq͸lrY,vx?ϕendstream endobj 461 0 obj << /Filter /FlateDecode /Length 253 >> stream x]1n0 EwB7$VKdhQ,QȂ }I)IN,?py)}}zRu:-q1N/~~UԀyp}pV}( 5Dl\QM3(,+;s8gAp.Î "9s$= Cԃ@Yi+C* R|@Hy0` U5#@ ot/ VNs}ƨ5,/rKSSP^endstream endobj 462 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2352 >> stream xuU{PSg`rEJmw I*ZZZ*UXE-*%D"D&b=yy PQ\Gn-v3{3ܹ;;I#HKHH/ެ͐I ϛ)kg4=,7-8 F #!a!FNeKEDP$%O]n5Uم-==eD+֤ȑ) r$Lњ9 sDe 6(EDYRH&}Uyզ͢M7Ϙ O8KW(K$*yL./ҥ陒IdA2~u$Bks"b.h!!6NLb{ENrѸD,Ώ!!oo fT^ŧPq&?GÜ`9wFCZyN.ԬAu _{(d|:k2 JmPW-2h 0PNp7ӻjG{S8Ų[OG`s?;|s=,v-]: fao#Á=wV"M` 3Ax閺X\GX9}s :w_,nЦS'vYP{7 ͿN;W 8uG'G/]fAWbЗJzEo11FQfԂ3%נz(E :(5bZcgNL{\u55`Sޜ9 1It[J32-.pCuT}=T8+mM u{,r*M*L"ꡄДBerX\nޔ;笩w|ʎw[~[ ^U^ZYaXaygM&_[}cK{ބtD|tw 9?}wlƽ }ڡkPA#4&"}]KcB1( Sf.-ۤēLLnÓSA `fE)2-K-Vs8D?@K/r1Ϯ>綼ѐaS;ro"r T3sSK@|fo;E1nxۀ{L»[K>;4E`ӷ_])(1j1<)L=)5:iH\eqS6Q|. \v5T;PTڎ 5}Ul8`}5DQn?Y<|k+fԪXaԶr7Tínz&;_?BE;c@qau ]lAT짃]?}haƳp*\_dWO7Z] nMAxdp5%_k_\.Ɠ`Yr*δU9@t}cgJN(Ȧ0K2t/>šY+ _*,Xe22&(8uF#=Z]rAUTX,q5]c2|wx.^"kЫTp3%˸^BHТ&.^p8K< -ſK8ZmFg#8+8OQ pt^zmZiI SġsDKL@.? [B$ q%g4}B\>zeoM/|\ϊkI|p aĺV | m?gqF.X>V|.A! Ŧ+ 3 ?,nr `uO@wžW 6sT~xH~w}Iēg#u}3r)h'~/i!̎,]V0cW䲳;=wm"j樨 & 7滈3( y5[+g$ huCVn_ /מM'55Ye{]Dԭ"yKz'zx_:wscnWhD:en؄Ue,}aazma/ĿjԳendstream endobj 463 0 obj << /Filter /FlateDecode /Length 214 >> stream x];0 = CB^`BB Q(vն)N:џq!c|{/0>;V䓝8#;ť1 55|FC'тh5H5 a !$Ď q\d@B\1 ! ۵iƤ."&[ްcnendstream endobj 464 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1514 >> stream x]mPTe%iYhw7E0eP)4V`Eyi].;""ۺ e4t-FM{a4rug:EgbJ$)^OJ64ٺI2*⧉g$P_{'? &c@4% ˊru7̉|uV:!RB!߸8?W)ЪWD&EW\,c:+{F6fSS&WIy>EM37:ŗbͧ(@)CM * & Q>FhsqxHR&],z&%BݢQ<7*OsA đh R/.ّHl+)|>o\)i_%yqK[pPhr aZ+wpҏ<fjem'a8o/vB'B ~]ɑ+oY*&e8Cw].WF^%!vvZwe<%wTjb}0(Seʓsч1%Iߋ2p5z{F#ѩ3=mC]KZ mɳ?B#gq*3ki孪Bs꺪:N}0"^PzgymY(NA%uWv2*8^ES#~̼%cI](hemh+σ=8!N:/x=5]NhܺܵRiHsuiWX]EZ xR﫶&+\EɷAekcmO{9 4y!_+%/K^W `ّ ,9x>TڡѼu;O{xO屙pA*L:MUvRH宱t]k S1vӛZK\Jka$$PA/n7w~gNe ņ YxVwϺJ;TN-7gDTWm:M[} Z*h 7L\ͬS5AM`'7q›߇}'"loښԵ};Cg#g$d+b{ʯE!xi F 1xEqY :-i!]w=|-3xϼ*"_}TоǕOlzml׃c.@xAw 20"ANMdU ',[]H6Cj!P CeVy0ްu~7*Tc*gf1I2xx\ OxjR_҂Ʀ=v7ad";gmZ-uπ֣6bk6=EQendstream endobj 465 0 obj << /Filter /FlateDecode /Length 561 >> stream x]n@{=@ٛq Hu2TdgfdH"}0oy=߻eo~[Zwh/u3?|l ׶YƝ4<Z.vvח}ݟNu?!ONU3Ra<2Y;/2ѿ.èUzUcS> stream xY XS׶>1sT1=γN8QEQD%FQaJ20Y@ U֩jU+}p}ϣwZ_յ %z/\ O/^ yג8kO]~|k.6 l{EZ#ڶы@eNVZɊ8Цᠶ-tc@voA1 &$\ <Ҕ@sRA18 )VIPwt΁6}#z _sbU}m4lƠe4܂jH_jP2o$l5SЗk丄^d&C08]H!EÿݗǝxP)mYteXݖA=PI>/̝_. P̠PAɒ)!ќ"RZɑAVǺ;( m|^!xT87a Os ;N}6 ukA++d˷~e)oxvdž&0 5-쥥ِ79AovdMUnĴBċ)I,LTwG 7 Ȝ>3N3V'@ {>dc=U VV*e檠(ybOQĝmIc& nH4ٺ`v@R:7C/.L9yi,=\Hp!"-m."nMCiM0~hL/G3jurEn@hգ+Vl`r\(Gn>SERCAO -vz暀ԯרr9=C0*P lÃB%8h ٫wqw"8veK::gCu6:Ob ki 2s+I5Kay7 n ށϣ9Mt`K{|t2T]\5W,G# fz/#hpC1h.>"GUhs념 79MQ36g.l$X蛆!m;\Bx 0C-{+?&A-^i ^ݹ QMS 2,A md:WC1g7h#u!B lH7/GC0eei`,CN*BVztwnk/)e9(>&:Dh]1lu&/LhGk6/z+}s{ʫDU)"t=Y>T2Hz:h#V|5Z~|B4$jS4cQ6U\i3Ti6a  kDìMd5 09Wmi囍 umf$?PS3K=eJ4 ٦lBE7GtKn`A-w]!MͧܓR.U: rhM{.L@Qw:ȫ*9zo| \:/hV`JeXoB/sҚϱ3}ҫ/)3IYkhtvgm5,i_(+vBo˒$ de* ݆hBI*g@DV,"4٬5AnNnO&A{{,V/nj)ju5;!,VYc1DVZHUb| C s?iA, (z~Ydj} ECO7jC+pֶ8 z)MYQ"aG)&]);\4۾J K턭;<Ҕ{I5?P|SXNxͱvm'َ iCZ4P%% j Ra8WAaF$XƷѲp!s9i ]ޚUׯ202<6.ԻG>8Y;9E/?{T*"iC1?檀Вv[ 9gi*`L>!כMgNh[Ӣw@V]YYvn HKNb~ٙ6~) ɱ8 GgJtPdS^T:rҐo&@wB@`8\%kiAǛԹf[ez]ŗLpxy\x+`'s"ǯ½ &AuB TTM8"[c)ڀǢ7œz?*-a Vre}5kU5Z2ͅU X*mwz>ǯy߿[=Ex' !1U…_ r!U *3<0FˆqM'eU򂒪+0-0"RmshuW t0;ZSlw`Mb)C%_sQΌ0~xHp=i?Nq  0UINuRsX?ϙ/P_x_!ˆ+PgJ.oa&3̗w+8/~!~ ʖ@\l2j;< FIxQ Jr^L !_)dܕAC}($CYðҚ b9KQV yZQ,1h.X'Fpz5NzL(Svg.%9$3Ss= OJH-+<26HMr<+=U~p}Q*"Ƭݵ~s׸NÄ&'uPۍ`Ur:r3L.(1~ױsKn$6pQB=I]G Q%C҆ՄAnW V`*cJBCbC9Vin聜*lRL ĖęD(BghrI5A$Q5BEiD2d6&ވ{W=&z zs)PE@>$$Of^(QaTu\C e R-8̰kC{/mt deDrW'qF?2$6"Ʈ/;Fe%DMBXBAZq~OBBۑ#5/nAi+&ةkvn+m/1.v Opf]Y$dIĒ%m27 (T YE##, 9i(Uݘ\HZ_JoaULhf t^شkœZ9u[gVug劄}';fuWW&D}~ɢMlp.u1[bte%{c&MҤ4V.U{ ^x0դA*1$e\Ag繀ޏj,@\eqrU:RNK&Pv.ߓa6( V^UZl=;Cr&MO#`mE%B15H? kZRPHL鳸TH`R33ss/c3- t$b rq$. g'+0~ =RmJ#Y-|#3P-D"BΉrP!CZDwv+DѪ M!MĈhi~_۪$dT i~?4jm9oM6rrMz4`"c UDѢkȁl{Jb*Ǹ6qLzJfrn~AO⪪ΣDYZ-}wP>q.jm~dМԷa:Fq#fm|Ps1op+%NpRV,N,d!܁p n,w19`*,S m] -}]̿Dt ܢcADY8Qɴ1\0~ng?<h67$"A ً"[[h9ݪvvc˩HJ+bך8jjFmK 7WSLĞkc%ZWH&M4+bAϱ{gєai<\q (`[ <`^C5=AA6:UUX$X7OP/A4ܥcc"#-bt9` 7/&B\!R#ٷ9m/ҧ|zz';SJIK;1[!pg9o?.&4(j-.zS]}8W y8֍Ao"U/%pM?ê<C{–ꘃ[PȰ3mz\ jb?f:0V$4ybF)ق2g̸;xn*>q4e9~RERZ{ZD#a1I)|3px*+(!H#hq&vd}?c1Lf^qiMGϤ0{:H,8 >sgsem}Ss9i=o?_PPwR$}JJčRT?coDvW?PEX<#Wvq& [vo־~%JeLlZ<2<2pt8DVE鞚{ɬcJ7- K2@A/ '`g]%ڧ /"?:ÑF rGN'qploCNwd=佚߾7Z;"a5ƔL,E7yf[<먟d>*3Ք0n-FF f$!p&7L¯֢C{TkViC@{R|ߝK3@)A8Hꪣ #;Qe$& _o:ZD$K4Fj0-(C}wgGu8j]}]ݩ1O-濆fvOEa;ęc.:ۨ qQe($'Lb҃uҾ[@S^h4暌 W(/^endstream endobj 467 0 obj << /Filter /FlateDecode /Length 248 >> stream x]=n0 wB7 .钡EL" 3%CG#@j8^OlzkMR3^JU㤗IMp|;+y.xk1aj6Aa]Y':%CUDP%$NJku8q~1T 'NKc "3i9PjɁR$NDVv~.!w;M-#S~}endstream endobj 468 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1966 >> stream xuU{PS!ﮀJ{* 2ju}R[-յ< DG $$ `Uyqu뫮JVWim+;۞0Ǚ3s=~;,"2`Xw.)oLY-,ז`G~Į™[3(fCtב55OY}E婒òJq&9ymb"ϓS%ڪ1_X^ߕAZfQKR+ K"~f~ c{z?-}`oI+Aʪja"q*K,#2LB@D"AuD 1$,!qDvwlMd\,Q&29?Fb>I4C+,ľ<١.4fVx~/O-Dq(IpAT99;Jd?us9~8f}FH3z1{w3[F Vuv2, xz2}~IoN+AVC%ދ;\3F?Z_KZ9hF'\FK5pԄc{!m(;+ؓ_,&D<8B!,=V^nFSaҩ8m=d.eh#>= {LRdmgcw_/&q#. ZtZ0VU[sv8Ev5TVw OS+I[o6 IU1">)&0|_mkf %؉0AL h_- EEe\t ACI 4fY{h2: 7s L`yN&i*Q9M S8M FAKݑ@o/oC#h)]#m)w:? {y_BQH%JS18NWxig VOpE0xLݝs(svq mPAdXneNМ!'F#d^aAu3u]F#yС2뗪'j=ЬRjjų*]yƷE4VPx^{,őp=2'{@^w5K0( | +YF$A+Pd!&: r)Ņm'{@=Si ΃| 5 3Np_R zmx6i?ivq|`4ڻ@0&zI@P4zZI G#7z>}YhSzOAnIRy蜘<8B'=uo_BIS~q>v38?§C[m( %x'Pw^ hSG޲p7"2$ /=~V4Lܙ܉lo~P*D R<'>maq?#zp@:B{a쑷ˤrǤ'(O]Cƨ Zp><?J])hZwc3L2|.wx-h]俹i0jHK61oV=^gv 3vI|[sOrVUc;X]Fk2J][E*w4ר'anb]]*K|!V+sKuhisȫTުtZ}f7eFN/RAN੭-vN:jU 5"+ޯA"I>bIni8HRUkZ ҳ 4׷ě4V .4ŢtJujz}.jd$d4,Fˈ}Ti5&kt A+*endstream endobj 469 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 bKVUAp$@w}wY˕]_:6fD$ht,ôOqAVm9˪B A#E#VOݝM(rJM%FT&c=|)X!2S5endstream endobj 470 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 329 >> stream xcd`ab`dd N+ JM/I,f!CǗ^<<,{/݇3#cxZs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡹ e``` b`0f`bdd? ʾ?}17/w<~$.S@w_>.|ԧ+Mؾ>Z_7o}8,WG .d;[%$s쾞޾ S3endstream endobj 471 0 obj << /Filter /FlateDecode /Length 4137 >> stream x[vܸk,Yhto`)1c%d3΂zsMTˎT`۲OBd [ %/V{=N?㳽?z |z/4¨B*o-g_هEYZZ^zXo;X^J)ٻw/<{ [5\@gFyr 8 C%-.1«yw\i^~eN{]SYfCyc <tVZr0>КU8>/J˽crH؊Fʰ TZ[|&aT 4²*`d)YKϣ y/u벷{;*vgh}mbf’z14[߆^H&-첍]m`uI{X)Dž?$h=@ž\QJa9LL h+ ^;[u38V."C_km45Y5᮫.=Rrˮ>oúnmBK8mBPF![dz):M`{5A!=MH \nJkؿU9tn~eU3^CXu6_܎ Ja-OajJN- ֠ tV^baPyXvM"B'uşf(SS K۴ " i\%2?m>G}]5[; ;Olf {v7޷.N;a". +u )˩d7Sk*6ǫM.w )'"spvtjyMO(Zd70kú wKii[S8r- /N\BR|װH±߶fC#谴YW:T}p&^V Xl&McDBRVB8-2jq|ˢ}/`a=FzjθJ/ f1N\H dTbPjrC(oڮ^T&3`oG2J!Ηmq;[6}}vuWҊ]k#g]|Y_ !"qJTA&XÚj+IRm61K91$ùz!ٟ*jIuL=Ekwn䐪CUjdlMM༅ 6xt3CT,QRN2Z`.pZN`ҔvR8Y.BOh3:R N\gqoH+i.E#.`uJ2eVKWrc kRk_eW g*g PԧoKXlb*[p{J_͖z~EĜ)gzHGHL5*;?`zAtQ!GxPQ7AR3Oϲumg U\vW҆tg4{ L#C;9N&ʷpQu5]JˆSxM >r<۶j#Ǡsx^$!˴'gaَsߛ@{an֏>; A=R׭/f YjWbp`7W8XIUy>(DU{7"* ΄{.Mimw \=oa4ITV/o+|;J@ 3ak2_2YCK*gCMT ?8%O}j+9=JMYz>t NClV%Jb0o YMRl Aƃhӯq1<<-r(#.]ҧG\s3!QL󑘮#ʒ ּ#x/]jT N%%B12 C7g@SΤ`ُ`sq\_ir݋]JM#A1`Fj˜Ԣj|anї/)Aw*B昐 )rl-$-)O4X?wɋKzkCK 5Yj:!/^L<v5F%,Bq嗺I&x:K=y^Q!Q52UZbQm.nj~Vʱ4̷{u+$H"՚Af#c']6m; R2+LYV~9=[&K!/?Fq4RY}WoO#hW,ą8绽PԄ6j1m{ۤU-LR c\ߜ|/ӗϡ\"uPR Lc-s;"Rӊj7<i:|\)F;(-X3|h!m=e0v  9n2mN%EC|`gx6,*EN)'2feN=[BawjC4wt89!l*|[d@TW(^݇#NYuc⾞/M8J‰g9BX G&1",˽ɾfsƓ;=Hdyne$ǵUQe\С.{|T$J!Bqf@Mum֦+|0@Zy2 )P|vGVCxBK1 <Ioΰ.=ҙ/s/Oe`oKWl+p*˻r63YcD>|H>TZ)re6=}ޯإ Iƃ' *`_7]#=nq~,:p*ɻͶ72F[kӪаˣܝ&dMAa$vfXe j;!j> stream xZMs=iLI؛uđuRTeE͚ȶp([I\@~O{eJ^wʽΧN?ó?t|zw{m '| ;9 ;5(g;z"=L-ʒKv59(R[n+z19ROұk6̞.i^[Aԅ0U zRYL[E {9TL0)&J(XrŞAuWW9gVC/Ӛ=_Գ&{*&\GaOaab6l[@G^O [pN]S0ٟMe钛^\O4n5n)ڏ"φVq]s5w;XГ1r'`¿ h0rB+'$noS6nv]qdzy3~nra`Y.Gebz^Z`;@d.l R) CS B볣v>9*=IK-% UQs͕0e6l^ `u 0҅pz()-@^4?hS dzCw*chUQ" i hPIaC0$ ל)wVIJRbװӴɼnB GBHs<T3|B8gkɮnx fU=$u{#OIe7@#4;mSxerF1W`Da<%>%{°c?'f .^* Gbq슽CL̘*|h;h;Y߶D}_R/Yn-6uG.9wl.Ɲf|Sw8=WSh3b=jv<{Ӷ{&qo0p% K<Μ>g4 $j_a-h ~DTE4[yft~ !1_q71\Mק̯"A:R*rAP/@N.lb(2ab<hmC\".ZHR05?Yz1pkaI>G@8y\@2$0sy Ѹ/xj0@ӫwR1-vrSܮ]K佃qu&n_uz#GWI Wq¤Aʪ֜=C^ +Jvlzi \R9[>̓8R}dnD@1l }!bS<@Q+lʪYvq\Td7 CBR)"5ni1 j GS%j i&W$3v 6498LARuycO?ߊڦ4m0<+!ITnQc({Bz `ug9 M<"I ZAZYI]W!S[G~'wbX&< k@*fܥY6 Z sGy/|LAzVJ޺4:gpkWq~yf)T>AaF^ ]a8Nc.$CicQ E**>-xPeLhPӛU툛CGz!ؙmM$hٗLEpva?PiJWqV znߏaKGl$:1 VyJk'Eؤ)J#iT7;g0P!d*B^@Y~$jBfBkU燨 go}J $h\Ѧ"mF>*d$K9z2T{כÝ+]>~bc6#~JVUZO)<:[7dhX'qQ/i[_O! ˜N/MHiw! ioU]9,8%~(+'p.[8fc"r:GYl?`GuM _CJY0?$/9A4t \g/8j+EṞt}F;yi<`J󰯠0=DO$鼞"WϳuN$j2-۫.P BX*[[GUR‡@}>}!(|$/ctפ-߃YK@򂽏qwtPte@Ct3=%9Pk( 饓"vd!g"'ᱨtJI^Ui5/ WM0 % !JOݨoSU(.J΀ڻQԘql$˵cy#0].hsΗʞ(pO#ӼIxp1 8o0  X2|CV1;.@mӯX&P)TfqH>©6g NiT,Zs<\P HpU2Z즞uhKswrz7TwMŴm\un_MY TVO"lՌ+ nē2@yF6~9?+ɬe u[F0śG-=0&r& ԷDV8_@_ċ51Go۬ϏT,B,dE4>Qf=+$l ੒㶍t~_$#*BM6TG6dQ-.”mF0#!'4`aFxxKaz=3D\GJ S '"_|K^b  _T/HW -%6T5?nk#iyj9[6~ W NbaϗS2Sۚ]HfQ9(Z{%j `ϲ88S8U2> 0iaUHH XRgv7ſxIͩgK>^&h B9֣שA*>Yș*N1аoÍ ,6d<7Dl"̶l&@AhBI*URT K@4{UѭAטPUSWaG MQ)N8\my!6fKW""Y+H;_1#Q BIj(Jr*f- }JҡEkx]!ad*^W[@y5HF5 AVf;Gԧ'[2[[j1 v}Z G*e"gP 4ϓHt J8*K@-STy,h[lޅ`-,ُUMe)rs mm#AQ5S`nHrOEHb)ѿj }Oc-MQzIu  F,1ku/yzz/95y3e::T*ϖdă,Ч&y"| _kGm2/rkm^k246!@ `%KW:G=$G F/>ur asendstream endobj 473 0 obj << /Filter /FlateDecode /Length 163 >> stream x]O1 y@Z5C%]2~1!C@Hg|wu&/U$i2XX8Kxr&<.yU!t/V뎑UR 8()J747I3 7#SDendstream endobj 474 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 279 >> stream xcd`ab`dd M34 JM/I,f!Cܬ<<,{7 }_1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C50\``````(a`bdd?3qG߷0~բxy؜u̙[r| 87mBU\XBy8L;ódKމ}}}&20fTendstream endobj 475 0 obj << /Filter /FlateDecode /Length 387 >> stream x]1N@C"7&i5 4 \ L&((,Gz̗-2v\O2nRyz|av7򵖚?{=mOˣ|: [MӔڸx~~=jĒ,bN"rܱ\ix"d6YV% d{a$dCΣ:rBolaIoi6 “ɠA$dHB=Cq,═P>=C [LNJLNJLNJS5+mBsr{MR6}=zUS7endstream endobj 476 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3507 >> stream xV TSW~!Ds8uZ(ťڎP`Ek@@$H(pEX+nNTTtZ8uΙNC}_ eiAI$5PaDxBt; uX>NكRRdUjjNwpw*A1J%@(>pqٰY sQm^rO EV~n𙢨1-P톥6+#"Ѯno1cwKQ˨djDVQ)/j rRޔK-SKOP5(Gqxʉr&RSRQT*uR2_Rn!(x*]%2ɊJDѼ[،f;rOm86 c1ms@Kcik+0| LakSd)88BEWmD^t+q0 9 ߔͶ<ĩJ2D71s'=gp1AI*{ĒXM#}&XŃ|K97 oۥK}W/#Q?d1'!l}ܒ[g07]31+?g1tM:;{^3@=/mZ1~`,xL@dð*^3r̓]pYa2j9#R4]?L &#.$ @4퓱7۲wF bAqW˿&2gSD 4W؄C}&\塖 !`!xQSLѢ Netl!O*HjLndո):n>+4`-f{sztO/K* t_m^NH!Kֲ ~*(ۣαp.sbQWWy I(?pkBxa k kY$"5,[GohȪs,_} 8 IU3lVLPxnJvY&]$bCm~rʋjzsqR! $1g'oMB٩ 03{ᕿ3ΐ+iliLy;[MC 2sYHze {b2pnÝ@'O%vr>8 y$ѕ}qĽיa Kp{?>:vOI3 qdL^}G[_VlSGj0՝g8>rVk 4bSgٱP"8qm+E|Xk\h~9skyfpK"xQ3$ӓ ȤWgEzɘWcHd`JѨTh0 OˋX?8=D !;Xv/q_8 oUl٬L N+H)/1$kb#?/:M\!>w $XRuF7GmV+ažOjSj5Y)وoVrƙtUIҪ]%<-xt^Kĥ31pH,TLHOQ\-3!rL#5L)ׯ]#:.[l%M01w6촴mhU伄\bԵ۪JB/u 9~PbD.Y6PjUds'8xa_9r/`3%;;̘^ӰXmWF):r ܾ ˗I, ކMpfᩝCEX;_ֿMbxpsKZ{>5^_Y٤7;ޙS{)-yT:7<7p{ 1yԣ#4V,u8h3zu&%`ܻ?XaxwbHLX7Xyޛ#8-/5hɿ2Rq.Nd"˲Z<@@8j㈚5d5X6f&[@GZـ ^ tdVFt8xX^~y/{G/Tb;J[R36XAjqgp2 7hήLD`V*b;\gDPCdiقǑ55-:sfn/tR`[}3! .qM7t2w=ɚh+;otKp ӨU'&EGzSIl=EnrA+ї׿z(iTv-,`KsszӼi4 Rٌ_]o+/*h((*ͯyzN1WCendstream endobj 477 0 obj << /Filter /FlateDecode /Length 5152 >> stream x\YoHr~Ųͼ31< NW ԺCSԫ?qd,$U򈌌㋃뢩ŢI9DEe_ixR& O /θ:(8ߜTR/U n 'WK SRiM/}.OR>lr 5}6A{_)_Q}Hki=MЋS#j/d?fp SY[Mȍb[k!Z]6QkRzd1Nct 0>1oM"UB/L(_=!}X)H]U-ٖ)C繬j8y)(DTZY k4gJVK@)ԡjD sim<oMHV]ZM^ӏv<}{9M)%!:Uuw4&[SŬzyULuIyZSڅj0V7i)-_j) 5ξB 7;!tV n˫jOPmw]"L{UFa v! B(A#-l^Lq$+*.b?^?_nۯD6zwٿ_ D y's1kt^.Ht,]_6dFӠ蠑Ζi¯^Qj[l N32QnnG$԰ Ŭnv5~Sdr9FĠtқ.NdH1UD7)N BRinbGyB*61mG+E!_[XY L;w٫Zl ZOWv6MΧ]ž=?\=:6cft%ŶD% ;d$#8O@mq|w^C%V.IU]iULܰ^W_,-6Ew dqԱI禺\u+&* / = _qca{""_hnOtbgsYtv!\t08uA01A ;wk$GY"KXf 4=DH> #*m`GaLiץ/a46x48]w;'"nn<+/An`)Pd!8N|5i3K#Yx-3G'? Y@^ |Bsۛ+W!M"+++4Kc3A#=@B4um~%7q/KA#4 #hA"XwT#ŗ~V,l痨"06t=֘Һf#oɹZ*@Va#o$Q+C[j}\űC*ꣾM!şz)V/G3JB^@RۻK-B\uUdZ0-B6\~M&ᤂ/O*/V N*@}}{еm:],<\+O}X %GiOZ0kt#X[FyR)$ DA @oV%~- P "(Qwf>FUv-vlYpac}d8U| n~(v?YJ .8sF wgh{q&*}<iHZoB 6Fr"āJF6%dmHQmuvevW{طΠZv pPxBKv 9>\aԪbj5i@oT j|.D Q5YKcKbX-)U(h|щ6L;@Paam!nӎ>b3x\, H*xa7&4->SWÅs}ᕈJ=BEkDz6e_y 7UC?. ŝA*}]L9 @vIMY9؜bj;d`"̝XBoDح)1\$ NG@髸D ^JN& X>bDɦՑ`/[k_{5\h1xڔ06"A% Ɣ:rv(r0|9MߗR@6Gt`AF5%t gf s|t4NC ()M6z2ւ刘m ] n62h+3wޗ""'zpXܬ;}C!dbNCeҮۮ/>")*<~XkvȋxZBݺT`f>q_%4'tw7C3 r~0G@B8sg&pe"rnp> js@ph_&,edd͂ў.=zR6OøPzMQ\tcKƂmH;IR4Rẃrȗ0 pΒBGQ] +fpTD'>ҁ2)gH0 v B -EdqDJ*M!rH?SdBD$|.gҋ˘1Uו؞u|+PhE74^K.ۑ`62vUA+;Φ_S~B%/XBo\R:Q{n/ a#4ibEI ٻȸȕ;)D9uy)M Znci6ޤ}^CY[FՀGI V1e LL U̓PyJqFCIFU`d"{ٍ6u\ fzltԩeTuJ9mgs5~C-6TWJI%M-i`91ӽBaZ*lQX2Q̝eהip͏ esǫf$ +q!AW0lq14PH`Q"ցV/h4(%ml $Qh jT &[ UhVTXd*Zԟ\2uR!Tɩvq0_ L>dó#CumUtz89M"+j`Z2UQ"E0*1 B4=ˑP )|? 8_Nwpިꍳ=V./Oٮ};brυ΃k(8 hԵnb38UFc OXj[`(c˼;zBFFD~YD! y8! A@I `/@)'hW?}^؀X䡕b&O1[HABLMΧn^6\þm*&Wq zSyz.>X¾%M>Ί_Afgu'q*ad0]"ͱjgt0mi#o=N4;rzk22dS'7wErH-?#\/< X` V1MHR}FssSc$:J*WNmi0n;V2ha7nv/ޫBgިMR;vwqQJw/pڶwk,zۨGToϹlNqXPYzIK(Uyr ǙK!9i_L9Agwp W@Fp7@Y}Eu_Dn=>׶o Zm)@;8$M̻4xpB9`ucZK?c/ddU:OcoA3וh'V~r/h7 ŶD)jB"B|>f8J0wk^T 7{>j> stream x[I۸1K+d*)&K9V/Hbg-zՇ&E-ʵX؝>ߟ__֮tbq~ySĢTk|wVH|ģswث.JTj] X)=ce49p,뜂WF舺@Y{zM]$+]2)?%/;~L[?2EײU>S"e?oB*6] .}VRY˕v)~Z.\kq Bbh@O}yRNhSЌl+#Gܯ\ ׁ{|(儜aS(p]bi+9X61JIIDcT.fHJ׀ 9B 9hp.Zi FՃ= 1$@:`a=  ڄvp÷S@O"M&nT,Fq.@/7#(8'8GR4tnmV9+ k^׸n fEE(yC2=XmWdro` }W#Pqs`5F Rf[I휩~ g=!nBqO3^#n[:?eq E! (uSދ+bTE飣s:[u]6,ڛHǔ ?{:LS1 tv~u4:jd+R[0ʩ3~?꛵s֖~ud!d9e$6GCW,TRe1}]} ׎ ZN.":3Ktzt@Vv>.d u3؋$ŝ!{ܔ]ɨѵ;pj\ 'W0k'Ձ 6"QW,kS~yTzB7`at(#:Ka}яd$+~wc">u* J@c!wK>P3&j K ^> Њ,rnxOե򓆼a1gYa#I =@(_dvlB` s/obIެ,L2|;fwoqA5ݚC@8-D \.$IpazH&`#0/m aې (iy4Nu/%#'F΄8|B!^+um 8?!Ix ~ =v֏l<vpWAIN=fet&:ïytLWChuь 8ڬ7ma9JoC`+Kɗ ݭ ,P#6߆ouAyë$2}l]|ƍi Ѹ-v.Sպ*|:Sՠ;}ݞ\%~:1ʓHb\+!RHt[relO^? P q< 8!THn^d7ldVڶ8Nwcdt& {sH+޾XN"!lJQSė2!kFɃ0W̼ûtc=>e u"u:]XyҺ=5SaJ@Py QxlghŚL 7 JCد$GD+,1 $qTIcG ^o<RJlkN!dHs@R1='ܜxQY+ek=)Ք3 ?VPh޷SZW%fC!!3 bp<0t֮"Y&i8N(ie[̗r!h$R 8>kÉq̐scC\胵9R#*hƒ)(cDŽμ@d5V䁋]Gʺ^zN)֙lFJ+4V4̏ݣz J^Ēp\q)hh EM aniBݠ3 SͰT cV',AhP{Z"dz*SnV\O)Ks&CijlZcy3͸h x!} `Hˆ,$^N4DgV705|.9"YÀ|%Sѓ5s) >5$EZk*Yrbl7mEG#ңDrOj%&.B{XHH nJjA@aIyTIهN4 dM߅'죘-lHO Rm;)@IzWs¤C|UUgY3 o$WOzxI@xMN4 4N3N̔pRZR!:g`) $EbEt`R(SQU)Ъ7X`6xXN'Қ4173-jwI0*&chzmf<[%M=HE5,|9J{4KtbmxX|NV52:+.^~/tc!X0r{J:2Bi`D1p-@61ǡ1fq\ =۳̇_J]lB&CVImRb+ai:%՗6MO: 7)!&hW^rJ \ ]4ކ* @6,gkݞ*yh@`/H"̹y zq|_Hsp +UgQ/f\nކ5:i҄M?i!eO( lcsvZЮ>݇;Ӥ{4zVG{4W:n{uPs<Ə ߏmdC(ҚE$_fcJ*sfm_eݳGL5Xi~7qdC͘ÌJр}SMjiq)cG=,,|aov}QiyiĎ2h>rendstream endobj 479 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceGray /DecodeParms << /Columns 156 /Predictor 15 >> /Filter /FlateDecode /Height 156 /Subtype /Image /Width 156 /Length 165 >> stream x10 տW)ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*Naendstream endobj 480 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 156 /SMask 479 0 R /Subtype /Image /Width 156 /Length 3976 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?Z( ( ( (MVQiqOHq)g=@ZL4Tk4m+ĮH.ʤZjMm,PH߭oQQB ( ( ( ( (C)hWO"9pۊɎa <@ *MwpHUZ*F  }TuniHbA[ui/7}8ɤEFemn!f/$[ڮ+m?ST5MOm Pc IJ +n5 :י\Hm.}'#Zz>p-zoԹPte:`IQ4sx]d9kF=m%Sz\&݈uvHؓp#H8'$Ri:mty-+uDP0)Yu724 ŠekTi66K_ɟr# }Ep~-{ "pT@C Rp_ AfD T(af$  %_◇MF8ʸ;\@?qtmkqòA'Y6M8KzπXS?@w;Fk0 9euղVV8mOj.Hm#G#%~^O2NbHE2YY*"f=jjiĔzUczh;GGz1SlLPu?5#)n{Mn*L93Riba75V~Ŀ5|CyI(&$08s֛v1Qnw(#-1W1c6:hm$W(]񆒺΁wj)ÑZ")G\:{_: ԯmz xɬt:pIj:Wcϖ2:IE|է\-*J .զV*+3^ډ\Hw_3*YяJZ~g2vo-qjF?5N+X`+t҈m**y7hǬ|H"JcypA!&rŝUgf9rA,ѶAؠTpz| 5pYHR=ГAu8/Ҽl /Ҽ#;xʨNVxI9 :hkx'[rdBdʞ ^4kGuu\ǦECx%kIS>?Zj+[CK:ޏ6P9l$hj( >)Z GHWoOEuOW]CLq4lp,>l0.A]_Gwx$z-nV*s$qZ>黂*o>^[L0Ҽx]I&;^&q\泠u\11NIҚ7s@s[+9Ӱ< reoκ(Dc2}=>qn[uq _s@zqÏk⋻RтHsJږxKjpbstBB 2M|Ikq3IQJz"$k_c.q ۂWn=>@|W.o>`;}s^iHZg4RV`DaR"uW/xlm?kdTPF4d`A]do>{:#m(XTƬuFբ9& O>:^om׮Y>?ZddErAkhLs2:v5Zsܽ`\taPΈ;=yGk6w_*cڽ7c%f:(HSJ+3N$I8{ڪpY%O&?qknC0-+ֵAkg!6<;wo+G{8ڡݳ#;^cxylHny+#˙ZyY^ܱ"s>_^ o֚49gRVe2]߄![ c|P),js\~G)fR9;8:TӺ6S,CԬDw1O(^/g,Ü*9C49\TDF*OWcڵ-cOҡ2]7':@^ H-[!OaY8EE yb$[8DW+,!ݎQYQp1ҷ4!a޶@`S EPE%1 HTPj>((~{mTk9,Vcd Ԥatf{ͳ AztpPQwN-!zijvS.vFN:('@|P>؜򩡚9I"pV Ԕ vGQGRAKTF`a[k匜2FzgK@ fhy Fl29)˩ݥOT,۰e+cON5s@6.*J((((+mBsEn)  *Aʞ[h>Gi9ҡ5V=vVqInAs _By-޺jd 0EV5^ S ( ( (?endstream endobj 481 0 obj << /Filter /FlateDecode /Length 4617 >> stream xL 9P4D}UFI]s  s8׌Z4̖rh%Xf%?R1O!ŠD M)Զ2LQ#ÑեA6M-0$aDQ{c.E0&.NL[(]n#V6Deh玲Vdjn\j4ܹ:ȿ6q6i);WH8?»󳿜qNhf\0˯B.(\Z!gRʐ ALjӵ+փr9;eW`J6IIw#'[plZkyD&ORKl!TMTUy$ I%F?gUU$5?bxp5:|`ih:/ Ql; ΰ (;9ɐC}2sR\ Nzu$-S͡޳Xy.dPUn8 gk2C’4&V!Zyy#!,".|FlO|3_&;8gC3M'%hw03 h);\<UW .'K#<oai'04I_Kw'L,Ad1F+(;8R$RY]sjqȔ` @>ΏTJK.Iq&Gm R١kմ %xZpy$iS~'.Ӱ*ػ%w$MB>KT_5) $,:U\)UF1:BCf4KtP~ A$A./,`RmE}/ڣ[)zFL'^[&ɨVPbLha߁UZ񇣒ar'ūOT jBM\G .Kmc( )1,mŬvU* ~G rpCq anOU KdYlM9t%,CW 9ܦhWLw3KX*8ܫh7hn(@ 6,fbz3بoS 4yHR7jD&\ln``"x(ӳ=u(K/*#ŴXf=+'Y0Vsi C;8?ݥy=dO84Nl:cQj< Uèׇ Ԫ D*7-")ԫG^& AvMANC,~It&C]"~3hA)zMC9fzn ?|BmHJg^7ʼni`kO3 0x%wtoiBN^z"vAX)Dﴰ?ȄUTeY&SK}Z(qwn|]lEog旅.np3\!nWYQQ"axxS7`WY7t|oDD YxTkS{WEc5 ׻}ae!V(" j%iM5r0Hbh?ry‘>j;* lCzEꔉbQ o tE+dgY]!XjSNx Y^r ڡ)ijo!2u"^ҕ9ؘˇCq"D!`v DMCgsf}×UrvA*P&?|Ķ?z:vjP#L !)TU~aՍ<M;88+70ZR6Sa[VFSb{ ˎ^gKm!$%2qgs_ &xUX.ƺV3cLUnnMi^COs`rrendstream endobj 482 0 obj << /Filter /FlateDecode /Length 224 >> stream x]1n0 EwB7bpI -P$*YP!'t<[~w8˼ԖͫsIo˽Eg7n3^C5#ԟGe} OK[ [(6s4LKosގ=)aB#)=)aBw@w)AQf)$ʤ@Y4Ţ aBq^/”gI7*le e.q],0oitendstream endobj 483 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1426 >> stream x[LggYve\X֑5V("`A +.r߂,;., rS.oYEH4&Mkm3#R2|3~ىH$vUIVnO?.802%7;xjaDuޗge"WxA7J*o q)ܶ .<95GU撕i\x .BU(fs*%2}{1QoooRX:]+5=EERQjFR۩Pj7AZ)gJC=HtIZss, tZS`6]5ii/[aܳ. /c[˽C`OJZ$SO~!cZm$*{?j]!LM(>/;5 I"qˍ-tc;,P%!O9pdY@ 96AW] uFwY7hmj7^=9pzByg|6^{GbbXs<&Ս \ź ߠZލ[gH$M|I$v:o^[[Ȱ̙DYU `x"u,'\DHshUt_з:_t]{/f S5Q,#B 9F+f{fd2q `0.8YWİSP,[M{ 34TvF:THҒ0lC9wGC1|b> 7<~G ba<_]&c0mk/[c^J5g߂vIˌ}ρ7Tx+t{ْf! mfھye ozIt盛 &{7 ~endstream endobj 484 0 obj << /Filter /FlateDecode /Length 2383 >> stream xZr+I M󸮔M|%KtHLQV`C`8(Yh8dYn1`ó-'~P<N%|(RՖz1bii9d=].׳wqqgGc)%9zP1A9}aJ(GIP!(P\:*?"vے[vի`~4r'lh>4%Id6$_rq{{;5e0%3\@Sn%s>29"G2Jhz]DEsĭ@`ky_|~}ҐIƦR(u!՘KASKx[e$',Dk!ZUu\uЄ1%C #nxȸ u9Et;7&NX #)2%TI! eZ.otXD~ "V$ͫeUl)1w+ E+#U&K1!Bx[$ Ĝ)tC5@;X*A1ڥ4EYH߲o5]̖ XљQ^8Z-g˳^PHcpC_H8=8veX76 0g N3YG?6䷸xݟ8h-׳b@no| gR54"NF&W2Cba@$m컖V$!$NWfq'2zwAWfLK|Ybt⪬?(nR[eRɬU| fW߂ie:` ̮VGBqU{YeրO]^ P-4be_=j, 2CHȓҜk3k"ONϣ"Q>bk ZJ%;z;;j8`UrꚸYyg!n׫8H#ݼ:CW8'HF[M0] ]ܵ InI,)&moRtݰSm;+II5tLPo<=䧢8S. TċEv?䧠Uw\"={Fu&ۉ?M0GWxڋӤ 9TiI?jT8OO2'|vV( y.jp@~?&(H+E ė” *&R7y{N)8&ўi %7a7J2|'ņ+fvѝUW_sѲ_`YEM2a7~o[FV]ֽ/M6&wPb3㖸JZrV_&q^W#NGv ;pUp]/҂\? xU'M6ISex EL][2϶I+Y&[ȉxO_몖d^L ffMV?k+UWYh;E_ϫr}m }ᾰ GN=`fxŬ"x? gRvpRRjȘZԆX/t>K1sOEtEofm&?|~C6 mPrsgyuY^d=gMb|-, ";w@Ywq-Og?o{S0SŬj*#n-B*٩%/A m?+ ؟[2;b <kxX|sÏrCOLF𬟕:gCI%r6endstream endobj 485 0 obj << /Filter /FlateDecode /Length 4178 >> stream x[K#|S[t1:7A^'Hb8:@zGhcƓ/NUlѬ;=dUꫯo']& _,ϺٷgN_}i$\i]̿&M2jrY֛0k~A]Йt0ZDy|?̸kHZJ5d٬_?bձf}LN6w­E׫dl@4vClCzjMK6yd]xKw%MN9-̾Vl0G߁k09 5=EGT}Up3\Px)TK9Wk%3݅7hdP# tP"s^1XXMdywkG: 7I Wk/yE;YHG,=j3Kǥ S-q. S͵202np݊ˆqM0FW|ڛPNC#cF^0HMճqD vwU7v'P}7S4]Ja х;3A.RCE;1@4ҥUå[`I_!$rXS?dgzGI-k@ ahausI3 XOEԆ P?ex`D; :x~qZ X60 2?=q-/asҧ}7; *hs hV+f#cI'*A#bEz7$|$-@ZF7@(@ {1²8Q;y>y6,P5 6,fcOa^ ޤxKQ3Z%xMTILSE ,9`β&' g橼Jʉ2̓cT* (p\:+!R=p Q AHW@\B$JXpY@ ;QpYs[O ځE-:9[ZEA&0]Uxy@dSTBbӘOIr N'~&w pߟqRPkLhɕWpSgEG 趇$g޳VeԷ)YRM<䓅xE<Ǐ)0Κe2udx6(iRHu<3XPjQ3kBk[$̹5Msoe1A+^9ފ[7Drղ Q ;- #h:;aae`8m&Q#~}!6UdqQXyr?D}hv9*Vu- `ĄXUQM&ӵRw1~^u@l,;I vb=cVydt&"UM&*!HEA2c/w۬8 zojX=88ĪVL\\ 1Y!qT>ƁZԗCOщǞ| {*|ON~B5Y%8 $ò@x#y/fB̌GG 8nd <+Gu.J \qDg#.p0cֵJLt7HŸbHA 47b҃"cY`K5 ~qpJIec T5;RW4± MJF, ] D-hs,Xh\s`GMhLȧ{4O*{јsewNu^. Wk<sY1Iv:)6ٲEӫqT.O @B|^WÛzf1$\u!$1Xv˜v젼ǥxsX'> ck,~AM](QmL ۦ7@PI)Ǡ4I۩7߬CVbA!2PGX3j@XHj+αcلP1]pOGV,iVX%#xc?–Q}℔/q4OU u&=5ۓJԓ$;5gY] -h &{wO˂ <0 %o|‘S?)iO9ڱΌ{N?Xy؀RʱR!r;"1;<OvzNeUྼTͼ~dlkPrVnauX,)iփzWXq;IvPW%jUwi :4RȒ$w@nQ38A)y8< (evǭ@=(_ vHXx Q- Ԓ(dZ"QAˑ.= u>Lt:,P1[e۸mBtomJrrk `TRP\JcO޷bG|;dn:*qQض:wR !ߋ=~iQ:xbp-VZhVk^VH|:nŋ.Hl  OVu?/ JTkœM[ koeSv91;CbdZvSfNCxh E yՖ;O'EqV鋂3ͱy}$ rg\Jħ7X_ Jz(‚@~7ׅ.m*b8MxJ~(tI`|~jXxp\q_FM#!X$:L$-p8|b5>+f!sy'Q>&BNx.f;`noCAeY1: Q} iő}79jz|^Nͽ[1VvQ0*`֟m,!N% ql;v8L{:880+qha ]yy  -EP. :+&t@Vv5Rم'2zD)&?Q9x+/,)X}70UsjG $Fa0$Zobg%T+] 4}_Zx,xR^~h;#;׊@QD=<*1&zauf6 9oEHj7_> hexlpw/GH]R\o*%!z}\EO?B8KxګhZ`[Q=+3d]]"թ?#^'tbIy̹v>B]2ZJG=,,7B7w_ﺨ$֛ø: > |3ҔukR!us0E0 7q&&j(_ȗ vŏyYq2|vmٙa9'ccOx[r[A~b}b(D{!~' Gq߅ɸ2frl2։\A ia}:5Zbvٴ-} , HN<xȅcxr90$XgNq/ endstream endobj 486 0 obj << /Filter /FlateDecode /Length 4300 >> stream x[K8C*śx*C!)U]#"g%3> `]N @?~V%V/Tӻɇ _ɗ9rlz%lʵ,SL鄚^o&ogUY)aX劶nCeVۢngs!Dg72%΁6^L 5~7K LBVkyS|uBb[8݌۲bL-Hee]ܒ[jQnUʖ[?MJwxOG;s";G?Kå!n|Ex| W\\Wdy4q]:Dq_O@RpoM~\r79g04ujxvMcM] [<NW*D2Ϸ 2x:$kT&윲T`茸Լh9nVA;'u]9ov)qXj2oq,z7uStpoxfg1Ф3=^bɇuNo`.WH!wM&E]Q#r. ~r6ו€[|N(WQ?zaT!I4v%k.&* ~Uә,D>9# RV=ooGMd*ы9]lw-IEKʢe@h.|*Z'؞B8j~ʁ"Eyj~_n~oSMFCNJ|Z$||Oy׋xNm35#uܞwT !a>@˧"Cun,/p3;u#qUʷ5ڡ@c{jpj`;q5Ch%c]ӋmX\R,Onvb7ܳm^č\}V1 $^B>] }3P<Fq! BPp07c8Ô$*rcTdi% S Tɴ C:t-I!Ԍ If7GCrnj9IZ*m*((v{!NC!9(Ν.F 8";PB)MfMj:켛Aj1DJm:-aAS D[9>Qq;BBZ 4*f^X 9P 0x̊Cu+O+g"灣yf<?ć =37pX@ VQ`>uv$@Ӏ-а~ }z$DrCl*B_zedEеvgcsj MX_Q@d@ NMa!.VŤ`crE0SWV֔E Y{3i IaUϪOh|ZǑ46,Md$K" G@-/.ӄ"CN~ g9Β|"J"i"l^zyH& gѳI"c;dh"˻ǻ@hgDFFw(i1HV1R5YTLiPxU/ -pYnj.N%Kօl Ș!cjay'}ՖVTYfCup{PC`m sVق\ĭU E_&I>6T>6E)ۧ W B^MU"`/qzõgƁ0OȂc ӭ)4WFaì;~2Ng/P 6]2|68u2Z<ujyV@sm!h1Dw&0#+LB]ng1呲TN?ñ9D#XO~yw:;Wt*Zky<+zeluk!M_|fuC[9>@>enr}GL_LaLix٪O [#6u@#Z܀ϱq}x{}ˊ7~pzT1 x@p8WR;wQF]aE?'V/*) T}eiBK|]OC iP;|7]"ϫUn\xv 7F7NȋMf^֓M' iMc\C+aB9U:zӁ8G05,_H#ȪػHHuR1󛕧]QѠ&ežx BhV qfhI\VGjtb-^ E"5Qq4O!F3(%D|v _ sz]vҹaqmWgvM=yPm-tleS UO(!< `l:&=CT z{kK#T9ߥP<&R 2^I&ޑzj&!| T)pVS @}\úYÓ*D\q~ם Aw],eUKRKϐ/Êc.5$]$)Y8'H.Dy/A,_}/td]0)uKVZZteNpc REMhH?:,>ĕ+pm:ﯟkI5dݡӇF|> stream x%t[*h+w1 L 250a[͌,z*4"YER7/7.w7›US7jqpS"Epa{`lcQw뛟ۥu㪮6zUաkw[c %~2AM@]cc,싧|}!?w~vq= zi!ߐBsM}.,C¾x*&͝}}X|޾0_O7MvG>X"պ+twNٌcG!Q Vbyv-ƭ8`./78m87LHΦBUYCwqs?P'?HX,%}\P fU9 9a {I*:8l($ڶS#Z# yYu'D6n+$2D8uV 8hD_h+Pǧvo"Կbͫz%;l&_z!BG612:V)qFU٬tK'@gzDq/?6mPR2;@a:F++TS4y:1}N_m͟nԸLP~\R@/ KY|ca+\vpt_=e RIpuLXoT^XR͔I(♄jInE  }U僋|PXf 4'v9۔_Vڼ@3~P={z2<&,Xs/Uަ^N#NK7j؂/˄]@8E14ud#>45U~ixß-#ZPxؾNȣR&\iHs5QJ `t  DBH n6:m˶:4%:Й2b{l_y(mYJiyއ2esN23Į?9 (ֱ K\!˱{&`uf)p g!YWiCWox,%=Tшuscj Zww5@N Rb$] s:Z_JIc6qG3d?PQx oܛ%p7@s*U83Ѧ? H[O۟FBoC/s9K2j:*v TA2+\@& s@>圷Ei&) W8y> cðT#]L8RD|yԛp9>G=vz LdC`IJKk ;IT*]ڐbTMզA)lJl {/PoE?1P2DJy<;q@=*P۵l>5#{Qqpl`s9y9P" +9F"ֵ 9sy1!P8W *--)H"nrv h0߲kJA=C֘T9x9Gs.48qՠ Gh2+.:x^H4h~%N9SP$yj=ehs/" 3'XL@ g)G9)@_H?cZ!&y8Vh}{2O*r(hu eY//Tvtw KfHr80I" liKH(ZT#h`<"k s1mڱzϕP3Ӗ$-/Dg}.+ >bOËڢ-gl j:h8ΖEfUW~`{%MNűؕ`:#<{`wo y2 z4$+\vu)(}l_2ƷZB!TU$Vo\PVl#"2 >?ۍ}gX~\6lL&R}:4jޖ'|*6Cąߙ<*5i6H;)Q 8um$n`7n"0bh3䥢e|&i/CswZØX`3BJfʕؗNdS}ͬ5 "M%UO.%ĈNy(=pQ^k,,tv3jGƷtV+Ϛ6鰺ҚZ k#̗LCe@pe rԤaq@ -ofhљ:>q|pKNS8X>AMŽbpBsT OGΝ8lhE_e~)d)?9~77 &Y{MM*pC ;L A= ;Jh V3Tk |0?ǵΫ{AKI5N,y3-d}GJDf.|D` QmxoK4,ȮΒb6AХFYeI9!É*n7z3!"2ݙ 3Z-HY{*|1PK=Nޙ #3¸~/Yįд4N^iZMjYO/"iA;hM&e\Qcǎj(4Ns`[)M8 !Æ2T?}8w,zNAEjM\Ӛʅ>\S~3!Iq;*h!.YhA=-S+cuUtⰲfRM+HQkH1Ťy+ +$qeo?=B*hs4ܤ47":|5uH)43%ebPJ"Oz̻:aucFC}z[(vGx<ܠX|F U+77ۛ?_d5UD~!`!`vwp[+xoJJ:ŭYA\ fGL "EeW=$FPq5*xy6r;jfw'w1vwte 55yF!%8)kE fxqn0\£7%&^*0x[a$tL3,$j#LYj\'x%f2AO"wSG\Enr3cS*}M iC[ VLwKgwp4A/x.~쇍4HM {DR:{[E0׊ܦ@ݟ8UYHȠ UtŔ&Q*,$E-7BoȜ B2rL/XnZJq($RΏW R؊ۃe#FKhp`U35 Ρ)@9 ?/.6IF`rk> stream xe ֻXs1 E@oVwku.4oy~a#DBp[uӭЋEZWnV6.m~_ɠ:V!aB"0R kRQN!ҡ1AT j r-QR&FЭpG,_*W EHoj`"uG£j3@F`x.%r ¡~Gw?2J%Mg`g^$C  Kߪ&A/8i=s޸^J'vэK/^.'FRЯ$l裙yFTVUYƯq!`<@yhAAVnL<ߩfBmw=ICy qޙ.#4f[<D˯ザ[Q'jbvs5',6kXUBǓi[׀2OVk09],w6jol$VݾCY4z1Lה80Qk&G@GFj߶0ݧm^>h3ƒ7-hCDe Is@zǗhcQx,BC~+c-"+@wtl&:: ud$<E>X ͻXw3WI8D&vL_FtX'2bH/A~hvY igme'U-[J@wەdg;hyiB{kP+Iw!s-'۴M!9m[՘C Q~j*oK'ypZ;>S,æ@F-i`q:!\?Kz@^=Y|9a8f2_ Ge#m'ZuZ;oÔ,:ݶ= 5Ys NLͺp&N,UKmaEׇϣ_^O+QP!,[AnXEV}J0Z6}F+ch fvs:Dh˅Ej;v1USq _7Y_ұk={TBR2m?OIt(=&J}5#x #d߉u7P 4))= N=a:ړE_OGWόN7j^:OQs?~ήwGHqV2hϽ VVi[j)-8xSgg%A~O\q\xlA/a}-*ȗ5?9?(5?A[br.`*w)7x6|A~cWiΗbq `|?ׇre)A-dkǽ*JeĥVqgǝ~yݫuiCOΞxoۋAApA|>;6)EBR7LYQcIenT78c{&!/`gXuX#Uж L,lL*(!igEYP "%'}SFc:p"9#Ӭ=p\*:aK 2n9xp6Ȕ(b>G o=3RyS`&y1'%Utc=.Y1ݓ(q< U/3Mu6VpJ g3'rVv1X{LrȦkg MRҡd:^V_(~Ԙْ 2,YýtPNl^QԈIeFԨQ16ҟ-8h6 [j1s@+IJs4X `BnߡN;&! ` 2.5xq'kyd 5Se!*P׊LlQ&q+9jhч%.:F zߎMp1wwtբ{3EJk$*hcfpgI/bJY5 Ss 7鱚 oI2 P1fDuUm ̯)4y]loɻ2}t A''3&tJ7,ZV:jA}h8mR//(Ʊ4ra'aܟ6z1k#Omm)it<[b%1)°|w&uZ< fOsk42'I,sZM^:НGWdvlx*!7;bRۀ"͎ݧ.T!nB}i:#RvrɪmDìbcY@XhafٌtB-23dU㱟 DH`?jtm㏪l#Gʤ$p3٠`zW\tDǸ%~J-ܺl(;!;8`%.J5wEHVlꍍ[jO&ܞȍ魍,a$ۏ ݁`fq1Z4,BJ| ޺!-Xt'S/3j6;r7vcRzqBCzO}Ѽ$m2'?CIU e>ULu Cmzw#D&\4?o83YGZtfMz\6yGٞq;b"@ة jB),Gh*ㆥ3#<``7d,E}T/Ratآ2CŦqg rۏmeä+_thZٙ4nlj҂~0k-#E祗`ZKx֧O9DƣI672Y&Bl:E{1=6VU rry=&bLZv ϻ>T!x/:h.Ƴ[ Ys(.߮56Kq,6` e%y ƾ!ŖFwTuY|w5t4,I%Wm~?W Z/t2WL9r.P, c(p. ;/"D ތh4F5灗Pb7 ]w9L/r l*qc,Kl5c m.:*0 Up8>LlLK-i^SzDjxݗE6|:ŵ`O.fTnBS)t,gNdtx&tc  Z,=XǪ]BcZ=ۍoK)Z&WBZM/'`y&%rV>/; ۫B΂Luu5C:SYB>O]Igll4]:so,N 1ΑD>,S֧֬q93Ud6߮&^aP.6BC!e],ۣ/}KN^qs? 8PɆj0(U8ۚ.'_䎏)绲!lݤig@ &0¼,'4-3֝3grk(m 7->g[cb(n7~xjFKz٥QJhm՜< lu3c\(CdsZkdGKQ)S{,_jӪڀ. ,lJk4-ƸH \Au6.#^QX<0TkOtDjڊRfi;1vL[;hIO̫g쪠W].EatܦyA,#NXF!vV3.@Q[acae}WFC ]R2V-@xoqAX6#qa !~?Sd9y{>|N6PBk ߾\r` >ilʠ^$4m>6+\yye~endstream endobj 489 0 obj << /Filter /FlateDecode /Length 4923 >> stream x[IFv:M9 `+I4Gj#vMmBWL/j#E|\E\_z"-zCeͺ.k.jԢrպ6nq*h[6WzsSm#[xwNJ]6Ň w`Ǒm-˕4mUqjcgz0jPŶ0B P4[D*}mmẰv+|kB h]*%sz+;C.9_lDr]! +mqzZG1mGp\k Xh钉h8"F,ʬ̶~{u? h;@M2-`/8ڂ|_Wb%wrnTm]@jQ)UM jxKq,k' $A]⡕to<|lo}?;Ǯ=t(ڎb10.6bM4Yv[4ivlل9:dH NO奆9;7d SeJdjw`zh`0Sԃ%;*K݁㈗݁|hw)mfoPf]Yσj-1Y Vq܄?!~$a{6tLTbbI`{ׅTF)sKz *_ͭܳPDF|Wsz J2AOE8V6_l>u}سu@ސ7CMDz8K!^(عCxw626ڵYǽ|ӞAzTh*ݍ>$R0@UMc80I!!M~kt:&9/#zVXF#pm{HGC~ "kK%[ oj--̂ť3i*v5(IL.k#h,xkMF8i!BˑF{BÇ^>7)(M n۝꾿w#ifw6`OwDͽ߸_t+5$Ki1,9{)"5Vǃ3Yg2y߳hBki9ҊHȻ\4\E<4IFhIz];1LFVAbx+襎r/8 _;| h|1Rȟt,>RiN KW~M ,rClW@w"A7=`e"/q>BL XrጹPDi7T1^0doqI\!YyJ쌎bij'uP[bnXIZe.ofXRCmnd7]+e,N(Iс]xcC d?'!$ًThҽ}qer{x4KA͡KK2OK9:q'G!.x‰ѰxCzJI;ҒB\xك52:?>\O"NjL0CKfcɅz%-.NjeFH@>@PR ۾Ա͟Ө^KG)Vebj@!&&7CٝPRCjڱ5kmȈYgHfNӢwF.P'O IGN:'Lf0hy&K|Ѽ T9 >HԗБ6BJ({Z9e 1#H>,ƆrVOٜ.9~z %pnvBG%zޒ5-D~ @=h9Fd3ь'W8ck0rQV*3N,px-;!wԊR)oiAuJMڲ'5 BxȘL]R Q0`t4tb6 4Clm10glhBsvl|xь}ɩ) a?+1ds8' gƔ(?Yk=eŀ?f/݄WJ-V; ي59m\>Χk"C'K)E8Rt0K*Ny,*N40t6f,q#CݤcL ^q>.w)D'la+&&DB6BMxnJI9[+U0%bRlNcme'h pZ%oY0]l:̪qD M˴R 0YiMw"#H0bjm;Fŏljl1Yx}$8  h覅8Y'w{Ĭmؕ wZNخ~EL2٥)z6^+Z别X 2qg|zh@9CПD`lP&wbu³#N6ȍDK{Jc72]s] tS9,{:@;A-:n :\ `\@Հq=rUU嗊+UE%ϜĔj> DSu 8RV:p XDå hv.Bk(BD^ɥHf 4WXLj %)%\fnOz_͈ "OtL:JyW?U4/vWaHSoW?^T4 +/*Ca)vp [azi%w ^S\oN)LTӝF@6Tl_r(R=9\esqa 3tZ[P4sIk=#vVv_{ft|7on?AڏCwo48Ҫ־iҥV\+N[|xIn7 @B]?,3IYxOJDendstream endobj 490 0 obj << /Filter /FlateDecode /Length 4240 >> stream x[K|2k`[d;pb'uyj܏gד_")g7NsDz~U,}hjh/؜5]gg4Ԯqlq~}_a F 8ߜUY`'ԍ4٫v+dn&媩eնzr%y W]o夵;}vr>HGO"+j'ӇsQ7F0Q`!81^="5 9Voc!nJef22VW.Ԭz #Uqz휩Eơ0'LMt׻~6v=^}߽Nwmx("ϤMvnsA(y-D}޽_qGZDg|5E7R\'ڒ@L.«6kKt0*ɧ*if&NcXA6B(}Ri6K)hWDUVz2 Y2!쌋< +mjmUX9XWBSpp8w1vJէWNPuNORJ E4s$h6̩yYI&2b| ք \1jlZϔ2vi)'T]f)a װ%jLc+d@a"jOaFdc˹]$ Wql\dxAmQ@:y#L O_Eb@?˸7K1,]wɔD=I=]m*Un}7}:B-B^ +0k2C!=պn=#4DJ ]?儉`7@Sd6#8YHK bVnWm+-H몏"$׆`$̈́N<2\q>܅ou k'nԛYp9Bl9 >u<fE"䪛h\[m?qOBz7>Vv#H Pn0ӐǦVd-[H1`e+P7 /q+(X,CNW]=PA\RA\2#1_U؋2P~i1Oxj* , p%:m<^<;FgT>~8H;6A0M CH} #~`BY,Xނ `uaՍcjK>\6cgP"`2_i!ToGͥ(#FʡG=dݐsqx.Pd-TM=uKL2[.*dA  Oc ;54Ra'P9nGUPa⠼L!,nYe7O4*JfqeX^P)18YoJN(m`p{>%9Jr)r(ބ=vwgNI8vX<;*5o>ncODQf1b$t5nvgE׍X6æ[gY53>4JGNi83\W.f PP@ŮMYcPyJ#S$-u/+YKG*#k???Eܣ]٨Zd$p:Ri=C7l|ij.ܩF#yVB ׏+wɥD}8]3Y*TyC*gND%Xvʖ51A A ư(^ 6^|)+UR)=lv8%Ǚ*jU^MZ`9Lȹ%b~'C6nIW'׾XӚƝ4 (pM q!YA*ef,1͘OB6W'Ly oj+f%ܾg e.MQ=| )IM:KVƽ oIQ߾p%.*j2e/yP:zJ/.w?KщK M57_%BL1^ Cd!R>fE$QtƩLlPhDEZ:Nڸ` *aWs0:qy|0g5*aw+tYoo2b4Mg#k bݍ +Qm\=˛\k?dr ڮ '.#wlx^<y t Ǵ:BpVEe;W^΀O^̳2 L'azh:%tdx x(eS m~}KO*H*Z;P8O(@wI*%A|W.mhe%.v"7Y4TfÞѕ >z+#d@]wƒGR(x\We!Bs13;IhaRONnxrhE觍?9޻YO.+5J ^|`sN- tV63Xόԡ!k f!à:4FI_~iTPg}~d)hS M2vWՂIYA&o!㍥~0Z^cm%x y9GZSt>@+ې~ gTE%d.}{?fڞ!cڸ r^|w16BhTgf S1nû`GeJ ]EtE[𒈘kXLqf3 Itٔ")I.sD+`X*Y[$ ‰n,8|gi!}ٖؖmjGwT(LҤ(@;[.ca$]|Y3C~(TJ[}+ 8{B6TCD@4 DM¯Oxp8iRz."X-n,_YAbs3Y}}p @K q@[737|A-h-CQxq{ ,R#A]렞އxɣD\>^PW)\]8%|\Yة %5 1gc0s> stream xWyxT"8:xoAA " }',dO23f_6{a DM"lk"XZ=Nw`+3w=;y}?5"p8O].AZpH8{VrM = M=-Q #N|xݣi,Fq83JZ-Lż8k֜X 4f̘5 YtaLBfR̚fƬ˜iY1SdlIuMc^ߴak3Ƈ& $SBQB~`\(j꫙˲g"7O*i}8-2^^ь`S)j56RSfj N^VRשj.5ZKS8G=M#8&cX969/5 rDH>biԳQGs?kGF>iN;qn̟~5n,.~Ux#\^PۘA% * &xGY?eESkOC'J*ˌJ i -hdڠC UI͊yN;&hY? :c^\p2upQ_GB[\݊(y0{eE< kiw]vԹj]A>gzCTh9в$I!-āVx&ST\ :)M+KqX#@Wy+c2{Oۃw_@Rg" SwT'CJ^NA DGZ8!\?m_o—hJX PV\F(Q'$j],(4k6}ʛ3y옿sn|ћFdHy߮4?I>g $@O!MeA5?g&{þFwo F\[c O!5-h *rk ={94d/\{6>Ӊz#(X>0Wژe18zQ.gV,VG|4 sP}B͡ okA`hP)ty[SD) K7IRW%r]!G mT x QtΆ& l;ipyu/1MESs,+vjgGCCceQtwmj\\4`PeOhMF)D 4lOPh*}EI,vnv/̔EKXqO=:&=[0?|@ jk EȔRV%d?T#wP:5hz֪q9-2+ӇJZ,&3K d=Ah>4g..Q ZZkQ<&{ W- Z+~c] ՁA+e1~?p skdrAf&;(wW_DVF:қwߕ%aT=[bV8k7\Z4RZS{3`^bfn2 d3#͢}Y{U//gI߆j.Z2o9[ O h]2\=h]q5 57w5#oG%ZVOQ1JiR.f^/7HDꩶ@gSy;~ѽgplx,Y--͒玡H2K^JD&~xx .e~VdNG">C?^DlrЛ/u3ZTʕ6_͆4D%jᴘcBvioΜa }CFwq f+ =-xi?DJ{<@*:JӪ5 bg" 5g1g{IL\f̖iڡTķ.j4)@RB?Ʈ!@8VIu7vIspWMW AjƇĄZϳ-`׭*J =n;8zz ,>$țք=a~Z'Cqmd6YI WltE - /Hۚޏ;γ>@sn_tr]F#CCze)b`Xۄ#?GiNVZÙwz>cc.Վi2'[0?yyɻV1{|"eQ0FlɊ4-$Me:S;;1,9z4E*Mendstream endobj 492 0 obj << /Filter /FlateDecode /Length 463 >> stream x]n0D{}$6v"AteNE>3#_C`DiR<=˽=oWN{}M?R_Nkym~j|{=LQ|TnSRq}ͥesS鿭S K+Ca OP u#]P]7p%XV@+l%؞D@ " !f 6Ҧ,&ZQBӂ(**(*j3od߈Q}#Fd7jTʱd Y'O=)~b ! !SR7l(c*e,e51 s28+`L1ǐƔȘȐƔȘȐƔȘГg h  8Lׁ:1T`u D"A_/oy\|{]\<3Zݿjendstream endobj 493 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4984 >> stream xX T׶TcQCA(C}fAQ,f8FF1&1)q֘SmѼ_{Zꢸ}{16L&_lexoq+cվQ֧#$g4FzI֕n}!Qe0h d"5 GGŸL8qq>/ex%!`߰.K/^> v#`. Wy.w5/{RP˃=b|݃C}NļE|,xQ6cL 5ۣ K CDvDa7,\Qݒ\j̅>˸_YyYkf?+\"լ jLhEZد¥,_sgKpa7V±ݩ67l,-r/YT 溎h6 %B~f!5E夥vAp"𝱪]Y's%s ]?sjRC^p)"ldVV F#wToUc̟`K5O.DYpŁāʓQЀMf""W(az˨.I rqsBtch]ǣ]>Chm+R-b,,Ԋ l2qZYI 9)tKhq/bvg>5"mi"dAzzRu3ǰ[ԿˎfHD{ױ" (Ẉ@*=ijm_FQN?0yv(zp"?Y+pgDCy4>;u189syT 3@%ncX9hPm)Ħzu>qdYug䖃SFhZqoq~F!{+lXO'E775XT)xk8~ϺPXg/nНh5_-5fLJ@Cz(K8"K8Ø A]! ր}Gc^8L%bszaز i*okUH 3S/ό=rx9p>~[r**b{ 0RtG3wqR"ye𖐜X~ƁՍ{}WN {?8ߩg{v$+w2DS{{  8'JIb,zM'CzS T"X519]<ߔ{ƺ q]oPUZ' eHޟQX):2\.KEs$1왮֟ @*䄷#0w-Rc~~FK?:41D$>$ OɱMJZ< Lz,+UF$6цHSR)鸬"pm~z Ƕ˰wI>wK$=ݼ,ϷyLkIYҀ2h` H-МTH)aKUT ؈ lY%To>4d$?Ǝg)aĚͲ=W=>xI fņ;} FY=ނyyIsW~i5|Mۦlݤ+CkZn= #8狎Wb/ZW,vY`hǵ(_ȥCUWҪN`;BJ^E9ZuSGKuB,y u+]{P?_&'Υ靖#ODNNp'vs&Lr? muuAz0脚O7O53<Q$VanEpx ~Eoќoɥ 8K /w"cFrټ^2^Ix|i pƺWDzB h}&d2 i Bاu(2lA슏T٢ڸd ߼Hx*X 뱋)vR|MZGA,HLYEr;N[EgVtR ǠQ;OTuR/gͽ1Wp̿+lwH1ߠ>fObPXΪjlp,-g^ uEWmP:Ôci"x(+4 Ql(/dH?ܢ}7nsa屄8~ld(qn&X6'enPՎS.F[ݡ\\n!snpi|,</ܴzFe 6 I८M2޺`LN$Bnm!UJXkC6dR== | ;(?Da&X kk^n՚G'QIr?Ks*(fggQʷ-VX58W[2ɕ8o&*x) >4}Xt<꾏W:nFs5,[?Ԝ-tY󮾁iĿWNX#yl iڞ$vɀK+3Z}tUIHW"o5U TUjd ]]]Aj+Y%s̪2j!9 ģcZf|+~%37f'B>69nm~23"7.R/%^#C{QFMW/X?+ Q$cq'u^!NB/rgɸ$ 0|J`H+lV+ZL@rfv,6N8jmxȑG]%[e#> stream x]Mn07N$4tE*1Eo7/I]>F3)O+9})^ۚԝ{ŮrÔK_~u8mR.}ҵZtK7Rh~<>ֽ0W*0d8& }cFݶ{Ԣ 0ޣ v[a^ `@IT 5iJah*"FcHhX79sos4F9T-/ny㖹E[ޔGXn9^endstream endobj 495 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2821 >> stream xVytSu~i* DGGC-BB[/i4Mٓ{BtIR,t8à2x\Fg/: maΙyre`FLL0o0(?k ~ΓǙxgmyD3!:=A3PL`$IJ%h8B\Vh1zF-G x_(%1bPA-7 ?C? Q#uWP)> _+ZG\D+ؐ%Y-[~>Ks1K$YW1j{7z52C W,.!D_d´I1[BL#)H*rbPNr029Z+&/=5 wM%ܷG3#h>ZH2ȆrnmSP n<qG}'500]+ }ERJED_G_5{lDӍ.4Koe'=rUꦶR/ho'hf%,n.XwXa5eue^BIK\MNM-1ԣKvШ󈀤A{T֫<)$(9*:.*ʔ&n9Z n>Tuj%QkknitPW,*>4irT+K"gXZ׸Ɋ*<j8qǾ;F}fҨhk-TSڝLrci![دػ96!-iM\$Rjqׁ\7rf b?ޑ('a$Z?k ram1OrŗN]9xl"HXGֿsA&}GewO*bj Oi'wm-<E׿q~ZD* =1WdͶgo? }hZBP'T~Sqme| I[O.tDc#MU{e%U?Q23JmVypuBHV3(n%=5OV_#+&Kחn]:Z-J8FkkU@jz8#p2mxRUfN(WE?3Vxd($|S`w1v{ewȟEF}|nLf_BlUZ]2^tw]lp燻{ZmA+Ouid1]T[w2?SO` dB#`8=W7{&>&hu:z0+l*?yb2QqvPPV,ojnm5%ݩ` -g o2GmF*ժږZNCkr9LxF΃ZӉJYiӉi詭3[܆N#7Fendstream endobj 496 0 obj << /Filter /FlateDecode /Length 246 >> stream x]An0нO` &dѪj{c!޾.H|6u_iΩmv˜M4!iNo|pAۡ$|astDs8=v/q<<GҀ#04`+Hvž4`/ܑ =i@/ܓ Ҁ0 D0zI/X)> stream xeT PSW~!ђd#嵥l]]"R[\+?"H"A .Ni@BB-$[kn;bZ:EVEۭtf{̝9;9_Kޢٙ]2jK^A:t&]c[m{ (pxHj()x[ 4k5%UYŽar5"Hd`6F'G34:.bj  [; rWU@ܮFd2 Μ :ކFh WG>C Emms34P ;O(1HDq/ PzE[և|_#O@:O8r$piPE~AuCC . Db M$*<Mg  ?*ޕ X(`MR X_R( ݁0Feb )ϯ wVL$w{?G{*$)8x#9 WlCL+J54*TItv:|pYB!K`1-݌Eb2>K G>4_5q0#kB+etaVpr+9 DaxS0+6X`嗢n A߃d7$w&¤#7!!CԊ8xժ< ; /lkiFh#Q0qT&jX%>a:[-Z9x mo(`7i*wa#:FK :pxCWUTf'1H(2 ?Bܡ=|:qWɨ;H;4&X -o*24\~BLnF=cX,X{$-1a_w8|IEeY] eUC@G{#te;CbW>4E>=FRPK[kn3uRjR gGkcpr*L cGUu8yNiPD >5~2緵C ~)v8yGYlhK*/Ѩ=G]}$Oo/V.AdMW]OIgOXdԂHgSыsVfsm~Th_B!hil+emUoSOphp``$NB^Z`ϭf:fk7 BjDA̱Z-D"gyfiZ!{R)endstream endobj 498 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1007 >> stream xumL[Umt&2hpLY攍AJBK[(mioPV@K6@*SI6fLb<^|xsB"";糜3\m_Vg4sC?xJC꾃VOIB /Shv ^!i19fv Z_f,&׻- k30yYYq{P0mLZ+{%70EuE]Aqaўu宩a9!5X\+p ,5b2Yld86r ȒR;: B LȄ"@U~$.MTʿHINGcO-Cyz{{!QC#ӕ+U4v_OEm?&$@cR  ?~dլJI !TD9 չ IJH@Z<Ҋ)ULʰzMjV6q$]2=yT6+˫.*wo o*Tu6]R!mfQ iVJV၎V,Twƚ!} J%Ga3Eχ #K,4[y8u(K,,-JhZW!$.<&0\ ~ %Yl2\aYCݠo$9,1 !LQ;)Jx?NiZ7S ]m9_{K6o.U-Fxa5 ۣ'^5^O@:}>肝ZY8[9r3{ l&<>ʇsLe:5s}0&Ի}5'_Y%N|)QPCӰv=6'tfk?+kC]%~6&PWXX (endstream endobj 499 0 obj << /Filter /FlateDecode /Length 171 >> stream x]1 EwN TM%]2^1!CoIߒgD#zxa:qk#N֑FPm!]0@XS H7Ռy>exKPQ Iǹ쌑[FVFKҵJq~?Rf:(1Ke[!&Wfendstream endobj 500 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 449 >> stream xcd`ab`ddM,M) JM/I,If!CwʟM<<,{~ }/^=G1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C5;U( $3?/1)K!E5|ek~63~w/3 J+WwW,\н`f`璞޾i='NY;wƴ zxxUendstream endobj 501 0 obj << /Filter /FlateDecode /Length 172 >> stream x]A E@՘4l Q/@ahXt .@[.Oa]FDj,[:hT5Vm*& nҿ?h Y络=cSKA\VZ̖<DI{"Γ?e%X XۼEDV`endstream endobj 502 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 492 >> stream xcd`ab`dd M̳uIf!Cw̏?"YyyX ݛ3#cxJs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k8 a```Lf`bpYL c6ؿqwfsEwuwvrDwolkH.蓌:=|e]dkwkwKߜ)v/ؘ0;;45toұ'Y%=GؤYNuK}к6M%~]L\ŏkʻ*ʣ9~+uWqwI;X?45WJ%*^j/+tqSVL\UNȺ=~l{srqp4wM}{O7Zl^̋endstream endobj 503 0 obj << /Filter /FlateDecode /Length 191 >> stream x]A E5mҰM^а(.0X.$3epv=ztoQaԜj/aU :_exMP=װ J71WM1fsv (:tmB c]£(RͳW`ߗ-Fp+yyI` endstream endobj 504 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 706 >> stream x]=LSaR+^)U1 (Z*kcX[ :J8X\LPMOA$or{(IJizEex_XuٻylجIl +2`Lze`W: $҆㳉g}ΎNPl_h ~Kt9PnUW--9:vAlB}Zh}um]^ !;Bb )2©_$H L_5@\q²6 Dn`{`e͝ɳDL7'MƹΠNIuSh7ҵWF9.qKdi@m5YA)4 y5l3rα&DzC7HVo}4U+oh02,3N@` VV̒pz9 1Z7[q=c,c$$S״>KF/U `L@"p`}'sd04pWk2YkygsɪJzoO 1\-j~0a++½JZX ZY1VX[M ض9,y;w&lqVdyY\tR{:6 xCRhL5VFG1"G&3'7=xIrendstream endobj 505 0 obj << /Filter /FlateDecode /Length 172 >> stream x]1 EwN D:D,钡U`L@ }I:tlo=7p˴y/:oaIT<yjIE7ߟt5yμ`p 0)?"7+ݝ\*$]ecj0K@>W Vxo1Ē#Vendstream endobj 506 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 434 >> stream xcd`ab`ddM,,IL JM/I,ɨf!Cw菴<<,{(}=I1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C5 E$#$Zy5|ek~;}k ^ѓ2 5k´rYݖ.]-&Ns;PC %/~q 7gYS7juo]ju^"[Bw[ lx;9W7eVT8$$Ews$rzYJp6mlKsqp.3aľ<> stream x]n@ D|!H/%VU RqȂ9;$=0 xz9q-ei-1KN%\l x:vϜJ|;uT}mG8:w1-]Nš0 V{yx|nkT`0 (8;cowLF0QQƱ5 :bfsf >WWYܳlna_A> stream xW pgnYH41(k%I>&d&72@8 /ٖ/lGuKi˖-ؖ 111H @ a&l&M6ޚeCRfwTR~{DĨ0B$MXv"#.s+sSNY?% @GMb"j2ơu H5)k"@5wy3fEQ{ όZ7MjڙQъ<0%j"3jOBr\zb"1*&!6j7nZq}&b[˲sV䮊+ػ6:!q}RƔ-ċ:bJl"^&btb F,%ferbXI#V įDcqCQDhUa^fTبK3N&8&wڧEឧ#myZ#v6AUɼ(fr60ԮAZc,FZ|Ndz"ƪB!-oAHzHgseP >Wc$D^a[eʋu6ژ ePE #Rh#\BO֞dnV~3Kɚ zg]+@7|vΑrNvI;S)Kozȁ}ZĒq{YAU>dd͹bzk.+jSS#4A~)\K/Ff3zva%A[2͞ k>{'w67I` Ij(:ik,PCHf K#_CjWm蠛?т9%* t I'|'&$ +b̹\kA#FZ,z6tgD~)0,".oIk@G>ja/ev ]F"~7a0M l"DJlAgi2ȸGQXYRs' nq/2By1:q; m1YbFg(LRfZY8ܓ^q) FOc^mCGBQWu; Rb>$_THݚH_Oou|^4.K jTU+;Bs[2K4ϖUOP!nrg7]tat衈6J!0%ܕ^W,IB}r6:47)!.?g,WZ ,94S X%W^'[h 1 4K/r$lz'JsRIf&̤YW۵ZO;ZRjSbȬyBX;c8G05}9&l(=$>ME[Asa1NiD㧯:Ul+3UXj Hcr"_/̑,>;%B)Y17}hZ#ACq=ByA{Yab0T_7Ev_09 kw*p@4PMݭ23ze.&'@Bʁ֚溚"ʼ/OŽ[wkh4rt93ܦ̀=ؼPΫ//H3eK) F 3sE{{u?.SX+3[p[[e}-hle70 ιR=\!g&bROɿtf}?8J%b>}&\#͵v:696mg*@Qn$'=αG /ϰ{({U=-XFn\1[b~2eX:=eɛX cz?p 'ڎNoҚ٤t:N~hS_w[8aT)u~(nR ,-}Zl#c >3(\`ء t. A0e 'n{P9KJ ,ex^V*Gd‹CW~LP[6vLAGdVIe@:9U]t5 a7 b"U|ʪpGXқ޿H}oWR`c~?Y9pɑv/d٢ e!EdjyW>iy9DwHz@{ֿ$SSO.a`E A‚>Ou:Vn p(&~So|Fv(n+JD5>/]:$VctErM$0-tڛEV{ sr R;szkAj]!mAy:Ay)ch|_WWJ=Z뱃dE ~n6-͐ ([4~^̖]g6Qz5 {O "Fk1 PV唨 *)۰ aꬾ =ti3߾r nw|d2'OYpw7.Z1j}jAf$ |kFVmHDU$īu*p"˺b $F:Z͔0u莥ĊӍĭ79uԝF2Al.EZ_t(`}-ڪHN2 65;OPzwiO* ߺ"DPoщ* BKb>Š ]"䑯_TZ' Lza5EZ67+wrxw$WB4D4Mߜ@jԥ y}g*yjcTa1hi=5B>J@'pHp/'E5ILEfVMIus\%\aLY3Zy 8haM=*:<,pQ}hzm= dcP% Ai\4zCSji!9[[%yd'(uqN.Xlec-E4h[%UXڀ^apLf1},]ɶu)#V:'ԉC,h`|K[Ѷ@]j] @!3P w_l55jBH={vF r۞?0^68ʊZGeRTN^;5S l4#wZ[;4??àˆG"T55ؓOQcG(Tβn oe+er4Aޚ|endstream endobj 509 0 obj << /Filter /FlateDecode /Length 391 >> stream x]n@{?? kHC(J|\`,E>3H1'}`y^x->Ʃ_|[R.{-1]33o)WvKܥtw.vuw> stream xW TSW~1 (H|*SQ+֥E+ (J#D6DdSVYdkPq)jSZf\uܗqڞ3/ Ngz&y6HWPv ب M0Ǐ ފ>d/F6' XHEO(R6F\M&\gx(51Q. .>.~Jp3eR+wQ]VEX8?p U WO2na¢DU&49lYJx|cdT&7SN>c9O!+Wb%'bH|J^jbF!‡%H #1H™Mp"lLD= *RmcghcDK~ 5wRw j:UNky[/fvEvGn!Lr~謡&;t9<|#rFd#|N'Ҙu92ˢs&2sbQ)6DDduRHVTMF1mSχU4F ܋S:@UVC9#9=5rHQ~@2AC~u!6GnV ֏`z fU!Mv=x^S1 aob>9 TO'4_ruW/L~I⩆m} }tq'2 Jʮne^+Imf8ȉ0AIGA, nc ǎDg,{yy_}—.p8O'd0O7# MUD2{ӋoLvlڟrQ ~ X|>ZIT6ܥә>x5'B)`a nGJ=:'a}#L cjwa&G$';X(3O)~Y2R٥(X~s#څ|B>X vNjw` 农jl0D?`iC:A_H ]lW ZAFnT<֣&%G0xh[ Tg}SqNW8(̵ZN4HoI(v-YRNãGQjSlC;%s1a9V5jQmے_Rh(?9XN2l)5f:ZM*" j %HaH(԰9y5x?rqMtM94'eib򙼵(Dy"c3 !}9iΞ]3w2sZr̕o^:k2QK9Q3'ɞ`[ E[ɱ u@%mn'aW)oBz\ZP^G̶x3|1?4 bp\IܶSٻFM[!OMpHr|!kF [(@|מmkU V-QDu;wGQ^3]sN@-tcK&d6Jo.ơƔ暎Ca*Cc~,G ,c%~##lD]BKH5+u_Pa]z~ 7Y"Nb "+9`Qr.^'~艤Y0Wf; Ab;rzm:}3Rg19PoD\tމ_axmU>*bt¨D54cO?<xp1WC87o}szbRVvkQplhDIB8<;G6`,Fu`ωGy r6yNdfVay㬤v+]ǁ[5<ynSO# qsg NK_w~8ݦD~B(*"!SfeƣxW-/ _އ1xR0 Il P.0w'ډPeqY#QOMWwfR[*]I>J8YEt`HHPPa'2`7΃'CY}Ml}X1ș^8AyzP=NZkdz}UceS8^OTMJJT6 &Ăd~#x]xĀ7zz8qHo ape SڈfZZ:+J>(hht"jՠh7C ;hعٗ,E߼wD)b>h /Hэ*YHVC} LkA&ضy\l#ӌo: ?I`˱tSruJbVr6WvG9Ϊzm]sY]E17^zA:T, Ty Hl%1#T#>g]}>[ _ʕ'#9A`kEyIJzDžo&JS~}Cj4\)PK>s:dg8Ϗ̓W.);225%?x<9}s?02!#AψWY$[PXR ʝEOTi<0q3 ,?qЕglQOxA.ddښ՘P(ڼX*?,L hCB |GmS0 2L dTVvwJe5(~O]qqfޣU=€s{-ia5ӕ *m4'+D̹$0쇇 CWW݇s:~2 !HdCl*(ycS {(P-&mk %LFZU{[Cc1xukq΃`0S^_ϝ>}'}0oUoel3.;S{(D&|8{ug7>ɞ38Gfd]8nklqɲsYe:w9VdT *࣪Bٚ[UJjuEڂME52#pCGendstream endobj 511 0 obj << /Filter /FlateDecode /Length 4633 >> stream x[Ksȑb# F{ٝؕcfaGXH|GnIw>HMl"DVOmjY=ۙ_ŷg} R&?ظ.ɸeS7դjWUj cLxCy`˫*-/%*RurN k{\sW&Mup8طծMr. I Y}ՉKh];W! ý{S*TY=Xp]T.B$ d"5祆qU[UKᜢ0I:,/F c,o0I$Ϳoڹvu%$bL!'wIJ]q,`PC^$W`kȈoz -.AWD E[۵!@H{B~ڰ/jCʗzPw uf Y2n5*VW$| -0ڶO_E`om{w7n'V-rIuvdݰ,:-彀Р}?ApAXp5 viۃi!Լͱq/ږD9TQa g>,}͋&""oca'D1< dhQ7Ў}HJ&q4D +TFs}n% 2M*2 :'Ed[lӐTZr ~VjJOjÀ-N8CbM5 CP};Pk׫DJz>@Mf!Z\ 3a-&-2) 9pΙ$kPGrevXQ2R`QO#I@zc `fԁW,›;@rJN:w1r>.\*jvDp}s x5X ! .q))_.uej"tI8N~G4ï( ]u[ =n;%Eݘh3 pw *\@Th8t7)cG:Zzxꕊ0gX۽>=_(1BnLT\XgJ em0b8n^âFUCtW_FE9a2L!?S42ةz g=pu 6_(ϞI+M@.&D} cGaVgZyrڿJBİ(`S28J");`GE_ '!eA\5)WT 1r3%ԓIW̉#0qċ(/X `dk0_u`tUљ5u 4`(t2J&ٟMhmIUI9I|:: pdTUJgr0%gq]@Ж1,^0@N7.ʷ[QŨWs0}^:= 1)ϸx 4V `}7ugbTzR;7}O5{\H"?ӌV/K!T>`ɏl&+/`Z:90ձFMZreű/O03j]3$!(XTe')bd[%zG 5L8Su;V.︷p ǒjOKF5D'$#$Q{u`ދJ) Z|:03=Imw^9 L4AD2+rͦ[.o| ?հ>|x:K'mNniԍM 3"ΰt?XL3 /Pĝq_`aMc_oql9K1?G8p3(`*r &hTN$0D`@RVhS}⢲G Ӥd5 B!#Qw멾>TS gkLn P/<*˫p^7#c I2\oۓ~}\alٜ"[S%Ո.7DsavϪQeŖR~ ^hW;a-"Xyr>\Rhҫ2d&3n@շy&".F5d&oBNp O/L(/JA=z=/5@ I/݇gRlsw׶!y0Y3|R4 CYW/WQzs hrQB ?p-rMKDIj35v3ɼ lJj/rcYTx.p/~:y|1 JB8n[zo1 \ 0hȆA*9mM@p>e+6Xl^tux}UQ4;qM/RA$kW#ƨ~.-k@7mStSmt#X 8X) endstream endobj 512 0 obj << /Filter /FlateDecode /Length 4539 >> stream x[KoΙǜ8h'n>F88fPH_ٮYx0ĝ~U}UUO߭ϚOgֳoϠI fWgIkWef7Տnr վww|ϼW~PJU_;Aӥp ¬0b~l54nP7׫ I;/u u#T] _7NVzƟ!jY6ⴃW]w[Iﶛ4qԖd ]Tlأvs'#]O`eILbO߯9HebFKza \]m StpB_MΖi{_%(I"9?,N&מ‹);s̚Y y˦wYN܅Mڳ'W8W "$66Zj_JѨ&竴tQ,>/VPI]sI#eM+49yWXj `S8N+ڲhD TNi1~7_HIOK6۪Jmp2 LMtܤiĔakeUn)9Fb))6Yy;$ڂYs[d]HЌ| uUY͜{{ ˤPLw[)X{nw(!o!wL5̠ݵkf#cP:nKsPwFq"[*T#\0>%g=i) /D,3~ 8dBBp2zXڨχo: ާQF!C?(|c{M7rBi'.wph`$o;ʼn^N=DK"D\S|| H-cnst}$kB{:Ez'JOS%Έ|a|H}!olqjfn(iw܎mkڠ_פ YrlJ8YșY@Ϝk6_@;8aW};D%'5i]Ƥҙu6"M=/OZUUumo>ˆ[,97Bp=Zy-sc.%pbS˟ 7U jȍ`c6\P}j.4U UQk%*w2A}b5Y1֡9AEDiFnf @gW-C)I0$ b,?~d6kMg|"hA \<ʁ!DߴaYt2ՐR[m^X m0Xq nQ&!R(2P]FAt:qUQ/P燹׈.mq7(͔:`1MPkiOr-tS4'2N/2E2t#OӍP&cW/0Q6T^E¨S7+RA,R,Iy\hHh U[ J۝ܔ-Is]qZmBKbtaw"c>}T\ X( 0 (C-0B4 h33mL-:Mӏf[cK:AdPܫw>ǰ@>'&y nk l4<8&o@)??v )OK&h͇ȼ\j=|W:z4iGTK$FX9~+iRiQMOFf5 {7 Vn$DgIӈO}K(~(>$ж 釒d%T 3Mc}I?G, ex(+Dj3@ Il/(„síFtbF۵Xi.I,f~SlB?vD qC$X-!~<{[\-&]g]5v.WӃȟHdUivw"]}cvZ1$Y+~borjd-Yl19k:*ʋfC*ve\uAŪ8Z|Raڱ(Nga ȯoЮi7weџ)ϮD?QCh: XƊ.g5\aGzV22O+ TZߗ ʡ2dYy+۸8䪇R/Ut4і+_t(z9-&װ1:]q:D)iBY=, 3B;V᝚ǰfd5o6~jgQˤLvjF,KS&nj c6ED1{| Bj(]"7Lb 8c\?_SWNqmńN@z",1v R#h`  3yu$ *Tcy$5Iv^2j҃ˣr\i8nkKlnqO#" uXఢ jOHY&ot78h6} oq1ϺL".RYÜ]rBv02P℗E8mYxb@=BӐD.@Zv$ AkqъץO_ / > I~hLKGLcM),ܥ&Nrb2RWR7PP4+R4Y:ؖ CԽԥK%MmM |A)Ƚ)KCPQt{Ɏӈ%#b.%_x'"th#]*NiJIPs,< #_5P cux 1&̸C%ήGm:9^Ne@0rjp$Fk؍_i)`$(= ڞjORX+/:CM;4P0@ufg*WHT/s' ~~Zo"}/uq֯ӌIg-Hs ߙi2f2Ie1Jݣ=~ Mt etz>RI3LPdfmx8NOy@;vT4<é}ğDcn"uYY6t*rؗwXqp@)[//Dp)~>j1i1ҡfTZ\)|] EuC!3@GH4+n+/OK[l\7⇳endstream endobj 513 0 obj << /Filter /FlateDecode /Length 5832 >> stream x\[o$u'[ySOW%lB"L` Mΐli.\v>R!wagεˬ*ŬU5JЯf~p~)C3g\]o !?A砲ޕv0zyx[% JOs˪XUY/šR &ŷ96)'Pg}?::"mvL-ۑ-v%͡w^ 6D:s vPIDqF[Wཔq0aMeؗɆ8i`i .ogU˰wݘb'v~4lH7Ń1ةqiOX6٢}sg RtlvCwzjՒz/[@|W mW9qG(8r N?_@ 3\ɑ* $d]`a2(Lq 4zWl蚃ũ@FV\*k.~DŽlc x;D9Ȃ.>wOqJ{zx6i&M_b7e/$ZډI`n#C@!Hn"F F^K&~4;mxVZ+]NsxDd .C.f ptš˔,=cqc}ѥOߖV ijYԪW?9I7M$D@Cic0i2 kux?7jBuoӷ w=uC]#74D)]S+"u2~7tmZ\wOd6% k3+BiJP[xRW> J@\,-[Z7 eL"k3=W6iV+K$grY*b(YtҊ tvzTԬ`! ]JakGPUx Ҝ?w{>ds<ĝ8;b $͍Eyh !zI9j~jN3Nw rcB<}.pi]v ='&j~קC$ۀ^> 'iVzXZ JXRh&N7 ݦOx/&?_Ёĕ`- WpV`XGYI3RѬ K.#yye^no$}Y%X"m}f΀{ HI A8Ot]{@AU~.ˬQl ^2¹bYl/2âYqICgU9˓4˙ZݢHYfl&r?[).LnnCyL䲽2a0w'"AJ) l1eqP&KY(E/Rn_ӝ29%M·٠,Z2aQͦFNtg8 Z$+y]r) T}A}d~~VrSWf=nt xIAinPuzgU@~`ըHFߝ(yn$*jr+=ޒ*Gp_~3@b!RokxiӦ"W3Y;b~Ɲ&+Ԋeb:`U:l>g@IMDe,);H+ G: :wGsj+p-/3:cĔr"'R5 R;3DF+u4d 7G)򓜭})T/o`jnW-qQ/:T_2-wIz+T(%µ f UZ |MXK#\qUZDC%"M:m=t73+[s 9zO!1`FOg8*͕o7WbWڈcO;.|LǞ1$ñasg(-#$Ž<-řI++UItЧr'NZ8 Cal΃~-4=0 PU ShH;↩۪(!74CHU ZNGup4 ⮔)x clW֝\:uYK;0W0 èsDD2l;[?ʔ擷[%VHg+5#nvCN-D%s^ X"36*2_3WFȜTR~cvu sK}dӂ\ 0:3z5ZY(Fa`\q(~O눼9~448µu!؎mzԥ{TZpQsC0m7;B,W:=5-9L՛9i]T>Ohk3t^*h|bDNr鍤b[OwI03`66@Tz\ m"\.o\wh*0SJNjt{΄X6LJ^lLpb܈6ÚJy^,H8ҷhrCzQkt-,uy@ѝ(^fD}E>m:D1xlV'*D*,cbc0b#Jwok264rpQ6׷CF1\6OGt\B \p6Q&@Iw- e<ٕQCOw )zQ`V&4X$pĬ2Aڊ`D.,qu3zcЁo켌Uq>vgK-:&^i'{'ֵPM޾끆͑&?W8]wm`d?sH9\I@.Y;g3-&Z_*{`b pBXeM'W %~TMsxXp~gC(#,*8TRAC@IQ\*j[~q ULTJǖeQ|A(.VՇ9;}nFSVTӱ[};ץ2._y",Xd9U 1 EѸRj1޻?I:po:bSHHݗi@oҰ}:iR4y1V9gd݃pP{O؜E4@cxiT+`vs10?9MkؑJCÛGm+.MJicZ8ӻ-nbe 07ҕ݊KSo7"cMl/-8LcKloI_ Ǒq@Jܨ.J u*9pk'| е~LN)1]qfg jf(`9~ RqOs R9*e_2;b.`>Zk*e[ǃI'ZԖLVqcx7P'SPi&?z^#6:ZZky lz7sRm:Y%8NXRz{-A>.QEZ[_TX`?WӤ$i;*FÖٜfhٗa";~%]Mx5:~"n4њ> stream xF9 xPtr!Y,v-[2| ɇ D|e9W% \ˋ/ }\4̛Q׷WՑ S[A_n68-O D ͭ?EVy_vP)[|(hO$mpjwYiX77#NWi2sglp<U9*Ӽ[`Lψ&6,.Un%㈧m/78V׺a!LlėݮEBfuSwKn fӨChcf <2<3BUMAx6n]w6aRsߤ+xQ5͋;W+v]Oc&MT^{+T,INN,IuZ#_р.}z5i"܋٦0Uv6ᨚ#*눇>fXi%@̝s1h>r@Tl;))APqMqF,غļj.\V|V4Mssf#sd2P_\+0L9_ iU:dlIc"Ԗ`H\ aL 1@]:׳յneܭwKП(uwB׀ dw]lXl)h'4Ej|[Q-F*BZ 8K;=j@׼x^l3 EU`omȤD^*n'0W_ǡܧlHɫ^F>MUfk%E%egH֢uz mtz[R܅E` \MT+|ku\}%nrnBm9ZYRBiD}#=pU$@ _ii'(M6O:*A:]7 5f*NN4 s]1֒`\zApvي,ӏ G埰VR-x`F#%"H^''iXDƗ! & nX2ENR&H>I#vmhj(y4:Vx3drp1a{I.,jAUo2/g)LVt3([ XGb) %>'EJX]+Pn{`&hws]Hg 0N7ɩk&[!WQ/?fsh3I&E#̀CfTI 3Si)rZ4džQ6:10M:: PJc\ c~CE(_T~㚟ö0 )mdګ8ďy!q=!كT08+<|Eìvdl}j_$-݀?yWNR]ͭiJ![6"D:%i^/OqoF2s,fY18EJ[:]@6^u޿UiQﯚWƸ#kKt0}(# DZfRO!4j&f>F0Dו\ JB/\ۓ%o^L'KʄH,\?6߃,W e QMӶIuBs:KMyYlC_bP*UzkMI]Xٮ-M,L0X0wB˘VǩwB>3?sRHs i$Iî_7WcRȾ6tUIE~jҎQ8b*Jݡn9Ply٭׻PŷC8ML ̞xxT>EMTTv`[i6$H n,CKd}L{{ 2\5j`h4`uٓRGlznm>&"׫4}M87?<ޞBTUpv][W6]LƦ]JK};q3k;PD>r&u .G%Ϝd1śmypFTKI.0VW" }'g}zq:W bi#DT#fRvv5kn/!P}W9K1"\!I%i}Sˎh&b5FWN zq1YStl3 {nI!{%'ȫA'NRNx~~¥^Bװjy(Oa|b{Xjws@֭sc";D u]R|]_̆^ԣ%g=ưt#n GYo`EFD . !X}TVIoxA*=ʷtq,Źvg]3 61T=qW5"]$#Sע>q/ ZlDk߲\ ip^,尫VKi97TB[-$=7og<\j9m8: lܔ]X{:`SRDɅF6Mj}nw00T(]lO(VggDdHc]5)9UoH7!5%),! )!bi14bP;_Pf?cr^X l֡0/]=\D{b2xZ"I(U+c~FkJx@("28:f̍Hlo#2h"O$Ƅ~[}*mǛn;.xEn's]~ETLXGs_#@s6j>:Nt }JJ~ݘd=:G.cs; .GŚ=Bq'ޓeQsJEXu{, F AP rD) =|9/D0oUػWO}Ye)hv7NaESRES!@[ȍz >!_PUn"Ƨ]عmBӍTOxJ-KA_kTCm}|VԵ ޣ!X'jKk];H6Gn:Hh0jH@=R[ldO|4v}1zHՉ>% 2V9]l`6oYn)ތ#۽YKS힔fZ*K ݂>zSRZ,_AŔ_=wҟW!Ll JeB3G;#sG K|1xB0g8j7nJC賈g;c6ix$PD?8mDr ф~h1\9[U>"= ȌoF'n!,"9e_&<(yߚm#d)+rf+Zyq5H"vAw4_vwY& Eq?4endstream endobj 515 0 obj << /Filter /FlateDecode /Length 169 >> stream x]A Ec7v㢍i{p ޾id>Oވad#SpꁑK:ϸXb5pmU|Uz&ϗG~+{ۖӸy0HZuUw I=A)'PCϺj `)1\! %O-~tV'endstream endobj 516 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 351 >> stream xcd`ab`ddM,M) JM/I,If!Cgɏì<<,{_+={ #cxnus~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+kawhAQfn*2.fFFk3[1|/{Z?jKKJvϔqmE| /+2qnrcV}o?n]5ݒu&M6A uOkyO-ùw䞉=z,3wZ^(endstream endobj 517 0 obj << /Filter /FlateDecode /Length 5057 >> stream x\Ks#9r476x뢣Y[xaa;fc᝕i;lIKz({ޙ D)9MP@"/O?l/O~]>l]^7^,./+bъ3,.?`Սvn)Va)ۺi>.WMݘVn\)`bY}[#Dkln[Ξ}_?G&[%bWԭn.N~ȟOò^؈?Ҧu2ۓ6KQ7 +hA-lxAœqWpZU/tzM޻jX&:ӸӾ17#<~_lt<XYY8 L![Jo}dHi)/A\˓`C.І%P^..q?Uհ Sǫʿi|O'bG[4p=DZ)QWf3Л$K$i@m ?a1RnT"40S;85h Ia|ڋ,TeѸkaE21+Q|$näҩ dM7M7Fӑ$i56Kf=A_z(JkAQ )Y@n^e/?z[ B6Ao& WzA#͐w&j!׿LEA_t]磸?匕RJX`O>bjM!0=}xRi?eej-ߝLZ[Fޣ>xƀ|^< n=ק|)4 42&WtpJWsGlLZg8#9#tE*R l?{xPx!k]d̨NF9=wro'_{TNp\E ςr |7hpF 8NN`c1/k)gAOhĭP"Iunˤ R4,ն 9hhge D2h|" bo4^F 6;F>$ʘ-:n|" *MP tA\ 6~pf.(1w:Eƍ 'f<\b"Z b̙Ͱ\4@du 9++m$ $ˋ?^tY쟛RD۪[r ;6:6L} 3G6C4m4R .n mQ>5[.S}B-0rcahk1-J|0e^uwʶr1DX&.>Bb ߯Et%Xv/2i p;#ɬO A669Մ9&lۡ-t"t`҄du %O ݾȇo4'?طo.+ 3 joFSBcPݓ;1ɗ />|? 0JLs`ʹEhGFQd9Ҟ6EZ[ DSn3YAMˡ/L)% ~ 0!ھD#aCmǙ4x[ˈ`d., '<._6~AWǔ.!+rhoĜIrb;X2_EZa.`*?O -'(";!dk!뙷1YK3C,2?qO淑69^7o6F,eGg &|m}d~禆isšBcʸ+Ձ q5RU'2VCeoD%7i;K07_scIau€mLq7=gٮSumm"5: mf[P}8 ,  S|Ma9E^hc, +fF:W}\E^E+]IWSl=@ͦ}p ȴ1!ͧvyCs2Ytp,PqˆqtTmsѵ }sgo@X /E#_7#xFb~DE/x9*rfS̄]2HB#y@/2jNBhцXۄ\9i9vԴU:f/Z#`S<8feO2x|]668tPJ`VΈ=Ig!ı '.`y3h"0ТIQS"~/;+,0Y]bo Lmxch˶i gP-e]BmZ"8:–n KZ<.Ǹ9iǴŇ4DM<招]DG<<bAsҀ|vB6Z ?PTv"4ۇMrp.t@_!.H8.^+`vRE. H񜩍*Vyģn\WʢYu,1VgkR$Ỳ#:5 Ê"?HVjQ|OgQkde$81 V*BZ_^.P=i0;_N9ǺTj5 (0i"e&mk3BCՈѩ*t4H|yd>%xO4~ɝiAg!SK > Ba-]2X^c+\*߱`^Y >eel/C:Ux6aiM8>՛8-DaE~K-dw7iĴ`< "DD`Ɏv S3:ޜeQŇl|=mӀ;~NCPd0UI2yߍž#:̕ =ݐ6ܻv#g(!(=uI"=x+h+.q\v%4#9`/ AǤ306S8h)T6x+^M Ey)@߸*1* 1zMې>—]9^&ͬaE#]mXۼ61h@C|R!$7 gWBҴ$:kC1}J+%@$pV j &`x7_7e<6W@N0%W-S:b]?0/ib~?H0ٷ hSEHM)ai4c%J<# hL!$7AnF!q}5pnZU MZ $rr"} W+'"z_t󀭟T$t56Ny:3iS*_Ob]H2i7V<c:mBiP'䡭Z]BX/oY}eL\ck@X)j*A M(kas!Fs$UwBӚ(. idu2;BaOB ^Sv q'8[!%4Rѭg} ΜKJ9Њ޽-3Ű7Kι vZlӘjݝ6| ^zc>;ژM,6-Umw@8"?W )ޫ:yV[;/_w'^\'Pz vGٰMa,6ԛ]'xKO,lfx*5'(%a;MN U~GE/t>Sᐈ03Ry</ު-endstream endobj 518 0 obj << /Filter /FlateDecode /Length 5200 >> stream x\oGr7H!þe6LwC|w.P.w6@Hc\bTUwN,WFtw}?ΚZ:kfg? z:K\;d#n@1d/ bǢ 2՚EB bne{ҠX)@n (Lh͠#Cg:~bI 0D>K}\ПW`_/[c-xq2p!A5#i!iN[I#J%4̊C]4 3hu8a\2jiH 307-=Ca]ުĒj,Ms&2KGI4gQ'̻41~a|X3x<_1!D1>bNC&Ƈ<[r6m(&֑*E` u3zBK0bi(z$T2!P]&ԓHߟHMBI#r"z'%8/1Bf8N)|+GBA @Ӈuo q \+PQ&cNqT@m#YM #h&)Ē0mcz %5 /=[TlGј0Pz}Cv}4^g:l,\ޒB$ Ǩ/Sǝ#hDr XEi?994#> k܃$`*`b^"D^]WCyobѦA qz86I{4J]R L28S?"c#SkiYèQutcfPT2XmǀC/wc nmx#{/}L #RRK㧉`V >-vu`g{]e3*jʁes"P1Rˀ,2m0j8reI8nyLp~,ҨyOtcM9nE߻vw}Ut,+3PP\F'C/!iO/nINFGid$xjo"0EJԛWhYIFj%1/Y3  j+_],^_gjQT&UiJ[N87u#2 >9+E(2 ?} #JV)Gu$% h'AxĤ}h1ϬF5XR&@\&NrE\1vc# X4eG\Oc"9|=`9e2RJt`ϼ#J~Թ%GzLkMF+c0e l-Q?[ ]uSު^tDn SqF;u%j(+fl[Po}΋PII^SsTѩ_I,C`0K I3*룡Xe (O7QZRK;O E~&ެ\*L n!++Ӭ%=Mr}[®ۚ"3Ʃ]-\ÛZ~9ŸVgS"33pf%S6~ ^ތ;dgiA]&Z\ B#5_Cv3tؠ$͍=RQCnBreߪ\U )}Sr Ո98)հzM4+d\F m2a؍]>fL6z0B֓Ԭ{Y W)ym(6a-Pe0SGIڰ0bDqú6 qzYv _ Gp3: Cp(SR cp]eFxIƌv[ %(-b(~tO,@?A#LJd NM}^ZRi78I->$^F i%`D%" TUֈIU鞊1]]cXLTD'CzF[щ&N]<@aq2'@X9=֕M=/r'A?'B_c.>KߨAzJ.-XfRX W]vTˁnwf)ǖݚn'^90cM}*{G'R;ӌxl!ɵVzB7 rV4Q:@2MEs[__i"^ei7]n'&؄tm {+Zxmv:^oj}u_P`6':ԶnEuM_ݡ?+<x DXH|ڗ? |"_ÎdӍ*2/THmYÞoW\yUG"d(_QK1JR;:p3cV\J9))\jf]ߝfgΤvmf@탺S$Be'Sƀ G~T}JuŸ4c8aIBG<3;}( %R#<ÎX[\\`ѾϢO>EnZ5VO9Y ;JAT2bGta[m'}X9kpM=ѬVNkT&XNrܽSp,a>BQ:-V̨ޝvg;+: I :3$][,9M,H4|jzڒ %A޸jc c`ߔ$LDWRp$'1ōfj8SJuKͼPfG, &kWhN^5z=]ſ$;*;.M;z%@B$R@`^%}NhY*,]VR+NO^! )Fy.4頊DOı87/⽜GM(T-U.ߺ[$endstream endobj 519 0 obj << /Filter /FlateDecode /Length 4297 >> stream x\K /rHr5-=Be;+ㅑ@}ygg$o~}HVUOg5#ˈ=`,#gM-f K_.ҟWˋ?ixS&E"f^̜quPfv_~bi;+]=̥Fzhx᭯v=_(``Y}'Dz6A{lٯ˫C˿.d a!qAU/ɷ^D06yilr_nu̱m_ҙj]Aø6+DխFh7~ù~L\p]w_~Yޟ  r̛GMTfJVZ+]"^eYQ,j],# &YD0RD%l C#GrK//.BI X]'d iV=ܗvO{֡ܤgaJ*/Shg_v7QKlI?ˆEN{q1+9 1/Xtjv +.2<ϛeO+Fmbӏ~9Sm U{Gځ*AoEQ&=UƯoCAA*u9l^6ؕHc>]㦋lIo,A̛@ 4^`OX+gRQ-Iݼ]]bv.T Yf&/V'!Hͱj $&cMRU^OACz?aK@K\>N:GLZfKy- K6c+673Mzj aQNzg ײV펹#0觛%k9چI{A7hIv7«UAۖvGϘe@Adbq wsԱ'l4xA*S:IĀc@\v.'q|Wt)?vnm8X۠0l_ RUe2`f+"&L(>%C1#S q"*)(ŔGv -G+%(H G9IR`w#)=K`$t.s=20F-Ѱ]a: )$D9O(iar& 'Ȳc:]vkms{q2Iaz5E+9넵!(Lt Whow?skSSI 9`РJ|W0.l?fSJVe[&ǀov^{2%G_ٔ{D%>f&0E!6p2ԗ 7(v+WǨWEG[8MO҂c  >4@SMЩSpSh:.0v*M)ǖ*1վ '92Ǝ Fcw{2:}S@#hA*Ä(IJdiGĔ d<Ԑ Q@`T1R31g4x}Kt(;] 2-^ǡ0rqese}\%J쑤&m.c4J\^Dic:zhIcX7/%n싟vȄ/޽&eOn Yv a I7L[ Xy48? cXxtW;ú?{;&$K-3;8%\N.-C q$L o^ޣ嗿<?Nk{/ؙntg"֎ܚq%MmIX8zeZjkJ>6i%5qzMӔdK'Ā^eG`Q7 /7B/։yxȲvNpEoѬd]rڂ$ʃ'aMn0dǁ7VDDIG;2R"=970ܨ@jyVϝV*wC23o>㈔MfAu&V;x V&1.T߁3-hRC"dH<XT9T)uglݾ,شcPz|M )ǞNQŬ3[sVCbexwXV: hR3#8ƨ'fX DXv\aӹ:;:_ }D[2o (C#VW^w?%?qTJڑ$|VYypi" ؕc8x_JD.o7 ϳx+2B[Ew3*[(`3شE*J2$_.l"iXH=a h" qP-Hu>eplz4! j'ӣN}@M`9dW7L]&;:VLeܱv^埃N R)VP^׽CE&pTRsV\cI9}Z}Cz9- o4лkWNfLBS_pⵢ[/Ob3 VX%k ݤF'^lt}.V)WoqZ +B`4<|jߖv{n&ixKf$&g)I)鬞 PGgA^L?۬wyfv9z( Ti%X}3TVbۧi 5)N|:$%q1<>v2jpY U|7T_pt)8OT< ,|Ͷgש2+1/Cxn1/j\ d q6NjZfV n_NXCGzݮa8x.ϥGl)nǭyFVd64up`#{Ցge$ s*.3*L/?vNn/$<Rh~0Z?(X @Nǥxǒ' T6X~y@ro_l - }㫋/endstream endobj 520 0 obj << /Filter /FlateDecode /Length 4397 >> stream x]#GQxAH!1Fa[HHB$H޽l\_OUu=E:"{8{]]_]kŤE7B_'鿫/p҆.E"&^LqmPfrh^ {vŗ͋Tt0:tֵ[td3ş]h {gǾ[UYFvL뭍(m;/zP4տ3)Ci>O4~wv7;H5_\׷ŪU)ݴә|/_?@kF_k9}lVM6"B~d( ޅ 4nmN n>Npf E{B4x5#Tkt..edR @34iD>uᳲС2TJ0r]fɟE"(HL? l [&-WE:4bٞ%?_w Sg&GYitMo[o\__$k3PU5|ݯPAn($|= 'oD`9P~﷥W CAVuuvٜt 6DAI)۰g|ܭMlb?̶t̠y2_n_ؗv0oPFKؿZ&N7ލoѾt $xZYT/bs(‡E Πkp[}x9F=ɨX32 Bk`D}(ṛTY}98tzN6IGI6L:-*Z7*n)`g}T-D\Xa̟Fp _)(95/?4:LtX' R(OW⪤)":^i)dg"4[48ۭtpף+W~/،9Ҍ5{g*DFѷSdfhܕA ~,VRM{Sx"QKôޘ$}Թ Eco}om}U e\&պO!|92o~ae9٬yWb6.lIyA7]L vTDo^&L< f ݌^y&*K8tԅEy"ޏCJLMߎZ\'qӛ3`wbz8SǧOe'|>Ef6` o~;+f>ZB^;:w@{*#qOłzWVZݥklJћ1᩟zuxk-U]OPvc>*cYeh4tmunlנCLM6[{CkTf7_PAszʀ<~SV[պ.TU̍VkS;#bN-MOUs**);TәQ Gә,ҭV pr }өb(Y%WPI q$+!!J  YGDƢ,_^QOZRoRZauU7/fLxᷠUnF{(#FAΩ|Ueed阊ISӁdDx}!O+gH UǗ=/]0*g' 2+wLщjG ~9Z?Vla@dU^1ʠJ5:#vl6Qaxufh ?(.SCSA7kncyV́s& l,Y92QoU=OO$/#MФj$mdC5660j4]H8b>UJt\ Jf48_ ' iW&XEgXOĂH~H{i4ꒉko]w^7NRwհH7ϸ*gtg |nZjBW%H}^h;gi AZy|%AS@i5g@ŋ 0}5sha607[iHCw1sPQhdP/fAc79*z/ :gCIii%gy$mWvU@gS# @8; &H8 <+1 B,:U/S,w>.'d7Е8N09?x)id'u/<\hSs(bd$&{> 5487˙F)SW&55D-$ı)nZR63j"XQT<4Dc-)'g) P31ZU D5ț+qxuaТ-鷧53$OYcVtI9G<=Njz(˹fTa,/>ctɧ4O2#077G3:ꫴ{@6 : ~6w~?TB#= g#evw;$ʓ7N;&{)DZWizbq@>qUCR4cHM|B@J,";̜$|B0))i NqX2WJ;Zj']z802 aJt;+|;Vq,7隘2cYlc*^6"(fA ~/lAu0^]7NwYsP!XB/K- hlxKLn.0MVhWȓ48.r@-7 ңsLj\_ӤテRO82|HR!_!{tceGbX5e_]SL6jHPeЦy2s0'anD@@t\;Q Zh:R*LB2]Q C]zAPGS ./BX, ѷ8OFS`N/ 0Ci^8>XA ĹE'\p)ELCO}ʍC~sD> stream x<[\v9w\ePCfp(=[PK%orf%oz닟weɢ)5~{SԬVUƸ01bp]-J[ūW\Ô\׋T_ժuе1w92*-]ֵw7t_fX+ZϮ[3J-WiM?b pI n*oÜחRZ(̮]*xeU X=~6xHOD6ʺ ++ŝ4.v XU8gK+[!rz G.*ւx{jD2]b6؆o|iafo$6wl𼩐Hebᕽ^WE@CYŋC=$SUWA,m9pqCn,!բ4Fth|нI絫0dd1nwkhr{S46E׾ˤVMs߮TZ)Hcooa#WWt<6F6(=ȏwŷ<6nHFW;ȓk$uw~=]as9RƫěfDk1N%sW`MZ(o*[liKpfq`8L)a@)q G!lb)"IM: B});S6PDNp*/&ɰ!!TqS.V5Ŗ@>"~]zIc>7|P]LTǻ{$`oO\.ۇ 9}۾IUa_ZA{&L ~C9a.jJZN#d9fI+1] L |:"VwWZ~?$`q'r3vh]$EB E"PRwn#kXjd UI!`Ȱ#UcyA;"7}08L ަo>Gu\N"^@ށ*]ˀ-0u͡ 7*^ꌖf|p5E>2R.D$ϲd4ZM8MC`ϾoFģaIe1M=741u\!* ԨhLt@! aC0N^Ռj\v`=5`wj`jJL:>?hGS.*[b' Bj>HUAf4橛`ܻ;.t @ T%sy+rQ'vu֥yOז` 2H}J0fTqd]I``An@Pt7KҪ$4ĪCxhk |stƤSJ0f)N⬾E nLТq`. _+XL iJ&?qR6@Zp|I'!Scd30W*d!iWx!QOu/dO1IkEz Hc3hQe[JnynFwss=eb <d+_^ڵ\g*\l 9E֓=`XpjǜA}E|1O4C;N\ XDv?>qsw\HԜ ̆jZaǨ1˹C.C`\(kNtaeXeG՘H$%}Y8UAe7 77ݪ;oh~t[(pheFWzFYs?MjUW2%8W f;*:*pڑ7l\fu(VC :Hw.$My;z%*V/,,)V{3Vl:̟-j[o{#~d.Um&2}HノEjN|?g)Q7Θ[mعJ=9h/<>8ϽuСM'# #+)#B7}T0Zgһ YKA>w,mʓogFqs!+ܷImi^!j‚b?eda7^p>2T O'bUGO-1{"yS9e;Vl* T I6K5-MCd&=J6!*A1^95-(Ëq/*潨MZu *k7w" ׄpYHtUNGn[^}3DDC9Do:M֝Kr8-Vn.Na48ԄtD,o9Gd?Gc7G wo#LZɰ8MuXKs_^l♷Q {6;L}$mjW!W4͆g 颌g:%?sYUCi#gGfɛTO3ĐFENS-Uh5S! n9B('asYrb^%e~B_Iu&VGH%\pB ZdJɖ5sz`YP#Z;JІf2z5H ^fPvB|M`)%|+x_//!Wig8^~]CbNj]F_ɳ) n ųyCqJ$.q?bkMuGLpO1G1*65!LZѸ@(/𨳵,5!\ ?\킪p">@\F=SMh~&uD`9 ?Uю%a'À(C-*B}ї_@aKL񟲼o/S/9zÃFIuh,!:t$.0 04T2ʑ\fP>e$&ZN WZ4w~1ᭋB#M@֨ GҒ>SeRw)W˟Q֩-U0,IyzᘚBD>aN'i-\}1>4MƘ b>Lyip;3UΔˌOI%Ka% Rs \Á!X?OgR}.|Qv~NOŘ΅xnhŢ/iBᨠ*C,Ej\?,q?QA?Ybo;= vsYň9(\ m ~W3*#)63[0J tT9R|{\9U =rp/ u5n3GOq&fJ7j/xI-l,\\G~:H&`endstream endobj 522 0 obj << /Filter /FlateDecode /Length 5264 >> stream x\Iȕi2L6- H-AT-PbIL _,Uu+t_{KϫT /vg3Eի?5KVZ_ҵ-5ek|wǺ*+gUš;b߼/zc)&ol:j۳BOgkC۬6ƕmq~sXmʚ>]まX]TbϺl)ޯ7)+S?Cbw )liֻ^6CZ}q}Y)Υ|oUSChMq_5PH'{M!:mJ҃.R765Na-w~+R|q5B.Pt0nu߆+DzA|Gi#DoE˸ca ͖]/]h^쮋oq2'9$D'*tn_+wE7cEsUKvkCTs J^|w q=#'[qѴ sg r?;fS|I0]]VH{\ -)xC7I~\XZ:zH&B _g;c5VSj> *5[Fygu l2d` 464n?.T=S==_'濍j(U %R8gq+ 4,+Ѳ 1 `ҀJ[@ؤڗ'֠K#X=Rg/ô-tUrFQZRݺ(z鼛5cܯgcLs覡9L5MYh k|T۞t|:-ˑ3#b6T JMe -L8I38Ae e*KCưMm :eTDPDw9ܮ00D=j"iRElXWmOt0BܸVA9)8S:tb#A.g7YPKQoIϚj?$&Cܔ!G2m" e =pK'PlL6t1:Twevp0 [Ka#\nv:E/yEgB;2[)k2\T͂v,^CovK:&}% 8!sq6nQqDr?Uz 4pa 1ږ^+ . e2ᦑoT nB 8A|-Bno51=9܎֤r'kJq+L$4%+R5T XoyG`}7 Aچx}~Sa`>xk|$& \rRd&ቃ{.nk2ع 2TrH,/o17Xx2ű U~xz\ uxsSe"\45#7qS=U3KFKf3US0ɀN Kn>cXt]q  Zp^o,tq#h]bl٤Z}JHCX`KDqg:؃٢R< +(@kCR;1W9,sik&Ag'>`e 5Wي&i)I6'n ݞMiw"&Qy!W45G4ZG\Ot&P%q<!oVn};amF6ԱȂ8"e+䘽)ORoO;sKAL'ۍtBWgl 0^olG/`' Llɷgl܆Q O3rLJ"W1И@p KJAGIGp'"픗"i*(&5\nf,.7N9ƒ{8& nB[\أR i-̋ȺN~m@1;lFaE69h{?ڙɈi"[ 6ocp˻⻿uG,NRq _g n5# a!L$~12-ݞ4`Ih؀+Fwūjt,t> ^yJcXkBg??1ZGb9b!w3X@vWj!NfZ#cC{#GwE%Q=IJlKS]y݌)lbSg穗̘L,F^M'r2_b\VU5LݎBo~[-%(Os\m3UYa-$;:ЖD#i8˺Js? IF.=,/cXun~KneIj9,(q+4DZ,g MCkO k@-~e-DĞQh)+yɹ5nHӍLg -)3>'t{]0¯L8REFq{> Cj}ҎmIcSؒV^lmq3FTa%ph՗B clQԤ^Q$7s/ f"k=3!b<0 /ҪJ(0eI )½)yw =FcA@{SdH9@1WN9ݵ \XtuRX\kbʗbil-i֔r N]uvKq|]F0:s550Ѳ15. m85FPƗ^ʔbCq˰HIc2Q&69E;){%Ц 'wG%X3Cz^z'>p¬`*kmg[Wդ8ĵRR uC f&p*JAljH_VvBa8n5x2!w^]+uK |Y5;PHNZcZ7@!,J23:+/s )Q6">m%%a)c]X<Q,90hp=S|Ñe<.c~e%."0'ۿY A0`6Vsb 5Me~i0arQXGN=e%Z0tAX|xO܊IplY0{tmw"L *nҶqfWGE8PmM4EM6ȥq$>l 0CyeMԖqÉ8rEg5|E*ӡWޞ:(uzٻ#I5Pn?3NFJaadNp&m2/DO3{1Dl@_M!u/b)bbEdjFLJR|bzVݔf$@Grp9p}LSDfKķ97/ZꪇT<K=dOܪȘ#.- GCf5pk$#F{O<őiEd*2qWzoڬtʺ _:o Zkզ CBf"ְ#_4|.ɗq̈́݇ͯ3)ܶ%?W]$T;!稕h!+j| ~r6NjnsTpHfpI'XT'檵;UP-6?7Pth) {EKxJuFպऑǜEF+Z1'o"XrbbᅲYͰ ݌>UeD!%B FQy`t|^sfwb̝?yxޗ+3"D-lt[-/Qo`4yW6;V ɀ< 7wC0/kc(qcH V(^v:KM`l)z붅\B;]U\?R?`}q@ۻa<,pK&I>F$w.&žu z-%I*ՂNm\UN1]DПZ#pKFNiq0j)vu#O_윽p ? L n7q>!wz; ^ǻ~U؎,AM kq3 F3#<Ї5~bFGu!4b}idmEz|elMFnBӺ))Q!J|^#GNDٔIom̀Kv)))4A?4F6G"&%_|\c솇Q)ӓKWendstream endobj 523 0 obj << /Filter /FlateDecode /Length 4894 >> stream x\K#y~X更v ǎ''oyǬקHvnm{EY﯊}hjh_{ho.=]?Wvc˛ ?-,[ej'r{Qq; n /%)Vim4LTUS72mur%y5Ik9[:*!˿[ͮ~˟/W3^{.N1}QBsE*k,-k ~TluZ]*en_d Җ`sqz q0BSmO0 H}Nw 0j]sZrRNDftf+4x֞:@s^ ^UK헗]x WûjL. JCuͶ} u{}VB[ZdD^r8`O@V90m`ļZ˕D!61;Ӵvy i@lwaն趽>l T'??:Y8g7zs.kӨxMپJ14>S=-N(WU = U,C qWF6Z`skڱyx9X4~xlf)0_NH2z%YHEwqNx|M.],.: ҆'jec$9 {FNC Ԁ~c@.Oǰ2 ~)bCFA'5t.Ui`_+eƋv h voQ$@WxNO8 >dn7e++j+\s AKy|4kVsވwlpټWlZY,h6MtRMmY=YZBoʘBTuu'C>n" (m*p@ #-WQ5[S^L2v LcHFW9ar a0QH(2)ueȓ̃]D$|Ǵk6jf+ܵ A6/E(P =Ȃ%΍,TCD1#{ga 6Lmd#-CӶ۴ FEo ` ?[h9*JLŋ:X8;Ȯ4 ύ0RjHr1!҄7:`"3q`9D>؛:F?4ey >нt5Д~6Z vb aQILkC)1 IYɂaP_-ƗBڣYPg[V WϠl-e']pʏ}ڙa8dwV}0 ENKԩ$+ xY3@9DvYD 5=RԀeHVōxA4ϟo<3@8bJ0=+EQ=6:."kTE6azKW+mb|{Δ-KPq0:3e,!(]) fVD4F5sHϟ WmVNq1 .YG#iѽf},/-> s#jpl"j`׷' ՘42;P0*s6>G,>Y֟g|Tlҍ3 bnhEy'o&+f‚$X9#4*]a}<]eMif6hUYniVrY9jiV+1 TTH(Et IM7R|<v>{a2}-ƙL.0 2s2n4Sy(,d7׫' B%ᾤnHwM~6yصX>iL:9 yJ\.#XV3u7>(qϟJZϫ 7A0oGz&7G|9j-P"S(5{9k!e!jH]=h~*GS^Xpm WiR&đlj nCu#h88Gsh&5utAKo> :NPOcth: ٣U4Le<âQ%_虧G}bǃ# tmb ǎ4_NqjLʶ)q K&SQeI!x% F!tJ07k6dacz}]%n~ λr{珗R;adabYIJs);\$<:4SM kΩe8?;:a@S:UC j$sTsL>S ~0E#'N7UudNIB*ti hjZ{'gkZ9b]2Fà_FMnY΅h X}!=Jq SQd`)/q &mFKb`Wx_hޤ.K`Gݬ6݀3 \°I|7Y?,;Ӹ#3*4 '- *'W?^ʻ"?{iof,(<[I+ڣk>QD&h ȩ,eINj+ Z\{k5KY*(+.tُ-i_[̞o>᧘SouС;Bi}iw~N~Glϰ=\+ :9Y@Ӱu|tDqtӟȎ0vA0Ņ6UE%#$t:t.^' qLdzw(G}olм˛dEM$?3|Q!38`sb#CR'1]F\>+ Y{gp.7/KEG7YFŦ։WdAU5nË6bW6 YU6Rwz|Rb tLGﱤ27מtsTQW1MĂ\V{4Nb?{alq lx]je/U3Q*j{CO? }ꍯgEqbϟqӏѕt> stream x\K$qv8/ W;K7pA\Q2KR0-Px:8 yKgz&S'6ZmX"4 涵RJXlB=,I6j=-6E@'V @$$J@De1lC"6ZAD6Ku@uu qr;4?s;N vYYlgԪeKLU?Wi ki4L̏(TB> F}P)Bhž%hI9+s@ⴡNT_ Wd4XȻĄ/|Oe߮o=EMM`lPmxz5b0gdN?W@\dQ%K/8=AN!샟.wpG*! Bo10bj TtSqd-p,Cj1`0pIKˊR4CpC|e "^#,"=f]!;a{w<\uxO$S8!_5?oAT]Ӈsn6R`p, }qp>lpґ}o}EZA_Hz-o`"|sqox8OM"RWnPx+(u eu G?G0PEoтKlR2/i.$Ϭ22~(B&B%^ ;,26NqJhӃ g0aR|pJ`DYFWh_eؾ 83_h듐1v{J*W֞,(ͣU4aMGYK%BS:OBV'7uO$Al#nsY 2'Pر%S#-GC~t0cw}i Q.FOa1F= FhM)y[3'$i`:I+%Kj#ͤp+F ِG< K,G 7-7ą. ,M9+8ojD?l T[ġY!T à%[[Q:%T_0>[+ G?D%.1$qk(Ҳ=c2; 33 lC~c"|l8=P)=ſ*O|ѓq"F ==bIGUae< yta?kKMGǀc}"AUXU&sbU%6,0 EUj&騂="K\@i2}޼:+G&WJѕ-7f0]GN-N c;A7ZN:68Fc0/˴͔:Pʻ~S@ttB#2vM9@l14+!Xw)k2b+\IGШ'LgO5o y2+G,;^t h W1tHȱ'xzph,$lҴT47pcØ$Wǧ`&Gw ).j6Dx9~'_jJjilL%$iHE^gjʹ_')}i}=tz!Fj]փs  iؚh Ɗ~[S wն,k:NaBGhނ?OEp)AtJD&~>y>Ig5]A?F\L/KQD4H`NH"b#;-{oUQSBӚ+ 12F>DR36BFDj@l%Ij=Cc*lEYfє]pt? FMbo"owTᒶ٢bdӎ*ԎeʀZIV#R  J7iىfq&ɦesYA#*H meOC(1^ e72; I:xSELU:%5)B n ZD=|> d_1% Vπ Rm/JL~Paq[pis` K{tئ1>N+cBK>x$@X[x2Cj-U MDBsߏC/X) aQ ` SDqz 6ԍ&Η9mL*$麡SCOTrkiz[wA)Ҟ= L3R A{0yy菘}s&x)Y>óefKQ'h o3W5id\|T"fR x࿇NfK2dmd}X3cmiw(gV fGDu56.B1u֭ͦRdM#XLy8UƇetXB8C|xBJwt Z@?@Im 9sqy@h}aaEpnc) F,܀Î"GN f'*o R1IA7)+->˅j8S9fa<_];XRA&}uq[-+}ήJ˭ҷG brtѿ~9h :a}٧]QRNPUxTV=uNUi/Ph =ݷZG{hHRwz{b-gaߚ,s?y'!ҪuUbA{ʇOsOQ  L>xm^U2soeup`aB3NU%>>;ev_g+v|)}ԬƩZVQxX/ORle2@σ+[igSR қ.lE;&ku ?|bUҁBhטWPo&TLGjy`/ V'4*QWie9j7Q]9Cu,ѻ3H|7qu&M8n8'q@h)TYs=% fc*xDU7`6Pm(aFȌˣGKRڑO/E⡖7zA XSg)/;SGN>͑,v~dn? yX Q G|??Wendstream endobj 525 0 obj << /Filter /FlateDecode /Length 202 >> stream x] w7mS]}19ԡoC?w|9s{ieqO},}i\E(+{;oվMjQnycGdh,&RqN U6tn3Ns*c9JQ%> stream xu}L[eB[Tu B퀈Ř$ m1JhY]k]]lU"UZ;j-f}$!P3pt8QlcGI~?s eEQvh }۔EЖ\='LkX Vž vޏűJG*ST1v0 Fmh:}V caԊS`S)tl53fFgzkwk]zvߡab{UVMH Q *EO 1AEP6<h]^`qYy?@#+ӏ;1%V,49 ݼ-K]U0 ?|$YtQ]YFa 쁸zkV(U+|e{tg? glS-3<}($Ҳ2j hX| $ALf:.?i($X寙+ & e+EQ]e_)+}~pH s eCggtySzӜBPendstream endobj 527 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10 j;!0Um?eB:Igv]_:6fD$ht,i 㤃]'rUeUm!树DTS[b'36Jqp8I.~r V/\'Sendstream endobj 528 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 538 >> stream xcd`ab`ddd/*N+6415~H3a!]kD< <<,~,.={3#}s~AeQfzFFBHbrG~jvybIjcNXMBQjqjQYjBԢ<\4R|BRojIbZ~:`A AE) ޙy > L@00:~_բQO~o]EBw)A\ :;:c=f<Ⱦ͇W.:ޫ_Wn{-U~~v-.W*.jzyv:xND:{;{{z{Bl38>%6g\nb^RAJZxTdxj)lQ~]Y1-M-;f;}fީU$)};#wzz{z{9  L?A~޲Svܴ..?*Cx9?]D7-ɫNΉ5QXwZ+9Xp20|7 endstream endobj 529 0 obj << /Filter /FlateDecode /Length 5583 >> stream xL8xrʉojE{<)b9I>$U\v(6 Y)M蠪7reK'ٞg\=?˪+;s~ysKyUuyUgSˢ\6c×kM[E\,Ňw?q) ծ .gi-|ik|mu=b<OZ b錇bǻkyvfmQ]إ-o]k?l5Yߋv4G(v8PgItFQ"iGx88pkAYp~MY7@#ŹC0L.<I_m>lA"v0`T㗵$xz;zod )P@«P°/bAbw$&yGlF; W+ߜ l $Z3 /G(Fm1z%A媊2 o//bOd7ۑ+4fiA}G,GZJj@o$i3Te0B0uNțg}@ADG]f)5 J#`$Q>-B=Rl഻ca'b@-5E*O!WOe'K LS;{!hk{mԚBʕ5Rǂ*DXƂL$Oy˭DyEifV!b+Z%k3O PUV/* h9+v-/:t,THhu:g$5V an ;lYPf5Nɲb ~HH_!(2*]g2K~tSSpJOݲ#%g0_\c ҅ -aMDlӰPj*5 &!d-)!Q0UXXJ Fɮ 8קAehk]1>[Pd1 ŕ"阅!"E]S-0eJ$2>V-~58) ϕ^GɃ8J:Y䊥_0^ ƏJY&F s+K`7!gZ^ˉt gTnotGŻ1TI{Tu̦dWd+܀=x8aa ㊊\fX)G! UF85[zhj XwUQ$l{0}o%^FK&ӡ\tvKuD,OZiZP Z'c=dX:1sRC6t.[Clbh)RmXg| R.:hf(ԋPD9=N`Fȟ˺xjME-2Q%#,7:smqa_[,ilȲEO}kFe# Hl9u[S8,7`z(88k;'2]ā0zѺMzZksFW/ő"[MKdQSe,]M;-Yƫ8s**OUh0u3iLJ~tŻ{0_S)\uD%WXM~.)|D,<>Ǭ[ʕ܂2MT4hD[7ZyY4K kyOַ uSkf~^\H}4JQn\ZmNb384I^ D{!ðT缷,ŏ۽QqD_ ⨻ۅ*jʌ"yE LƕYI4[L 4YP%-dᨀkP`@73+RSO}=}P4ʈXõo0:qUƙ1zd8ePtRڡi7cbk T:=mfr{--]ΪUcrc_ Ű̓a*E5T,d42 ڄ#PlpF|wI8VL*RVO"ovٚtv$'2[=Y23CaWi~S, +lM2|l$ũ^5C8\a F; 8eq8 Prob3$Yuܤ6~A2--/Ga&c>>8֔Bd8yfg g{ @ <mwY!Ի0gunaMng!@-_N%y g4-~ @3 @\ɔghg'ƭg΀lLrA |EFF187q ]Fؐ,4w9 V-aL6OUu=+B1s;/cLB0VQ WRZWã$y%nM<-j$t5ZC mxxԽ8r4TN @$ÓcxkYs$`#;F\lȖX6+4p iE1M( $eikaSĒC6ZQ׆dD26'u}58q~av6dt/Zv?|FB⯲tf~ ϱ%}g-GfT!φs^'#*űU[Q#S< o^[/Tϡ#c(^NFdssam˝^N8@ugž- `^ot[}G($u:*ʔ#8AE`H)ڦr_njӄK$?I 8[ vT32$C<XӸP")rMbǁs|7ӥ!L\sM>>rmWhKVVGRyMϷ x'PecJɬy-~W=NmƲ m5xR)fd|Ӽ˳)-W)Y=KUE,9YZRJԮFm1h(#(>f7ۏw(z;s[I Q`nT5@mY uh0^S<=WhynJΏh]~dZXB\-IDid9ITj1r+(x-1$KDRiV7CH{zayѐY!벾.M'd0J\Te+ry<=t^˖xj|:=B$x|a_6!nxF+cU )fe ت5w.\. ;tD]$6NE1ڤSONf>1><ƿQ2ΓKKs`6h  >#_y$Ÿm;[ $YZ7Ä ޥ@9s<=u25%MoxH@e-:i\}$`~I9qHb4z@Ej\ps]]~\1gVO;g&e^B1_Ԣ>)ӊ%ҥxg2r0k"MT*bIR5?/XI+| 9!&\bl=o?JC~vzԓ ^ME^t ~fF"I#TX~Rd1)W \,["VV<Ь`]VċuID3][>3WkǸM)kɁ鉙^8(+yzYS38RzE[=I 3q#^{J/$l!TOTe=m~{Q?<0x=j. 3UbLS]?fPYpC?iAe8L8@ϱ=׳Cendstream endobj 530 0 obj << /Filter /FlateDecode /Length 4938 >> stream x\ݏ7r}J'5?غ;ۉ| ܃ -ڞV_"bsf֑;z4,~ibEBЯˋ|RƉͅE,յݢ5mY\n.^UZ6ucT+Wp.W[':UaRJU/^<_N'0[^pvRGo?-WFjwxGhӵN}ߤQ]W}aئ݆D8JhxV}/%3$RIilk36ZjXaÔnYUwo<%8P=0w6?=[|>Q;ڏmEl]\6ك O"N*S>D6@Jt[*89]j3-._\\˫,ԧD8Id`R Z]' W8Oaa br6"z3ldj<񂸀A;'|6#oUЉyzPؽ42r 4cK8$az6aM,BI(gGdqEd7jЯCzr4HQ`^8aKVl+o7C?x=U i!pm~Uk|;/.xP.}c-a`0jbd(V&qhޅϢLgvGH.ϻ]5]xW־Z^ 4x$?dVbq~3LUd&+HDOIjI?#l~Q5*9YC4hbEr5j}B.qM ae_#[9i#_IB+`nxy)O-siUJ]E"L,{dyp 81D{1DRO r{(K2q3h&L~zH'CI4c 8qKK['?L+d';G^F~ oϏ~l.7d [Nl I9}輅x1e3hM+YQmY_ָVX.nvՇaό'CU}\m?paSPډ-o@;ٯWuÏS ] f΋Pv\7j I?D"֟r ISK:'J"NkDedLW=GdSя;79<ّhѶܚIѻԖEXUuxk 'a#kpLr~d Yjsݕ25\+?]K-M Սy%^4"ok+EᥟS丶Z(2YesB]J6'_/q//ĊZEB kjn m;A[4΢`௘4Tchڂ NTi_tLmh%1 Z_TK*r8*MNJڞ߆)9eXl<4'*H' 2'0aΡ<\DlsrpzW [0}a VZnt'MYnZ04"`#{s)!Q毢`m',,į`e<۾RRʦ6鼤>>zsw[?~U;.5YOs+LBB\O/T1&F1$JIth XXu:87 Zಲ(KBb >-3!eI:8C|H#wGğ<ֶTdIK'r }sއy[S-NbJ8>1 x }z"&jȓWa- Sb.2L43]9A"rR1\КBfFW2* r՟S=T(I̔s$|)/AP ۋϙ{rksh;!6;$t|Ѣa*ͩ3*"BT(1cu(dÐ( <#B.ԊVXz6) kX;iX 8ÔmI$MUQL~9J\l ~ZC6X+*tSh6q$@ڽAAg \f¾,W.5{:ji6dh:,z@P ~Ί61L)chn+[W8v܎*"SLq|_NL*͞,fNH&Se UDm6E b"\M \U^ VQٱo+&y~(%E‘^!0BIԼgK9/PH&V'.?$@nyӚ oF8UZ.΋?lXR &wUfu [_ca F\v<}NV݌6,^ eОMI'`WR4c ҟˉ0b5`mt~G,)Q PE%˻#70 g*xs;'L 8@oEv &hY+Ouۧ3L֒?8y`jr}v ߂KA9ok IgKɱPJNۧT h%zH(!%Z.Ux_PC)¦u0;TU?ȅ='^3j|Yg 20: } #Y -FW7ɃLt?\ )LJa0s 7W?wJ=ش̤^*J%lpe%D+F`qN^YKأ=vmO4{-'U/+=9IHE^@uOB'JNi< |HQ{k2v#`poAԽ{Tn}Ʈ8j<7bs+K_Lg*jajk@cep~t;7F aiEtUQ]@i<׹y3uBC b)Y/>0 K Ӿ NGpo.dbIf1|j}W1-&I iɁ$-rhr\3af:<} .ȆjGN ;,W!O5=# i+aΜȺl?#yrֹ}7޲ 7z8 xj[5wq`/i˶+u D,~Bo=8Þw#դ]$H! nx&,+؇ *໙ O~F^z,Gmyk1K/B ˏ8Cg*͠}>PFl=kϺzG Y=纸=YIasF]O 4D[4 _%]7FxA uBv!r>)* ?%SY`BN)ĒtܢkՐj#U8!ϡ4,p=!mu!%_2DU>SFB|f>)>stQ:#̡+!.] " fa߃E6ԅ1 :"6K)3nIpgxEOThR2n(30\{Cr*߿\%.$3dq/ *ܺgR4'[b_бSWػtUeF|>wi5~熊d" t,ma'wѩU'|pd\ӭc=ag"lcLi۫ȄٶԵMx&R>loqFOLˤS<b$rrZ}(%EJkӍ+C@aꟗB{;wXǨe`4,iUnxCE˄QÝj}̈́M~H|գW.耻9C4h6g+k)ǖ!yxyKaw#?LE\,^O!ثj<p?04*}wi@z5^\ru]ڋ}%qf-i/_$)SCTبWDT$9 \]aCwSu$X%y8zbsLY LPKMﶩ_,d;K%^U@K*ބp]J fw {(U~S 6iL9}C?:PcD/JLZɓ ZpT~=dݡDxG==%Q2Oщc]Drc.ݑ͑ ÔhDѷ̄9;2a'endstream endobj 531 0 obj << /Filter /FlateDecode /Length 211 >> stream x]=0 "7[(?R.&@v8.00'}IF]`4jlItQՍvT;t{%'Ҷ G\dGd,e:GE]m^.z4U.QU"v-?-`glPk^Pf,iᴝr8J$rI"T4Kiendstream endobj 532 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1402 >> stream xklew !J%L#9 / dݽk׵kO/zut`00`)DQ~ |8ONcIIwJy~Mֆ6ugm<JUv?F 5̪ߞE+PrEEohr^۸qӆ MNjDrIry|'Ab! s}}oX>9wahsz$l?jux3͢ep6ȶ,.i K-ӕ܁:T$u%F=Czx"GR8{n[=GMMB?TKt5صFLQPQ`; ؅+1*C8RhL> stream x]1 EwN iE,钡UĘ!2t-}?zp%. Lů89bMˍ:aցyiJ .AFMNJY[[a{Ԩ*)֨lMSa:81" ^ #|(-žVendstream endobj 534 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 395 >> stream xcd`ab`dd M3 JM/I, f!C럺<<,{*=3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k; g```2e`b8LR ݛ~t҇?z6%tX#c\9Oong/˞]"vfa }?r]gs?Et`).,\=SgEKW,-鮕V[[=K۬e@9?g}ϟ:y&{r\,!<{z{zz'N>ówsO)Syx퐛endstream endobj 535 0 obj << /Filter /FlateDecode /Length 163 >> stream x]O10 B ]:~ 8ʀ0%:t컓ϲ^Gֱ4%"@cQ`}*B7ޟ@n]O$)j 745$ZN?i vw6@Pr48n.1Ҵ4CN 8SLendstream endobj 536 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 377 >> stream xcd`ab`dd M̳uIf!Cw??XyyX}'WwwfFʢ#c]] iTध_^竧_TSHJHISOSIP v Vp CqX} ߱[ϸ 3Щ2S;:[ús8ٻt7vtv[];ʺKCN#d(V; 96.-M wf}8eNonIڙ?};u&~|r\,!> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 538 /ID [<83628ef6659e87c43432ee8384f0d78e><4fce56c8f707a9ee3033a733b7f66f00>] >> stream x=KBasy$Dc-6`PR[-DM -.E[- hsk6pqs?zG:Ӹ2ͦINW[:U*= Kb8ИyT eRy(敇ڄ̓0{̏3$bv 'vk`AtEsE1dNԢ@ oSu^궘B33E+<{E %&bz2[#|;;S=?L;1uϴ>t9R|=34M?NonmO8לi{ ~ glN_3A0gj >z7оsn~I endstream endobj startxref 257468 %%EOF LaplacesDemon/inst/doc/LaplacesDemonTutorial.R0000644000176200001440000002661715145054160021076 0ustar liggesusers### R code from vignette source 'LaplacesDemonTutorial.Stex' ################################################### ### code chunk number 1: LaplacesDemonTutorial.Stex:64-65 (eval = FALSE) ################################################### ## install.packages(pkgs="path/LaplacesDemon_ver.tar.gz", repos=NULL, type="source") ################################################### ### code chunk number 2: LaplacesDemonTutorial.Stex:72-73 ################################################### library(LaplacesDemon) ################################################### ### code chunk number 3: LaplacesDemonTutorial.Stex:80-97 ################################################### data(demonsnacks) N <- nrow(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) J <- ncol(X) for (j in 2:J) {X[,j] <- CenterScale(X[,j])} mon.names <- "LP" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ################################################### ### code chunk number 4: LaplacesDemonTutorial.Stex:122-140 ################################################### Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- dnormv(beta, 0, 1000, log=TRUE) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(beta, Data$X) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + sum(beta.prior) + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } ################################################### ### code chunk number 5: LaplacesDemonTutorial.Stex:203-204 ################################################### Initial.Values <- c(rep(0,J), 1) ################################################### ### code chunk number 6: LaplacesDemonTutorial.Stex:211-212 ################################################### set.seed(666) ################################################### ### code chunk number 7: LaplacesDemonTutorial.Stex:219-220 (eval = FALSE) ################################################### ## help(LaplacesDemon) ################################################### ### code chunk number 8: LaplacesDemonTutorial.Stex:225-228 (eval = FALSE) ################################################### ## Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, ## Covar=NULL, Iterations=1000, Status=100, Thinning=1, ## Algorithm="AFSS", Specs=list(A=500, B=NULL, m=100, n=0, w=1)) ################################################### ### code chunk number 9: LaplacesDemonTutorial.Stex:246-249 ################################################### Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, Covar=NULL, Iterations=1000, Status=100, Thinning=1, Algorithm="AFSS", Specs=list(A=500, B=NULL, m=100, n=0, w=1)) ################################################### ### code chunk number 10: LaplacesDemonTutorial.Stex:254-255 (eval = FALSE) ################################################### ## str(Fit) ################################################### ### code chunk number 11: LaplacesDemonTutorial.Stex:260-261 ################################################### Fit$Acceptance.Rate ################################################### ### code chunk number 12: LaplacesDemonTutorial.Stex:272-274 (eval = FALSE) ################################################### ## Fit ## print(Fit) ################################################### ### code chunk number 13: LaplacesDemonTutorial.Stex:279-280 ################################################### Consort(Fit) ################################################### ### code chunk number 14: LaplacesDemonTutorial.Stex:285-286 (eval = FALSE) ################################################### ## Fit$Posterior2 ################################################### ### code chunk number 15: LaplacesDemonTutorial.Stex:309-309 ################################################### ################################################### ### code chunk number 16: LaplacesDemonTutorial.Stex:311-312 (eval = FALSE) ################################################### ## plot(Fit, BurnIn=500, MyData, PDF=FALSE, Parms=NULL) ################################################### ### code chunk number 17: fig1 ################################################### par(mfrow=c(3,3)) BurnIn <- 500 for (j in 1:3){ plot((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], type="l", xlab="Thinned Samples", ylab="Value", main=MyData$parm.names[j]) panel.smooth((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], pch="") plot(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), xlab="Value", main=MyData$parm.names[j]) polygon(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], plot=FALSE) se <- 1/sqrt(length(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=MyData$parm.names[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } ################################################### ### code chunk number 18: fig2 ################################################### par(mfrow=c(3,3)) for (j in 4:5){ plot((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], type="l", xlab="Thinned Samples", ylab="Value", main=MyData$parm.names[j]) panel.smooth((BurnIn+1):Fit$Thinned.Samples, Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], pch="") plot(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), xlab="Value", main=MyData$parm.names[j]) polygon(density(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j], plot=FALSE) se <- 1/sqrt(length(Fit$Posterior1[(BurnIn+1):Fit$Thinned.Samples,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=MyData$parm.names[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } plot((BurnIn+1):length(Fit$Deviance), Fit$Deviance[(BurnIn+1):length(Fit$Deviance)], type="l", xlab="Thinned Samples", ylab="Value", main="Deviance") panel.smooth((BurnIn+1):length(Fit$Deviance), Fit$Deviance[(BurnIn+1):length(Fit$Deviance)], pch="") plot(density(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)]), xlab="Value", main="Deviance") polygon(density(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)], plot=FALSE) se <- 1/sqrt(length(Fit$Deviance[(BurnIn+1):length(Fit$Deviance)])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main="Deviance", xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) ################################################### ### code chunk number 19: fig3 ################################################### par(mfrow=c(2,3)) JJ <- NCOL(Fit$Monitor); nn <- NROW(Fit$Monitor) for (j in 1:JJ){ plot((BurnIn+1):nn, Fit$Monitor[(BurnIn+1):nn,j], type="l", xlab="Thinned Samples", ylab="Value", main=MyData$mon.names[j]) panel.smooth((BurnIn+1):nn, Fit$Monitor[(BurnIn+1):nn,j], pch="") plot(density(Fit$Monitor[(BurnIn+1):nn,j]), xlab="Value", main=MyData$mon.names[j]) polygon(density(Fit$Monitor[(BurnIn+1):nn,j]), col="black", border="black") abline(v=0, col="red", lty=2) z <- acf(Fit$Monitor[(BurnIn+1):nn,j], plot=FALSE) se <- 1/sqrt(length(Fit$Monitor[(BurnIn+1):nn,j])) plot(z$lag, z$acf, ylim=c(min(z$acf,-2*se),1), type="h", main=MyData$mon.names[j], xlab="Lag", ylab="Correlation") abline(h=(2*se), col="red", lty=2) abline(h=(-2*se), col="red", lty=2) } ################################################### ### code chunk number 20: LaplacesDemonTutorial.Stex:424-425 (eval = FALSE) ################################################### ## plot(BMK.Diagnostic(Fit$Posterior1[501:1000,])) ################################################### ### code chunk number 21: fig4 ################################################### par(mfrow=c(1,1)) plot(BMK.Diagnostic(Fit$Posterior1[501:1000,])) ################################################### ### code chunk number 22: LaplacesDemonTutorial.Stex:442-443 (eval = FALSE) ################################################### ## caterpillar.plot(Fit, Parms="beta") ################################################### ### code chunk number 23: fig5 ################################################### par(mfrow=c(1,1)) caterpillar.plot(Fit, Parms=1:4) ################################################### ### code chunk number 24: LaplacesDemonTutorial.Stex:462-463 ################################################### Pred <- predict(Fit, Model, MyData, CPUs=1) ################################################### ### code chunk number 25: LaplacesDemonTutorial.Stex:472-473 ################################################### summary(Pred, Discrep="Chi-Square") ################################################### ### code chunk number 26: LaplacesDemonTutorial.Stex:487-488 (eval = FALSE) ################################################### ## plot(Pred, Style="Density", Rows=1:9) ################################################### ### code chunk number 27: fig6 ################################################### par(mfrow=c(3,3)) for (j in 1:9){ plot(density(Pred$yhat[j,]), xlab="Value", main=paste("Post. Pred. Plot of yhat[", j, ",]", sep=""), sub="Black=Density, Red=y") polygon(density(Pred$yhat[j,]), col="black", border="black") abline(v=Pred$y[j], col="red") } ################################################### ### code chunk number 28: LaplacesDemonTutorial.Stex:509-510 (eval = FALSE) ################################################### ## plot(Pred, Style="Fitted") ################################################### ### code chunk number 29: fig7 ################################################### par(mfrow=c(1,1)) temp <- summary(Pred, Quiet=TRUE)$Summary plot(temp[,1], temp[,5], pch=16, cex=0.75, ylim=c(min(temp[,c(1,4:6)], na.rm=TRUE), max(temp[,c(1,4:6)], na.rm=TRUE)), xlab="y", ylab="yhat", main="Fitted") for (i in 1:length(y)) { lines(c(temp[i,1], temp[i,1]), c(temp[i,4], temp[i,6]))} panel.smooth(temp[,1], temp[,5], pch=16, cex=0.75) ################################################### ### code chunk number 30: LaplacesDemonTutorial.Stex:572-573 (eval = FALSE) ################################################### ## LaplacesDemon LaplacesDemon/inst/doc/Examples.Stex0000755000176200001440000142647615144316355017164 0ustar liggesusers\documentclass[nojss]{jss} %% need no \usepackage{Sweave.sty} \usepackage{amsmath} %\VignetteIndexEntry{LaplacesDemon Examples} %\VignettePackage{LaplacesDemon} %\VignetteDepends{LaplacesDemon} \author{Statisticat, LLC} \title{\includegraphics[height=1in,keepaspectratio]{LDlogo} \\ \pkg{LaplacesDemon} Examples} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Statisticat LLC} %% comma-separated \Plaintitle{LaplacesDemon Examples} %% without formatting \Shorttitle{Examples} %% a short title (if necessary) \Abstract{The \pkg{LaplacesDemon} package is a complete environment for Bayesian inference within \proglang{R}. Virtually any probability model may be specified. This vignette is a compendium of examples of how to specify different model forms. } \Keywords{Bayesian, LaplacesDemon, LaplacesDemonCpp, R} \Plainkeywords{bayesian, laplacesdemon, laplacesdemoncpp, r} %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2011} %% \Submitdate{2011-01-18} %% \Acceptdate{2011-01-18} \Address{ Statisticat, LLC\\ Farmington, CT\\ E-mail: defunct\\ URL: \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index} } %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} \begin{document} \pkg{LaplacesDemon} \citep{r:laplacesdemon}, often referred to as LD, is an \proglang{R} package that is available at \url{https://web.archive.org/web/20150430054143/http://www.bayesian-inference.com/software}. \pkg{LaplacesDemonCpp} is an extension package that uses \proglang{C++}. A formal introduction to \pkg{LaplacesDemon} is provided in an accompanying vignette entitled ``\pkg{LaplacesDemon} Tutorial'', and an introduction to Bayesian inference is provided in the ``Bayesian Inference'' vignette. The purpose of this document is to provide users of the \pkg{LaplacesDemon} package with examples of a variety of Bayesian methods. It is also a testament to the diverse applicability of \pkg{LaplacesDemon} to Bayesian inference. To conserve space, the examples are not worked out in detail, and only the minimum of necessary materials is provided for using the various methodologies. Necessary materials include the form expressed in notation, data (which is often simulated), the \code{Model} function, and initial values. The provided data, model specification, and initial values may be copy/pasted into an \proglang{R} file and updated with the \code{LaplacesDemon} or (usually) \code{LaplaceApproximation} functions. Although many of these examples update quickly, some examples are computationally intensive. All examples are provided in R code, but the model specification function can be in another language. A goal is to provide these example model functions in C++ as well, and some are now available at \url{https://web.archive.org/web/20140513065103/http://www.bayesian-inference.com/cpp/LaplacesDemonExamples.txt}. Initial values are usually hard-coded in the examples, though the Parameter-Generating Function (PGF) is also specified. It is recommended to generate initial values with the \code{GIV} function according to the user-specified \code{PGF}. Notation in this vignette follows these standards: Greek letters represent parameters, lower case letters represent indices, lower case bold face letters represent scalars or vectors, probability distributions are represented with calligraphic font, upper case letters represent index limits, and upper case bold face letters represent matrices. More information on notation is available at \url{https://web.archive.org/web/20150501205317/http://www.bayesian-inference.com/notation}. This vignette may grow over time as examples of more methods become included. Contributed examples are welcome via \url{https://github.com/LaplacesDemonR/LaplacesDemon/issues}. All accepted contributions are, of course, credited. \begin{center} \Large{\textbf{Contents}} \end{center} \begin{itemize} \item Adaptive Logistic Basis (ALB) Regression \ref{alb} \item ANCOVA \ref{ancova} \item ANOVA, One-Way \ref{anova.one.way} \item ANOVA, Two-Way \ref{anova.two.way} \item Approximate Bayesian Computation (ABC) \ref{abc} \item AR(p) \ref{arp} \item AR(p)-ARCH(q) \ref{arparchq} \item AR(p)-ARCH(q)-M \ref{arparchqm} \item AR(p)-GARCH(1,1) \ref{arpgarch} \item AR(p)-GARCH(1,1)-M \ref{arpgarchm} \item AR(p)-TARCH(q) \ref{arptarchq} \item AR(p)-TARCH(q)-M \ref{arptarchqm} \item Autoregressive Moving Average, ARMA(p,q) \ref{armapq} \item Beta Regression \ref{beta.reg} \item Beta-Binomial \ref{beta.binomial} \item Binary Logit \ref{binary.logit} \item Binary Log-Log Link Mixture \ref{binary.loglog.mixture} \item Binary Probit \ref{binary.probit} \item Binary Robit \ref{binary.robit} \item Binomial Logit \ref{binomial.logit} \item Binomial Probit \ref{binomial.probit} \item Binomial Robit \ref{binomial.robit} \item Change Point Regression \ref{changepoint} \item Cluster Analysis, Confirmatory (CCA) \ref{cca} \item Cluster Analysis, Exploratoryy (ECA) \ref{eca} \item Collaborative Filtering (CF) \ref{eofa} \item Conditional Autoregression (CAR), Poisson \ref{car.poisson} \item Conditional Predictive Ordinate (CPO) \ref{cpo} \item Contingency Table \ref{contingency.table} \item Dirichlet Process \ref{eca} \ref{imm} \item Discrete Choice, Conditional Logit \ref{conditional.logit} \item Discrete Choice, Mixed Logit \ref{dc.mixed.logit} \item Discrete Choice, Multinomial Probit \ref{dc.mnp} \item Distributed Lag, Koyck \ref{dl.koyck} \item Dynamic Linear Model (DLM) \ref{dfa} \ref{ssm.lin.reg} \ref{ssm.ll} \ref{ssm.llt} \item Dynamic Sparse Factor Model (DSFM) \ref{dsfm} \item Exponential Smoothing \ref{exp.smo} \item Factor Analysis, Approximate Dynamic (ADFA) \ref{adfa} \item Factor Analysis, Confirmatory (CFA) \ref{cfa} \item Factor Analysis, Dynamic (DFA) \ref{dsfm} \item Factor Analysis, Exploratory (EFA) \ref{efa} \item Factor Analysis, Exploratory Ordinal (EOFA) \ref{eofa} \item Factor Regression \ref{factor.reg} \item Gamma Regression \ref{gamma.reg} \item Gaussian Process Regression \ref{kriging} \item Geographically Weighted Regression \ref{gwr} \item Hidden Markov Model \ref{hmm} \item Hierarchical Bayes \ref{linear.reg.hb} \item Horseshoe Regression \ref{horseshoe} \item Inverse Gaussian Regression \ref{ig.reg} \item Kriging \ref{kriging} \item Kriging, Predictive Process \ref{kriging.pp} \item Laplace Regression \ref{laplace.reg} \item LASSO \ref{bal} \ref{lasso} \item Latent Dirichlet Allocation (LDA) \ref{lda} \item Linear Regression \ref{linear.reg} \item Linear Regression, Frequentist \ref{linear.reg.freq} \item Linear Regression, Hierarchical Bayesian \ref{linear.reg.hb} \item Linear Regression, Multilevel \ref{linear.reg.ml} \item Linear Regression with Full Missingness \ref{linear.reg.full.miss} \item Linear Regression with Missing Response \ref{linear.reg.miss.resp} \item Linear Regression with Missing Response via ABB \ref{linear.reg.miss.resp.abb} \item Linear Regression with Power Priors \ref{linear.reg.pp} \item Linear Regression with Zellner's g-Prior \ref{linear.reg.g} \item LSTAR \ref{lstar} \item MANCOVA \ref{mancova} \item MANOVA \ref{manova} \item Missing Values \ref{linear.reg.full.miss} \ref{linear.reg.miss.resp} \ref{linear.reg.miss.resp.abb} \item Mixed Logit \ref{mixed.logit} \item Mixture Model, Finite \ref{cca} \ref{fmm} \item Mixture Model, Infinite \ref{eca} \ref{imm} \item Mixture Model, Poisson-Gamma \ref{poisson.gamma} \item Model Averaging \ref{ssvs} \ref{rj} \item Multilevel Model \ref{linear.reg.ml} \item Multinomial Logit \ref{mnl} \item Multinomial Logit, Nested \ref{nmnl} \item Multinomial Probit \ref{mnp} \item Multiple Discrete-Continuous Choice \ref{mdcc} \item Multivariate Binary Probit \ref{multiv.bin.probit} \item Multivariate Laplace Regression \ref{multivariate.lap.reg} \item Multivariate Poisson Regression \ref{multivariate.pois.reg} \item Multivariate Regression \ref{multivariate.reg} \item Negative Binomial Regression \ref{negbin.reg} \item Normal, Multilevel \ref{norm.ml} \item Ordinal Logit \ref{ordinal.logit} \item Ordinal Probit \ref{ordinal.probit} \item Panel, Autoregressive Poisson \ref{panel.ap} \item Penalized Spline Regression \ref{pspline} \item Poisson Regression \ref{poisson.reg} \item Poisson Regression, Overdispersed \ref{poisson.gamma} \ref{negbin.reg} \item Poisson-Gamma Regression \ref{poisson.gamma} \item Polynomial Regression \ref{polynomial.reg} \item Power Priors \ref{linear.reg.pp} \item Proportional Hazards Regression, Weibull \ref{prop.haz.weib} \item PVAR(p) \ref{pvarp} \item Quantile Regression \ref{quantile.reg} \item Revision, Normal \ref{revision.normal} \item Ridge Regression \ref{ridge.reg} \item Robust Regression \ref{robust.reg} \item Seemingly Unrelated Regression (SUR) \ref{sur} \item Simultaneous Equations \ref{simultaneous} \item Space-Time, Dynamic \ref{spacetime.dynamic} \item Space-Time, Nonseparable \ref{spacetime.nonsep} \item Space-Time, Separable \ref{spacetime.sep} \item Spatial Autoregression (SAR) \ref{sar} \item STARMA(p,q) \ref{starma} \item State Space Model (SSM), Dynamic Sparse Factor Model (DSFM) \ref{dsfm} \item State Space Model (SSM), Linear Regression \ref{ssm.lin.reg} \item State Space Model (SSM), Local Level \ref{ssm.ll} \item State Space Model (SSM), Local Linear Trend \ref{ssm.llt} \item State Space Model (SSM), Stochastic Volatility (SV) \ref{sv} \item Stochastic Volatility (SV) \ref{sv} \item Survival Model \ref{prop.haz.weib} \item T-test \ref{anova.one.way} \item Threshold Autoregression (TAR) \ref{tar} \item Topic Model \ref{lda} \item Time Varying AR(1) with Chebyshev Series \ref{tvarcs} \item Variable Selection, BAL \ref{bal} \item Variable Selection, Horseshoe \ref{horseshoe} \item Variable Selection, LASSO \ref{lasso} \item Variable Selection, RJ \ref{rj} \item Variable Selection, SSVS \ref{ssvs} \item VARMA(p,q) - SSVS \ref{varmapqssvs} \item VAR(p)-GARCH(1,1)-M \ref{varpgarchm} \item VAR(p) with Minnesota Prior \ref{varp} \item VAR(p) with SSVS \ref{varpssvs} \item Variety Model \ref{mdcc} \item Weighted Regression \ref{weighted.reg} \item Zellner's g-Prior \ref{linear.reg.g} \item Zero-Inflated Poisson (ZIP) \ref{zip} \end{itemize} \section{Adaptive Logistic Basis (ALB) Regression} \label{alb} Adaptive Logistic Basis (ALB) regression is an essentially automatic non-parametric approach to estimating the nonlinear relationship between each of multiple independent variables (IVs) and the dependent variable (DV). It is automatic because when using the suggested $K = 2J + 1$ components (see below) given $J$ IVs, the data determines the nonlinear relationships, whereas in other methods, such as with splines, the user must specify the number of knots and possibly consider placement of the knots. Knots do not exist in ALB. Both the DV and IVs should be centered and scaled. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{S}\delta$$ $$\textbf{S}_{i,m} = \frac{\phi_{i,m}}{\sum^M_{m=1} \phi_{i,m}}$$ $$\phi_{i,m} = \exp(\alpha_m + \textbf{X}_{i,1:J}\beta_{1:J,m}), \quad i=1,\dots,N, \quad m=1,\dots,M$$ $$\alpha_m \sim \mathcal{N}(0, 10), \quad m=1,\dots,(M-1)$$ $$\alpha_M = 0$$ $$\beta_{j,m} \sim \mathcal{N}(0, 100), \quad j=1,\dots,J, \quad m=1,\dots,(M-1)$$ $$\beta_{j,M} = 0$$ $$\delta_m \sim \mathcal{N}(\zeta, \tau^2), \quad m=1,\dots,M$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\zeta \sim \mathcal{N}(0, 10)$$ $$\tau \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- as.matrix(log(demonsnacks[,c(1,4,10)]+1)) \\ J <- ncol(X) \\ y <- CenterScale(y) \\ for (j in 1:J) X[,j] <- CenterScale(X[,j]) \\ K <- 2*J+1 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,K-1), beta=matrix(0,J,K-1), \\ \hspace*{0.27 in} delta=rep(0,K), zeta=0, sigma=0, tau=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$K-1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J*(Data$K-1)) \\ \hspace*{0.27 in} delta <- rnorm(Data$K) \\ \hspace*{0.27 in} zeta <- rnorm(1) \\ \hspace*{0.27 in} sigma <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} tau <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} return(c(alpha, beta, delta, zeta, sigma, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.delta=pos.delta, pos.zeta=pos.zeta, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.tau=pos.tau) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J, Data$K-1) \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} zeta.prior <- dnormv(zeta, 0, 10, log=TRUE) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnorm(delta, zeta, tau, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} phi <- cbind(exp(matrix(alpha, Data$N, Data$K-1, byrow=TRUE) + \\ \hspace*{0.62 in} tcrossprod(Data$X, t(beta))),1) \\ \hspace*{0.27 in} mu <- tcrossprod(phi / rowSums(phi), t(delta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + delta.prior + zeta.prior \\ \hspace*{0.62 in} sigma.prior + tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), rep(0,J*(K-1)), rep(0,K-1), 0, 1, 1)} \section{ANCOVA} \label{ancova} This example is essentially the same as the two-way ANOVA (see section \ref{anova.two.way}), except that a covariate $\textbf{X}_{,3}$ has been added, and its parameter is $\delta$. \subsection{Form} $$\textbf{y}_i \sim \mathcal{N}(\mu_i, \sigma^2_1)$$ $$\mu_i = \alpha + \beta[\textbf{X}_{i,1}] + \gamma[\textbf{X}_{i,2}] + \delta \textbf{X}_{i,2}, \quad i=1,\dots,N$$ $$\epsilon_i = \textbf{y}_i - \mu_i$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=1,\dots,J$$ $$\beta_J = - \sum^{J-1}_{j=1} \beta_j$$ $$\gamma_k \sim \mathcal{N}(0, \sigma^2_3), \quad k=1,\dots,K$$ $$\gamma_K = - \sum^{K-1}_{k=1} \gamma_k$$ $$\delta \sim \mathcal{N}(0, 1000)$$ $$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,3$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \#Number of levels in factor (treatment) 1 \\ K <- 3 \#Number of levels in factor (treatment) 2 \\ X <- cbind(rcat(N,rep(1/J,J)), rcat(N,rep(1/K,K)), runif(N,-2,2)) \\ alpha <- runif(1,-1,1) \\ beta <- runif(J-1,-2,2) \\ beta <- c(beta, -sum(beta)) \\ gamma <- runif(K-1,-2,2) \\ gamma <- c(gamma, -sum(gamma)) \\ delta <- runif(1,-2,2) \\ y <- alpha + beta[X[,1]] + gamma[X[,2]] + delta*X[,3] + rnorm(N,0,0.1) \\ mon.names <- c("LP", paste("beta[",J,"]",sep=""), \\ \hspace*{0.27 in} paste("gamma[",K,"]",sep=""),"s.beta","s.gamma","s.epsilon") \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), gamma=rep(0,K-1), \\ \hspace*{0.27 in} delta=0, sigma=rep(0,3))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J-1) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K-1) \\ \hspace*{0.27 in} delta <- rnorm(1) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, delta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.gamma=pos.gamma, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} beta <- c(beta, -sum(beta)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} gamma <- c(gamma, -sum(gamma)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[3], log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- dnormv(delta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- alpha + beta[Data$X[,1]] + gamma[Data$X[,2]] + \\ \hspace*{0.62 in} delta*Data$X[,3] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Variance Components \\ \hspace*{0.27 in} s.beta <- sd(beta) \\ \hspace*{0.27 in} s.gamma <- sd(gamma) \\ \hspace*{0.27 in} s.epsilon <- sd(Data$y - mu) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + delta.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, beta[Data$J], \\ \hspace*{0.62 in} gamma[Data$K], s.beta, s.gamma, s.epsilon), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,(J-1)), rep(0,(K-1)), 0, rep(1,3))} \section{ANOVA, One-Way} \label{anova.one.way} When $J=2$, this is a Bayesian form of a t-test. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$\mu_i = \alpha + \beta[\textbf{x}_i], \quad i=1,\dots,N$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=1,\dots,J$$ $$\beta_J = - \displaystyle\sum^{J-1}_{j=1} \beta_j$$ $$\sigma_{1:2} \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 1000 \\ J <- 3 \\ x <- rcat(N, rep(1/J, J)) \\ alpha <- runif(1,-1,1) \\ beta <- runif(J-1,-2,2) \\ beta <- c(beta, -sum(beta)) \\ y <- alpha + beta[x] + rnorm(N,0,0.2) \\ mon.names <- c("LP",paste("beta[",J,"]",sep="")) \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), sigma=rep(0,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J-1) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, x=x, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} beta <- c(beta, -sum(beta)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- alpha + beta[Data$x] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,beta[Data$J]), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,(J-1)), rep(1,2))} \section{ANOVA, Two-Way} \label{anova.two.way} In this representation, $\sigma^m$ are the superpopulation variance components, \code{s.beta} and \code{s.gamma} are the finite-population within-variance components of the factors or treatments, and \code{s.epsilon} is the finite-population between-variance component. \subsection{Form} $$\textbf{y}_i \sim \mathcal{N}(\mu_i, \sigma^2_1)$$ $$\mu_i = \alpha + \beta[\textbf{X}_{i,1}] + \gamma[\textbf{X}_{i,2}], \quad i=1,\dots,N$$ $$\epsilon_i = \textbf{y}_i - \mu_i$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=1,\dots,J$$ $$\beta_J = - \sum^{J-1}_{j=1} \beta_j$$ $$\gamma_k \sim \mathcal{N}(0, \sigma^2_3), \quad k=1,\dots,K$$ $$\gamma_K = - \sum^{K-1}_{k=1} \gamma_k$$ $$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,3$$ \subsection{Data} \code{N <- 1000 \\ J <- 5 \#Number of levels in factor (treatment) 1 \\ K <- 3 \#Number of levels in factor (treatment) 2 \\ X <- cbind(rcat(N,rep(1/J,J)), rcat(N,rep(1/K,K))) \\ alpha <- runif(1,-1,1) \\ beta <- runif(J-1,-2,2) \\ beta <- -sum(beta) \\ gamma <- runif(K-1,-2,2) \\ gamma <- -sum(gamma) \\ y <- alpha + beta[X[,1]] + gamma[X[,2]] + rnorm(N,0,0.1) \\ mon.names <- c("LP", paste("beta[",J,"]",sep=""), \\ \hspace*{0.27 in} paste("gamma[",K,"]",sep=""), "s.beta", "s.gamma", "s.epsilon") \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), gamma=rep(0,K-1), \\ \hspace*{0.27 in} sigma=rep(0,3))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J-1) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K-1) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} beta <- c(beta, -sum(beta)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} gamma <- c(gamma, -sum(gamma)) \#Sum-to-zero constraint \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[3], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- alpha + beta[Data$X[,1]] + gamma[Data$X[,2]] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Variance Components \\ \hspace*{0.27 in} s.beta <- sd(beta) \\ \hspace*{0.27 in} s.gamma <- sd(gamma) \\ \hspace*{0.27 in} s.epsilon <- sd(Data$y - mu) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, beta[Data$J], \\ \hspace*{0.62 in} gamma[Data$K], s.beta, s.gamma, s.epsilon), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,(J-1)), rep(0,(K-1)), rep(1,3))} \section{Approximate Bayesian Computation (ABC)} \label{abc} Approximate Bayesian Computation (ABC), also called likelihood-free estimation, is not a statistical method, but a family of numerical approximation techniques in Bayesian inference. ABC is especially useful when evaluation of the likelihood, $p(\textbf{y} | \Theta)$ is computationally prohibitive, or when suitable likelihoods are unavailable. The current example is the application of ABC in the context of linear regression. The log-likelihood is replaced with the negative sum of the distance between $\textbf{y}$ and $\textbf{y}^{rep}$ as the approximation of the log-likelihood. Distance reduces to the absolute difference. Although linear regression has an easily calculated likelihood, it is used as an example due to its generality. This example demonstrates how ABC may be estimated either with MCMC via the \code{LaplacesDemon} function or with Laplace Approximation via the \code{LaplaceApproximation} function. In this method, a tolerance (which is found often in ABC) does not need to be specified, and the logarithm of the unnormalized joint posterior density is maximized, as usual. The negative and summed distance, above, may be replaced with the negative and summed distance between summaries of the data, rather than the data itself, but this has not been desirable in testing. \subsection{Form} $$\textbf{y} = \mu + \epsilon$$ $$\mu = \textbf{X} \beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP","sigma") \\ parm.names <- as.parm.names(list(beta=rep(0,J))) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood Approximation \\ \hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma <- sd(epsilon) \\ \hspace*{0.27 in} LL <- -sum(abs(epsilon)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior Approximation \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,sigma), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J))} \section{AR(p)} \label{arp} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p}, \quad t=1,\dots,T$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} sigma <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} return(c(alpha, phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L=L, PGF=PGF, P=P, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L[p])] <- mu[-c(1:Data$L[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L[p])] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-c(1:Data$L[Data$P])], mu[-c(1:Data$L[Data$P])], \\ \hspace*{0.62 in} sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,P+1), 1)} \section{AR(p)-ARCH(q)} \label{arparchq} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p}, \quad t=1,\dots,T$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_q \epsilon^2_{t-q}, \quad t=2,\dots,T$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_q \sim \mathcal{U}(0, 1), \quad q=1,\dots,Q$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Volatility lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Volatility order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), omega=0, \\ \hspace*{0.27 in} theta=rep(0,Q))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(Data$Q, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} theta[q]*epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + omega.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,P+1), 1, rep(0.5,Q))} \section{AR(p)-ARCH(q)-M} \label{arparchqm} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p} + \delta \sigma^2_{t-1}, \quad t=1,\dots,T$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\delta \sim \mathcal{N}(0, 1000)$$ $$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_q \epsilon^2_{t-q}, \quad t=2,\dots,T$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_q \sim \mathcal{U}(0, 1), \quad q=1,\dots,Q$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Volatility lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Volatility order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), delta=0, omega=0, \\ \hspace*{0.27 in} theta=rep(0,Q))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} delta <- rnorm(1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(Data$Q, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, phi, delta, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.delta=pos.delta, pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- dnormv(delta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} theta[q]*epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\ \hspace*{0.27 in} mu <- mu + delta*sigma2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + delta.prior + omega.prior + \\ \hspace*{0.62 in} theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.62 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,P+2), 1, rep(0.5,Q))} \section{AR(p)-GARCH(1,1)} \label{arpgarch} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p}, \quad t=1,\dots,T$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma^2_t = \theta_1 + \theta_2 \epsilon^2_{t-1} + \theta_3 \sigma^2_{t-1}$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_k = \frac{1}{1 + \exp(-\theta_k)}, \quad k=1,\dots,3$$ $$\theta_k \sim \mathcal{N}(0, 1000) \in [-10,10], \quad k=1,\dots,3$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), omega=0, \\ \hspace*{0.27 in} theta=rep(0,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(2, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L=L, P=P, PGF=PGF, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\ \hspace*{0.27 in} if(sum(theta) >= 1) theta[2] <- 1 - 1e-5 - theta[1] \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L[p])] <- mu[-c(1:Data$L[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma2 <- c(omega, omega + theta[1]*epsilon[-Data$T]\textasciicircum 2) \\ \hspace*{0.27 in} sigma2[-1] <- sigma2[-1] + theta[2]*sigma2[-Data$T] \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L[Data$P])], sigma2[-c(1:Data$L[Data$P])], \\ \hspace*{0.95 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + omega.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm)\\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,P), rep(0.4,3))} \section{AR(p)-GARCH(1,1)-M} \label{arpgarchm} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p} + \delta \sigma^2_{t-1}, \quad t=1,\dots,(T+1)$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma^2_t = \omega + \theta_1 \epsilon^2_{t-1} + \theta_2 \sigma^2_{t-1}$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_k \sim \mathcal{U}(0, 1), \quad k=1,\dots,2$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, delta=0, phi=rep(0,P), omega=0, \\ \hspace*{0.27 in} theta=rep(0,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} delta <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(2, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, delta, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L=L, P=P, PGF=PGF, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\ \hspace*{0.27 in} if(sum(theta) >= 1) theta[2] <- 1 - 1e-5 - theta[1] \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} delta.prior <- dnormv(delta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L[p])] <- mu[-c(1:Data$L[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} sigma2 <- c(omega, omega + theta[1]*epsilon[-Data$T]\textasciicircum 2) \\ \hspace*{0.27 in} sigma2[-1] <- sigma2[-1] + theta[2]*sigma2[-Data$T] \\ \hspace*{0.27 in} mu <- mu + delta*sigma2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L[Data$P])], sigma2[-c(1:Data$L[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + delta.prior + phi.prior + omega.prior + \\ \hspace*{0.62 in} theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,2), rep(0,P), rep(0.4,3))} \section{AR(p)-TARCH(q)} \label{arptarchq} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=2,\dots,T$$ $$\mu_t = \alpha + \phi^P_{p=1} \textbf{y}_{t-p}, \quad t=(p+1),\dots,T$$ $$\epsilon = \textbf{y} - \mu$$ $$\delta = (\epsilon > 0) \times 1$$ $$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_{q,1} \delta_{t-1} \epsilon^2_{t-1} + \theta_{q,2} (1-\delta_{t-1}) \epsilon^2_{t-1}$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_{q,j} \sim \mathcal{U}(0, 1), \quad q=1\dots,Q, \quad j=1,\dots,2$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Volatility lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Volatility order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), omega=0, \\ \hspace*{0.27 in} theta=matrix(0,Q,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(Data$Q*2, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- matrix(interval(parm[Data$pos.theta], 1e-10, 1-1e-5), Data$Q, \\ \hspace*{0.62 in} 2) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- as.vector(theta) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} delta <- (epsilon > 0) * 1 \\ \hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} delta[1:(Data$T-Data$L.Q[q])] * theta[q,1] * \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 + \\ \hspace*{0.95 in} (1 - delta[1:(Data$T-Data$L.Q[q])]) * theta[q,2] * \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + omega.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,P), 1, rep(0.5,Q*2))} \section{AR(p)-TARCH(q)-M} \label{arptarchqm} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=2,\dots,T$$ $$\mu_t = \alpha + \phi^P_{p=1} \textbf{y}_{t-p} + \delta_{t-1} \gamma_1 \sigma^2_{t-1} + (1 - \delta_{t-1}) \gamma_2 \sigma^2_{t-1}, \quad t=(p+1),\dots,T$$ $$\epsilon = \textbf{y} - \mu$$ $$\delta = (\epsilon > 0) \times 1$$ $$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_{q,1} \delta_{t-1} \epsilon^2_{t-1} + \theta_{q,2} (1-\delta_{t-1}) \epsilon^2_{t-1}$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\gamma_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,2$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\omega \sim \mathcal{HC}(25)$$ $$\theta_{q,j} \sim \mathcal{U}(0, 1), \quad q=1\dots,Q, \quad j=1,\dots,2$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Volatility lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Volatility order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, gamma=rep(0,2), phi=rep(0,P), \\ \hspace*{0.27 in} omega=0, theta=matrix(0,Q,2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.omega <- grep("omega", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} gamma <- rnorm(2) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- runif(Data$Q*2, 1e-10, 1-1e-5) \\ \hspace*{0.27 in} return(c(alpha, gamma, phi, omega, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.omega] <- omega \\ \hspace*{0.27 in} theta <- matrix(interval(parm[Data$pos.theta], 1e-10, 1-1e-5), Data$Q, \\ \hspace*{0.62 in} 2) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- as.vector(theta) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} delta <- (epsilon > 0) * 1 \\ \hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} delta[1:(Data$T-Data$L.Q[q])] * theta[q,1] * \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 + \\ \hspace*{0.95 in} (1 - delta[1:(Data$T-Data$L.Q[q])]) * theta[q,2] * \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\ \hspace*{0.27 in} mu <- mu + delta*gamma[1]*sigma2 + (1 - delta)*gamma[2]*sigma2 \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + gamma.prior + phi.prior + omega.prior + \\ \hspace*{0.62 in} theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,3), rep(0,P), 1, rep(0.5,Q*2))} \section{Autoregressive Moving Average, ARMA(p,q)} \label{armapq} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p} + \sum^Q_{q=1} \theta_q \epsilon_{t-q}$$ $$\epsilon_t = \textbf{y}_t - \mu_t$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\theta_q \sim \mathcal{N}(0, 1000), \quad q=1,\dots,Q$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Moving average lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Moving average order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), sigma=0, \\ \hspace*{0.27 in} theta=rep(0,Q))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\ \hspace*{0.27 in} sigma <- rhalfcauchy(1,5) \\ \hspace*{0.27 in} theta <- rnorm(Data$Q) \\ \hspace*{0.27 in} return(c(alpha, phi, sigma, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dnormv(theta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rep(alpha, Data$T) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\ \hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\ \hspace*{0.27 in} epsilon <- Data$y - mu \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} mu[-c(1:Data$L.Q[q])] <- mu[-c(1:Data$L.Q[q])] + \\ \hspace*{0.95 in} theta[q]*epsilon[1:(Data$T-Data$L.Q[q])] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-c(1:Data$L.P[Data$P])], \\ \hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + sigma.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0, rep(0,P), 1, rep(0,Q))} \section{Beta Regression} \label{beta.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{BETA}(a,b)$$ $$a = \mu \phi$$ $$b = (1 - \mu) \phi$$ $$\mu = \Phi(\beta_1 + \beta_2 \textbf{x}), \quad \mu \in (0, 1)$$ $$\beta_j \sim \mathcal{N}(0, 10), \quad j=1,\dots,J$$ $$\phi \sim \mathcal{HC}(25)$$ where $\Phi$ is the normal CDF. \subsection{Data} \code{N <- 100 \\ x <- runif(N) \\ y <- rbeta(N, (0.5-0.2*x)*3, (1-(0.5-0.2*x))*3) mon.names <- "LP" \\ parm.names <- c("beta[1]","beta[2]","phi") \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ PGF <- function(Data) return(c(rnormv(2,0,10), rhalfcauchy(1,5))) \\ MyData <- list(PGF=PGF, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.phi=pos.phi, x=x, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dhalfcauchy(phi, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- interval(pnorm(beta[1] + beta[2]*Data$x), 0.001, 0.999, \\ \hspace*{0.62 in} reflect=FALSE) \\ \hspace*{0.27 in} a <- mu * phi \\ \hspace*{0.27 in} b <- (1 - mu) * phi \\ \hspace*{0.27 in} LL <- sum(dbeta(Data$y, a, b, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + phi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbeta(length(mu), a, b), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,2), 0.01)} \section{Beta-Binomial} \label{beta.binomial} \subsection{Form} $$\textbf{y}_i \sim \mathcal{BIN}(\textbf{n}_i, \pi_i), \quad i=1,\dots,N$$ $$\pi_i \sim \mathcal{BETA}(\alpha, \beta) \in [0.001,0.999]$$ \subsection{Data} \code{N <- 20 \\ n <- round(runif(N, 50, 100)) \\ y <- round(runif(N, 1, 10)) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(pi=rep(0,N))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} pi <- rbeta(Data$N,1,1) \\ \hspace*{0.27 in} return(pi) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, mon.names=mon.names, n=n, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[1:Data$N] <- pi <- interval(parm[1:Data$N], 0.001, 0.999) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} pi.prior <- sum(dbeta(pi, 1, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, pi, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + pi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbinom(Data$N, Data$n, pi), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0.5,N))} \section{Binary Logit} \label{binary.logit} \subsection{Form} $$\textbf{y} \sim \mathcal{BERN}(\eta)$$ $$\eta = \frac{1}{1 + \exp(-\mu)}$$ $$\mu = \textbf{X} \beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{data(demonsnacks) \\ J <- 3 \\ y <- ifelse(demonsnacks$Calories <= 137, 0, 1) \\ X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} eta <- invlogit(mu) \\ \hspace*{0.27 in} LL <- sum(dbern(Data$y, eta, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbern(length(eta), eta), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Binary Log-Log Link Mixture} \label{binary.loglog.mixture} A weighted mixture of the log-log and complementary log-log link functions is used, where $\alpha$ is the weight. Since the log-log and complementary log-log link functions are asymmetric (as opposed to the symmetric logit and probit link functions), it may be unknown \textit{a priori} whether the log-log or complementary log-log will perform better. \subsection{Form} $$\textbf{y} \sim \mathcal{BERN}(\eta)$$ $$\eta = \alpha \exp(-\exp(\mu)) + (1 - \alpha) (1 - \exp(-\exp(\mu)))$$ $$\mu = \textbf{X} \beta$$ $$\alpha \sim \mathcal{U}(0, 1)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{N <- 100 \\ J <- 3 \\ X <- cbind(1, matrix(rnorm(N*(J-1),N,J-1))) \\ alpha <- runif(1) \\ beta <- rnorm(J) \\ mu <- tcrossprod(X, t(beta)) \\ eta <- alpha*invloglog(mu) + (1-alpha)*invcloglog(mu) \\ y <- rbern(N, eta) \\ mon.names <- c("LP","alpha") \\ parm.names <- as.parm.names(list(beta=rep(0,J), logit.alpha=0)) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} logit.alpha <- rnorm(1) \\ \hspace*{0.27 in} return(c(beta, logit.alpha)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$J+1] <- alpha <- interval(parm[Data$J+1], -700, 700) \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dunif(alpha, 0, 1, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} eta <- alpha*invloglog(mu) + (1-alpha)*invcloglog(mu) \\ \hspace*{0.27 in} LL <- sum(dbern(Data$y, eta, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,alpha), \\ \hspace*{0.62 in} yhat=rbern(length(eta), eta), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 0)} \section{Binary Probit} \label{binary.probit} \subsection{Form} $$\textbf{y} \sim \mathcal{BERN}(\textbf{p})$$ $$\textbf{p} = \phi(\mu)$$ $$\mu = \textbf{X} \beta \in [-10,10]$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ where $\phi$ is the CDF of the standard normal distribution, and $J$=3. \subsection{Data} \code{data(demonsnacks) \\ J <- 3 \\ y <- ifelse(demonsnacks$Calories <= 137, 0, 1) \\ X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\ \hspace*{0.27 in} p <- pnorm(mu) \\ \hspace*{0.27 in} LL <- sum(dbern(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbern(length(p), p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Binary Robit} \label{binary.robit} \subsection{Form} $$\textbf{y} \sim \mathcal{BERN}(\textbf{p})$$ $$\textbf{p} = \textbf{T}_\nu(\mu)$$ $$\mu = \textbf{X} \beta \in [-10,10]$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\nu \sim \mathcal{U}(5, 10)$$ where $\textbf{T}_\nu$ is the CDF of the standard t-distribution with $\nu$ degrees of freedom. \subsection{Data} \code{data(demonsnacks) \\ y <- ifelse(demonsnacks$Calories <= 137, 0, 1) \\ X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), nu=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} nu <- runif(1,5,10) \\ \hspace*{0.27 in} return(c(beta, nu)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.nu=pos.nu, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, 1000) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} nu.prior <- dunif(nu, 1e-100, 1000, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\ \hspace*{0.27 in} p <- pst(mu, nu=nu) \\ \hspace*{0.27 in} LL <- sum(dbern(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + nu.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbern(length(p), p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 5)} \section{Binomial Logit} \label{binomial.logit} \subsection{Form} $$\textbf{y} \sim \mathcal{BIN}(\textbf{p}, \textbf{n})$$ $$\textbf{p} = \frac{1}{1 + \exp(-\mu)}$$ $$\mu = \beta_1 + \beta_2 \textbf{x}$$ $$\beta_j \sim \mathcal{N}(0,1000), \quad j=1,\dots,J$$ \subsection{Data} \code{\#10 Trials \\ exposed <- c(100,100,100,100,100,100,100,100,100,100) \\ deaths <- c(10,20,30,40,50,60,70,80,90,100) \\ dose <- c(1,2,3,4,5,6,7,8,9,10) \\ J <- 2 \#Number of parameters \\ mon.names <- "LP" \\ parm.names <- c("beta[1]","beta[2]") \\ PGF <- function(Data) return(rnormv(Data$J,0,1000)) \\ MyData <- list(J=J, PGF=PGF, n=exposed, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, x=dose, y=deaths) } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- beta[1] + beta[2]*Data$x \\ \hspace*{0.27 in} p <- invlogit(mu) \\ \hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbinom(length(p), Data$n, p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Binomial Probit} \label{binomial.probit} \subsection{Form} $$\textbf{y} \sim \mathcal{BIN}(\textbf{p}, \textbf{n})$$ $$\textbf{p} = \phi(\mu)$$ $$\mu = \beta_1 + \beta_2 \textbf{x} \in [-10,10]$$ $$\beta_j \sim \mathcal{N}(0,1000), \quad j=1,\dots,J$$ where $\phi$ is the CDF of the standard normal distribution, and $J$=2. \subsection{Data} \code{\#10 Trials \\ exposed <- c(100,100,100,100,100,100,100,100,100,100) \\ deaths <- c(10,20,30,40,50,60,70,80,90,100) \\ dose <- c(1,2,3,4,5,6,7,8,9,10) \\ J <- 2 \#Number of parameters \\ mon.names <- "LP" \\ parm.names <- c("beta[1]","beta[2]") \\ PGF <- function(Data) return(rnormv(Data$J,0,1000)) \\ MyData <- list(J=J, PGF=PGF, n=exposed, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, x=dose, y=deaths) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- beta[1] + beta[2]*Data$x \\ \hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\ \hspace*{0.27 in} p <- pnorm(mu) \\ \hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbinom(length(p), Data$n, p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Binomial Robit} \label{binomial.robit} \subsection{Form} $$\textbf{y} \sim \mathcal{BIN}(\textbf{p}, \textbf{n})$$ $$\textbf{p} = \textbf{T}_\nu(\mu)$$ $$\mu = \beta_1 + \beta_2 \textbf{x} \in [-10,10]$$ $$\beta_j \sim \mathcal{N}(0,1000), \quad j=1,\dots,J$$ $$\nu \sim \mathcal{U}(5, 10)$$ where $\textbf{T}_\nu$ is the CDF of the standard t-distribution with $\nu$ degrees of freedom. \subsection{Data} \code{\#10 Trials \\ exposed <- c(100,100,100,100,100,100,100,100,100,100) \\ deaths <- c(10,20,30,40,50,60,70,80,90,100) \\ dose <- c(1,2,3,4,5,6,7,8,9,10) \\ J <- 2 \#Number of parameters \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,2), nu=0)) \\ PGF <- function(Data) return(c(rnormv(Data$J,0,1000), runif(1,5,10))) \\ MyData <- list(J=J, PGF=PGF, n=exposed, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, x=dose, y=deaths) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} parm[Data$J+1] <- nu <- interval(parm[Data$J+1], 5, 10) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} nu.prior <- dunif(nu, 5, 10, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- beta[1] + beta[2]*Data$x \\ \hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\ \hspace*{0.27 in} p <- pst(mu, nu=nu) \\ \hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + nu.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rbinom(length(p), Data$n, p), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 5)} \section{Change Point Regression} \label{changepoint} This example uses a popular variant of the stagnant water data set. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \alpha + \beta_1 \textbf{x} + \beta_2 (\textbf{x} - \theta)[(\textbf{x} - \theta) > 0]$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta \sim \mathcal{N}(0, 1000)$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\theta \sim \mathcal{U}(-1.3, 1.1)$$ \subsection{Data} \code{N <- 29 \\ y <- c(1.12, 1.12, 0.99, 1.03, 0.92, 0.90, 0.81, 0.83, 0.65, 0.67, 0.60, \\ \hspace*{0.27 in} 0.59, 0.51, 0.44, 0.43, 0.43, 0.33, 0.30, 0.25, 0.24, 0.13, -0.01, \\ \hspace*{0.27 in} -0.13, -0.14, -0.30, -0.33, -0.46, -0.43, -0.65) \\ x <- c(-1.39, -1.39, -1.08, -1.08, -0.94, -0.80, -0.63, -0.63, -0.25, -0.25, \\ \hspace*{0.27 in} -0.12, -0.12, 0.01, 0.11, 0.11, 0.11, 0.25, 0.25, 0.34, 0.34, 0.44, \\ \hspace*{0.27 in} 0.59, 0.70, 0.70, 0.85, 0.85, 0.99, 0.99, 1.19) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,2), sigma=0, theta=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(2) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} theta <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.theta=pos.theta, x=x, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], -1.3, 1.1) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- dunif(theta, -1.3, 1.1, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- alpha + beta[1]*x + beta[2]*(x - theta)*{(x - theta) > 0} \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0.2, -0.45, 0, 0.2, 0)} \section{Cluster Analysis, Confirmatory (CCA)} \label{cca} This is a parametric, model-based, cluster analysis, also called a finite mixture model or latent class cluster analysis, where the number of clusters $C$ is fixed. When the number of clusters is unknown, exploratory cluster analysis should be used. The record-level cluster membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. \subsection{Form} $$\textbf{Y}_{i,j} \sim \mathcal{N}(\mu_{\theta[i],j}, \sigma^2_{\theta[i]}), \quad i=1,\dots,N, \quad j=1,\dots,J$$ $$\theta_i \sim \mathcal{CAT}(\pi_{1:C}), \quad i=1,\dots,N$$ $$\pi_{1:C} \sim \mathcal{D}(\alpha_{1:C})$$ $$\alpha_c = 1$$ $$\mu_{c,j} \sim \mathcal{N}(0, \nu^2_c), \quad c=1,\dots,C, \quad j=1,\dots,J$$ $$\sigma_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$ $$\nu_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$ \subsection{Data} \code{data(demonsnacks) \\ Y <- as.matrix(log(demonsnacks + 1)) \\ N <- nrow(Y) \\ J <- ncol(Y) \\ for (j in 1:J) Y[,j] <- CenterScale(Y[,j]) \\ C <- 3 \#Number of clusters \\ alpha <- rep(1,C) \#Prior probability of cluster proportion \\ mon.names <- c("LP", paste("pi[", 1:C, "]", sep="")) \\ parm.names <- as.parm.names(list(theta=rep(0,N), mu=matrix(0,C,J), \\ \hspace*{0.27 in} nu=rep(0,C), sigma=rep(0,C))) \\ pos.theta <- grep("theta", parm.names) \\ pos.mu <- grep("mu", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} theta <- rcat(Data$N, p=rep(1/Data$C, Data$C)) \\ \hspace*{0.27 in} mu <- rnorm(Data$J*Data$J) \\ \hspace*{0.27 in} nu <- runif(Data$C) \\ \hspace*{0.27 in} sigma <- runif(Data$C) \\ \hspace*{0.27 in} return(c(theta, mu, nu, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, N=N, PGF=PGF, Y=Y, alpha=alpha, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.theta=pos.theta, \\ \hspace*{0.27 in} pos.mu=pos.mu, pos.nu=pos.nu, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} mu <- matrix(parm[Data$pos.mu], Data$C, Data$J) \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} pi <- rep(0, Data$C) \\ \hspace*{0.27 in} tab <- table(theta) \\ \hspace*{0.27 in} pi[as.numeric(names(tab))] <- as.vector(tab) \\ \hspace*{0.27 in} pi <- pi / sum(pi) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, pi, log=TRUE)) \\ \hspace*{0.27 in} mu.prior <- sum(dnorm(mu, 0, matrix(nu, Data$C, Data$J), log=TRUE)) \\ \hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\ \hspace*{0.27 in} pi.prior <- ddirichlet(pi, Data$alpha, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu[theta,], sigma[theta], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + theta.prior + mu.prior + nu.prior + pi.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,pi), \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu[theta,])), mu[theta,], sigma[theta]), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rcat(N,rep(1/C,C)), rep(0,C*J), rep(1,C), rep(1,C))} \section{Cluster Analysis, Exploratory (ECA)} \label{eca} This is a nonparametric, model-based, cluster analysis, also called an infinite mixture model or latent class cluster analysis, where the number of clusters $C$ is unknown, and a Dirichlet process via truncated stick-breaking is used to estimated the number of clusters. The record-level cluster membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. \subsection{Form} $$\textbf{Y}_{i,j} \sim \mathcal{N}(\mu_{\theta[i],j}, \sigma^2_{\theta[i]}), \quad i=1,\dots,N, \quad j=1,\dots,J$$ $$\theta_i \sim \mathcal{CAT}(\pi_{1:C}), \quad i=1,\dots,N$$ $$\mu_{c,j} \sim \mathcal{N}(0, \nu^2_c), \quad c=1,\dots,C, \quad j=1,\dots,J$$ $$\sigma_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$ $$\pi = \mathrm{Stick}(\delta)$$ $$\delta_c \sim \mathcal{BETA}(1, \gamma), c=1,\dots,(C-1)$$ $$\gamma \sim \mathcal{G}(\alpha, \beta)$$ $$\alpha \sim \mathcal{HC}(25)$$ $$\beta \sim \mathcal{HC}(25)$$ $$\nu_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$ \subsection{Data} \code{data(demonsnacks) \\ Y <- as.matrix(log(demonsnacks + 1)) \\ N <- nrow(Y) \\ J <- ncol(Y) \\ for (j in 1:J) Y[,j] <- CenterScale(Y[,j]) \\ C <- 5 \#Maximum number of clusters to explore \\ mon.names <- c("LP", paste("pi[", 1:C, "]", sep="")) \\ parm.names <- as.parm.names(list(theta=rep(0,N), delta=rep(0,C-1), \\ \hspace*{0.27 in} mu=matrix(0,C,J), nu=rep(0,C), sigma=rep(0,C), alpha=0, beta=0, \\ \hspace*{0.27 in} gamma=0)) \\ pos.theta <- grep("theta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.mu <- grep("mu", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} mu <- rnorm(Data$C*Data$J) \\ \hspace*{0.27 in} nu <- runif(Data$C) \\ \hspace*{0.27 in} sigma <- runif(Data$C) \\ \hspace*{0.27 in} alpha <- runif(1) \\ \hspace*{0.27 in} beta <- runif(1) \\ \hspace*{0.27 in} gamma <- rgamma(1, alpha, beta) \\ \hspace*{0.27 in} delta <- rev(sort(rbeta(Data$C-1, 1, gamma))) \\ \hspace*{0.27 in} theta <- rcat(Data$N, Stick(delta)) \\ \hspace*{0.27 in} return(c(theta, delta, mu, nu, sigma, alpha, beta, gamma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, N=N, PGF=PGF, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.theta=pos.theta, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.mu=pos.mu, pos.nu=pos.nu, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.gamma=pos.gamma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperhyperparameters \\ \hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} beta <- interval(parm[Data$pos.beta], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.beta] <- beta \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-10, 1-1e-10) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} mu <- matrix(parm[Data$pos.mu], Data$C, Data$J) \\ \hspace*{0.27 in} pi <- Stick(delta) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperhyperprior \\ \hspace*{0.27 in} alpha.prior <- dhalfcauchy(alpha, 25, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- dhalfcauchy(beta, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} delta.prior <- dStick(delta, gamma, log=TRUE) \\ \hspace*{0.27 in} gamma.prior <- dgamma(gamma, alpha, beta, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, pi, log=TRUE)) \\ \hspace*{0.27 in} mu.prior <- sum(dnorm(mu, 0, matrix(nu, Data$C, Data$J), log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu[theta,], sigma[theta], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + theta.prior + delta.prior + mu.prior + nu.prior + \\ \hspace*{0.62 in} alpha.prior + beta.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,pi), \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu[theta,])), mu[theta,], sigma[theta]), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rcat(N, rev(sort(rStick(C-1,1)))), rep(0.5,C-1), \\ \hspace*{0.27 in} rep(0,C*J), rep(1,C), rep(1,C), rep(1,3))} \section{Conditional Autoregression (CAR), Poisson} \label{car.poisson} This CAR example is a slightly modified form of example 7.3 (Model A) in \citet{congdon03}. The Scottish lip cancer data also appears in the WinBUGS \citep{spiegelhalter03} examples and is a widely analyzed example. The data $\textbf{y}$ consists of counts for $i=1,\dots,56$ counties in Scotland. A single predictor $\textbf{x}$ is provided. The errors, $\epsilon$, are allowed to include spatial effects as smoothing by spatial effects from areal neighbors. The vector $\epsilon_\mu$ is the mean of each area's error, and is a weighted average of errors in contiguous areas. Areal neighbors are indicated in adjacency matrix $\textbf{A}$. \subsection{Form} $$\textbf{y} \sim \mathcal{P}(\lambda)$$ $$\lambda = \exp(\log(\textbf{E}) + \beta_1 + \beta_2 \textbf{x} + \epsilon)$$ $$\epsilon \sim \mathcal{N}(\epsilon_\mu, \sigma^2)$$ $$\epsilon_{\mu[i]} = \rho \sum^J_{j=1} \textbf{A}_{i,j} \epsilon_i, \quad i=1,\dots,N$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\rho \sim \mathcal{U}(-1,1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 56 \#Number of areas \\ NN <- 264 \#Number of adjacent areas \\ y <- c(9,39,11,9,15,8,26,7,6,20,13,5,3,8,17,9,2,7,9,7,16,31,11,7,19,15,7, \\ \hspace*{0.27 in} 10,16,11,5,3,7,8,11,9,11,8,6,4,10,8,2,6,19,3,2,3,28,6,1,1,1,1,0,0) \\ E <- c( 1.4,8.7,3.0,2.5,4.3,2.4,8.1,2.3,2.0,6.6,4.4,1.8,1.1,3.3,7.8,4.6, \\ \hspace*{0.27 in} 1.1,4.2,5.5,4.4,10.5,22.7,8.8,5.6,15.5,12.5,6.0,9.0,14.4,10.2,4.8, \\ \hspace*{0.27 in} 2.9,7.0,8.5,12.3,10.1,12.7,9.4,7.2,5.3,18.8,15.8,4.3,14.6,50.7,8.2, \\ \hspace*{0.27 in} 5.6,9.3,88.7,19.6,3.4,3.6,5.7,7.0,4.2,1.8) \#Expected \\ x <- c(16,16,10,24,10,24,10,7,7,16,7,16,10,24,7,16,10,7,7,10,7,16,10,7,1,1, \\ \hspace*{0.27 in} 7,7,10,10,7,24,10,7,7,0,10,1,16,0,1,16,16,0,1,7,1,1,0,1,1,0,1,1,16,10) \\ A <- matrix(0, N, N) \\ A[1,c(5,9,11,19)] <- 1 \#Area 1 is adjacent to areas 5, 9, 11, and 19 \\ A[2,c(7,10)] <- 1 \#Area 2 is adjacent to areas 7 and 10 \\ A[3,c(6,12)] <- 1; A[4,c(18,20,28)] <- 1; A[5,c(1,11,12,13,19)] <- 1 \\ A[6,c(3,8)] <- 1; A[7,c(2,10,13,16,17)] <- 1; A[8,6] <- 1 \\ A[9,c(1,11,17,19,23,29)] <- 1; A[10,c(2,7,16,22)] <- 1 \\ A[11,c(1,5,9,12)] <- 1; A[12,c(3,5,11)] <- 1; A[13,c(5,7,17,19)] <- 1 \\ A[14,c(31,32,35)] <- 1; A[15,c(25,29,50)] <- 1 \\ A[16,c(7,10,17,21,22,29)] <- 1; A[17,c(7,9,13,16,19,29)] <- 1 \\ A[18,c(4,20,28,33,55,56)] <- 1; A[19,c(1,5,9,13,17)] <- 1 \\ A[20,c(4,18,55)] <- 1; A[21,c(16,29,50)] <- 1; A[22,c(10,16)] <- 1 \\ A[23,c(9,29,34,36,37,39)] <- 1; A[24,c(27,30,31,44,47,48,55,56)] <- 1 \\ A[25,c(15,26,29)] <- 1; A[26,c(25,29,42,43)] <- 1 \\ A[27,c(24,31,32,55)] <- 1; A[28,c(4,18,33,45)] <- 1 \\ A[29,c(9,15,16,17,21,23,25,26,34,43,50)] <- 1 \\ A[30,c(24,38,42,44,45,56)] <- 1; A[31,c(14,24,27,32,35,46,47)] <- 1 \\ A[32,c(14,27,31,35)] <- 1; A[33,c(18,28,45,56)] <- 1 \\ A[34,c(23,29,39,40,42,43,51,52,54)] <- 1; A[35,c(14,31,32,37,46)] <- 1 \\ A[36,c(23,37,39,41)] <- 1; A[37,c(23,35,36,41,46)] <- 1 \\ A[38,c(30,42,44,49,51,54)] <- 1; A[39,c(23,34,36,40,41)] <- 1 \\ A[40,c(34,39,41,49,52)] <- 1; A[41,c(36,37,39,40,46,49,53)] <- 1 \\ A[42,c(26,30,34,38,43,51)] <- 1; A[43,c(26,29,34,42)] <- 1 \\ A[44,c(24,30,38,48,49)] <- 1; A[45,c(28,30,33,56)] <- 1 \\ A[46,c(31,35,37,41,47,53)] <- 1; A[47,c(24,31,46,48,49,53)] <- 1 \\ A[48,c(24,44,47,49)] <- 1; A[49,c(38,40,41,44,47,48,52,53,54)] <- 1 \\ A[50,c(15,21,29)] <- 1; A[51,c(34,38,42,54)] <- 1 \\ A[52,c(34,40,49,54)] <- 1; A[53,c(41,46,47,49)] <- 1 \\ A[54,c(34,38,49,51,52)] <- 1; A[55,c(18,20,24,27,56)] <- 1 \\ A[56,c(18,24,30,33,45,55)] <- 1 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,2), epsilon=rep(0,N), rho=0, \\ \hspace*{0.27 in} sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.epsilon <- grep("epsilon", parm.names) \\ pos.rho <- grep("rho", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(2) \\ \hspace*{0.27 in} epsilon <- rnorm(Data$N) \\ \hspace*{0.27 in} rho <- runif(1,-1,1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, epsilon, rho, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(A=A, E=E, N=N, PGF=PGF, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.epsilon=pos.epsilon, \\ \hspace*{0.27 in} pos.rho=pos.rho, pos.sigma=pos.sigma, x=x, y=y) } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} epsilon <- parm[Data$pos.epsilon] \\ \hspace*{0.27 in} parm[Data$pos.rho] <- rho <- interval(parm[Data$pos.rho], -1, 1) \\ \hspace*{0.27 in} epsilon.mu <- rho * rowSums(epsilon * Data$A) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} epsilon.prior <- sum(dnorm(epsilon, epsilon.mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} rho.prior <- dunif(rho, -1, 1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(log(Data$E) + beta[1] + beta[2]*Data$x/10 + epsilon) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$y, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + epsilon.prior + rho.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(length(lambda), lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,2), rep(0,N), 0, 1)} \section{Conditional Predictive Ordinate} \label{cpo} For a more complete introduction to the conditional predictive ordinate (CPO), see the vignette entitled ``Bayesian Inference''. Following is a brief guide to the applied use of CPO. To include CPO in any model that is to be updated with MCMC, calculate and monitor the record-level inverse of the likelihood, $\mathrm{InvL}_i$ for records $i=1,\dots,N$. $\mathrm{CPO}_i$ is the inverse of the posterior mean of $\mathrm{InvL}_i$. The inverse $\mathrm{CPO}_i$, or $\mathrm{ICPO}_i$, is the posterior mean of $\mathrm{InvL}_i$. ICPOs larger than 40 can be considered as possible outliers, and higher than 70 as extreme values. Here, CPO is added to the linear regression example in section \ref{linear.reg}. In this data, record 6 is a possible outlier, and record 8 is an extreme value. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP",as.parm.names(list(InvL=rep(0,N)))) \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- dnorm(Data$y, mu, sigma, log=TRUE) \\ \hspace*{0.27 in} InvL <- 1 / exp(LL) \\ \hspace*{0.27 in} LL <- sum(LL) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,InvL), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Contingency Table} \label{contingency.table} The two-way contingency table, matrix $\textbf{Y}$, can easily be extended to more dimensions. Contingency table $\textbf{Y}$ has J rows and K columns. The cell counts are fit with Poisson regression, according to intercept $\alpha$, main effects $\beta_j$ for each row, main effects $\gamma_k$ for each column, and interaction effects $\delta_{j,k}$ for dependence effects. An omnibus (all cells) test of independence is done by estimating two models (one with $\delta$, and one without), and a large enough Bayes Factor indicates a violation of independence when the model with $\delta$ fits better than the model without $\delta$. In an ANOVA-like style, main effects contrasts can be used to distinguish rows or groups of rows from each other, as well as with columns. Likewise, interaction effects contrasts can be used to test independence in groups of $\delta_{j,k}$ elements. Finally, single-cell interactions can be used to indicate violations of independence for a given cell, such as when zero is not within its 95\% probability interval. \subsection{Form} $$\textbf{Y}_{j,k} \sim \mathcal{P}(\lambda_{j,k}), \quad j=1,\dots,J, \quad k=1,\dots,K$$ $$\lambda_{j,k} = \exp(\alpha + \beta_j + \gamma_k + \delta_{j,k}), \quad j=1,\dots,J, \quad k=1,\dots,K$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \beta^2_\sigma), \quad j=1,\dots,J$$ $$\beta_J = - \displaystyle\sum^{J-1}_{j=1} \beta_j$$ $$\beta_\sigma \sim \mathcal{HC}(25)$$ $$\gamma_k \sim \mathcal{N}(0, \gamma^2_\sigma), \quad k=1,\dots,K$$ $$\gamma_K = - \displaystyle\sum^{K-1}_{k=1} \gamma_k$$ $$\gamma_\sigma \sim \mathcal{HC}(25)$$ $$\delta_{j,k} \sim \mathcal{N}(0, \delta^2_\sigma)$$ $$\delta_{J,K} = - \displaystyle\sum \delta_{-J,-K}$$ $$\delta_\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{J <- 4 \#Rows \\ K <- 4 \#Columns \\ Y <- matrix(c(20,94,84,17,68,7,119,26,5,16,29,14,15,10,54,14), 4, 4) \\ rownames(Y) <- c("Black", "Blond", "Brunette", "Red") \\ colnames(Y) <- c("Blue", "Brown", "Green", "Hazel") \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), \\ \hspace*{0.27 in} gamma=rep(0,K-1), delta=rep(0,J*K-1), b.sigma=0, g.sigma=0, \\ \hspace*{0.27 in} d.sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.b.sigma <- grep("b.sigma", parm.names) \\ pos.g.sigma <- grep("g.sigma", parm.names) \\ pos.d.sigma <- grep("d.sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1,log(mean(Y)),1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J-1) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K-1) \\ \hspace*{0.27 in} delta <- rnorm(Data$J*Data$K-1) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, delta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, PGF=PGF, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.delta=pos.delta, pos.b.sigma=pos.b.sigma, \\ \hspace*{0.27 in} pos.g.sigma=pos.g.sigma, pos.d.sigma=pos.d.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} beta.sigma <- interval(parm[Data$pos.b.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.b.sigma] <- beta.sigma \\ \hspace*{0.27 in} gamma.sigma <- interval(parm[Data$pos.g.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.g.sigma] <- gamma.sigma \\ \hspace*{0.27 in} delta.sigma <- interval(parm[Data$pos.d.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.d.sigma] <- delta.sigma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} beta <- c(beta, -sum(beta)) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} gamma <- c(gamma, -sum(gamma)) \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} delta <- c(delta, -sum(delta)) \\ \hspace*{0.27 in} delta <- matrix(delta, Data$J, Data$K) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} beta.sigma.prior <- dhalfcauchy(beta.sigma, 25, log=TRUE) \\ \hspace*{0.27 in} gamma.sigma.prior <- dhalfcauchy(gamma.sigma, 25, log=TRUE) \\ \hspace*{0.27 in} delta.sigma.prior <- dhalfcauchy(delta.sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, beta.sigma, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, gamma.sigma, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnorm(delta, 0, delta.sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} beta <- matrix(beta, Data$J, Data$K) \\ \hspace*{0.27 in} gamma <- matrix(gamma, Data$J, Data$K, byrow=TRUE) \\ \hspace*{0.27 in} lambda <- exp(alpha + beta + gamma + delta) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$Y, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + beta.sigma.prior + \\ \hspace*{0.62 in} gamma.prior + gamma.sigma.prior + delta.prior + \\ \hspace*{0.62 in} delta.sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(length(lambda), lambda), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(log(mean(Y)), rep(0,J-1), rep(0,K-1), rep(0,J*K-1), \\ \hspace*{0.27 in} rep(1,3)) \\} \section{Discrete Choice, Conditional Logit} \label{conditional.logit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N, \quad j=1,\dots,J$$ $$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}$$ $$\phi = \exp(\mu)$$ $$\mu_{i,j} = \beta_{j,1:K} \textbf{X}_{i,1:K} + \gamma \textbf{Z}_{i,1:C} \in [-700,700], \quad j=1,\dots,(J-1)$$ $$\mu_{i,J} = \gamma \textbf{Z}_{i,1:C}$$ $$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1)$$ $$\gamma_c \sim \mathcal{N}(0, 1000)$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ Z <- as.matrix(demonchoice[,4:9]) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ for (j in 1:ncol(Z)) Z[,j] <- CenterScale(Z[,j]) \\ N <- length(y) \#Number of records \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of individual attributes (including the intercept) \\ C <- ncol(Z) \#Number of choice-based attributes (intercept is not included) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,J-1,K), gamma=rep(0,C))) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} gamma <- rnorm(Data$C) \\ \hspace*{0.27 in} return(c(beta, gamma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, K=K, N=N, PGF=PGF, X=X, Z=Z, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(tcrossprod(gamma, Data$Z), Data$N, Data$J) \\ \hspace*{0.27 in} mu[,-Data$J] <- mu[,-Data$J] + tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} phi <- exp(mu) \\ \hspace*{0.27 in} p <- phi / rowSums(phi) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,(J-1)*K), rep(0,C))} \section{Discrete Choice, Mixed Logit} \label{dc.mixed.logit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N$$ $$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}$$ $$\phi = \exp(\mu)$$ $$\mu_{i,j} = \beta_{j,1:K,i} \textbf{X}_{i,1:K} + \gamma \textbf{Z}_{i,1:C} \in [-700,700], \quad i=1,\dots,N, \quad j=1,\dots,(J-1)$$ $$\mu_{i,J} = \gamma \textbf{Z}_{i,1:C}$$ $$\beta_{j,k,i} \sim \mathcal{N}(\zeta^\mu_{j,k}, \zeta^\sigma2_{j,k}), \quad i=1,\dots,N, \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\gamma_c \sim \mathcal{N}(0, 1000), \quad c=1,\dots,C$$ $$\zeta^\mu_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\zeta^\sigma_{j,k} \sim \mathcal{HC}{25}), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ Z <- as.matrix(demonchoice[,4:9]) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ for (j in 1:ncol(Z)) Z[,j] <- CenterScale(Z[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ C <- ncol(Z) \#Number of choice-based attributes (intercept is not included) \\ S <- diag(J-1) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=array(0, dim=c(J-1,K,N)), \\ \hspace*{0.27 in} gamma=rep(0,C), zeta.mu=matrix(0,J-1,K), zeta.sigma=matrix(0,J-1,K))) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.zeta.mu <- grep("zeta.mu", parm.names) \\ pos.zeta.sigma <- grep("zeta.sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} zeta.mu <- matrix(rnorm((Data$J-1)*Data$K), Data$J-1, Data$K) \\ \hspace*{0.27 in} zeta.sigma <- matrix(runif((Data$J-1)*Data$K), Data$J-1, Data$K) \\ \hspace*{0.27 in} beta <- array(rnorm((Data$J-1)*Data$K*Data$N), \\ \hspace*{0.62 in} dim=c( Data$J-1, Data$K, Data$N)) \\ \hspace*{0.27 in} gamma <- rnorm(Data$C) \\ \hspace*{0.27 in} return(c(beta, gamma, as.vector(zeta.mu), as.vector(zeta.sigma))) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, K=K, N=N, PGF=PGF, S=S, X=X, Z=Z, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.zeta.mu=pos.zeta.mu, \\ \hspace*{0.27 in} pos.zeta.sigma=pos.zeta.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- array(parm[Data$pos.beta], dim=c(Data$J-1, Data$K, Data$N)) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} zeta.mu <- matrix(parm[Data$pos.zeta.mu], Data$J-1, Data$K) \\ \hspace*{0.27 in} zeta.sigma <- matrix(interval(parm[Data$pos.zeta.sigma], 1e-100, Inf), \\ \hspace*{0.62 in} Data$J-1, Data$K) \\ \hspace*{0.27 in} parm[Data$pos.zeta.sigma] <- as.vector(zeta.sigma) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} zeta.mu.prior <- sum(dnormv(zeta.mu, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.sigma.prior <- sum(dhalfcauchy(zeta.sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, zeta.mu, zeta.sigma, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(tcrossprod(Data$Z, t(gamma)), Data$N, Data$J) \\ \hspace*{0.27 in} for (j in 1:(Data$J-1)) mu[,j] <- rowSums(Data$X * t(beta[j, , ])) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} phi <- exp(mu) \\ \hspace*{0.27 in} p <- phi / rowSums(phi) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + zeta.mu.prior + zeta.sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,(J-1)*K*N), rep(0,C), rep(0,(J-1)*K), \\ \hspace*{0.27 in} rep(1,(J-1)*K))} \section{Discrete Choice, Multinomial Probit} \label{dc.mnp} \subsection{Form} $$\textbf{W}_{i,1:(J-1)} \sim \mathcal{N}_{J-1}(\mu_{i,1:(J-1)}, \Sigma), \quad i=1,\dots,N$$ \[\textbf{W}_{i,j} \in \left\{ \begin{array}{l l} $[0,10]$ & \quad \mbox{if $\textbf{y}_i = j$}\\ $[-10,0]$ \\ \end{array} \right. \] $$\mu_{1:N,j} = \textbf{X} \beta_{j,1:K} + \textbf{Z} \gamma$$ $$\Sigma = \textbf{U}^T \textbf{U}$$ $$\beta_{j,k} \sim \mathcal{N}(0, 10), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\gamma_c \sim \mathcal{N}(0, 10), \quad c=1,\dots,C$$ $$\textbf{U}_{j,k} \sim \mathcal{N}(0,1), \quad j=1,\dots,(J-1), \quad k=1,\dots,(J-1), \quad j \ge k, \quad j \ne k = 1$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ Z <- as.matrix(demonchoice[,4:9]) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ for (j in 1:ncol(Z)) Z[,j] <- CenterScale(Z[,j]) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ C <- ncol(Z) \#Number of choice-based attributes (intercept is not included) \\ S <- diag(J-1) \\ U <- matrix(NA,J-1,J-1) \\ U[upper.tri(U, diag=TRUE)] <- 0 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,(J-1),K), gamma=rep(0,C), \\ \hspace*{0.27 in} U=U, W=matrix(0,N,J-1))) \\ parm.names <- parm.names[-which(parm.names == "U[1,1]")] \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.U <- grep("U", parm.names) \\ pos.W <- grep("W", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} gamma <- rnorm(Data$C) \\ \hspace*{0.27 in} U <- rnorm((Data$J-2) + (factorial(Data$J-1) / \\ \hspace*{0.62 in} (factorial(Data$J-1-2)*factorial(2))),0,1) \\ \hspace*{0.27 in} W <- matrix(runif(Data$N*(Data$J-1),-10,0), Data$N, Data$J-1) \\ \hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\ \hspace*{0.27 in} W <- ifelse(Y[,-Data$J] == 1, abs(W), W) \\ \hspace*{0.27 in} return(c(beta, gamma, U, as.vector(W)))\} \\ MyData <- list(C=C, J=J, K=K, N=N, PGF=PGF, S=S, X=X, Z=Z, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.U=pos.U, pos.W=pos.W, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} u <- c(0, parm[Data$pos.U]) \\ \hspace*{0.27 in} U <- diag(Data$J-1) \\ \hspace*{0.27 in} U[upper.tri(U, diag=TRUE)] <- u \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} Sigma <- t(U) \%*\% U \\ \hspace*{0.27 in} Sigma[1,] <- Sigma[,1] <- U[1,] \\ \hspace*{0.27 in} W <- matrix(parm[Data$pos.W], Data$N, Data$J-1) \\ \hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\ \hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 1) \\ \hspace*{0.27 in} W[temp] <- interval(W[temp], 0, 10) \\ \hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 0) \\ \hspace*{0.27 in} W[temp] <- interval(W[temp], -10, 0) \\ \hspace*{0.27 in} parm[Data$pos.W] <- as.vector(W) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- sum(dnorm(u[-1], 0, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) + \\ \hspace*{0.62 in} as.vector(tcrossprod(Data$Z, t(gamma))) \\ \hspace*{0.27 in} \#eta <- exp(cbind(mu,0)) \\ \hspace*{0.27 in} \#p <- eta / rowSums(eta) \\ \hspace*{0.27 in} LL <- sum(dmvn(W, mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=max.col(cbind(rmvn(nrow(mu), mu, Sigma),0)), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)} \section{Distributed Lag, Koyck} \label{dl.koyck} This example applies Koyck or geometric distributed lags to $k=1,\dots,K$ discrete events in covariate $\textbf{x}$, transforming the covariate into a $N$ x $K$ matrix $\textbf{X}$ and creates a $N$ x $K$ lag matrix $\textbf{L}$. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_t = \alpha + \phi \textbf{y}_{t-1} + \sum^K_{k=1} \textbf{X}_{t,k} \beta \lambda^{\textbf{L}[t,k]}, \quad k=1,\dots,K, \quad t=2,\dots,T$$ $$\mu_1 = \alpha + \sum^K_{k=1} \textbf{X}_{1,k} \beta \lambda^{\textbf{L}[1,k]}, \quad k=1,\dots,K$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta \sim \mathcal{N}(0, 1000)$$ $$\lambda \sim \mathcal{U}(0, 1)$$ $$\phi \sim \mathcal{N}(0, 1000)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ x <- (y > 0.01)*1 \#Made-up distributed lag IV \\ T <- length(y) \\ K <- length(which(x != 0)) \\ L <- X <- matrix(0, T, K) \\ for (i in 1:K) \{ \\ \hspace*{0.27 in} X[which(x != 0)[i]:T,i] <- x[which(x != 0)[i]] \\ \hspace*{0.27 in} L[(which(x != 0)[i]):T,i] <- 0:(T - which(x != 0)[i])\} \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, beta=0, lambda=0, phi=0, sigma=0)) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(1) \\ \hspace*{0.27 in} lambda <- runif(1) \\ \hspace*{0.27 in} phi <- rnorm(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, lambda, phi, sigma)) \\ \hspace*{0.27 in} \} \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ MyData <- list(L=L, PGF=PGF, T=T, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.lambda=pos.lambda, pos.phi=pos.phi, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 0, 1) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} phi <- parm[Data$pos.phi] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- dnormv(beta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} lambda.prior <- dunif(lambda, 0, 1, log=TRUE) \\ \hspace*{0.27 in} phi.prior <- dnormv(phi, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- c(alpha, alpha + phi*Data$y[-Data$T]) + \\ \hspace*{0.62 in} rowSums(Data$X * beta * lambda\textasciicircum Data$L) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], mu[-1], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + lambda.prior + phi.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,2), 0.5, 0, 1)} \section{Dynamic Sparse Factor Model (DSFM)} \label{dsfm} \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\alpha{t,j} + \textbf{F}_{t,1:P} \Lambda_{1:P,1:j,t}, \Sigma^2_{t,j}), \quad t=1,\dots,T, \quad j=1,\dots,J$$ $$\alpha_{t,j} \sim \mathcal{N}(\alpha^\mu_j + \alpha^\phi_j(\alpha_{t-1,j} - \alpha^mu_j), \alpha^\sigma2_j)$$ $$\textbf{F}_{t,1:P} \sim \mathcal{N}_P(\textbf{F}^\phi \textbf{F}_{t-1,1:P}, \textbf{f}^\Sigma_{t,1:P})$$ $$\textbf{f}^\Sigma_{t,1:P} = t(\textbf{f}^\textbf{U}_{1:P,1:P,t})\textbf{f}^\textbf{U}_{1:P,1:P,t}$$ $$\textbf{f}^\textbf{U}_{p,q,t} \sim \mathcal{N}(\textbf{f}^{\textbf{u}_\mu}_{p,q} + \textbf{f}^{\textbf{u}_\phi}_{p,q}(\textbf{f}^\textbf{U}_{p,q,t-1} - \textbf{f}^{\textbf{u}_\mu}_{p,q}), \textbf{f}^{\textbf{u}_\sigma^2}_{p,q})$$ $$\Lambda_{p,j,t} \sim \mathcal{N}(\lambda^\mu_{p,j} + \lambda^\phi_{p,j}(\Lambda_{p,j,t-1} - \lambda^mu_{p,j}), \lambda^\sigma2_{p,j})$$ $$\Sigma_{t,j} = \exp(\log(\Sigma_{t,j}))$$ $$log(\Sigma_{t,j}) \sim \mathcal{N}(\sigma^\mu_j + \sigma^\phi_j(log(\Sigma_{t-1,j}) - \sigma^mu_j), \sigma^\sigma2_j)$$ $$\alpha^0_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\alpha^\mu_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\alpha^\phi_j+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$ $$\alpha^\sigma_j \sim \mathcal{HC}(5), \quad j=1,\dots,J$$ $$\textbf{f}^0_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\textbf{f}^\phi_j+1}{2} \sim \mathcal{BETA}(1, 1), \quad j=1,\dots,J$$ $$\textbf{f}^{\textbf{u}0}_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\textbf{f}^{\textbf{u}\mu}_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\textbf{f}^{\textbf{u}\phi}_j+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$ $$\textbf{f}^{\textbf{u}\sigma}_j \sim \mathcal{HC}(1), \quad j=1,\dots,J$$ $$\lambda^0_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\lambda^d_j \sim \mathcal{U}(0, |\lambda^\mu_j| + 3\sqrt{\frac{\lambda^\sigma_j}{1 - \lambda^\phi_j\lambda^\phi_j}}), \quad j=1,\dots,J$$ $$\lambda^\mu_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\lambda^\phi_j+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$ $$\lambda^\sigma_j \sim \mathcal{HC}(1), \quad j=1,\dots,J$$ $$\log(\sigma^0_j) \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\log(\sigma^\mu_j) \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$ $$\frac{\log(\sigma^\phi_j)+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$ $$\log(\sigma^\sigma_j) \sim \mathcal{HC}(1), \quad j=1,\dots,J$$ \subsection{Data} \code{data(demonfx) \\ Y.orig <- demonfx \\ Y <- log(as.matrix(Y.orig[1:20,1:3])) \\ Y.means <- colMeans(Y) \\ Y <- Y - matrix(Y.means, nrow(Y), ncol(Y), byrow=TRUE) \#Center \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \#Scale \\ T <- nrow(Y) \#Number of time-periods \\ J <- ncol(Y) \#Number of time-series \\ P <- 2 \#Number of dynamic factors \\ mon.names <- "LP" \\ U1 <- matrix(NA,P,P); U2 <- matrix(NA,P,J) \\ U1[upper.tri(U1, diag=TRUE)] <- 0; U2[upper.tri(U2)] <- 0 \\ Lambda <- array(NA, dim=c(P,J,T)) \\ U <- array(NA, dim=c(P,P,T)) \\ for (t in 1:T) \{ \\ \hspace*{0.27 in} U[ , , t] <- U1 \\ \hspace*{0.27 in} Lambda[ , , t] <- U2\} \\ parm.names <- as.parm.names(list(alpha0=rep(0,J), Alpha=matrix(0,T,J), \\ \hspace*{0.27 in} alpha.mu=rep(0,J), alpha.phi=rep(0,J), alpha.sigma=rep(0,J), \\ \hspace*{0.27 in} f0=rep(0,P), F=matrix(0,T,P), f.phi=rep(0,P), f.u0=U1, f.U=U, \\ \hspace*{0.27 in} f.u.mu=U1, f.u.phi=U1, f.u.sigma=U1, lambda0=U2, Lambda=Lambda, \\ \hspace*{0.27 in} lambda.d=U2, lambda.mu=U2, lambda.phi=U2, lambda.sigma=U2, \\ \hspace*{0.27 in} lsigma0=rep(0,J), lSigma=matrix(0,T,J), \\ \hspace*{0.27 in} lsigma.mu=rep(0,J), lsigma.phi=rep(0,J), lsigma.sigma=rep(0,J))) \\ pos.alpha0 <- grep("alpha0", parm.names) \\ pos.Alpha <- grep("Alpha", parm.names) \\ pos.alpha.mu <- grep("alpha.mu", parm.names) \\ pos.alpha.phi <- grep("alpha.phi", parm.names) \\ pos.alpha.sigma <- grep("alpha.sigma", parm.names) \\ pos.f0 <- grep("f0", parm.names) \\ pos.F <- grep("F", parm.names) \\ pos.f.phi <- grep("f.phi", parm.names) \\ pos.f.u0 <- grep("f.u0", parm.names) \\ pos.f.U <- grep("f.U", parm.names) \\ pos.f.u.mu <- grep("f.u.mu", parm.names) \\ pos.f.u.phi <- grep("f.u.phi", parm.names) \\ pos.f.u.sigma <- grep("f.u.sigma", parm.names) \\ pos.lambda0 <- grep("lambda0", parm.names) \\ pos.Lambda <- grep("Lambda", parm.names) \\ pos.lambda.d <- grep("lambda.d", parm.names) \\ pos.lambda.mu <- grep("lambda.mu", parm.names) \\ pos.lambda.phi <- grep("lambda.phi", parm.names) \\ pos.lambda.sigma <- grep("lambda.sigma", parm.names) \\ pos.lsigma0 <- grep("lsigma0", parm.names) \\ pos.lSigma <- grep("lSigma", parm.names) \\ pos.lsigma.mu <- grep("lsigma.mu", parm.names) \\ pos.lsigma.phi <- grep("lsigma.phi", parm.names) \\ pos.lsigma.sigma <- grep("lsigma.sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha0 <- rnorm(Data$J) \\ \hspace*{0.27 in} Alpha <- rnorm(Data$T*Data$J) \\ \hspace*{0.27 in} alpha.mu <- rnorm(Data$J) \\ \hspace*{0.27 in} alpha.phi <- rbeta(Data$J, 20, 1.5) * 2 - 1 \\ \hspace*{0.27 in} alpha.sigma <- runif(Data$J) \\ \hspace*{0.27 in} f0 <- rnorm(Data$P) \\ \hspace*{0.27 in} F <- rnorm(Data$T*Data$P) \\ \hspace*{0.27 in} f.phi <- rbeta(Data$P, 1, 1) * 2 - 1 \\ \hspace*{0.27 in} f.u0 <- rnorm(length(Data$pos.f.u0)) \\ \hspace*{0.27 in} f.U <- rnorm(length(Data$pos.f.U)) \\ \hspace*{0.27 in} f.u.mu <- rnorm(length(Data$pos.f.u.mu)) \\ \hspace*{0.27 in} f.u.phi <- runif(length(Data$pos.f.u.phi)) \\ \hspace*{0.27 in} f.u.sigma <- runif(length(Data$pos.f.u.sigma)) \\ \hspace*{0.27 in} lambda0 <- rnorm(length(Data$pos.lambda0)) \\ \hspace*{0.27 in} Lambda <- rnorm(length(Data$pos.Lambda)) \\ \hspace*{0.27 in} lambda.mu <- rnorm(length(Data$pos.lambda.mu)) \\ \hspace*{0.27 in} lambda.phi <- rbeta(length(Data$pos.lambda.phi), 20, 1.5) \\ \hspace*{0.27 in} lambda.sigma <- runif(length(Data$pos.lambda.sigma)) \\ \hspace*{0.27 in} lambda.d <- runif(length(Data$pos.lambda.d), 0, abs(lambda.mu) + \\ \hspace*{0.62 in} 3*sqrt(lambda.sigma/(1-lambda.phi\textasciicircum 2))) \\ \hspace*{0.27 in} lsigma0 <- rnorm(Data$J) \\ \hspace*{0.27 in} lSigma <- rnorm(Data$T*Data$J) \\ \hspace*{0.27 in} lsigma.mu <- rnorm(Data$J) \\ \hspace*{0.27 in} lsigma.phi <- rbeta(Data$J, 20, 1.5) * 2 - 1 \\ \hspace*{0.27 in} lsigma.sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha0, Alpha, alpha.mu, alpha.phi, alpha.sigma, f0, F, \\ \hspace*{0.62 in} f.phi, f.u0, f.U, f.u.mu, f.u.phi, f.u.sigma, lambda0, Lambda, \\ \hspace*{0.62 in} lambda.d, lambda.mu, lambda.phi, lambda.sigma, lsigma0, lSigma, \\ \hspace*{0.62 in} lsigma.mu, lsigma.phi, lsigma.sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, P=P, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha0=pos.alpha0, pos.Alpha=pos.Alpha, \\ \hspace*{0.27 in} pos.alpha.mu=pos.alpha.mu, pos.alpha.phi=pos.alpha.phi, \\ \hspace*{0.27 in} pos.alpha.sigma=pos.alpha.sigma, pos.f0=pos.f0, pos.F=pos.F, \\ \hspace*{0.27 in} pos.f.phi=pos.f.phi, pos.f.u0=pos.f.u0, pos.f.U=pos.f.U, \\ \hspace*{0.27 in} pos.f.u.mu=pos.f.u.mu, pos.f.u.phi=pos.f.u.phi, \\ \hspace*{0.27 in} pos.f.u.sigma=pos.f.u.sigma, pos.lambda0=pos.lambda0, \\ \hspace*{0.27 in} pos.Lambda=pos.Lambda, pos.lambda.d=pos.lambda.d, \\ \hspace*{0.27 in} pos.lambda.mu=pos.lambda.mu, pos.lambda.phi=pos.lambda.phi, \\ \hspace*{0.27 in} pos.lambda.sigma=pos.lambda.sigma, pos.lsigma0=pos.lsigma0, \\ \hspace*{0.27 in} pos.lSigma=pos.lSigma, pos.lsigma.mu=pos.lsigma.mu, \\ \hspace*{0.27 in} pos.lsigma.phi=pos.lsigma.phi, pos.lsigma.sigma=pos.lsigma.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha0 <- parm[Data$pos.alpha0] \\ \hspace*{0.27 in} Alpha <- matrix(parm[Data$pos.Alpha], Data$T, Data$J)\\ \hspace*{0.27 in} alpha.mu <- parm[Data$pos.alpha.mu] \\ \hspace*{0.27 in} alpha.phi <- interval(parm[Data$pos.alpha.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.alpha.phi] <- alpha.phi \\ \hspace*{0.27 in} alpha.sigma <- interval(parm[Data$pos.alpha.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.alpha.sigma] <- alpha.sigma \\ \hspace*{0.27 in} f0 <- parm[Data$pos.f0] \\ \hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$T, Data$P) \\ \hspace*{0.27 in} f.phi <- interval(parm[Data$pos.f.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.f.phi] <- f.phi \\ \hspace*{0.27 in} f.u0 <- parm[Data$pos.f.u0] \\ \hspace*{0.27 in} f.U <- parm[Data$pos.f.U] \\ \hspace*{0.27 in} f.u.mu <- parm[Data$pos.f.u.mu] \\ \hspace*{0.27 in} f.u.phi <- interval(parm[Data$pos.f.u.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.f.u.phi] <- f.u.phi \\ \hspace*{0.27 in} f.u.sigma <- interval(parm[Data$pos.f.u.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.f.u.sigma] <- f.u.sigma \\ \hspace*{0.27 in} lambda0 <- parm[Data$pos.lambda0] \\ \hspace*{0.27 in} Lambda <- parm[Data$pos.Lambda] \\ \hspace*{0.27 in} lambda.mu <- parm[Data$pos.lambda.mu] \\ \hspace*{0.27 in} lambda.phi <- interval(parm[Data$pos.lambda.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.lambda.phi] <- lambda.phi \\ \hspace*{0.27 in} lambda.sigma <- interval(parm[Data$pos.lambda.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda.sigma] <- lambda.sigma \\ \hspace*{0.27 in} lambda.d <- parm[Data$pos.lambda.d] \\ \hspace*{0.27 in} for (i in 1:length(lambda.d)) \\ \hspace*{0.62 in} lambda.d[i] <- interval(lambda.d[i], 0, abs(lambda.mu[i]) + \\ \hspace*{0.62 in} 3*sqrt(lambda.sigma[i]/(1-lambda.phi[i]\textasciicircum 2))) \\ \hspace*{0.27 in} parm[Data$pos.lambda.d] <- lambda.d \\ \hspace*{0.27 in} lsigma0 <- parm[Data$pos.lsigma0] \\ \hspace*{0.27 in} lSigma <- matrix(parm[Data$pos.lSigma], Data$T, Data$J) \\ \hspace*{0.27 in} lsigma.mu <- parm[Data$pos.lsigma.mu] \\ \hspace*{0.27 in} lsigma.phi <- interval(parm[Data$pos.lsigma.phi], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.lsigma.phi] <- lsigma.phi \\ \hspace*{0.27 in} lsigma.sigma <- interval(parm[Data$pos.lsigma.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lsigma.sigma] <- lsigma.sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha0.prior <- sum(dnorm(alpha0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} Alpha.prior <- sum(dnorm(Alpha, \\ \hspace*{0.62 in} matrix(alpha.mu, Data$T, Data$J, byrow=TRUE) + \\ \hspace*{0.62 in} matrix(alpha.phi, Data$T, Data$J, byrow=TRUE) * \\ \hspace*{0.62 in} (rbind(alpha0, Alpha[-Data$T,]) - \\ \hspace*{0.62 in} matrix(alpha.mu, Data$T, Data$J, byrow=TRUE)),\\ \hspace*{0.62 in} matrix(alpha.sigma, Data$T, Data$J, byrow=TRUE), log=TRUE)) \\ \hspace*{0.27 in} alpha.mu.prior <- sum(dnorm(alpha.mu, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} alpha.phi.prior <- sum(dbeta((alpha.phi + 1) / 2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} alpha.sigma.prior <- sum(dhalfcauchy(alpha.sigma, 5, log=TRUE)) \\ \hspace*{0.27 in} f0.prior <- sum(dnorm(f0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} f.phi.prior <- sum(dbeta((f.phi + 1) / 2, 1, 1, log=TRUE)) \\ \hspace*{0.27 in} f.u0.prior <- sum(dnorm(f.u0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} f.U.prior <- sum(dnorm(matrix(f.U, nrow=Data$T, byrow=TRUE), \\ \hspace*{0.62 in} matrix(f.u.mu, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE) + \\ \hspace*{0.62 in} matrix(f.u.phi, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE) * \\ \hspace*{0.62 in} (rbind(f.u0, matrix(f.U, nrow=Data$T, byrow=TRUE)[-Data$T,]) - \\ \hspace*{0.62 in} matrix(f.u.mu, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE)), \\ \hspace*{0.62 in} matrix(f.u.sigma, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE), \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} f.u.mu.prior <- sum(dnorm(f.u.mu, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} f.u.phi.prior <- sum(dbeta((f.u.phi + 1) / 2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} f.u.sigma.prior <- sum(dhalfcauchy(f.u.sigma, 1, log=TRUE)) \\ \hspace*{0.27 in} lambda0.prior <- sum(dnorm(lambda0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} Lambda.prior <- sum(dnorm(matrix(Lambda, nrow=Data$T, byrow=TRUE), \\ \hspace*{0.62 in} matrix(lambda.mu, Data$T, length(lambda.mu), byrow=TRUE) + \\ \hspace*{0.62 in} (rbind(lambda0, matrix(Lambda, nrow=Data$T, byrow=TRUE))[-(Data$T+1),] - \\ \hspace*{0.62 in} matrix(lambda.mu, Data$T, length(lambda.mu), byrow=TRUE)), \\ \hspace*{0.62 in} matrix(lambda.sigma, Data$T, length(lambda.sigma), byrow=TRUE), \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} lambda.d.prior <- sum(dunif(lambda.d, 0, abs(lambda.mu) + \\ \hspace*{0.62 in} 3*sqrt(lambda.sigma/(1-lambda.phi\textasciicircum 2)), log=TRUE)) \\ \hspace*{0.27 in} lambda.mu.prior <- sum(dnorm(lambda.mu, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} lambda.phi.prior <- sum(dbeta((lambda.phi + 1) / 2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} lambda.sigma.prior <- sum(dhalfcauchy(lambda.sigma, 1, log=TRUE)) \\ \hspace*{0.27 in} lsigma0.prior <- sum(dnorm(lsigma0, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} lSigma.prior <- sum(dnorm(lSigma, \\ \hspace*{0.62 in} matrix(lsigma.mu, Data$T, Data$J, byrow=TRUE) + \\ \hspace*{0.62 in} matrix(lsigma.phi, Data$T, Data$J, byrow=TRUE) * \\ \hspace*{0.62 in} (rbind(lsigma0, lSigma[-Data$T,]) - \\ \hspace*{0.62 in} matrix(lsigma.mu, Data$T, Data$J, byrow=TRUE)), \\ \hspace*{0.62 in} matrix(lsigma.sigma, Data$T, Data$J, byrow=TRUE), log=TRUE)) \\ \hspace*{0.27 in} lsigma.mu.prior <- sum(dnorm(lsigma.mu, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} lsigma.phi.prior <- sum(dbeta((lsigma.phi + 1) / 2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} lsigma.sigma.prior <- sum(dhalfcauchy(lsigma.sigma, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- 0; Yhat <- Data$Y; F.prior <- 0 \\ \hspace*{0.27 in} for (t in 1:Data$T) \{ \\ \hspace*{0.62 in} f.U.temp <- matrix(0, Data$P, Data$P) \\ \hspace*{0.62 in} f.U.temp[upper.tri(f.U.temp, diag=TRUE)] <- matrix(f.U, nrow=Data$T, \\ \hspace*{0.95 in} byrow=TRUE)[t,] \\ \hspace*{0.62 in} diag(f.U.temp) <- exp(diag(f.U.temp)) \\ \hspace*{0.62 in} f.Sigma <- as.symmetric.matrix(t(f.U.temp) \%*\% f.U.temp) \\ \hspace*{0.62 in} F.prior <- F.prior + dmvn(F[t,], rbind(f0, F)[t,] \%*\% diag(f.phi), \\ \hspace*{0.95 in} f.Sigma, log=TRUE) \\ \hspace*{0.62 in} Lambda.temp <- matrix(1, Data$P, Data$J) \\ \hspace*{0.62 in} Lambda.temp[lower.tri(Lambda.temp)] <- 0 \\ \hspace*{0.62 in} Lambda.temp[upper.tri(Lambda.temp)] <- matrix(Lambda, \\ \hspace*{0.95 in} nrow=Data$T, byrow=TRUE)[t,]*(abs(matrix(Lambda, \\ \hspace*{0.95 in} nrow=Data$T, byrow=TRUE)[t,]) > lambda.d) \\ \hspace*{0.62 in} mu <- Alpha[t,] + F[t,] \%*\% Lambda.temp \\ \hspace*{0.62 in} LL <- LL + sum(dnorm(Data$Y[t,], mu, exp(lSigma[t,]), log=TRUE)) \\ \hspace*{0.62 in} Yhat[t,] <- rnorm(Data$J, mu, exp(lSigma[t,])) \#Fitted \\ \hspace*{0.62 in} \} \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha0.prior + Alpha.prior + alpha.mu.prior + \\ \hspace*{0.62 in} alpha.phi.prior + alpha.sigma.prior + f0.prior + F.prior + \\ \hspace*{0.62 in} f.phi.prior + f.u0.prior + f.U.prior + f.u.mu.prior + \\ \hspace*{0.62 in} f.u.phi.prior + f.u.sigma.prior + lambda0.prior + \\ \hspace*{0.62 in} Lambda.prior + lambda.d.prior + lambda.mu.prior + \\ \hspace*{0.62 in} lambda.phi.prior + lambda.sigma.prior + lsigma0.prior + \\ \hspace*{0.62 in} lSigma.prior + lsigma.mu.prior + lsigma.phi.prior + \\ \hspace*{0.62 in} lsigma.sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=Yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rnorm(J), rnorm(T*J), rnorm(J), runif(J), runif(J), \\ \hspace*{0.27 in} rnorm(P), rnorm(T*P), rbeta(P,1,1)*2-1, rnorm(P*(P-1)/2+P), \\ \hspace*{0.27 in} rnorm((P*(P-1)/2+P)*T), rnorm(P*(P-1)/2+P), \\ \hspace*{0.27 in} rbeta(P*(P-1)/2+P,1,1)*2-1, runif(P*(P-1)/2+P), \\ \hspace*{0.27 in} rnorm(P*J-P-P*(P-1)/2), rnorm((P*J-P-P*(P-1)/2)*T), \\ \hspace*{0.27 in} runif(P*J-P-P*(P-1)/2,0,1e-3), rnorm(P*J-P-P*(P-1)/2), \\ \hspace*{0.27 in} rbeta(P*J-P-P*(P-1)/2,20,1.5)*2-1, runif(P*J-P-P*(P-1)/2), \\ \hspace*{0.27 in} rnorm(J), rnorm(T*J), rnorm(J), rbeta(J,20,1.5)*2-1, runif(J)) \\ } \section{Exponential Smoothing} \label{exp.smo} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_t = \alpha \textbf{y}_{t-1} + (1 - \alpha) \mu_{t-1}, \quad t=2,\dots,T$$ $$\alpha \sim \mathcal{U}(0,1)$$ $$\sigma \sim \mathcal{HC}$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ mon.names <- "LP" \\ parm.names <- c("alpha","sigma") \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[1] <- alpha <- interval(parm[1], 0, 1) \\ \hspace*{0.27 in} parm[2] <- sigma <- interval(parm[2], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dunif(alpha, 0, 1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- y \\ \hspace*{0.27 in} mu[-1] <- alpha*Data$y[-1] \\ \hspace*{0.27 in} mu[-1] <- mu[-1] + (1 - alpha) * mu[-Data$T] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], mu[-Data$T], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0.5, 1)} \section{Factor Analysis, Approximate Dynamic} \label{adfa} The Approximate Dynamic Factor Analysis (ADFA) model has many names, including the approximate factor model and approximate dynamic factor model. An ADFA is a Dynamic Factor Analysis (DFA) in which the factor scores of the dynamic factors are approximated with principal components. This is a combination of principal components and common factor analysis, in which the factor loadings of common factors are estimated from the data and factor scores are estimated from principal components. This is a two-stage model: principal components are estimated in the first stage and a decision is made regarding how many principal components to retain, and ADFA is estimated in the second stage. For more information on DFA, see section \ref{dsfm}. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=2,\dots,T, \quad j=1,\dots,J$$ $$\mu_{t,} = \textbf{F}_{t-1,} \Lambda$$ $$\Lambda_{p,j} \sim \mathcal{N}(0, 1), \quad p=1,\dots,P, \quad j=1,\dots,J$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,J$$ \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \#Number of time-periods \\ J <- ncol(Y) \#Number of time-series \\ P <- 7 \#Number of approximate factors \\ PCA <- prcomp(Y, scale=TRUE) \\ F <- PCA$x[,1:P] \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(Lambda=matrix(0,P,J), sigma=rep(0,J))) \\ pos.Lambda <- grep("Lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} Lambda <- rnorm(Data$P*Data$J) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(Lambda, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(F=F, J=J, P=P, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.Lambda=pos.Lambda, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} Lambda <- matrix(parm[Data$pos.Lambda], Data$P, Data$J) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} Lambda.prior <- sum(dnorm(Lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(rbind(rep(0,Data$P), F[-Data$T,]), t(Lambda)) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[-1,], mu[-1,], Sigma[-1,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + Lambda.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,P*J), rep(1,J))} \section{Factor Analysis, Confirmatory} \label{cfa} Factor scores are in matrix \textbf{F}, factor loadings for each variable are in vector $\lambda$, and $\textbf{f}$ is a vector that indicates which variable loads on which factor. \subsection{Form} $$\textbf{Y}_{i,m} \sim \mathcal{N}(\mu_{i,m}, \sigma^2_m), \quad i=1,\dots,N, \quad m=1,\dots,M$$ $$\mu = \textbf{F}_{1:N,\textbf{f}} \lambda^T$$ $$\textbf{F}_{i,1:P} \sim \mathcal{N}_P(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\lambda_m \sim \mathcal{N}(0, 1), \quad m=1,\dots,M$$ $$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$ $$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_P$$ \subsection{Data} \code{data(swiss) \\ Y <- cbind(swiss$Agriculture, swiss$Examination, swiss$Education, \\ \hspace*{0.27 in} swiss$Catholic, swiss$Infant.Mortality) \\ M <- ncol(Y) \#Number of variables \\ N <- nrow(Y) \#Number of records \\ P <- 3 \#Number of factors \\ f <- c(1,3,2,2,1) \#Indicator f for the factor for each variable m \\ for (m in 1:M) Y[,m] <- CenterScale(Y[,m]) \\ S <- diag(P) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(F=matrix(0,N,P), lambda=rep(0,M), \\ \hspace*{0.27 in} U=diag(P), sigma=rep(0,M)), uppertri=c(0,0,1,0)) \\ pos.F <- grep("F", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} U <- rwishartc(Data$N, Data$S) \\ \hspace*{0.27 in} F <- as.vector(rmvnpc(Data$N, rep(0,Data$P), U)) \\ \hspace*{0.27 in} U <- U[upper.tri(U, diag=TRUE)] \\ \hspace*{0.27 in} lambda <- rnorm(Data$M) \\ \hspace*{0.27 in} sigma <- runif(Data$M) \\ \hspace*{0.27 in} return(c(F, lambda, U, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(M=M, N=N, P=P, PGF=PGF, S=S, Y=Y, f=f, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.F=pos.F, pos.lambda=pos.lambda, \\ \hspace*{0.27 in} pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} lambda <- parm[Data$pos.lambda] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$N, Data$P) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$P, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$N, Data$S, log=TRUE) \\ \hspace*{0.27 in} F.prior <- sum(dmvnpc(F, rep(0,Data$P), U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- F[,Data$f] * matrix(lambda, Data$N, Data$M, byrow=TRUE) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$N, Data$M, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + lambda.prior + sigma.prior + F.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N*P), rep(0,M), upper.triangle(S, diag=TRUE), \\ \hspace*{0.27 in} rep(1,M))} \section{Factor Analysis, Exploratory} \label{efa} Factor scores are in matrix \textbf{F} and factor loadings are in matrix $\Lambda$. \subsection{Form} $$\textbf{Y}_{i,m} \sim \mathcal{N}(\mu_{i,m}, \sigma^2_m), \quad i=1,\dots,N, \quad m=1,\dots,M$$ $$\mu = \textbf{F} \Lambda$$ $$\textbf{F}_{i,1:P} \sim \mathcal{N}_P(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\Lambda_{p,m} \sim \mathcal{N}(0, 1), \quad p=1,\dots,P, \quad m=(p+1),\dots,M$$ $$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_P$$ $$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$ \subsection{Data} \code{data(USJudgeRatings) \\ Y <- as.matrix(USJudgeRatings) \\ for (m in 1:M) Y[,m] <- CenterScale(Y[,m]) \\ M <- ncol(Y) \#Number of variables \\ N <- nrow(Y) \#Number of records \\ P <- 3 \#Number of factors \\ Lambda <- matrix(NA, P, M) \\ Lambda[upper.tri(Lambda)] <- 0 \\ S <- diag(P) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(F=matrix(0,N,P), Lambda=Lambda, U=S, \\ \hspace*{0.27 in} sigma=rep(0,M)), uppertri=c(0,0,1,0)) \\ pos.F <- grep("F", parm.names) \\ pos.Lambda <- grep("Lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} U <- rwishartc(Data$N, Data$S) \\ \hspace*{0.27 in} F <- as.vector(rmvnpc(Data$N, rep(0,Data$P), U)) \\ \hspace*{0.27 in} Lambda <- rnorm(Data$P*Data$M-Data$P-Data$P*(Data$P-1)/2,0,1) \\ \hspace*{0.27 in} sigma <- runif(Data$M) \\ \hspace*{0.27 in} return(c(F, Lambda, U[upper.tri(U, diag=TRUE)], sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(M=M, N=N, P=P, PGF=PGF, S=S, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.F=pos.F, pos.Lambda=pos.Lambda, \\ \hspace*{0.27 in} pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$N, Data$P) \\ \hspace*{0.27 in} lambda <- parm[Data$pos.Lambda] \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$P, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} F.prior <- sum(dmvnpc(F, rep(0,Data$P), U, log=TRUE)) \\ \hspace*{0.27 in} Lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$N, Data$S, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Lambda <- matrix(1, Data$P, Data$M) \\ \hspace*{0.27 in} Lambda[lower.tri(Lambda)] <- 0 \\ \hspace*{0.27 in} Lambda[upper.tri(Lambda)] <- lambda \\ \hspace*{0.62 in} mu <- tcrossprod(F, t(Lambda)) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$N, Data$M, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + F.prior + Lambda.prior + U.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.27 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N*P), rep(0,P*M-P-P*(P-1)/2), rep(0,P*(P-1)/2+P), \\ \hspace*{0.27 in} rep(1,M))} \section{Factor Analysis, Exploratory Ordinal} \label{eofa} This exploratory ordinal factor analysis (EOFA) model form is also suitable for collaborative filtering. \subsection{Form} $$\textbf{Y}_{i,m} \sim \mathcal{CAT}(\textbf{P}_{i,m,1:K}), \quad i=1,\dots,N, \quad m=1,\dots,M$$ $$\textbf{P}_{,,K} = 1 - Q_{,,(K-1)}$$ $$\textbf{P}_{,,k} = |Q_{,,k} - Q_{,,(k-1)}|, \quad k=2,\dots,(K-1)$$ $$\textbf{P}_{,,1} = Q_{,,1}$$ $$Q = \phi(\mu)$$ $$\mu_{,,k} = \alpha_k - \textbf{F} \Lambda, \quad k=1,\dots,(K-1)$$ $$\textbf{F}_{i,1:P} \sim \mathcal{N}_P(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\gamma_p = 0, \quad p=1,\dots,P$$ $$\Lambda_{p,m} \sim \mathcal{N}(0, 1), \quad p=1,\dots,P, \quad m=(p+1),\dots,M$$ $$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_P$$ $$\alpha_k \sim \mathcal{N}(0, 1) \in [(k-1),k] \in [-5,5], \quad k=2,\dots,(K-1)$$ \subsection{Data} \code{M <- 10 \#Number of variables \\ N <- 20 \#Number of records \\ K <- 3 \#Number of discrete values \\ P <- 3 \#Number of factors \\ alpha <- sort(rnorm(K-1)) \\ Lambda <- matrix(1, P, M) \\ Lambda[lower.tri(Lambda)] <- 0 \\ Lambda[upper.tri(Lambda)] <- rnorm(P*M-P-P*(P-1)/2) \\ Omega <- runif(P) \\ F <- rmvnp(N, rep(0,P), Omega) \\ mu <- aperm(array(alpha, dim=c(K-1, M, N)), perm=c(3,2,1)) \\ mu <- mu - array(tcrossprod(F, t(Lambda)), dim=c(N, M, K-1)) \\ Pr <- Q <- pnorm(mu) \\ Pr[ , , -1] <- abs(Q[ , , -1] - Q[ , , -(K-1)]) \\ Pr <- array(Pr, dim=c(N, M, K)) \\ Pr[ , , K] <- 1 - Q[ , , (K-1)] \\ dim(Pr) <- c(N*M, K) \\ Y <- matrix(rcat(nrow(Pr), Pr), N, M) \#Make sure Y has all values \\ S <- diag(P) \\ Lambda <- matrix(0, P, M) \\ Lambda[lower.tri(Lambda, diag=TRUE)] <- NA \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(F=matrix(0,N,P), Omega=rep(0,P), \\ \hspace*{0.27 in} Lambda=Lambda, alpha=rep(0,K-1))) \\ pos.F <- grep("F", parm.names) \\ pos.Omega <- grep("Omega", parm.names) \\ pos.Lambda <- grep("Lambda", parm.names) \\ pos.alpha <- grep("alpha", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} Omega <- runif(Data$P) \\ \hspace*{0.27 in} F <- as.vector(rmvnp(Data$N, rep(0,Data$P), diag(Omega))) \\ \hspace*{0.27 in} Lambda <- rnorm(Data$P*Data$M-Data$P-Data$P*(Data$P-1)/2) \\ \hspace*{0.27 in} alpha <- sort(rnorm(Data$K-1)) \\ \hspace*{0.27 in} return(c(F, Omega, Lambda, alpha)) \\ \hspace*{0.27 in} \} \\ MyData <- list(K=K, M=M, N=N, P=P, PGF=PGF, S=S, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.F=pos.F, \\ \hspace*{0.27 in} pos.Omega=pos.Omega, pos.Lambda=pos.Lambda, pos.alpha=pos.alpha) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$N, Data$P) \\ \hspace*{0.27 in} Omega <- interval(parm[Data$pos.Omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.Omega] <- Omega \\ \hspace*{0.27 in} lambda <- parm[Data$pos.Lambda] \\ \hspace*{0.27 in} alpha <- sort(interval(parm[Data$pos.alpha], -5, 5)) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} F.prior <- sum(dmvnp(F, rep(0,Data$P), diag(Omega), log=TRUE)) \\ \hspace*{0.27 in} Omega.prior <- dwishart(diag(Omega), Data$N, Data$S, log=TRUE) \\ \hspace*{0.27 in} Lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Lambda <- matrix(1, Data$P, Data$M) \\ \hspace*{0.27 in} Lambda[lower.tri(Lambda)] <- 0 \\ \hspace*{0.27 in} Lambda[upper.tri(Lambda)] <- lambda \\ \hspace*{0.27 in} mu <- aperm(array(alpha, dim=c(Data$K-1, Data$M, Data$N)), \\ \hspace*{0.62 in} perm=c(3,2,1)) \\ \hspace*{0.27 in} mu <- mu - array(tcrossprod(F, t(Lambda)), \\ \hspace*{0.62 in} dim=c(Data$N, Data$M, Data$K-1)) \\ \hspace*{0.27 in} P <- Q <- pnorm(mu) \\ \hspace*{0.27 in} P[ , , -1] <- abs(Q[ , , -1] - Q[ , , -(Data$K-1)]) \\ \hspace*{0.27 in} P <- array(P, dim=c(Data$N, Data$M, Data$K)) \\ \hspace*{0.27 in} P[ , , Data$K] <- 1 - Q[ , , (Data$K-1)] \\ \hspace*{0.27 in} y <- as.vector(Data$Y) \\ \hspace*{0.27 in} dim(P) <- c(Data$N*Data$M, Data$K) \\ \hspace*{0.27 in} LL <- sum(dcat(y, P, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + F.prior + Omega.prior + Lambda.prior + alpha.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=matrix(rcat(nrow(P), P), Data$N, Data$M), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N*P), rep(0,P), rep(0,P*M-P-P*(P-1)/2), \\ \hspace*{0.27 in} seq(from=-1, to=1, len=K-1)) } \section{Factor Regression} \label{factor.reg} This example of factor regression is constrained to the case where the number of factors is equal to the number of independent variables (IVs) less the intercept. The purpose of this form of factor regression is to orthogonalize the IVs with respect to $\textbf{y}$, rather than variable reduction. This method is the combination of confirmatory factor analysis in section \ref{cfa} and linear regression in section \ref{linear.reg}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\nu, \sigma^2_{J+1})$$ $$\nu = \textbf{F} \beta$$ $$\mu_{i,1} = 1$$ $$\mu_{i,j+1} = \mu_{i,j}, \quad j=1,\dots,J$$ $$\textbf{X}_{i,j} \sim \mathcal{N}(\mu_{i,j}, \sigma^2_j), \quad i=1,\dots,N, \quad j=2,\dots,J$$ $$\mu_{i,j} = \lambda_j \textbf{F}_{i,j}, \quad i=1,\dots,N, \quad j=2,\dots,J$$ $$\textbf{F}_{i,1:J} \sim \mathcal{N}_{J-1}(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\lambda_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,(J-1)$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,(J+1)$$ $$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- as.matrix(log(demonsnacks[,c(1,4,10)]+1)) \\ J <- ncol(X) \\ for (j in 1:J) X[,j] <- CenterScale(X[,j]) \\ S <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J+1), lambda=rep(0,J), \\ \hspace*{0.27 in} sigma=rep(0,J+1), F=matrix(0,N,J), Omega=rep(0,J))) \\ pos.beta <- grep("beta", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.F <- grep("F", parm.names) \\ pos.Omega <- grep("Omega", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J+1) \\ \hspace*{0.27 in} lambda <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(Data$J+1) \\ \hspace*{0.27 in} Omega <- runif(Data$J) \\ \hspace*{0.27 in} F <- as.vector(rmvnp(Data$N, rep(0,Data$J), diag(Omega))) \\ \hspace*{0.27 in} return(c(beta, lambda, sigma, F, Omega)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, S=S, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.lambda=pos.lambda, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, pos.F=pos.F, pos.Omega=pos.Omega, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} lambda <- parm[Data$pos.lambda] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} F <- matrix(Data$pos.F], Data$N, Data$J) \\ \hspace*{0.27 in} Omega <- interval(parm[Data$pos.Omega], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.Omega] <- Omega \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} F.prior <- sum(dmvnp(F, rep(0,Data$J), diag(Omega), log=TRUE)) \\ \hspace*{0.27 in} Omega.prior <- dwishart(diag(Omega), Data$N, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- F * matrix(lambda, Data$N, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} nu <- tcrossprod(cbind(1,F), t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$X, mu, matrix(sigma[1:Data$J], Data$N, Data$J, \\ \hspace*{0.62 in} byrow=TRUE), log=TRUE)) \\ \hspace*{0.27 in} LL <- LL + dnorm(Data$y, nu, sigma[Data$J+1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + lambda.prior + sigma.prior + F.prior \\ \hspace*{0.62 in} Omega.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(Data$N, nu, sigma[Data$J+1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J+1), rep(0,J), rep(0,J+1), rep(0,N*J), rep(1,J))} \section{Gamma Regression} \label{gamma.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{G}(\lambda \tau, \tau)$$ $$\lambda = \exp(\textbf{X} \beta)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\tau \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 20 \\ J <- 3 \\ X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \\ beta <- runif(J,-2,2) \\ y <- round(exp(tcrossprod(X, t(beta)))) + 0.1 \#Must be > 0 \\ mon.names <- c("LP","sigma2") \\ parm.names <- as.parm.names(list(beta=rep(0,J), tau=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} return(c(beta, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.tau=pos.tau, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau \\ \hspace*{0.27 in} sigma2 <- 1/tau \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(tcrossprod(Data$X, t(beta))) \\ \hspace*{0.27 in} LL <- sum(dgamma(Data$y, tau*lambda, tau, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,sigma2), \\ \hspace*{0.62 in} yhat=rgamma(nrow(lambda), tau*lambda, tau), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Geographically Weighted Regression} \label{gwr} \subsection{Form} $$\textbf{y}_{i,k} \sim \mathcal{N}(\mu_{i,k}, \tau^{-1}_{i,k}), \quad i=1,\dots,N, \quad k=1,\dots,N$$ $$\mu_{i,1:N} = \textbf{X} \beta_{i,1:J}$$ $$\tau = \frac{1}{\sigma^2} \textbf{w} \nu$$ $$\textbf{w} = \frac{\exp(-0.5 \textbf{Z}^2)}{\textbf{h}}$$ $$\alpha \sim \mathcal{U}(1.5, 100)$$ $$\beta_{i,j} \sim \mathcal{N}(0, 1000), \quad i=1,\dots,N, \quad j=1,\dots,J$$ $$\textbf{h} \sim \mathcal{N}(0.1, 1000) \in [0.1, \infty]$$ $$\nu_{i,k} \sim \mathcal{G}(\alpha, 2), \quad i=1,\dots,N, \quad k=1,\dots,N$$ $$\sigma_i \sim \mathcal{HC}(25), \quad i=1,\dots,N$$ \subsection{Data} \code{crime <- c(18.802, 32.388, 38.426, 0.178, 15.726, 30.627, 50.732, \\ \hspace*{0.27 in} 26.067, 48.585, 34.001, 36.869, 20.049, 19.146, 18.905, 27.823, \\ \hspace*{0.27 in} 16.241, 0.224, 30.516, 33.705, 40.970, 52.794, 41.968, 39.175, \\ \hspace*{0.27 in} 53.711, 25.962, 22.541, 26.645, 29.028, 36.664, 42.445, 56.920, \\ \hspace*{0.27 in} 61.299, 60.750, 68.892, 38.298, 54.839, 56.706, 62.275, 46.716, \\ \hspace*{0.27 in} 57.066, 54.522, 43.962, 40.074, 23.974, 17.677, 14.306, 19.101, \\ \hspace*{0.27 in} 16.531, 16.492) \\ income <- c(21.232, 4.477, 11.337, 8.438, 19.531, 15.956, 11.252, \\ \hspace*{0.27 in} 16.029, 9.873, 13.598, 9.798, 21.155, 18.942, 22.207, 18.950, \\ \hspace*{0.27 in} 29.833, 31.070, 17.586, 11.709, 8.085, 10.822, 9.918, 12.814, \\ \hspace*{0.27 in} 11.107, 16.961, 18.796, 11.813, 14.135, 13.380, 17.017, 7.856, \\ \hspace*{0.27 in} 8.461, 8.681, 13.906, 14.236, 7.625, 10.048, 7.467, 9.549, \\ \hspace*{0.27 in} 9.963, 11.618, 13.185, 10.655, 14.948, 16.940, 18.739, 18.477, \\ \hspace*{0.27 in} 18.324, 25.873) \\ housing <- c(44.567, 33.200, 37.125, 75.000, 80.467, 26.350, 23.225, \\ \hspace*{0.27 in} 28.750, 18.000, 96.400, 41.750, 47.733, 40.300, 42.100, 42.500, \\ \hspace*{0.27 in} 61.950, 81.267, 52.600, 30.450, 20.300, 34.100, 23.600, 27.000, \\ \hspace*{0.27 in} 22.700, 33.500, 35.800, 26.800, 27.733, 25.700, 43.300, 22.850, \\ \hspace*{0.27 in} 17.900, 32.500, 22.500, 53.200, 18.800, 19.900, 19.700, 41.700, \\ \hspace*{0.27 in} 42.900, 30.600, 60.000, 19.975, 28.450, 31.800, 36.300, 39.600, \\ \hspace*{0.27 in} 76.100, 44.333) \\ easting <- c(35.62, 36.50, 36.71, 33.36, 38.80, 39.82, 40.01, 43.75, \\ \hspace*{0.27 in} 39.61, 47.61, 48.58, 49.61, 50.11, 51.24, 50.89, 48.44, 46.73, \\ \hspace*{0.27 in} 43.44, 43.37, 41.13, 43.95, 44.10, 43.70, 41.04, 43.23, 42.67, \\ \hspace*{0.27 in} 41.21, 39.32, 41.09, 38.3, 41.31, 39.36, 39.72, 38.29, 36.60, \\ \hspace*{0.27 in} 37.60, 37.13, 37.85, 35.95, 35.72, 35.76, 36.15, 34.08, 30.32, \\ \hspace*{0.27 in} 27.94, 27.27, 24.25, 25.47, 29.02) \\ northing <- c(42.38, 40.52, 38.71, 38.41, 44.07, 41.18, 38.00, 39.28, \\ \hspace*{0.27 in} 34.91, 36.42, 34.46, 32.65, 29.91, 27.80, 25.24, 27.93, 31.91, \\ \hspace*{0.27 in} 35.92, 33.46, 33.14, 31.61, 30.40, 29.18, 28.78, 27.31, 24.96, \\ \hspace*{0.27 in} 25.90, 25.85, 27.49, 28.82, 30.90, 32.88, 30.64, 30.35, 32.09, \\ \hspace*{0.27 in} 34.08, 36.12, 36.30, 36.40, 35.60, 34.66, 33.92, 30.42, 28.26, \\ \hspace*{0.27 in} 29.85, 28.21, 26.69, 25.71, 26.58) \\ N <- length(crime) \\ J <- 3 \#Number of predictors, including the intercept \\ X <- matrix(c(rep(1,N), income, housing),N,J) \\ D <- as.matrix(dist(cbind(northing,easting), diag=TRUE, upper=TRUE)) \\ Z <- D / sd(as.vector(D)) \\ y <- matrix(0,N,N); for (i in 1:N) \{for (k in 1:N) \{y[i,k] <- crime[k]\}\} \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=0, beta=matrix(0,N,J), H=0, \\ \hspace*{0.27 in} nu=matrix(0,N,N), sigma=rep(0,N))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.H <- grep("H", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- runif(1,1.5,100) \\ \hspace*{0.27 in} beta <- rnorm(Data$N*Data$J) \\ \hspace*{0.27 in} H <- runif(1,0.1,1000) \\ \hspace*{0.27 in} nu <- rgamma(Data$N*Data$N,alpha,2) \\ \hspace*{0.27 in} sigma <- runif(Data$N) \\ \hspace*{0.27 in} return(c(alpha, beta, H, nu, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, X=X, Z=Z, latitude=northing, \\ \hspace*{0.27 in} longitude=easting, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.H=pos.H, pos.nu=pos.nu, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], 1.5, 100) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$N, Data$J) \\ \hspace*{0.27 in} parm[Data$pos.H] <- H <- interval(parm[Data$pos.H], 0.1, Inf) \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} nu <- matrix(nu, Data$N, Data$N) \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dunif(alpha, 1.5, 100, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} h.prior <- dhalfnorm(H-0.1, 1000, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- sum(dgamma(nu, alpha, 2, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} w <- exp(-0.5 * Data$Z\textasciicircum 2) / H \\ \hspace*{0.27 in} tau <- (1/sigma\textasciicircum 2) * w * nu \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} LL <- sum(dnormp(Data$y, mu, tau, log=TRUE)) \\ \hspace*{0.27 in} \#WSE <- w * nu * (Data$y - mu)\textasciicircum 2; w.y <- w * nu * Data$y \\ \hspace*{0.27 in} \#WMSE <- rowMeans(WSE); y.w <- rowSums(w.y) / rowSums(w) \\ \hspace*{0.27 in} \#LAR2 <- 1 - WMSE / sd(y.w)\textasciicircum 2 \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + h.prior + nu.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormp(prod(dim(mu)), mu, tau), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(runif(1,1.5,100), rep(0,N*J), 1, rep(1,N*N), rep(1,N))} \section{Hidden Markov Model} \label{hmm} \subsection{Form} This introductory hidden Markov model (HMM) includes $N$ discrete states. $$\textbf{y}_t \sim \mathcal{N}(\mu_\theta, \sigma^2_\theta), \quad t=1,\dots,T$$ $$\mu \sim \mathcal{N}(\mu_0, \sigma^2)$$ $$\sigma^2 \sim \mathcal{HC}(25)$$ $$\theta_t \sim \mathcal{CAT}(\phi_{\theta_{t-1},1:N}), \quad t=1,\dots,T$$ $$\phi_{i,1:N} \sim \mathcal{D}(\alpha_{1:N}), \quad i=1,\dots,N$$ $$\mu_0 \sim \mathcal{N}(0, 1000)$$ $$\sigma^2_0 \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(log(as.matrix(demonfx[1:50,1]))) \\ T <- length(y) \#Number of time-periods \\ N <- 2 \#Number of discrete (hidden) states \\ alpha <- matrix(1,N,N) \#Concentration hyperparameter \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(mu0=rep(0,N), mu1=rep(0,N), \\ \hspace*{0.27 in} phi=matrix(0,N,N), sigma2=rep(0,N), theta=rep(0,T))) \\ pos.mu0 <- grep("mu0", parm.names) \\ pos.mu1 <- grep("mu1", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma2 <- grep("sigma2", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} mu0 <- sort(runif(Data$N, min(Data$y), max(Data$y))) \\ \hspace*{0.27 in} mu1 <- sort(runif(Data$N, min(Data$y), max(Data$y))) \\ \hspace*{0.27 in} phi <- matrix(runif(Data$N*Data$N), Data$N, Data$N) \\ \hspace*{0.27 in} phi <- as.vector(phi / rowSums(phi)) \\ \hspace*{0.27 in} sigma2 <- runif(Data$N) \\ \hspace*{0.27 in} theta <- rcat(Data$T, rep(1/Data$N,Data$N)) \\ \hspace*{0.27 in} return(c(mu0, mu1, phi, sigma2, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, T=T, alpha=alpha, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.mu0=pos.mu0, pos.mu1=pos.mu1, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.sigma2=pos.sigma2, pos.theta=pos.theta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} mu0 <- interval(parm[Data$pos.mu0], min(Data$y), max(Data$y)) \\ \hspace*{0.27 in} parm[Data$pos.mu0] <- mu0 \\ \hspace*{0.27 in} mu <- interval(parm[Data$pos.mu1], min(Data$y), max(Data$y)) \\ \hspace*{0.27 in} parm[Data$pos.mu1] <- mu <- sort(mu) \\ \hspace*{0.27 in} phi <- matrix(abs(parm[Data$pos.phi]), Data$N, Data$N) \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- phi / rowSums(phi) \\ \hspace*{0.27 in} sigma2 <- interval(parm[Data$pos.sigma2], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma2] <- sigma2 \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} mu0.prior <- sum(dnormv(mu0, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} mu.prior <- sum(dnormv(mu, mu0, sigma2, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- 0 \\ \hspace*{0.27 in} for (i in 1:Data$N) \\ \hspace*{0.62 in} phi.prior <- phi.prior + sum(ddirichlet(phi[i,], Data$alpha[i,], \\ \hspace*{0.95 in} log=TRUE)) \\ \hspace*{0.27 in} sigma2.prior <- sum(dhalfcauchy(sigma2, 25, log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, rbind(rep(1/Data$N,Data$N), \\ \hspace*{0.62 in} phi[theta[-Data$T],]), log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y, mu[theta], sigma2[theta], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + mu0.prior + mu.prior + phi.prior + sigma2.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnormv(length(theta), mu[theta], sigma2[theta]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(sort(runif(N, min(y), max(y))), \\ \hspace*{0.27 in} sort(runif(N, min(y), max(y))), runif(N*N), runif(N), \\ \hspace*{0.27 in} rcat(T, rep(1/N,N)))} \section{Inverse Gaussian Regression} \label{ig.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{N}^{-1}(\mu, \lambda)$$ $$\mu = \exp(\textbf{X}\beta) + C$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\lambda \sim \mathcal{HC}(25)$$ where $C$ is a small constant, such as 1.0E-10. \subsection{Data} \code{N <- 100 \\ J <- 3 \#Number of predictors, including the intercept \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta.orig <- runif(J,-3,3) \\ e <- rnorm(N,0,0.1) \\ y <- exp(tcrossprod(X, t(beta.orig)) + e) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), lambda=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} lambda <- runif(1) \\ \hspace*{0.27 in} return(c(beta, lambda)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.lambda=pos.lambda, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} lambda.prior <- dhalfcauchy(lambda, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- exp(tcrossprod(Data$X, t(beta))) + 1.0E-10 \\ \hspace*{0.27 in} LL <- sum(dinvgaussian(Data$y, mu, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + lambda.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rinvgaussian(length(mu), mu, lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Kriging} \label{kriging} This is an example of universal kriging of $\textbf{y}$ given $\textbf{X}$, regression effects $\beta$, and spatial effects $\zeta$. Euclidean distance between spatial coordinates (longitude and latitude) is used for each of $i=1,\dots,N$ records of $\textbf{y}$. An additional record is created from the same data-generating process to compare the accuracy of interpolation. For the spatial component, $\phi$ is the rate of spatial decay and $\kappa$ is the scale. $\kappa$ is often difficult to identify, so it is set to 1 (Gaussian), but may be allowed to vary up to 2 (Exponential). In practice, $\phi$ is also often difficult to identify. While $\Sigma$ is spatial covariance, spatial correlation is $\rho = \exp(-\phi \textbf{D})$. To extend this to a large data set, consider the predictive process kriging example in section \ref{kriging.pp}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$ \mu = \textbf{X} \beta + \zeta$$ $$ \textbf{y}^{new} = \textbf{X} \beta + \sum^N_{i=1} \left ( \frac{\rho_i}{\sum \rho} \zeta_i \right )$$ $$ \rho = \exp(-\phi \textbf{D}^{new})^\kappa$$ $$ \zeta \sim \mathcal{N}_N(\zeta_\mu, \Sigma)$$ $$ \Sigma = \sigma^2_2 \exp(-\phi \textbf{D})^\kappa$$ $$ \beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,2$$ $$ \sigma_j \sim \mathcal{HC}(25) \in [0.1,10], \quad j=1,\dots,2$$ $$ \phi \sim \mathcal{U}(1, 5)$$ $$ \zeta_\mu = 0$$ $$ \kappa = 1$$ \subsection{Data} \code{N <- 20 \\ longitude <- runif(N+1,0,100) \\ latitude <- runif(N+1,0,100) \\ D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ Sigma <- 10000 * exp(-1.5 * D) \\ zeta <- colMeans(rmvn(1000, rep(0,N+1), Sigma)) \\ beta <- c(50,2) \\ X <- matrix(runif((N+1)*2,-2,2),(N+1),2); X[,1] <- 1 \\ mu <- as.vector(tcrossprod(X, t(beta))) \\ y <- mu + zeta \\ longitude.new <- longitude[N+1]; latitude.new <- latitude[N+1] \\ Xnew <- X[N+1,]; ynew <- y[N+1] \\ longitude <- longitude[1:N]; latitude <- latitude[1:N] \\ X <- X[1:N,]; y <- y[1:N] \\ D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ D.new <- sqrt((longitude - longitude.new)\textasciicircum 2 + (latitude - latitude.new)\textasciicircum 2) \\ mon.names <- c("LP","ynew") \\ parm.names <- as.parm.names(list(zeta=rep(0,N), beta=rep(0,2), \\ \hspace*{0.27 in} sigma=rep(0,2), phi=0)) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(2) \\ \hspace*{0.27 in} sigma <- runif(2,0.1,10) \\ \hspace*{0.27 in} phi <- runif(1,1,5) \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} zeta <- rmvn(1, rep(0,Data$N), \\ \hspace*{0.62 in} sigma[2]*sigma[2]*exp(-phi*Data$D)\textasciicircum kappa) \\ \hspace*{0.27 in} return(c(zeta, beta, sigma, phi)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, D.new=D.new, latitude=latitude, longitude=longitude, \\ \hspace*{0.27 in} N=N, PGF=PGF, X=X, Xnew=Xnew, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.zeta=pos.zeta, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, pos.phi=pos.phi, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 0.1, 10) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\ \hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-phi * Data$D)\textasciicircum kappa \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.prior <- dmvn(zeta, rep(0, Data$N), Sigma, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma - 1, 25, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dunif(phi, 1, 5, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Interpolation \\ \hspace*{0.27 in} rho <- exp(-phi * Data$D.new)\textasciicircum kappa \\ \hspace*{0.27 in} ynew <- rnorm(1, sum(beta * Data$Xnew) + sum(rho / sum(rho) * zeta), \\ \hspace*{0.62 in} sigma[1]) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) + zeta \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + sigma.prior + phi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,ynew), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N), rep(0,2), rep(1,2), 1)} \section{Kriging, Predictive Process} \label{kriging.pp} The first $K$ of $N$ records in $\textbf{y}$ are used as knots for the parent process, and the predictive process involves records $(K+1),\dots,N$. For more information on kriging, see section \ref{kriging}. \subsection{Form} $$ \textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$ \mu_{1:K} = \textbf{X}_{1:K,1:J} \beta + \zeta$$ $$ \mu_{(K+1):N} = \textbf{X}_{(K+1):N,1:J} \beta + \sum^{N-K}_{p=1} \frac{\lambda_{p,1:K}}{\sum^{N-K}_{q=1} \lambda_{q,1:K}} \zeta^T$$ $$ \lambda = \exp(-\phi \textbf{D}_P)^\kappa$$ $$ \textbf{y}^{new} = \textbf{X} \beta + \sum^K_{k=1} (\frac{\rho_k}{\sum \rho} \zeta_k)$$ $$ \rho = \exp(-\phi \textbf{D}^{new})^\kappa$$ $$ \zeta \sim \mathcal{N}_K(0, \Sigma)$$ $$ \Sigma = \sigma^2_2 \exp(-\phi \textbf{D})^\kappa$$ $$ \beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,2$$ $$ \sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$ $$ \phi \sim \mathrm{N}(0, 1000) \in [1, 5]$$ $$ \kappa = 1$$ \subsection{Data} \code{N <- 100 \\ K <- 30 \#Number of knots \\ longitude <- runif(N+1,0,100) \\ latitude <- runif(N+1,0,100) \\ D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ Sigma <- 10000 * exp(-1.5 * D) \\ zeta <- colMeans(rmvn(1000, rep(0,N+1), Sigma)) \\ beta <- c(50,2) \\ X <- matrix(runif((N+1)*2,-2,2),(N+1),2); X[,1] <- 1 \\ mu <- as.vector(tcrossprod(X, t(beta))) \\ y <- mu + zeta \\ longitude.new <- longitude[N+1]; latitude.new <- latitude[N+1] \\ Xnew <- X[N+1,]; ynew <- y[N+1] \\ longitude <- longitude[1:N]; latitude <- latitude[1:N] \\ X <- X[1:N,]; y <- y[1:N] \\ D <- as.matrix(dist(cbind(longitude[1:K],latitude[1:K]), diag=TRUE, \\ \hspace*{0.27 in} upper=TRUE)) \\ D.P <- matrix(0, N-K, K) \\ for (i in (K+1):N) \{ \\ \hspace*{0.27 in} D.P[K+1-i,] <- sqrt((longitude[1:K] - longitude[i])\textasciicircum 2 + \\ \hspace*{0.62 in} (latitude[1:K] - latitude[i])\textasciicircum 2)\} \\ D.new <- sqrt((longitude[1:K] - longitude.new)\textasciicircum 2 + \\ \hspace*{0.27 in} (latitude[1:K] - latitude.new)\textasciicircum 2) \\ mon.names <- c("LP","ynew") \\ parm.names <- as.parm.names(list(zeta=rep(0,K), beta=rep(0,2), \\ \hspace*{0.27 in} sigma=rep(0,2), phi=0)) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(2) \\ \hspace*{0.27 in} sigma <- runif(2,0.1,10) \\ \hspace*{0.27 in} phi <- runif(1,1,5) \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} zeta <- rmvn(1, rep(0,Data$K), \\ \hspace*{0.62 in} sigma[2]*sigma[2]*exp(-phi*Data$D)\textasciicircum kappa) \\ \hspace*{0.27 in} return(c(zeta, beta, sigma, phi)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, D.new=D.new, D.P=D.P, K=K, N=N, PGF=PGF, X=X, \\ \hspace*{0.27 in} Xnew=Xnew, latitude=latitude, longitude=longitude, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.zeta=pos.zeta, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.sigma=pos.sigma, pos.phi=pos.phi, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\ \hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-phi * Data$D)\textasciicircum kappa \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.prior <- dmvn(zeta, rep(0, Data$K), Sigma, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma - 1, 25, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dunif(phi, 1, 5, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Interpolation \\ \hspace*{0.27 in} rho <- exp(-phi * Data$D.new)\textasciicircum kappa \\ \hspace*{0.27 in} ynew <- rnorm(1, sum(beta * Data$Xnew) + sum(rho / sum(rho) * zeta), \\ \hspace*{0.62 in} sigma) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} mu[1:Data$K] <- mu[1:Data$K] + zeta \\ \hspace*{0.27 in} lambda <- exp(-phi * Data$D.P)\textasciicircum kappa \\ \hspace*{0.27 in} mu[(Data$K+1):Data$N] <- mu[(Data$K+1):Data$N] + \\ \hspace*{0.62 in} rowSums(lambda / rowSums(lambda) * \\ \hspace*{0.62 in} matrix(zeta, Data$N - Data$K, Data$K, byrow=TRUE)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + sigma.prior + phi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,ynew), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), c(mean(y), 0), rep(1,2), 3)} \section{Laplace Regression} \label{laplace.reg} This linear regression specifies that $\textbf{y}$ is Laplace-distributed, where it is usually Gaussian or normally-distributed. It has been claimed that it should be surprising that the normal distribution became the standard, when the Laplace distribution usually fits better and has wider tails \citep{kotz01}. Another popular alternative is to use the t-distribution (see Robust Regression in section \ref{robust.reg}), though it is more computationally expensive to estimate, because it has three parameters. The Laplace distribution has only two parameters, location and scale like the normal distribution, and is computationally easier to fit. This example could be taken one step further, and the parameter vector $\beta$ could be Laplace-distributed. Laplace's Demon recommends that users experiment with replacing the normal distribution with the Laplace distribution. \subsection{Form} $$\textbf{y} \sim \mathcal{L}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 10000 \\ J <- 5 \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta <- runif(J,-3,3) \\ e <- rlaplace(N,0,0.1) \\ y <- tcrossprod(X, t(beta)) + e \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dlaplace(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rlaplace(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Latent Dirichlet Allocation} \label{lda} \subsection{Form} $$\textbf{Y}_{m,n} \sim \mathcal{CAT}(\phi[\textbf{Z}_{m,n},]), \quad m=1,\dots,M, \quad n=1,\dots,N$$ $$\textbf{Z}_{m,n} \sim \mathcal{CAT}(\theta_{m,1:K})$$ $$\phi_{k,v} \sim \mathcal{D}(\beta)$$ $$\theta_{m,k} \sim \mathcal{D}(\alpha)$$ $$\alpha_k = 1, \quad k=1,\dots,K$$ $$\beta_v = 1, \quad v=1,\dots,V$$ \subsection{Data} \code{K <- 2 \#Number of (latent) topics \\ M <- 4 \#Number of documents in corpus \\ N <- 15 \#Maximum number of (used) words per document \\ V <- 5 \#Maximum number of occurrences of any word (Vocabulary size) \\ Y <- matrix(rcat(M*N,rep(1/V,V)), M, N) \\ rownames(Y) <- paste("doc", 1:nrow(Y), sep="") \\ colnames(Y) <- paste("word", 1:ncol(Y), sep="") \\ \#Note: Y is usually represented as w, a matrix of word counts. \\ if(min(Y) == 0) Y <- Y + 1 \#A zero cannot occur, Y must be 1,2,...,V. \\ V <- max(Y) \#Maximum number of occurrences of any word (Vocabulary size) \\ alpha <- rep(1,K) \# hyperparameters (constant) \\ beta <- rep(1,V) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(phi=matrix(0,K,V), theta=matrix(0,M,K), \\ \hspace*{0.27 in} Z=matrix(0,M,N))) \\ pos.phi <- grep("phi", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ pos.Z <- grep("Z", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} phi <- matrix(runif(Data$J*Data$V), Data$K, Data$V) \\ \hspace*{0.27 in} phi <- phi / rowSums(phi) \\ \hspace*{0.27 in} theta <- matrix(runif(Data$M*Data$K), Data$M, Data$K) \\ \hspace*{0.27 in} theta <- theta / rowSums(theta) \\ \hspace*{0.27 in} z <- rcat(Data$M*Data$N, rep(1/Data$K,Data$K)) \\ \hspace*{0.27 in} return(c(as.vector(phi), as.vector(theta), z))\} \\ MyData <- list(K=K, M=M, N=N, PGF=PGF, V=V, Y=Y, alpha=alpha, beta=beta, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.theta=pos.theta, pos.Z=pos.Z) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} phi <- matrix(interval(parm[Data$pos.phi], 0, 1), Data$K, Data$V) \\ \hspace*{0.27 in} phi <- phi / rowSums(phi) \\ \hspace*{0.27 in} parm[Data$pos.phi] <- as.vector(phi) \\ \hspace*{0.27 in} theta <- matrix(interval(parm[Data$pos.theta], 0, 1), Data$M, Data$K) \\ \hspace*{0.27 in} theta <- theta / rowSums(theta) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- as.vector(theta) \\ \hspace*{0.27 in} Z <- matrix(parm[Data$pos.Z], Data$M, Data$N) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} phi.prior <- sum(ddirichlet(phi, beta, log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- sum(ddirichlet(theta, alpha, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- Z.prior <- 0 \\ \hspace*{0.27 in} Yhat <- Data$Y \\ \hspace*{0.27 in} for (m in 1:Data$M) \{for (n in 1:Data$N) \{ \\ \hspace*{0.62 in} Z.prior + Z.prior + dcat(Z[m,n], theta[m,], log=TRUE) \\ \hspace*{0.62 in} LL <- LL + dcat(Data$Y[m,n], as.vector(phi[Z[m,n],]), log=TRUE) \\ \hspace*{0.62 in} Yhat[m,n] <- rcat(1, as.vector(phi[Z[m,n],]))\}\} \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + phi.prior + theta.prior + Z.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=Yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(1/V,K*V), rep(1/K,M*K), rcat(M*N,rep(1/K,K)))} \section{Linear Regression} \label{linear.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 10000 \\ J <- 5 \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta <- runif(J,-3,3) \\ e <- rnorm(N,0,0.1) \\ y <- tcrossprod(X, t(beta)) + e \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dgamma(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Linear Regression, Frequentist} \label{linear.reg.freq} By eliminating prior probabilities, a frequentist linear regression example is presented. Although frequentism is not endorsed here, the purpose of this example is to illustrate how the \pkg{LaplacesDemon} package can be used for Bayesian or frequentist inference. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ \subsection{Data} \code{N <- 10000 \\ J <- 5 \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta <- runif(J,-3,3) \\ e <- rnorm(N,0,0.1) \\ y <- tcrossprod(X, t(beta)) + e \\ mon.names <- "LL" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma, 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} Modelout <- list(LP=LL, Dev=-2*LL, Monitor=LL, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Linear Regression, Hierarchical Bayesian} \label{linear.reg.hb} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(\gamma, \delta), \quad j=1,\dots,J$$ $$\gamma \sim \mathcal{N}(0, 1000)$$ $$\delta \sim \mathcal{HC}(25)$$ $$\sigma \sim \mathcal{HC}(\tau)$$ $$\tau \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), gamma=0, delta=0, sigma=0, \\ \hspace*{0.27 in} tau=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} gamma <- rnorm(1) \\ \hspace*{0.27 in} delta <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} return(c(beta, gamma, delta, sigma, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} \\ pos.delta=pos.delta, pos.sigma=pos.sigma, pos.tau=pos.tau, y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} gamma.prior <- dnormv(gamma, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} delta.prior <- dhalfcauchy(delta, 25, log=TRUE) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, gamma, delta, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, tau, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + delta.prior + sigma.prior + \\ \hspace*{0.62 in} tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 0, rep(1,3))} \section{Linear Regression, Multilevel} \label{linear.reg.ml} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_i = \textbf{X} \beta_{\textbf{m}[i],1:J}$$ $$\beta_{g,1:J} \sim \mathcal{N}_J(\gamma, \Omega^{-1}), \quad g=1,\dots,G$$ $$\Omega \sim \mathcal{W}_{J+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$ $$\gamma_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ where $\textbf{m}$ is a vector of length $N$, and each element indicates the multilevel group ($g=1,\dots,G$) for the associated record. \subsection{Data} \code{N <- 30 \\ J <- 2 \#\#\# Number of predictors (including intercept) \\ G <- 2 \#\#\# Number of Multilevel Groups \\ X <- cbind(1, matrix(rnorm(N*(J-1),0,1),N,J-1)) \\ Sigma <- matrix(runif(J*J,-1,1),J,J) \\ diag(Sigma) <- runif(J,1,5) \\ Sigma <- as.positive.definite(Sigma) \\ gamma <- runif(J,-1,1) \\ beta <- matrix(NA,G,J) \\ for (g in 1:G) \{beta[g,] <- rmvn(1, gamma, Sigma)\} \\ m <- rcat(N, rep(1/G,G)) \#\#\# Multilevel group indicator \\ y <- rowSums(beta[m,] * X) + rnorm(N,0,0.1) \\ S <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,G,J), gamma=rep(0,J), \\ \hspace*{0.27 in} sigma=0, U=S), uppertri=c(0,0,0,1)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} U <- rwishartc(Data$J+1, Data$S) \\ \hspace*{0.27 in} gamma <- rnorm(Data$J) \\ \hspace*{0.27 in} beta <- as.vector(rmvnpc(Data$G, gamma, U)) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, gamma, sigma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(G=G, J=J, N=N, PGF=PGF, S=S, X=X, m=m, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$G, Data$J) \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$J+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dmvnpc(beta, gamma, U, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rowSums(beta[Data$m,] * Data$X) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + U.prior + beta.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial.Values} \code{Initial.Values <- c(rep(0,G*J), rep(0,J), 1, \\ \hspace*{0.27 in} upper.triangle(S, diag=TRUE))} \section{Linear Regression with Full Missingness} \label{linear.reg.full.miss} With `full missingness', there are missing values for both the dependent variable (DV) and at least one independent variable (IV). The `full likelihood` approach to full missingness is excellent as long as the model is identifiable. When it is not identifiable, imputation may be done in a previous stage, such as with the \code{MISS} function. In this example, matrix $\alpha$ is for regression effects for IVs, vector $\beta$ is for regression effects for the DV, vector $\gamma$ is for missing values for IVs, and $\delta$ is for missing values for the DV. \subsection{Form} $$\textbf{y}^{imp} \sim \mathcal{N}(\nu, \sigma^2_J)$$ $$\textbf{X}^{imp} \sim \mathcal{N}(\mu, \sigma^2_{-J}$$ $$\nu = \textbf{X}^{imp} \beta$$ $$\mu = \textbf{X}^{imp} \alpha$$ \[\textbf{y}^{imp} = \left\{ \begin{array}{l l} $$\delta$$ & \quad \mbox{if $\textbf{y}^{mis}$}\\ \textbf{y}^{obs} \\ \end{array} \right. \] \[\textbf{X}^{imp} = \left\{ \begin{array}{l l} $$\gamma$$ & \quad \mbox{if $\textbf{X}^{mis}$}\\ \textbf{X}^{obs} \\ \end{array} \right. \] $$\alpha_{j,l} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad l=1,\dots,(J-1)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\gamma_m \sim \mathcal{N}(0, 1000), \quad m=1,\dots,M$$ $$\delta_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,J$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \\ X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \#Design matrix X \\ M <- matrix(round(runif(N*J)-0.45),N,J); M[,1] <- 0 \#Missing indicators \\ X <- ifelse(M == 1, NA, X) \#Simulated X gets missings according to M \\ beta.orig <- runif(J,-2,2) \\ y <- as.vector(tcrossprod(X, t(beta.orig)) + rnorm(N,0,0.1)) \\ y[sample(1:N, round(N*.05))] <- NA \\ m <- ifelse(is.na(y), 1, 0) \#Missing indicator for vector y \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=matrix(0,J-1,J-1), \\ \hspace*{0.27 in} beta=rep(0,J), \\ \hspace*{0.27 in} gamma=rep(0,sum(is.na(X))), \\ \hspace*{0.27 in} delta=rep(0,sum(is.na(y))), \\ \hspace*{0.27 in} sigma=rep(0,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm((Data$J-1)*(Data$J-1)) \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} gamma <- rnorm(sum(is.na(Data$X))) \\ \hspace*{0.27 in} delta <- rnorm(sum(is.na(Data$y)), mean(Data$y, na.rm=TRUE), 1) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, delta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.gamma=pos.gamma, pos.delta=pos.delta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- matrix(parm[Data$pos.alpha], Data$J-1, Data$J-1) \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnormv(delta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- X.imputed <- Data$X \\ \hspace*{0.27 in} X.imputed[which(is.na(X.imputed))] <- gamma \\ \hspace*{0.27 in} y.imputed <- Data$y \\ \hspace*{0.27 in} y.imputed[which(is.na(y.imputed))] <- delta \\ \hspace*{0.27 in} for (j in 2:Data$J) \{mu[,j] <- tcrossprod(X.imputed[,-j], \\ \hspace*{0.62 in} t(alpha[,(j-1)]))\} \\ \hspace*{0.27 in} nu <- tcrossprod(X.imputed, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(X.imputed[,-1], mu[,-1], \\ \hspace*{0.62 in} matrix(sigma[1:(Data$J-1)], Data$N, Data$J-1), log=TRUE), \\ \hspace*{0.62 in} dnorm(y.imputed, nu, sigma[Data$J], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + delta.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(nu), nu, sigma[Data$J]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0, (J-1)\textasciicircum 2), rep(0,J), rep(0, sum(is.na(X))), \\ \hspace*{0.27 in} rep(0, sum(is.na(y))), rep(1,J))} \section{Linear Regression with Missing Response} \label{linear.reg.miss.resp} This is an introductory example to missing values using data augmentation with auxiliary variables. The dependent variable, or response, has both observed values, $\textbf{y}^{obs}$, and missing values, $\textbf{y}^{mis}$. The $\alpha$ vector is for missing value imputation, and enables the use of the full-likelihood by augmenting te state with these auxiliary variables. In the model form, $M$ is used to denote the number of missing values, though it is used as an indicator in the data. \subsection{Form} $$\textbf{y}^{imp} \sim \mathcal{N}(\mu, \sigma^2)$$ \[\textbf{y}^{imp} = \left\{ \begin{array}{l l} $$\alpha$$ & \quad \mbox{if $\textbf{y}^{mis}$}\\ \textbf{y}^{obs} \\ \end{array} \right. \] $$\mu = \textbf{X}\beta$$ $$\alpha_m \sim \mathcal{N}(0, 1000), \quad m=1,\dots,M$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ y[sample(1:N, round(N*0.05))] <- NA \\ M <- ifelse(is.na(y), 1, 0) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,sum(M)), beta=rep(0,J), \\ \hspace*{0.27 in} sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(sum(Data$M), mean(y, na.rm=TRUE), 1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, M=M, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dgamma(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} y.imputed <- Data$y \\ \hspace*{0.27 in} y.imputed[which(is.na(Data$y))] <- alpha \\ \hspace*{0.27 in} LL <- sum(dnorm(y.imputed, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,sum(M)), rep(0,J), 1)} \section{Linear Regression with Missing Response via ABB} \label{linear.reg.miss.resp.abb} The Approximate Bayesian Bootstrap (ABB), using the \code{ABB} function, is used to impute missing values in the dependent variable (DV), or response, given a propensity score. In this example, vector $\alpha$ is used to estimate propensity score $\eta$, while vector $\beta$ is for regression effects, and vector $\gamma$ has the monitored missing values. For more information on ABB, see the \code{ABB} function. \subsection{Form} $$\textbf{y}^{imp} \sim \mathcal{N}(\mu, \sigma^2)$$ \[\textbf{y}^{imp} = \left\{ \begin{array}{l l} $$\gamma$$ & \quad \mbox{if $\textbf{y}^{mis}$}\\ \textbf{y}^{obs} \\ \end{array} \right. \] $$\mu = \textbf{X}\beta$$ $$\gamma \sim p(\textbf{y}^{obs} | \textbf{y}^{obs}, \textbf{y}^{mis}, \eta)$$ $$\eta = \frac{1}{1 + \exp(-\nu)}$$ $$\nu = \textbf{X} \alpha$$ $$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ y[sample(1:N, round(N*0.05))] <- NA \\ M <- ifelse(is.na(y), 1, 0) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP",paste("gamma[",1:sum(is.na(y)),"]",sep="")) \\ parm.names <- as.parm.names(list(alpha=rep(0,J), beta=rep(0,J), sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, M=M, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dgamma(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} y.imputed <- Data$y \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} nu <- as.vector(tcrossprod(Data$X, t(alpha))) \\ \hspace*{0.27 in} eta <- invlogit(nu) \\ \hspace*{0.27 in} breaks <- as.vector(quantile(eta, probs=c(0,0.2,0.4,0.6,0.8,1))) \\ \hspace*{0.27 in} B <- matrix(breaks[-length(breaks)], length(Data$y), 5, byrow=TRUE) \\ \hspace*{0.27 in} z <- rowSums(eta >= B) \\ \hspace*{0.27 in} for (i in 1:5) \{ \\ \hspace*{0.62 in} if(any(is.na(Data$y[which(z == i)]))) \{ \\ \hspace*{0.95 in} imp <- unlist(ABB(Data$y[which(z == i)])) \\ \hspace*{0.95 in} y.imputed[which(\{z == i\} \& is.na(Data$y))] <- imp\}\} \\ \hspace*{0.27 in} gamma <- y.imputed[which(is.na(Data$y))] \\ \hspace*{0.27 in} LL <- sum(dbern(Data$M, eta, log=TRUE), \\ \hspace*{0.62 in} dnorm(y.imputed, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,gamma), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(0,J), 1)} \section{Linear Regression with Power Priors} \label{linear.reg.pp} Power priors \citep{ibrahim00} are a class of informative priors when relevant historical data is available. Power priors may be used when it is desirable to take historical data into account while analyzing similar, current data. Both the current data, $\textbf{y}$ and $\textbf{X}$, and historical data, $\textbf{y}_h$ and $\textbf{X}_h$, are included in the power prior analysis, where $h$ indicates historical data. Each data set receives its own likelihood function, though the likelihood of the historical data is raised to an exponential power, $\alpha \in [0,1]$. In this example, $\alpha$ is a constant. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\textbf{y}_h \sim \mathcal{N}(\mu_h, \sigma^2)^\alpha$$ $$\mu = \textbf{X}\beta$$ $$\mu_h = \textbf{X}_h\beta$$ $$\alpha = 0.5$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \#Number of predictors, including the intercept \\ X <- Xh <- matrix(1,N,J) \\ for (j in 2:J) \{ \\ \hspace*{0.27 in} X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1)) \\ \hspace*{0.27 in} Xh[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta.orig <- runif(J,-3,3) \\ e <- rnorm(N,0,0.1) \\ yh <- as.vector(tcrossprod(beta.orig, Xh) + e) \\ y <- as.vector(tcrossprod(beta.orig, X) + e) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(alpha=0.5, J=J, PGF=PGF, X=X, Xh=Xh, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y, \\ \hspace*{0.27 in} yh=yh) \\ } \\ \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} muh <- tcrossprod(Data$Xh, t(beta)) \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(Data$alpha*dnorm(Data$yh, muh, sigma, log=TRUE) + \\ \hspace*{0.62 in} dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Linear Regression with Zellner's g-Prior} \label{linear.reg.g} For more information on Zellner's g-prior, see the documentation for the \code{dzellner} function. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta \sim \mathcal{N}_J(0, g \sigma^2 (\textbf{X}^T \textbf{X})^{-1})$$ $$g \sim \mathcal{HG}(\alpha), \quad \alpha = 3$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), g0=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.g <- grep("g0", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} g0 <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, g0, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.g=pos.g, \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.g] <- g <- interval(parm[Data$pos.g], 1e-100, Inf) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} g.prior <- dhyperg(g, alpha=3, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- dzellner(beta, g, sigma, Data$X, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + g.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(1,J), rep(1,2))} \section{LSTAR} \label{lstar} This is a Logistic Smooth-Threshold Autoregression (LSTAR), and is specified with a transition function that includes $\gamma$ as the shape parameter, $\textbf{y}$ as the transition variable, $\theta$ as the location parameter, and $d$ as the delay parameter. \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$ $$\mu_t = \pi_t (\alpha_1 + \phi_1 \textbf{y}_{t-1}) + (1 - \pi_t) (\alpha_2 + \phi_2 \textbf{y}_{t-1}), \quad t=2,\dots,T$$ $$\pi_t = \frac{1}{1 + \exp(-(\gamma (\textbf{y}_{t-d} - \theta)))}$$ $$\alpha_j \sim \mathcal{N}(0, 1000) \in [\textbf{y}_{min}, \textbf{y}_{max}], \quad j=1,\dots,2$$ $$\frac{\phi_j+1}{2} \sim \mathcal{BETA}(1, 1), \quad j=1,\dots,2$$ $$\gamma \sim \mathcal{HC}(25)$$ $$\theta \sim \mathcal{U}(\textbf{y}_{min}, \textbf{y}_{max})$$ $$\pi_1 \sim \mathcal{U}(0.001, 0.999)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector((log(as.matrix(demonfx[,1])))) \\ T <- length(y) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,2), phi=rep(0,2), gamma=0, \\ \hspace*{0.27 in} theta=0, pi=0, sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ pos.pi <- grep("pi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- runif(2,min(Data$y),max(Data$y)) \\ \hspace*{0.27 in} phi <- runif(2, -1, 1) \\ \hspace*{0.27 in} gamma <- runif(1) \\ \hspace*{0.27 in} theta <- runif(1,min(Data$y),max(Data$y)) \\ \hspace*{0.27 in} pi <- runif(1, 0.001, 0.999) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, phi, gamma, theta, pi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.phi=pos.phi, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.theta=pos.theta, pos.pi=pos.pi, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], min(Data$y), max(Data$y)) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], min(Data$y), max(Data$y)) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} parm[Data$pos.pi] <- pi <- interval(parm[Data$pos.pi], 0.001, 0.999) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dbeta((phi+1)/2, 1, 1, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- dhalfcauchy(gamma, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- dunif(theta, min(Data$y), max(Data$y), log=TRUE) \\ \hspace*{0.27 in} pi.prior <- dunif(pi, 0.001, 0.999, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} pi <- c(pi, 1 / (1 + exp(-(gamma*(Data$y[-Data$T]-theta))))) \\ \hspace*{0.27 in} mu <- pi * c(alpha[1], alpha[1] + phi[1]*Data$y[-Data$T]) + \\ \hspace*{0.62 in} (1-pi) * c(alpha[2], alpha[2] + phi[2]*Data$y[-Data$T]) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], mu[-1], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + gamma.prior + theta.prior + \\ \hspace*{0.62 in} pi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(mean(y),2), rep(0.5,2), 1, mean(y), 0.5, 1)} \section{MANCOVA} \label{mancova} Since this is a multivariate extension of ANCOVA, please see the ANCOVA example in section \ref{ancova} for a univariate introduction. \subsection{Form} $$\textbf{Y}_{i,1:J} \sim \mathcal{N}_K(\mu_{i,1:J}, \Sigma), \quad i=1,\dots,N$$ $$\mu_{i,k} = \alpha_k + \beta_{k,\textbf{X}[i,1]} + \gamma_{k,\textbf{X}[i,1]} + \textbf{X}_{1:N,3:(C+J)} \delta_{k,1:C}$$ $$\epsilon_{i,k} = \textbf{Y}_{i,k} - \mu_{i,k}$$ $$\alpha_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\beta_{k,l} \sim \mathcal{N}(0, \sigma^2_1), \quad l=1,\dots,(L-1)$$ $$\beta_{1:K,L} = - \sum^{L-1}_{l=1} \beta_{1:K,l}$$ $$\gamma_{k,m} \sim \mathcal{N}(0, \sigma^2_2), \quad m=1,\dots,(M-1)$$ $$\gamma_{1:K,M} = - \sum^{M-1}_{m=1} \beta_{1:K,m}$$ $$\delta_{k,c} \sim \mathcal{N}(0, 1000)$$ $$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$ $$\Sigma = \Omega^{-1}$$ $$\sigma_{1:J} \sim \mathcal{HC}(25)$$ \subsection{Data} \code{C <- 2 \#Number of covariates \\ J <- 2 \#Number of factors (treatments) \\ K <- 3 \#Number of endogenous (dependent) variables \\ L <- 4 \#Number of levels in factor (treatment) 1 \\ M <- 5 \#Number of levels in factor (treatment) 2 \\ N <- 100 \\ X <- matrix(c(rcat(N, rep(1/L,L)), rcat(N, rep(1/M,M)), \\ \hspace*{0.27 in} runif(N*C,0,1)), N, J + C) \\ alpha <- runif(K,-1,1) \\ beta <- matrix(runif(K*L,-2,2), K, L) \\ beta[,L] <- -rowSums(beta[,-L]) \\ gamma <- matrix(runif(K*M,-2,2), K, M) \\ gamma[,M] <- -rowSums(gamma[,-M]) \\ delta <- matrix(runif(K*C), K, C) \\ Y <- matrix(NA,N,K) \\ for (k in 1:K) \{ \\ \hspace*{0.27 in} Y[,k] <- alpha[k] + beta[k,X[,1]] + gamma[k,X[,2]] + \\ \hspace*{0.27 in} tcrossprod(delta[k,], X[,-c(1,2)]) + rnorm(1,0,0.1)\} \\ S <- diag(K) \\ mon.names <- c("LP", "s.o.beta", "s.o.gamma", "s.o.epsilon", \\ \hspace*{0.27 in} as.parm.names(list(s.beta=rep(0,K), s.gamma=rep(0,K), \\ \hspace*{0.27 in} s.epsilon=rep(0,K)))) \\ parm.names <- as.parm.names(list(alpha=rep(0,K), beta=matrix(0,K,(L-1)), \\ \hspace*{0.27 in} gamma=matrix(0,K,(M-1)), delta=matrix(0,K,C), U=diag(K), \\ \hspace*{0.27 in} sigma=rep(0,2)), uppertri=c(0,0,0,0,1,0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$K) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} beta <- rnorm(Data$K*(Data$L-1), 0, sigma[1]) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K*(Data$M-1), 0, sigma[2]) \\ \hspace*{0.27 in} delta <- rnorm(Data$K*Data$C) \\ \hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, delta, U[upper.tri(U, diag=TRUE)], \\ \hspace*{0.62 in} sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(C=C, J=J, K=K, L=L, M=M, N=N, PGF=PGF, S=S, X=X, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.gamma=pos.gamma, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- matrix(c(parm[Data$pos.beta], rep(0,Data$K)), Data$K, Data$L) \\ \hspace*{0.27 in} beta[,Data$L] <- -rowSums(beta[,-Data$L]) \\ \hspace*{0.27 in} gamma <- matrix(c(parm[Data$[pos.gamma], \\ \hspace*{0.62 in} rep(0,Data$K)), Data$K, Data$M) \\ \hspace*{0.27 in} gamma[,Data$M] <- -rowSums(gamma[,-Data$M]) \\ \hspace*{0.27 in} delta <- matrix(parm[Data$pos.delta], Data$K, Data$C) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnormv(delta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$K+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0,Data$N,Data$K) \\ \hspace*{0.27 in} for (k in 1:Data$K) \{ \\ \hspace*{0.62 in} mu[,k] <- alpha[k] + beta[k,Data$X[,1]] + gamma[k,Data$X[,2]] + \\ \hspace*{0.62 in} tcrossprod(Data$X[,-c(1,2)], t(delta[k,]))\} \\ \hspace*{0.27 in} LL <- sum(dmvnpc(Data$Y, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Variance Components, Omnibus \\ \hspace*{0.27 in} s.o.beta <- sd(as.vector(beta)) \\ \hspace*{0.27 in} s.o.gamma <- sd(as.vector(gamma)) \\ \hspace*{0.27 in} s.o.epsilon <- sd(as.vector(Data$Y - mu)) \\ \hspace*{0.27 in} \#\#\# Variance Components, Univariate \\ \hspace*{0.27 in} s.beta <- sqrt(.rowVars(beta)) \\ \hspace*{0.27 in} s.gamma <- sqrt(.rowVars(gamma)) \\ \hspace*{0.27 in} s.epsilon <- sqrt(.colVars(Data$Y - mu)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + delta.prior + \\ \hspace*{0.62 in} U.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, s.o.beta, s.o.gamma, \\ \hspace*{0.62 in} s.o.epsilon, s.beta, s.gamma, s.epsilon), \\ \hspace*{0.62 in} yhat=rmvnpc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), rep(0,K*(L-1)), rep(0,K*(M-1)), \\ \hspace*{0.27 in} rep(0,C*K), upper.triangle(S, diag=TRUE), rep(1,2))} \section{MANOVA} \label{manova} Since this is a multivariate extension of ANOVA, please see the two-way ANOVA example in section \ref{anova.two.way} for a univariate introduction. \subsection{Form} $$\textbf{Y}_{i,1:J} \sim \mathcal{N}_K(\mu_{i,1:J}, \Omega^{-1}), \quad i=1,\dots,N$$ $$\mu_{i,k} = \alpha_k + \beta_{k,\textbf{X}[i,1]} + \gamma_{k,\textbf{X}[i,1]}$$ $$\epsilon_{i,k} = \textbf{Y}_{i,k} - \mu_{i,k}$$ $$\alpha_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\beta_{k,l} \sim \mathcal{N}(0, \sigma^2_1), \quad l=1,\dots,(L-1)$$ $$\beta_{1:K,L} = - \sum^{L-1}_{l=1} \beta_{1:K,l}$$ $$\gamma_{k,m} \sim \mathcal{N}(0, \sigma^2_2), \quad m=1,\dots,(M-1)$$ $$\gamma_{1:K,M} = - \sum^{M-1}_{m=1} \beta_{1:K,m}$$ $$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$ $$\sigma_{1:J} \sim \mathcal{HC}(25)$$ \subsection{Data} \code{J <- 2 \#Number of factors (treatments) \\ K <- 3 \#Number of endogenous (dependent) variables \\ L <- 4 \#Number of levels in factor (treatment) 1 \\ M <- 5 \#Number of levels in factor (treatment) 2 \\ N <- 100 \\ X <- cbind(rcat(N, rep(1/L,L)), rcat(N, rep(1/M,M))) \\ alpha <- runif(K,-1,1) \\ beta <- matrix(runif(K*L,-2,2), K, L) \\ beta[,L] <- -rowSums(beta[,-L]) \\ gamma <- matrix(runif(K*M,-2,2), K, M) \\ gamma[,M] <- -rowSums(gamma[,-M]) \\ Y <- matrix(NA,N,K) \\ for (k in 1:K) \{ \\ \hspace*{0.27 in} Y[,k] <- alpha[k] + beta[k,X[,1]] + gamma[k,X[,2]] + rnorm(1,0,0.1)\} \\ S <- diag(K) \\ mon.names <- c("LP", "s.o.beta", "s.o.gamma", "s.o.epsilon", \\ \hspace*{0.27 in} as.parm.names(list(s.beta=rep(0,K), s.gamma=rep(0,K), \\ \hspace*{0.27 in} s.epsilon=rep(0,K)))) \\ parm.names <- as.parm.names(list(alpha=rep(0,K), beta=matrix(0,K,(L-1)), \\ \hspace*{0.27 in} gamma=matrix(0,K,(M-1)), U=diag(K), sigma=rep(0,2)), \\ \hspace*{0.27 in} uppertri=c(0,0,0,1,0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$K) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} beta <- rnorm(Data$K*(Data$L-1), 0, sigma[1]) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K*(Data$M-1), 0, sigma[2]) \\ \hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, U[upper.tri(U, diag=TRUE)], sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, L=L, M=M, N=N, PGF=PGF, S=S, X=X, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.gamma=pos.gamma, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- matrix(c(parm[Data$pos.beta], rep(0,Data$K)), \\ \hspace*{0.27 in} beta[,Data$L] <- -rowSums(beta[,-Data$L]) \\ \hspace*{0.27 in} gamma <- matrix(c(parm[Data$pos.gamma], \\ \hspace*{0.62 in} rep(0,Data$K)), Data$K, Data$M) \\ \hspace*{0.27 in} gamma[,Data$M] <- -rowSums(gamma[,-Data$M]) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$K+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0,Data$N,Data$K) \\ \hspace*{0.27 in} for (k in 1:Data$K) \{ \\ \hspace*{0.62 in} mu[,k] <- alpha[k] + beta[k,Data$X[,1]] + gamma[k,Data$X[,2]]\} \\ \hspace*{0.27 in} LL <- sum(dmvnpc(Data$Y, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Variance Components, Omnibus \\ \hspace*{0.27 in} s.o.beta <- sd(as.vector(beta)) \\ \hspace*{0.27 in} s.o.gamma <- sd(as.vector(gamma)) \\ \hspace*{0.27 in} s.o.epsilon <- sd(as.vector(Data$Y - mu)) \\ \hspace*{0.27 in} \#\#\# Variance Components, Univariate \\ \hspace*{0.27 in} s.beta <- sqrt(.rowVars(beta)) \\ \hspace*{0.27 in} s.gamma <- sqrt(.rowVars(gamma)) \\ \hspace*{0.27 in} s.epsilon <- sqrt(.colVars(Data$Y - mu)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + U.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, s.o.beta, s.o.gamma, \\ \hspace*{0.62 in} s.o.epsilon, s.beta, s.gamma, s.epsilon), \\ \hspace*{0.62 in} yhat=rmvnpc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), rep(0,K*(L-1)), rep(0,K*(M-1)), \\ \hspace*{0.27 in} upper.triangle(S, diag=TRUE), rep(1,2))} \section{Mixed Logit} \label{mixed.logit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N$$ $$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}$$ $$\phi = \exp(\mu)$$ $$\mu_{i,j} = \beta_{j,1:K,i} \textbf{X}_{i,1:K} \in [-700,700], \quad i=1,\dots,N, \quad j=1,\dots,(J-1)$$ $$\mu_{i,J} = 0$$ $$\beta_{j,k,i} \sim \mathcal{N}(\zeta^\mu_{j,k}, \zeta^\sigma2_{j,k}), \quad i=1,\dots,N, \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\zeta^\mu_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\zeta^\sigma_{j,k} \sim \mathcal{HC}{25}), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ S <- diag(J-1) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=array(0, dim=c(J-1,K,N)), \\ \hspace*{0.27 in} zeta.mu=matrix(0,J-1,K), zeta.sigma=matrix(0,J-1,K))) \\ pos.beta <- grep("beta", parm.names) \\ pos.zeta.mu <- grep("zeta.mu", parm.names) \\ pos.zeta.sigma <- grep("zeta.sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} zeta.mu <- matrix(rnorm((Data$J-1)*Data$K), Data$J-1, Data$K) \\ \hspace*{0.27 in} zeta.sigma <- matrix(runif((Data$J-1)*Data$K), Data$J-1, Data$K) \\ \hspace*{0.27 in} beta <- array(rnorm((Data$J-1)*Data$K*Data$N), \\ \hspace*{0.62 in} dim=c( Data$J-1, Data$K, Data$N)) \\ \hspace*{0.27 in} return(c(beta, as.vector(zeta.mu), as.vector(zeta.sigma))) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.zeta.mu=pos.zeta.mu, \\ \hspace*{0.27 in} pos.zeta.sigma=pos.zeta.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- array(parm[Data$pos.beta], dim=c(Data$J-1, Data$K, Data$N)) \\ \hspace*{0.27 in} zeta.mu <- matrix(parm[Data$pos.zeta.mu], Data$J-1, Data$K) \\ \hspace*{0.27 in} zeta.sigma <- matrix(interval(parm[Data$pos.zeta.sigma], 1e-100, Inf), \\ \hspace*{0.62 in} Data$J-1, Data$K) \\ \hspace*{0.27 in} parm[Data$pos.zeta.sigma] <- as.vector(zeta.sigma) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} zeta.mu.prior <- sum(dnormv(zeta.mu, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.sigma.prior <- sum(dhalfcauchy(zeta.sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, zeta.mu, zeta.sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0, Data$N, Data$J) \\ \hspace*{0.27 in} for (j in 1:(Data$J-1)) mu[,j] <- rowSums(Data$X * t(beta[j, , ])) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} phi <- exp(mu) \\ \hspace*{0.27 in} p <- phi / rowSums(phi) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.mu.prior + zeta.sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,(J-1)*K*N), rep(0,(J-1)*K), rep(1,(J-1)*K))} \section{Mixture Model, Finite} \label{fmm} This finite mixture model (FMM) imposes a multilevel structure on each of the $J$ regression effects in $\beta$, so that mixture components share a common residual standard deviation, $\nu_m$. Identifiability is gained at the expense of some shrinkage. The record-level mixture membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_i = \textbf{X}_{i,1:J}\beta_{\theta[i],1:J}, \quad i=1,\dots,N$$ $$\theta_i \sim \mathcal{CAT}(\pi_{1:M}), \quad i=1,\dots,N$$ $$\beta_{m,j} \sim \mathcal{N}(0, \nu^2_m), \quad j=1,\dots,J, \quad m=2,\dots,M$$ $$\beta_{1,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\nu_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\pi_{1:M} \sim \mathcal{D}(\alpha_{1:M})$$ $$\alpha_m = 1$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ M <- 2 \#Number of mixtures \\ N <- length(y) \#Number of records \\ J <- ncol(X) \#Number of predictors, including the intercept \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ alpha <- rep(1,M) \#Prior probability of mixing probabilities \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(theta=rep(0,N), beta=matrix(0,M,J), \\ \hspace*{0.27 in} nu=rep(0,M), sigma=0)) \\ pos.theta <- grep("theta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} theta <- rcat(Data$N, rep(1/Data$M, Data$M)) \\ \hspace*{0.27 in} nu <- runif(Data$M) \\ \hspace*{0.27 in} beta <- rnormv(Data$M*Data$J, 0, \\ \hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1))) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(theta, beta, nu, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, M=M, N=N, PGF=PGF, X=X, alpha=alpha, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.theta=pos.theta, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.nu=pos.nu, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$M, Data$J) \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} pi <- rep(0, Data$M) \\ \hspace*{0.27 in} tab <- table(theta) \\ \hspace*{0.27 in} pi[as.numeric(names(tab))] <- as.vector(tab) \\ \hspace*{0.27 in} pi <- pi / sum(pi) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, \\ \hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1)), log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, p=pi, log=TRUE)) \\ \hspace*{0.27 in} pi.prior <- ddirichlet(pi, Data$alpha, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rowSums(beta[theta,] * Data$X) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + theta.prior + pi.prior + nu.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rcat(N,rep(1/M,M)), rep(0,M*J), rep(1,M), 1)} \section{Mixture Model, Infinite} \label{imm} This infinite mixture model (IMM) uses a Dirichlet process via truncated stick-breaking. The record-level mixture membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_i = \textbf{X}_{i,1:J}\beta_{\theta[i],1:J}, \quad i=1,\dots,N$$ $$\theta_i \sim \mathcal{CAT}(\pi_{1:M}), \quad i=1,\dots,N$$ $$\beta_{m,j} \sim \mathcal{N}(0, \nu^2_m), \quad j=1,\dots,J, \quad m=2,\dots,M$$ $$\beta_{1,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\nu_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\pi = \mathrm{Stick}(\delta)$$ $$\delta_m \sim \mathcal{BETA}(1, \gamma), m=1,\dots,(M-1)$$ $$\gamma \sim \mathcal{G}(\alpha, \iota)$$ $$\alpha \sim \mathcal{HC}(25)$$ $$\iota \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ M <- 3 \#Maximum number of mixtures to explore \\ N <- length(y) \#Number of records \\ J <- ncol(X) \#Number of predictors, including the intercept \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP", as.parm.names(list(pi=rep(0,M)))) \\ parm.names <- as.parm.names(list(theta=rep(0,N), delta=rep(0,M-1), \\ \hspace*{0.27 in} beta=matrix(0,M,J), nu=rep(0,M), sigma=0, alpha=0, iota=0, gamma=0)) \\ pos.theta <- grep("theta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.iota <- grep("iota", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} nu <- runif(Data$M) \\ \hspace*{0.27 in} beta <- rnormv(Data$M*Data$J, 0, \\ \hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1))) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} alpha <- runif(1) \\ \hspace*{0.27 in} iota <- runif(1) \\ \hspace*{0.27 in} gamma <- rgamma(1, alpha, iota) \\ \hspace*{0.27 in} delta <- rev(sort(rbeta(Data$M-1, 1, gamma))) \\ \hspace*{0.27 in} theta <- rcat(Data$N, Stick(delta)) \\ \hspace*{0.27 in} return(c(theta, delta, beta, nu, sigma, alpha, iota, gamma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, M=M, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.theta=pos.theta, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.nu=pos.nu, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.iota=pos.iota, pos.gamma=pos.gamma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperhyperparameters \\ \hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\ \hspace*{0.27 in} iota <- interval(parm[Data$pos.iota], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.iota] <- iota \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-10, 1-1e-10) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$M, Data$J) \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} pi <- Stick(delta) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperhyperprior \\ \hspace*{0.27 in} alpha.prior <- dhalfcauchy(alpha, 25, log=TRUE) \\ \hspace*{0.27 in} iota.prior <- dhalfcauchy(iota, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} delta.prior <- dStick(delta, gamma, log=TRUE) \\ \hspace*{0.27 in} gamma.prior <- dgamma(gamma, alpha, iota, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, \\ \hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1)), log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- sum(dcat(theta, pi, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rowSums(beta[theta,]*Data$X) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + delta.prior + theta.prior + nu.prior + \\ \hspace*{0.62 in} sigma.prior + alpha.prior + iota.prior + gamma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,pi), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rcat(N, rev(sort(rStick(M-1,1)))), rep(0.5,M-1), \\ \hspace*{0.27 in} rep(0,M*J), rep(1,M), rep(1,4))} \section{Multinomial Logit} \label{mnl} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N$$ $$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}, \quad \sum^J_{j=1} \textbf{p}_{i,j} = 1$$ $$\phi = \exp(\mu)$$ $$\mu_{i,J} = 0, \quad i=1,\dots,N$$ $$\mu_{i,j} = \textbf{X}_{i,1:K} \beta_{j,1:K} \in [-700,700], \quad j=1,\dots,(J-1)$$ $$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,J-1,K))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm, Data$J-1, Data$K) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0, Data$N, Data$J) \\ \hspace*{0.27 in} mu[,-Data$J] <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} phi <- exp(mu) \\ \hspace*{0.27 in} p <- phi / rowSums(phi) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,(J-1)*K))} \section{Multinomial Logit, Nested} \label{nmnl} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(\textbf{P}_{i,1:J}), \quad i=1,\dots,N$$ $$\textbf{P}_{1:N,1} = \frac{\textbf{R}}{\textbf{R} + \exp(\alpha \textbf{I})}$$ $$\textbf{P}_{1:N,2} = \frac{(1 - \textbf{P}_{1:N,1}) \textbf{S}_{1:N,1}}{\textbf{V}}$$ $$\textbf{P}_{1:N,3} = \frac{(1 - \textbf{P}_{1:N,1}) \textbf{S}_{1:N,2}}{\textbf{V}}$$ $$\textbf{R}_{1:N} = \exp(\mu_{1:N,1})$$ $$\textbf{S}_{1:N,1:2} = \exp(\mu_{1:N,2:3})$$ $$\textbf{I} = \log(\textbf{V})$$ $$\textbf{V}_i = \displaystyle\sum^K_{k=1} \textbf{S}_{i,k}, \quad i=1,\dots,N$$ $$\mu_{1:N,1} = \textbf{X} \iota \in [-700,700]$$ $$\mu_{1:N,2} = \textbf{X} \beta_{2,1:K} \in [-700,700]$$ $$\iota = \alpha \beta_{1,1:K}$$ $$\alpha \sim \mathcal{EXP}(1) \in [0,2]$$ $$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1) \quad k=1,\dots,K$$ where there are $J=3$ categories of $\textbf{y}$, $K=3$ predictors, $\textbf{R}$ is the non-nested alternative, $\textbf{S}$ is the nested alternative, $\textbf{V}$ is the observed utility in the nest, $\alpha$ is effectively 1 - correlation and has a truncated exponential distribution, and $\iota$ is a vector of regression effects for the isolated alternative after $\alpha$ is taken into account. The third alternative is the reference category. \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ mon.names <- c("LP", as.parm.names(list(iota=rep(0,K)))) \\ parm.names <- as.parm.names(list(alpha=0, beta=matrix(0,J-1,K))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rtrunc(1, "exp", a=0, b=2, rate=1) \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} return(c(alpha, beta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, y=y) } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} alpha.rate <- 1 \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha],0,2) \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dtrunc(alpha, "exp", a=0, b=2, rate=alpha.rate, \\ \hspace*{0.62 in} log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- P <- matrix(0, Data$N, Data$J) \\ \hspace*{0.27 in} iota <- alpha * beta[1,] \\ \hspace*{0.27 in} mu[,1] <- tcrossprod(Data$X, t(iota)) \\ \hspace*{0.27 in} mu[,2] <- tcrossprod(Data$X, t(beta[2,])) \\ \hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\ \hspace*{0.27 in} R <- exp(mu[,1]) \\ \hspace*{0.27 in} S <- exp(mu[,-1]) \\ \hspace*{0.27 in} V <- rowSums(S) \\ \hspace*{0.27 in} I <- log(V) \\ \hspace*{0.27 in} P[,1] <- R / (R + exp(alpha*I)) \\ \hspace*{0.27 in} P[,2] <- (1 - P[,1]) * S[,1] / V \\ \hspace*{0.27 in} P[,3] <- (1 - P[,1]) * S[,2] / V \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, P, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,iota), \\ \hspace*{0.62 in} yhat=rcat(nrow(P), P), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0.5, rep(0.1,(J-1)*K))} \section{Multinomial Probit} \label{mnp} \subsection{Form} $$\textbf{W}_{i,1:(J-1)} \sim \mathcal{N}_{J-1}(\mu_{i,1:(J-1)}, \Sigma), \quad i=1,\dots,N$$ \[\textbf{W}_{i,j} \in \left\{ \begin{array}{l l} $[0,10]$ & \quad \mbox{if $\textbf{y}_i = j$}\\ $[-10,0]$ \\ \end{array} \right. \] $$\mu_{1:N,j} = \textbf{X} \beta_{j,1:K}$$ $$\Sigma = \textbf{U}^T \textbf{U}$$ $$\beta_{j,k} \sim \mathcal{N}(0, 10), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\textbf{U}_{j,k} \sim \mathcal{N}(0,1), \quad j=1,\dots,(J-1), \quad k=1,\dots,(J-1), \quad j \ge k, \quad j \ne k = 1$$ \subsection{Data} \code{data(demonchoice) \\ y <- as.numeric(demonchoice[,1]) \\ X <- cbind(1, as.matrix(demonchoice[,2:3])) \\ for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\ N <- length(y) \\ J <- length(unique(y)) \#Number of categories in y \\ K <- ncol(X) \#Number of predictors (including the intercept) \\ S <- diag(J-1) \\ U <- matrix(NA,J-1,J-1) \\ U[upper.tri(U, diag=TRUE)] <- 0 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,(J-1),K), \\ \hspace*{0.27 in} U=U, W=matrix(0,N,J-1))) \\ parm.names <- parm.names[-which(parm.names == "U[1,1]")] \\ pos.beta <- grep("beta", parm.names) \\ pos.U <- grep("U", parm.names) \\ pos.W <- grep("W", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\ \hspace*{0.27 in} U <- rnorm((Data$J-2) + (factorial(Data$J-1) / \\ \hspace*{0.62 in} (factorial(Data$J-1-2)*factorial(2)))) \\ \hspace*{0.27 in} W <- matrix(runif(Data$N*(Data$J-1),-10,0), Data$N, Data$J-1) \\ \hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\ \hspace*{0.27 in} W <- ifelse(Y[,-Data$J] == 1, abs(W), W) \\ \hspace*{0.27 in} return(c(beta, U, as.vector(W)))\} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.U=pos.U, pos.W=pos.W, \\ \hspace*{0.27 in} y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\ \hspace*{0.27 in} u <- c(0, parm[Data$pos.U]) \\ \hspace*{0.27 in} U <- diag(Data$J-1) \\ \hspace*{0.27 in} U[upper.tri(U, diag=TRUE)] <- u \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} Sigma <- t(U) \%*\% U \\ \hspace*{0.27 in} Sigma[1,] <- Sigma[,1] <- U[1,] \\ \hspace*{0.27 in} W <- matrix(parm[Data$pos.W], Data$N, Data$J-1) \\ \hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\ \hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 1) \\ \hspace*{0.27 in} W[temp] <- interval(W[temp], 0, 10) \\ \hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 0) \\ \hspace*{0.27 in} W[temp] <- interval(W[temp], -10, 0) \\ \hspace*{0.27 in} parm[Data$pos.W] <- as.vector(W) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 10, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- sum(dnorm(u[-1], 0, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} \#eta <- exp(cbind(mu,0)) \\ \hspace*{0.27 in} \#p <- eta / rowSums(eta) \\ \hspace*{0.27 in} LL <- sum(dmvn(W, mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=max.col(cbind(rmvn(nrow(mu), mu, Sigma),0)), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)} \section{Multiple Discrete-Continuous Choice} \label{mdcc} This form of a multivariate discrete-continuous choice model was introduced in \citet{kim02} and referred to as a variety model. The original version is presented with log-normally distributed errors, but a gamma regression form is used here instead, which has always mixed better in testing. Note that the $\gamma$ parameters are fixed here, as recommended for identifiability in future articles by these authors. \subsection{Form} $$\textbf{Y} \sim \mathcal{G}(\lambda\tau, \tau)$$ $$\lambda_{i,j} = \exp(\textbf{Z}_{i,j}\log(\psi1_{m[i],j}) + \textbf{X1}_{i,1:K}\log(\beta) + \textbf{X2}_{i,1:L}\log(\delta))(\textbf{Y}_{i,j} + \gamma_j)^\alpha_j), \quad i=1,\dots,N, j=1,\dots,J$$ $$\alpha_j \sim \mathcal{U}(0,1), \quad j=1,\dots,J$$ $$\log(\beta_k) \sim \mathcal{N}(0,1000), \quad k=1,\dots,K$$ $$\gamma_j = 1, \quad j=1,\dots,J$$ $$\log(\delta_{j,l}) \sim \mathcal{N}(0,1000), \quad j=1,\dots,(J-1), \quad l=1,\dots,L$$ $$\log(\psi0_j) \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\log(\psi1_{g,j}) \sim \mathcal{N}_{J}(\log(\psi0), \Omega^{-1}), \quad g=1,\dots,G, \quad j1=,\dots,J$$ $$\Omega \sim \mathcal{W}_{J+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$ $$\tau_j \sim \mathcal{HC}(25), \quad j=1,\dots,J$$ \subsection{Data} \code{G <- 6 \#Number of Multilevel Groups (decision-makers, households, etc.) \\ J <- 3 \#Number of products \\ K <- 4 \#Number of product attributes \\ L <- 5 \#Number of decision-maker attributes \\ N <- 30 \#Number of records \\ X1 <- matrix(rnorm(N*K), N, K) \#Product attributes \\ X2 <- matrix(rnorm(N*L), N, L) \#Decision-maker attributes \\ Sigma <- matrix(runif((J-1)*(J-1),-1,1),J-1,J-1) \\ diag(Sigma) <- runif(J-1,1,5) \\ Sigma <- as.positive.definite(Sigma) / 100 \\ alpha <- runif(J) \\ log.beta <- rnorm(K,0,0.1) \\ log.delta <- matrix(rnorm((J-1)*L,0,0.1), J-1, L) \\ log.psi0 <- rnorm(J) \\ log.psi1 <- rmvn(G, log.psi0, Sigma) \\ m <- rcat(N, rep(1/G,G)) \# Multilevel group indicator \\ Z <- as.indicator.matrix(m) \\ Y <- matrix(0, N, J) \\ Y <- round(exp(tcrossprod(Z, t(cbind(log.psi1,0))) + \\ \hspace*{0.27 in} matrix(tcrossprod(X1, t(log.beta)), N, J) + \\ \hspace*{0.27 in} tcrossprod(X2, rbind(log.delta, colSums(log.delta)*-1))) * \\ \hspace*{0.27 in} (Y + 1)\textasciicircum matrix(alpha,N,J,byrow=TRUE) + \\ \hspace*{0.27 in} matrix(rnorm(N*J,0,0.1),N,J)) \\ S <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), log.beta=rep(0,K), \\ \hspace*{0.27 in} log.delta=matrix(0,J-1,L), log.psi0=rep(0,J), \\ \hspace*{0.27 in} log.psi1=matrix(0,G,J), tau=rep(0,J), U=S), \\ \hspace*{0.27 in} uppertri=c(0,0,0,0,0,0,1)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.log.beta <- grep("log.beta", parm.names) \\ pos.log.delta <- grep("delta", parm.names) \\ pos.log.psi0 <- grep("log.psi0", parm.names) \\ pos.log.psi1 <- grep("log.psi1", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- runif(Data$J,0.9,1) \\ \hspace*{0.27 in} log.beta <- rnorm(Data$K,0,0.1) \\ \hspace*{0.27 in} log.delta <- rnorm((Data$J-1)*Data$L,0,0.1) \\ \hspace*{0.27 in} log.psi0 <- rnorm(Data$J) \\ \hspace*{0.27 in} U <- rwishartc(Data$J+1, Data$S) \\ \hspace*{0.27 in} log.psi1 <- as.vector(rmvnpc(Data$G, log.psi0, U)) \\ \hspace*{0.27 in} tau <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, log.beta, log.delta, log.psi0, log.psi1, tau, \\ \hspace*{0.62 in} U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(G=G, J=J, K=K, L=L, N=N, PGF=PGF, S=S, X1=X1, X2=X2, Y=Y, \\ \hspace*{0.27 in} Z=Z, m=m, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.log.beta=pos.log.beta, \\ \hspace*{0.27 in} pos.log.delta=pos.log.delta, pos.log.psi0=pos.log.psi0, \\ \hspace*{0.27 in} pos.log.psi1=pos.log.psi1, pos.tau=pos.tau) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha], 0, 1) \\ \hspace*{0.27 in} log.beta <- parm[Data$pos.log.beta] \\ \hspace*{0.27 in} log.delta <- matrix(parm[Data$pos.log.delta], Data$J-1, Data$L) \\ \hspace*{0.27 in} log.psi0 <- parm[Data$pos.log.psi0] \\ \hspace*{0.27 in} log.psi1 <- matrix(parm[Data$pos.log.psi1], Data$G, Data$J) \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} lambda <- tcrossprod(Data$Z, t(log.psi1)) + \\ \hspace*{0.62 in} matrix(tcrossprod(Data$X1, t(log.beta)), Data$N, Data$J) + \\ \hspace*{0.62 in} tcrossprod(Data$X2, rbind(log.delta, colSums(log.delta)*-1)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$J+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} alpha.prior <- sum(dunif(alpha, 0, 1, log=TRUE)) \\ \hspace*{0.27 in} log.beta.prior <- sum(dnormv(log.beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} log.delta.prior <- sum(dnormv(log.delta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} log.psi0.prior <- sum(dnormv(log.psi0, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} log.psi1.prior <- sum(dmvnpc(lambda, \\ \hspace*{0.62 in} matrix(log.psi0, Data$N, Data$J, byrow=TRUE), U, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- sum(dhalfcauchy(tau, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} alpha <- matrix(alpha, Data$N, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} lambda <- exp(lambda)*(Data$Y + 1)\textasciicircum alpha \\ \hspace*{0.27 in} tau <- matrix(tau, Data$N, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dgamma(Data$Y+1, lambda*tau, tau, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + U.prior + alpha.prior + log.beta.prior + log.delta.prior + \\ \hspace*{0.62 in} log.psi0.prior + log.psi1.prior + tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rgamma(prod(dim(lambda)), lambda*tau, tau)-1, \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(runif(J,0.9,1), rnorm(K,0,0.1), \\ \hspace*{0.27 in} rnorm((J-1)*L,0,0.1), rnorm(J,0,0.1), \\ \hspace*{0.27 in} rmvnpc(G, rnorm(J,0,0.1), rwishartc(J+1,S)), runif(J), \\ \hspace*{0.27 in} upper.triangle(rwishartc(J+1,S), diag=TRUE))} \section{Multivariate Binary Probit} \label{multiv.bin.probit} \subsection{Form} $$\textbf{W}_{i,1:J} \sim \mathcal{N}_J(\mu_{i,1:J}, \Omega^{-1}), \quad i=1,\dots,N$$ \[\textbf{W}_{i,j} \in \left\{ \begin{array}{l l} $[0,10]$ & \quad \mbox{if $\textbf{y}_i = j$}\\ $[-10,0]$ \\ \end{array} \right. \] $$\mu_{1:N,j} = \textbf{X} \beta_{j,1:K}$$ $$\Omega = \rho^{-1}$$ $$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$ $$\beta_{J,k} = - \sum^{J-1}_{j=1} \beta_{j,k}$$ $$\rho \sim \mathcal{U}(-1, 1)$$ \subsection{Data} \code{N <- 30 \\ J <- 2 \#Number of binary dependent variables \\ K <- 3 \#Number of columns to be in design matrix X \\ X <- cbind(1, matrix(rnorm(N*(K-1),0,1), N, K-1)) \\ beta <- matrix(rnorm(J*K), J, K) \\ mu <- tcrossprod(X, beta) \\ u <- runif(length(which(upper.tri(diag(J)) == TRUE)), -1, 1) \\ rho <- diag(J) \\ rho[upper.tri(rho)] <- u \\ rho[lower.tri(rho)] <- t(rho)[lower.tri(rho)] \\ rho <- as.positive.semidefinite(rho) \\ Omega <- as.inverse(rho) \\ U <- chol(Omega) \\ W <- interval(rmvnpc(N, mu, U) + matrix(rnorm(N*J,0,0.1), N, J), \\ \hspace*{0.27 in} -10, 10) \\ Y <- 1 * (W >= 0) \\ apply(Y, 2, table) \\ mon.names <- "LP" \\ rho <- matrix(NA, J, J) \\ rho[upper.tri(rho)] <- 0 \\ parm.names <- as.parm.names(list(beta=matrix(0,J,K), rho=rho, \\ \hspace*{0.27 in} W=matrix(0,N,J))) \\ pos.beta <- grep("beta", parm.names) \\ pos.rho <- grep("rho", parm.names) \\ pos.W <- grep("W", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J*Data$K) \\ \hspace*{0.27 in} rho <- rep(0, length(which(upper.tri(diag(Data$J))))) \\ \hspace*{0.27 in} W <- matrix(runif(Data$N*Data$J,-10,0), Data$N, Data$J) \\ \hspace*{0.27 in} W <- ifelse(Y == 1, abs(W), W) \\ \hspace*{0.27 in} return(c(beta, rho, as.vector(W)))\} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.rho=pos.rho, pos.W=pos.W) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J, Data$K) \\ \hspace*{0.27 in} u <- interval(parm[Data$pos.rho], -1, 1) \\ \hspace*{0.27 in} rho <- diag(MyData$J) \\ \hspace*{0.27 in} rho[upper.tri(rho)] <- u \\ \hspace*{0.27 in} rho[lower.tri(rho)] <- t(rho)[lower.tri(rho)] \\ \hspace*{0.27 in} if(is.positive.semidefinite(rho) == FALSE) \\ \hspace*{0.62 in} rho <- as.positive.semidefinite(rho) \\ \hspace*{0.27 in} parm[Data$pos.rho] <- upper.triangle(rho) \\ \hspace*{0.27 in} Omega <- as.inverse(rho) \\ \hspace*{0.27 in} U <- chol(Omega) \\ \hspace*{0.27 in} W <- matrix(parm[Data$pos.W], Data$N, Data$J) \\ \hspace*{0.27 in} W[Data$Y == 0] <- interval(W[Data$Y == 0], -10, 0) \\ \hspace*{0.27 in} W[Data$Y == 1] <- interval(W[Data$Y == 1], 0, 10) \\ \hspace*{0.27 in} parm[Data$pos.W] <- as.vector(W) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} rho.prior <- sum(dunif(u, -1, 1, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} LL <- sum(dmvnpc(W, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + rho.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=1*(rmvnpc(nrow(mu), mu, U) >= 0), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)} \section{Multivariate Laplace Regression} \label{multivariate.lap.reg} \subsection{Form} $$\textbf{Y}_{i,k} \sim \mathcal{L}_K(\mu_{i,k}, \Sigma), \quad i=1,\dots,N; \quad k=1,\dots,K$$ $$\mu_{i,k} = \textbf{X}_{1:N,k} \beta_{k,1:J}$$ $$\Sigma = \Omega^{-1}$$ $$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$ $$\beta_{k,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{data(mtcars) \\ Y <- as.matrix(mtcars[,c(1,7)]) \\ X <- cbind(1, as.matrix(mtcars[,c(3,4,6)])) \\ N <- nrow(Y) \#Number of records \\ J <- ncol(X) \#Number of columns in design matrix \\ K <- ncol(Y) \#Number of DVs \\ S <- diag(K) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,K,J), U=diag(K)), \\ \hspace*{0.27 in} uppertri=c(0,1)) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K*Data$J) \\ \hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\ \hspace*{0.27 in} return(c(beta, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$J) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishart(U, Data$K+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} LL <- sum(dmvlc(Data$Y, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rmvlc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J*K), upper.triangle(S, diag=TRUE))} \section{Multivariate Poisson Regression} \label{multivariate.pois.reg} \subsection{Form} $$\textbf{Y}_{i,k} \sim \mathcal{P}(\lambda_{i,k}), \quad i=1,\dots,N \quad k=1,\dots,K$$ $$\lambda_{i,k} = \exp(\textbf{X}_{i,k}\beta_{k,1:J} + \gamma_{i,k}), \quad i=1,\dots,N, \quad k=1,\dots,K$$ $$\beta_{k,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J, \quad k=1,\dots,K$$ $$\gamma_{i,1:K} \sim \mathcal{N}_K(0, \Omega^{-1}), \quad i=1,\dots,N$$ $$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$ \subsection{Data} \code{N <- 20 \#Number of records \\ J <- 4 \#Number of columns in design matrix \\ K <- 3 \#Number of DVs \\ X <- matrix(runif(N*J),N,J); X[,1] <- 1 \\ beta <- matrix(rnorm(K*J),K,J) \\ Omega <- matrix(runif(K*K),K,K); diag(Omega) <- runif(K,1,K) \\ Omega <- as.symmetric.matrix(Omega) \\ gamma <- rmvnp(N, 0, Omega) \\ Y <- round(exp(tcrossprod(X, beta) + gamma)) \\ S <- diag(K) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,K,J), gamma=matrix(0,N,K), \\ \hspace*{0.27 in} U=S), uppertri=c(0,0,1)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K*Data$J) \\ \hspace*{0.27 in} gamma <- rnorm(Data$N*Data$K) \\ \hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\ \hspace*{0.27 in} return(c(beta, gamma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$J) \\ \hspace*{0.27 in} gamma <- matrix(parm[Data$pos.gamma], Data$N, Data$K) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dmvnpc(gamma, 0, U, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, Data$K+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(tcrossprod(Data$X, beta) + gamma) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$Y, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(prod(dim(lambda)), lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K*J), rep(0,N*K), rep(0,K*(K+1)/2))} \section{Multivariate Regression} \label{multivariate.reg} \subsection{Form} $$\textbf{Y}_{i,k} \sim \mathcal{N}_K(\mu_{i,k}, \Sigma), \quad i=1,\dots,N; \quad k=1,\dots,K$$ $$\mu_{i,k} = \textbf{X}_{1:N,k} \beta_{k,1:J}$$ $$\Sigma \sim \mathcal{HW}_{2}(\gamma, 1e6)$$ $$\beta_{k,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J, \quad k=1,\dots,K$$ \subsection{Data} \code{data(mtcars) \\ Y <- as.matrix(mtcars[,c(1,7)]) \\ X <- cbind(1, as.matrix(mtcars[,c(3,4,6)])) \\ N <- nrow(Y) \#Number of records \\ J <- ncol(X) \#Number of columns in design matrix \\ K <- ncol(Y) \#Number of DVs \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=matrix(0,K,J), gamma=rep(0,K), \\ \hspace*{0.27 in} U=diag(K)), uppertri=c(0,0,1)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K*Data$J) \\ \hspace*{0.27 in} gamma <- runif(Data$K) \\ \hspace*{0.27 in} U <- rhuangwandc(2, gamma, rep(1,Data$K)) \\ \hspace*{0.27 in} return(c(beta, gamma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$J) \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} HW.prior <- dhuangwandc(U, 2, gamma, rep(1e6,Data$K), log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\ \hspace*{0.27 in} LL <- sum(dmvnc(Data$Y, mu, U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rmvnc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J*K), rep(1,K), rep(0,K*(K+1)/2))} \section{Negative Binomial Regression} \label{negbin.reg} This example was contributed by Jim Robison-Cox. \subsection{Form} $$\textbf{y} \sim \mathcal{NB}(\mu, \kappa)$$ $$p = \frac{\kappa}{\kappa + \mu}$$ $$\mu = \exp(\textbf{X} \beta)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\kappa \sim \mathcal{HC}(25) \in (0,\infty]$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \#Number of predictors, including the intercept \\ kappa.orig <- 2 \\ beta.orig <- runif(J,-2,2) \\ X <- matrix(runif(J*N,-2, 2), N, J); X[,1] <- 1 \\ mu <- exp(tcrossprod(X, t(beta.orig)) + rnorm(N)) \\ p <- kappa.orig / (kappa.orig + mu) \\ y <- rnbinom(N, size=kappa.orig, mu=mu) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), kappa=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.kappa <- grep("kappa", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} kappa <- runif(1) \\ \hspace*{0.27 in} return(c(beta, kappa)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.kappa=pos.kappa, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$J + 1] <- kappa <- interval(parm[Data$pos.kappa], \\ \hspace*{0.62 in} .Machine$double.xmin, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} kappa.prior <- dhalfcauchy(kappa, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- as.vector(exp(tcrossprod(Data$X, t(beta)))) \\ \hspace*{0.27 in} \#p <- kappa / (kappa + mu) \\ \hspace*{0.27 in} LL <- sum(dnbinom(Data$y, size=kappa, mu=mu, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + kappa.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnbinom(length(mu), size=kappa, mu=mu), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Normal, Multilevel} \label{norm.ml} This is Gelman's school example \citep{gelman04}. Note that \pkg{LaplacesDemon} is slower to converge than \proglang{WinBUGS} through the \pkg{R2WinBUGS} package \citep{r:r2winbugs}, an \proglang{R} package on CRAN. This example is very sensitive to the prior distributions. The recommended, default, half-Cauchy priors with scale 25 on scale parameters overwhelms the likelihood, so uniform priors are used. \subsection{Form} $$\textbf{y}_j \sim \mathcal{N}(\theta_j, \sigma^2_j), \quad j=1,\dots,J$$ $$\theta_j \sim \mathcal{N}(\theta_{\mu}, \theta_\sigma^2)$$ $$\theta_{\mu} \sim \mathcal{N}(0, 1000000)$$ $$\theta_{\sigma[j]} \sim \mathcal{N}(0, 1000)$$ $$\sigma \sim \mathcal{U}(0, 1000)$$ \subsection{Data} \code{J <- 8 \\ y <- c(28.4, 7.9, -2.8, 6.8, -0.6, 0.6, 18.0, 12.2) \\ sd <- c(14.9, 10.2, 16.3, 11.0, 9.4, 11.4, 10.4, 17.6) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(theta=rep(0,J), theta.mu=0, \\ \hspace*{0.27 in} theta.sigma=0)) \\ pos.theta <- 1:J \\ pos.theta.mu <- J+1 \\ pos.theta.sigma <- J+2 \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} theta.mu <- rnorm(1) \\ \hspace*{0.27 in} theta.sigma <- runif(1) \\ \hspace*{0.27 in} theta <- rnorm(Data$J, theta.mu, theta.sigma) \\ \hspace*{0.27 in} return(c(theta, theta.mu, theta.sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.theta=pos.theta, pos.theta.mu=pos.theta.mu, \\ \hspace*{0.27 in} pos.theta.sigma=pos.theta.sigma, sd=sd, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} theta.mu <- parm[Data$pos.theta.mu] \\ \hspace*{0.27 in} theta.sigma <- interval(parm[Data$pos.theta.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.theta.sigma] <- theta.sigma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} theta.mu.prior <- dnormp(theta.mu, 0, 1.0E-6, log=TRUE) \\ \hspace*{0.27 in} theta.sigma.prior <- dunif(theta.sigma, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} theta.prior <- sum(dnorm(theta, theta.mu, theta.sigma, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dunif(Data$sd, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, theta, Data$sd, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + theta.prior + theta.mu.prior + theta.sigma.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(theta), theta, Data$sd), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(mean(y),J), mean(y), 1)} \section{Ordinal Logit} \label{ordinal.logit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(P_{i,1:J})$$ $$P_{,J} = 1 - Q_{,(J-1)}$$ $$P_{,j} = |Q_{,j} - Q_{,(j-1)}|, \quad j=2,\dots,(J-1)$$ $$P_{,1} = Q_{,1}$$ $$Q = \frac{1}{1 + \exp(\mu)}$$ $$\mu_{,j} = \delta_j - \textbf{X} \beta, \quad \in [-5,5]$$ $$\beta_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\delta_j \sim \mathcal{N}(0, 1) \in [(j-1),j] \in [-5,5], \quad j=1,\dots,(J-1)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- 3 \#Number of categories in y \\ X <- as.matrix(demonsnacks[,c(1,3:10)]) \\ K <- ncol(demonsnacks) \#Number of columns in design matrix X \\ y <- log(demonsnacks$Calories) \\ y <- ifelse(y < 4.5669, 1, ifelse(y > 5.5268, 3, 2)) \#Discretize \\ for (k in 1:K) X[,k] <- CenterScale(X[,k]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,K), delta=rep(0,J-1))) \\ pos.beta <- grep("beta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K) \\ \hspace*{0.27 in} delta <- sort(rnorm(Data$J-1)) \\ \hspace*{0.27 in} return(c(beta, delta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.delta=pos.delta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], -5, 5) \\ \hspace*{0.27 in} delta <- sort(delta) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dtrunc(delta, "norm", a=-5, b=5, log=TRUE, \\ \hspace*{0.62 in} mean=0, sd=1) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(delta, Data$N, Data$J-1, byrow=TRUE) - \\ \hspace*{0.62 in} matrix(tcrossprod(Data$X, t(beta)), Data$N, Data$J-1) \\ \hspace*{0.27 in} P <- Q <- invlogit(mu) \\ \hspace*{0.27 in} P[,-1] <- abs(Q[,-1] - Q[,-(Data$J-1)]) \\ \hspace*{0.27 in} P <- cbind(P, 1 - Q[,(Data$J-1)]) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, P, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + delta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(P), P) \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), seq(from=-1, to=1, len=(J-1)))} \section{Ordinal Probit} \label{ordinal.probit} \subsection{Form} $$\textbf{y}_i \sim \mathcal{CAT}(P_{i,1:J})$$ $$P_{,J} = 1 - Q_{,(J-1)}$$ $$P_{,j} = |Q_{,j} - Q_{,(j-1)}|, \quad j=2,\dots,(J-1)$$ $$P_{,1} = Q_{,1}$$ $$Q = \phi(\mu)$$ $$\mu_{,j} = \delta_j - \textbf{X} \beta, \quad \in [-5,5]$$ $$\beta_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\delta_j \sim \mathcal{N}(0, 1) \in [(j-1),j] \in [-5,5], \quad j=1,\dots,(J-1)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- 3 \#Number of categories in y \\ X <- as.matrix(demonsnacks[,c(1,3:10)]) \\ K <- ncol(demonsnacks) \#Number of columns in design matrix X \\ y <- log(demonsnacks$Calories) \\ y <- ifelse(y < 4.5669, 1, ifelse(y > 5.5268, 3, 2)) \#Discretize \\ for (k in 1:K) X[,k] <- CenterScale(X[,k]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,K), delta=rep(0,J-1))) \\ pos.beta <- grep("beta", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K) \\ \hspace*{0.27 in} delta <- sort(rnorm(Data$J-1)) \\ \hspace*{0.27 in} return(c(beta, delta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.delta=pos.delta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], -5, 5) \\ \hspace*{0.27 in} delta <- sort(delta) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dtrunc(delta, "norm", a=-5, b=5, log=TRUE, \\ \hspace*{0.62 in} mean=0, sd=1) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(delta, Data$N, Data$J-1, byrow=TRUE) - \\ \hspace*{0.62 in} matrix(tcrossprod(Data$X, t(beta)), Data$N, Data$J-1) \\ \hspace*{0.27 in} P <- Q <- pnorm(mu) \\ \hspace*{0.27 in} P[,-1] <- abs(Q[,-1] - Q[,-(Data$J-1)]) \\ \hspace*{0.27 in} P <- cbind(P, 1 - Q[,(Data$J-1)]) \\ \hspace*{0.27 in} LL <- sum(dcat(Data$y, P, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + delta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(P), P) \\ \hspace*{0.62 in} parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,K), seq(from=-1, to=1, len=(J-1)))} \section{Panel, Autoregressive Poisson} \label{panel.ap} \subsection{Form} $$\textbf{Y} \sim \mathcal{P}(\Lambda)$$ $$\Lambda_{1:N,1} = \exp(\alpha + \beta \textbf{x})$$ $$\Lambda_{1:N,t} = \exp(\alpha + \beta \textbf{x} + \rho \log(\textbf{Y}_{1:N,t-1})), \quad t=2,\dots,T$$ $$\alpha_i \sim \mathcal{N}(\alpha_\mu, \alpha^2_\sigma), \quad i=1,\dots,N$$ $$\alpha_\mu \sim \mathcal{N}(0, 1000)$$ $$\alpha_\sigma \sim \mathcal{HC}(25)$$ $$\beta \sim \mathcal{N}(0, 1000)$$ $$\rho \sim \mathcal{N}(0, 1000)$$ \subsection{Data} \code{N <- 10 \\ T <- 10 \\ alpha <- rnorm(N,2,0.5) \\ rho <- 0.5 \\ beta <- 0.5 \\ x <- runif(N,0,1) \\ Y <- matrix(NA,N,T) \\ Y[,1] <- exp(alpha + beta*x) \\ for (t in 2:T) \{Y[,t] <- exp(alpha + beta*x + rho*log(Y[,t-1]))\} \\ Y <- round(Y) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,N), alpha.mu=0, \\ \hspace*{0.27 in} alpha.sigma=0, beta=0, rho=0)) \\ pos.alpha <- 1:N \\ pos.alpha.mu <- grep("alpha.mu", parm.names) \\ pos.alpha.sigma <- grep("alpha.sigma", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.rho <- grep("rho", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha.mu <- rnorm(1) \\ \hspace*{0.27 in} alpha.sigma <- runif(1) \\ \hspace*{0.27 in} alpha <- rnorm(Data$N, alpha.mu, alpha.sigma) \\ \hspace*{0.27 in} beta <- rnorm(1) \\ \hspace*{0.27 in} rho <- rnorm(1) \\ \hspace*{0.27 in} return(c(alpha, alpha.mu, alpha.sigma, beta, rho)) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.alpha.mu=pos.alpha.mu, \\ \hspace*{0.27 in} pos.alpha.sigma=pos.alpha.sigma, pos.beta=pos.beta, pos.rho=pos.rho, \\ \hspace*{0.27 in} x=x) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} alpha.mu <- parm[Data$pos.alpha.mu] \\ \hspace*{0.27 in} alpha.sigma <- interval(parm[Data$pos.alpha.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.alpha.sigma] <- alpha.sigma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} rho <- parm[Data$pos.rho] \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} alpha.mu.prior <- dnormv(alpha.mu, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} alpha.sigma.prior <- dhalfcauchy(alpha.sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnorm(alpha, alpha.mu, alpha.sigma, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- dnormv(beta, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} rho.prior <- dnormv(rho, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Lambda <- Data$Y \\ \hspace*{0.27 in} Lambda[,1] <- exp(alpha + beta*x) \\ \hspace*{0.27 in} Lambda[,2:Data$T] <- exp(alpha + beta*Data$x + \\ \hspace*{0.62 in} rho*log(Data$Y[,1:(Data$T-1)])) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$Y, Lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + alpha.mu.prior + alpha.sigma.prior + \\ \hspace*{0.62 in} beta.prior + rho.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(prod(dim(Lambda)), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,N), 0, 1, 0, 0)} \section{Penalized Spline Regression} \label{pspline} This example applies penalized splines to one predictor in a linear regression. The user selects the degree of the polynomial, $D$, and the number of knots, $K$. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$\mu = \textbf{X} \beta + \textbf{S}$$ $$\textbf{S} = \textbf{Z} \gamma$$ \[\textbf{Z}_{i,k} = \left\{ \begin{array}{l l} (\textbf{x}_i - k)^D & \quad \mbox{if $\textbf{Z}_{i,k} > 0$}\\ 0 \\ \end{array} \right. \] $$\beta_d \sim \mathcal{N}(0, 1000), \quad d=1,\dots,(D+1)$$ $$\gamma_k \sim \mathcal{N}(0, \sigma^2_2), \quad k=1,\dots,K$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$ \subsection{Data} \code{N <- 100 \\ x <- 1:N \\ y <- sin(2*pi*x/N) + runif(N,-1,1) \\ K <- 10 \#Number of knots \\ D <- 2 \#Degree of polynomial \\ x <- CenterScale(x) \\ k <- as.vector(quantile(x, probs=(1:K / (K+1)))) \\ X <- cbind(1, matrix(x, N, D)) \\ for (d in 1:D) \{X[,d+1] <- X[,d+1]\textasciicircum d\} \\ Z <- matrix(x, N, K) - matrix(k, N, K, byrow=TRUE) \\ Z <- ifelse(Z > 0, Z, 0); Z <- Z\textasciicircum D \\ mon.names <- c("LP", paste("S[", 1:nrow(X) ,"]", sep="")) \\ parm.names <- as.parm.names(list(beta=rep(0,1+D), gamma=rep(0,K), \\ \hspace*{0.27 in} log.sigma=rep(0,2))) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(1+Data$D) \\ \hspace*{0.27 in} gamma <- rnorm(Data$K) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} return(c(beta, gamma, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, K=K, N=N, PGF=PGF, Z=Z, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[2], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} S <- as.vector(tcrossprod(Data$Z, t(gamma))) \\ \hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) + S \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,S), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,1+D), rep(0,K), c(1,1))} \section{Poisson Regression} \label{poisson.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{P}(\lambda)$$ $$\lambda = \exp(\textbf{X}\beta)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ \subsection{Data} \code{N <- 10000 \\ J <- 5 \\ X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \\ beta <- runif(J,-2,2) \\ y <- round(exp(tcrossprod(X, t(beta)))) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J))) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} return(beta) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(tcrossprod(Data$X, t(beta))) \\ \hspace*{0.27 in} LL <- sum(dpois(Data$y, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(length(lambda), lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- rep(0,J)} \section{Polynomial Regression} \label{polynomial.reg} In this univariate example, the degree of the polynomial is specified as $D$. For a more robust extension to estimating nonlinear relationships between $\textbf{y}$ and $\textbf{x}$, see penalized spline regression in section \ref{penalized.spline}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X} \beta$$ $$\textbf{X}_{i,d} = \textbf{x}^{d-1}_i, \quad d=1,\dots,(D+1)$$ $$\textbf{X}_{i,1} = 1$$ $$\beta_d \sim \mathcal{N}(0, 1000), \quad d=1,\dots,(D+1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ D <- 2 \#Degree of polynomial \\ y <- log(demonsnacks$Calories) \\ x <- log(demonsnacks[,10]+1) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,D+1), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(1+Data$D) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, N=N, PGF=PGF, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, x=x, \\ \hspace*{0.27 in} y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} X <- matrix(Data$x, Data$N, Data$D) \\ \hspace*{0.27 in} for (d in 2:Data$D) \{X[,d] <- X[,d]\textasciicircum d\} \\ \hspace*{0.27 in} X <- cbind(1,X) \\ \hspace*{0.27 in} mu <- tcrossprod(X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,D+1), 1)} \section{Proportional Hazards Regression, Weibull} \label{prop.haz.weib} Although the dependent variable is usually denoted as $\textbf{t}$ in survival analysis, it is denoted here as $\textbf{y}$ so Laplace's Demon recognizes it as a dependent variable for posterior predictive checks. This example does not support censoring, but it will be included soon. \subsection{Form} $$\textbf{y}_i \sim \mathcal{WEIB}(\gamma, \mu_i), \quad i=1,\dots,N$$ $$\mu = \exp(\textbf{X} \beta)$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\gamma \sim \mathcal{G}(1, 0.001)$$ \subsection{Data} \code{N <- 50 \\ J <- 5 \\ X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \\ beta <- c(1,runif(J-1,-1,1)) \\ y <- round(exp(tcrossprod(X, t(beta)))) + 1 \# Undefined at zero \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), gamma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} gamma <- rgamma(1,1e-3) \\ \hspace*{0.27 in} return(c(beta, gamma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- dgamma(gamma, 1, 1.0E-3, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- exp(tcrossprod(Data$X, t(beta))) \\ \hspace*{0.27 in} LL <- sum(dweibull(Data$y, gamma, mu, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rweibull(length(mu), gamma, mu), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{PVAR(p)} \label{pvarp} This is a Poisson vector autoregression, with autoregressive order $p$, for multivariate time-series of counts. It allows for dynamic processes and accounts for overdispersion. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{P}(\lambda_{t,j}), \quad t=1,\dots,T \quad j=1,\dots,J$$ $$\lambda_{t,j} = \sum^P_{p=1} \Phi_{1:J,j,p} \textbf{Y}_{t-p,j} + \exp(\alpha_j + \gamma_{t,j})$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\Phi_{i,k,p} \sim \mathcal{N}(\Phi^\mu_{i,k,p}, \Sigma_{i,k,p}), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\gamma_{t,1:J} \sim \mathcal{N}_J(0, \Omega^{-1}), \quad t=1,\dots,T$$ $$\Omega \sim \mathcal{W}_{J+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$ where $\Phi^\mu$ and $\Sigma$ are set according to the Minnesota prior. \subsection{Data} \code{data(demonsessions) \\ Y.orig <- as.matrix(demonsessions) \\ Y <- Y.orig[1:24,1:5] \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L <- c(1,2,3) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ Phi.mu <- array(0, dim=c(J,J,P)) \\ Phi.mu[, , 1] <- diag(J) \\ S <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), \\ \hspace*{0.27 in} Phi=array(0, dim=c(J,J,P)), gamma=matrix(0,T-L[P],J), U=S), \\ \hspace*{0.27 in} uppertri=c(0,0,0,1)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1e-10, 1e-10) \\ \hspace*{0.27 in} gamma <- rnorm((Data$T-Data$L[Data$P])*Data$J) \\ \hspace*{0.27 in} U <- rwishartc(Data$J+1, diag(Data$J)) \\ \hspace*{0.27 in} return(c(alpha, Phi, gamma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, L=L, P=P, PGF=PGF, Phi.mu=Phi.mu, S=S, T=T, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.Phi=pos.Phi, pos.gamma=pos.gamma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} gamma <- matrix(parm[Data$pos.gamma], Data$T-Data$L[Data$P], Data$J) \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} Omega <- t(U) \%*\% U \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, theta=0.5, \\ \hspace*{0.62 in} diag(as.inverse(Omega))) \\ \hspace*{0.27 in} Phi.prior <- sum(dnormv(Phi, Data$Phi.mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dmvnp(gamma, 0, Omega, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishart(Omega, Data$J+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} lambda <- exp(matrix(alpha, Data$T, Data$J, byrow=TRUE) + \\ \hspace*{0.62 in} rbind(matrix(0, Data$L[Data$P], Data$J), gamma)) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} lambda[(1+Data$L[p]):Data$T,] <- lambda[(1+Data$L[p]):Data$T,] + \\ \hspace*{0.95 in} Data$Y[1:(Data$T-Data$L[p]),] %*% Phi[, , p] \\ \hspace*{0.27 in} LL <- sum(dpois(Data$Y[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} lambda[(1+Data$L[Data$P]):Data$T,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + Phi.prior + gamma.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(prod(dim(lambda)), lambda), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(0,J*J*P), rep(0,(T-L[P])*J), \\ \hspace*{0.27 in} rep(0,J*(J+1)/2))} \section{Quantile Regression} \label{quantile.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\phi, \sigma^2)$$ $$\phi = \frac{(1 - 2P)}{P(1 - P)} \zeta + \mu$$ $$\mu = \textbf{X} \beta$$ $$\sigma = \frac{P (1 - P) \tau}{2 \zeta}$$ $$\beta \sim \mathcal{N}(0, 1000)$$ $$\tau \sim \mathcal{HC}(25)$$ $$\zeta \sim \mathcal{EXP}(\tau)$$ where $P$ is the user-specified quantile in $(0,1)$. \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\ N <- nrow(X) \\ J <- ncol(X) \\ P <- 0.5 \#Quantile in (0,1) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), tau=0, zeta=rep(0,N))) \\ pos.beta <- grep("beta", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ pos.zeta <- grep("zeta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} zeta <- rexp(Data$N, tau) \\ \hspace*{0.27 in} return(c(beta, tau, zeta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, N=N, P=P, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.tau=pos.tau, \\ \hspace*{0.27 in} pos.zeta=pos.zeta, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} zeta <- interval(parm[Data$pos.zeta], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.zeta] <- zeta \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} zeta.prior <- sum(dexp(zeta, tau, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} phi <- (1 - 2*Data$P) / (Data$P*(1 - Data$P))*zeta + mu \\ \hspace*{0.27 in} sigma <- (Data$P*(1 - Data$P)*tau) / (2*zeta) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, phi, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + tau.prior + zeta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(phi), phi, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1, rep(1,N))} \section{Revision, Normal} \label{revision.normal} This example provides both an analytic solution and numerical approximation of the revision of a normal distribution. Given a normal prior distribution ($\alpha$) and data distribution ($\beta$), the posterior ($\gamma$) is the revised normal distribution. This is an introductory example of Bayesian inference, and allows the user to experiment with numerical approximation, such as with MCMC in \code{LaplacesDemon}. Note that, regardless of the data sample size $N$ in this example, Laplace Approximation is inappropriate due to asymptotics since the data ($\beta$) is perceived by the algorithm as a single datum rather than a collection of data. MCMC, on the other hand, is biased only by the effective number of samples taken of the posterior. \\ \code{\#\#\# Analytic Solution \\ prior.mu <- 0 \\ prior.sigma <- 10 \\ N <- 10 \\ data.mu <- 1 \\ data.sigma <- 2 \\ posterior.mu <- (prior.sigma\textasciicircum -2 * prior.mu + N * data.sigma\textasciicircum -2 * data.mu) / \\ \hspace*{0.27 in} (prior.sigma\textasciicircum -2 + N * data.sigma\textasciicircum -2) \\ posterior.sigma <- sqrt(1/(prior.sigma\textasciicircum -2 + data.sigma\textasciicircum -2)) \\ posterior.mu \\ posterior.sigma \\ } \subsection{Form} $$\alpha \sim \mathcal{N}(0,10)$$ $$\beta \sim \mathcal{N}(1,2)$$ $$\gamma = \frac{\alpha^{-2}_\sigma \alpha + N \beta^{-2}_\sigma \beta}{\alpha^{-2}_\sigma + N \beta^{-2}_\sigma}$$ \subsection{Data} \code{N <- 10 \\ mon.names <- c("LP","gamma") \\ parm.names <- c("alpha","beta") \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1,0,10) \\ \hspace*{0.27 in} beta <- rnorm(1,1,2) \\ \hspace*{0.27 in} return(c(alpha, beta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(N=N, PGF=PGF, mon.names=mon.names, parm.names=parm.names) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} alpha.mu <- 0 \\ \hspace*{0.27 in} alpha.sigma <- 10 \\ \hspace*{0.27 in} beta.mu <- 1 \\ \hspace*{0.27 in} beta.sigma <- 2 \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[1] \\ \hspace*{0.27 in} beta <- parm[2] \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnorm(alpha, alpha.mu, alpha.sigma, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- dnorm(beta, beta.mu, beta.sigma, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Posterior \\ \hspace*{0.27 in} gamma <- (alpha.sigma\textasciicircum -2 * alpha + N * beta.sigma\textasciicircum -2 * beta) / \\ \hspace*{0.62 in} (alpha.sigma\textasciicircum -2 + N * beta.sigma\textasciicircum -2) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,gamma), \\ \hspace*{0.62 in} yhat=rnorm(1, beta.mu, beta.sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(0,0)} \section{Ridge Regression} \label{ridge.reg} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$ $$\mu = \textbf{X}\beta$$ $$\beta_1 \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=2,\dots,J$$ $$\sigma_k \sim \mathcal{HC}(25), \quad k=1,\dots,2$$ \subsection{Data} \code{data(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(log(demonsnacks[,-2]+1))) \\ J <- ncol(X) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=rep(0,2))) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, c(1000, rep(sigma[2], Data$J-1)), \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(1,J), rep(1,2))} \section{Robust Regression} \label{robust.reg} By replacing the normal distribution with the Student t distribution, linear regression is often called robust regression. As an alternative approach to robust regression, consider Laplace regression (see section \ref{laplace.reg}). \subsection{Form} $$\textbf{y} \sim \mathrm{t}(\mu, \sigma^2, \nu)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\nu \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 100 \\ J <- 5 \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta <- runif(J,-3,3) \\ e <- rst(N,0,1,5) \\ y <- tcrossprod(X, t(beta)) + e \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0, nu=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.nu <- grep("nu", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} nu <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma, nu)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.nu=pos.nu, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[1:Data$J] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} nu.prior <- dhalfcauchy(nu, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dst(Data$y, mu, sigma, nu, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior + nu.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rst(length(mu), mu, sigma, nu), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1, 5)} \section{Seemingly Unrelated Regression (SUR)} \label{sur} The following data was used by \citet{zellner62} when introducing the Seemingly Unrelated Regression methodology. This model uses the Yang-Berger prior distribution for the precision matrix of a multivariate normal distribution. \subsection{Form} $$\textbf{Y}_{t,k} \sim \mathcal{N}_K(\mu_{t,k}, \Omega^{-1}), \quad t=1,\dots,T, \quad k=1,\dots,K$$ $$\mu_{1,t} = \alpha_1 + \alpha_2 \textbf{X}_{t-1,1} + \alpha_3 \textbf{X}_{t-1,2}, \quad t=2,\dots,T$$ $$\mu_{2,t} = \beta_1 + \beta_2 \textbf{X}_{t-1,3} + \beta_3 \textbf{X}_{t-1,4}, \quad t=2,\dots,T$$ $$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ where $J=3$, $K=2$, and $T=20$. \subsection{Data} \code{T <- 20 \#Time-periods \\ year <- c(1935,1936,1937,1938,1939,1940,1941,1942,1943,1944,1945,1946, \\ \hspace*{0.27 in} 1947,1948,1949,1950,1951,1952,1953,1954) \\ IG <- c(33.1,45.0,77.2,44.6,48.1,74.4,113.0,91.9,61.3,56.8,93.6,159.9, \\ \hspace*{0.27 in} 147.2,146.3,98.3,93.5,135.2,157.3,179.5,189.6) \\ VG <- c(1170.6,2015.8,2803.3,2039.7,2256.2,2132.2,1834.1,1588.0,1749.4, \\ \hspace*{0.27 in} 1687.2,2007.7,2208.3,1656.7,1604.4,1431.8,1610.5,1819.4,2079.7, \\ \hspace*{0.27 in} 2371.6,2759.9) \\ CG <- c(97.8,104.4,118.0,156.2,172.6,186.6,220.9,287.8,319.9,321.3,319.6, \\ \hspace*{0.27 in} 346.0,456.4,543.4,618.3,647.4,671.3,726.1,800.3,888.9) \\ IW <- c(12.93,25.90,35.05,22.89,18.84,28.57,48.51,43.34,37.02,37.81, \\ \hspace*{0.27 in} 39.27,53.46,55.56,49.56,32.04,32.24,54.38,71.78,90.08,68.60) \\ VW <- c(191.5,516.0,729.0,560.4,519.9,628.5,537.1,561.2,617.2,626.7, \\ \hspace*{0.27 in} 737.2,760.5,581.4,662.3,583.8,635.2,723.8,864.1,1193.5,1188.9) \\ CW <- c(1.8,0.8,7.4,18.1,23.5,26.5,36.2,60.8,84.4,91.2,92.4,86.0,111.1, \\ \hspace*{0.27 in} 130.6,141.8,136.7,129.7,145.5,174.8,213.5) \\ J <- 2 \#Number of dependent variables \\ Y <- matrix(c(IG,IW), T, J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,3), beta=rep(0,3), \\ \hspace*{0.27 in} U=diag(J)), uppertri=c(0,0,1)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(3) \\ \hspace*{0.27 in} beta <- rnorm(3) \\ \hspace*{0.27 in} U <- runif(Data$J*(Data$J+1)/2) \\ \hspace*{0.27 in} return(c(alpha, beta, U)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, T=T, Y=Y, CG=CG, CW=CW, IG=IG, IW=IW, \\ \hspace*{0.27 in} VG=VG, VW=VW, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dyangbergerc(U, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- Data$Y \\ \hspace*{0.27 in} mu[-1,1] <- alpha[1] + alpha[2]*Data$CG[-Data$T] + \\ \hspace*{0.62 in} alpha[3]*Data$VG[-Data$T] \\ \hspace*{0.27 in} mu[-1,2] <- beta[1] + beta[2]*Data$CW[-Data$T] + \\ \hspace*{0.62 in} beta[3]*Data$VW[-Data$T] \\ \hspace*{0.27 in} LL <- sum(dmvnpc(Data$Y[-1,], mu[-1,], U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rmvnpc(nrow(mu), mu, U), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,3), rep(0,3), rep(0,J*(J+1)/2))} \section{Simultaneous Equations} \label{simultaneous} This example of simultaneous equations uses Klein's Model I \citep{kleine50} regarding economic fluctations in the United States in 1920-1941 (\textbf{N}=22). Usually, this example is modeled with 3-stage least sqaures (3SLS), excluding the uncertainty from multiple stages. By constraining each element in the instrumental variables matrix $\nu \in [-10,10]$, this example estimates the model without resorting to stages. The dependent variable is matrix \textbf{Y}, in which $\textbf{Y}_{1,1:N}$ is \textbf{C} or Consumption, $\textbf{Y}_{2,1:N}$ is \textbf{I} or Investment, and $\textbf{Y}_{3,1:N}$ is \textbf{Wp} or Private Wages. Here is a data dictionary: \\ \code{\hspace*{0.27 in} A = Time Trend measured as years from 1931 \\ \hspace*{0.27 in} \textbf{C} = Consumption \\ \hspace*{0.27 in} \textbf{G} = Government Nonwage Spending \\ \hspace*{0.27 in} \textbf{I} = Investment \\ \hspace*{0.27 in} \textbf{K} = Capital Stock \\ \hspace*{0.27 in} \textbf{P} = Private (Corporate) Profits \\ \hspace*{0.27 in} \textbf{T} = Indirect Business Taxes Plus Neg Exports \\ \hspace*{0.27 in} \textbf{Wg} = Government Wage Bill \\ \hspace*{0.27 in} \textbf{Wp} = Private Wages \\ \hspace*{0.27 in} \textbf{X} = Equilibrium Demand (GNP) \\ } See \citet{kleine50} for more information. \subsection{Form} $$\textbf{Y} \sim \mathcal{N}_3(\mu, \Omega^{-1})$$ $$ \mu_{1,1} = \alpha_1 + \alpha_2 \nu_{1,1} + \alpha_4 \nu_{2,1}$$ $$ \mu_{1,i} = \alpha_1 + \alpha_2 \nu_{1,i} + \alpha_3 \textbf{P}_{i-1} + \alpha_4 \nu_{2,i}, \quad i=2,\dots,N$$ $$ \mu_{2,1} = \beta_1 + \beta_2 \nu_{1,1} + \beta_4 \textbf{K}_1$$ $$ \mu_{2,i} = \beta_1 + \beta_2 \nu_{1,i} + \beta_3 \textbf{P}_{i-1} + \beta_4 \textbf{K}_i, \quad i=2,\dots,N$$ $$\mu_{3,1} = \gamma_1 + \gamma_2 \nu_{3,1} + \gamma_4 \textbf{A}_1$$ $$\mu_{3,i} = \gamma_1 + \gamma_2 \nu_{3,i} + \gamma_3 \textbf{X}_{i-1} + \gamma_4 \textbf{A}_i, \quad i=2,\dots,N$$ $$\textbf{Z}_{j,i} \sim \mathcal{N}(\nu_{j,i}, \sigma^2_j), \quad j=1,\dots,3$$ $$\nu_{j,1} = \pi_{j,1} + \pi_{j,3} \textbf{K}_1 + \pi_{j,5} \textbf{A}_1 + \pi_{j,6} \textbf{T}_1 + \pi_{j,7} \textbf{G}_1, \quad j=1,\dots,3$$ $$\nu_{j,i} = \pi_{j,1} + \pi_{j,2} \textbf{P}_{i-1} + \pi_{j,3} \textbf{K}_i + \pi_{j,4} \textbf{X}_{i-1} + \pi_{j,5} \textbf{A}_i + \pi_{j,6} \textbf{T}_i + \pi \textbf{G}_i, \quad i=1,\dots,N, \quad j=1,\dots,3$$ $$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,4$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,4$$ $$\gamma_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,4$$ $$\pi_{j,i} \sim \mathcal{N}(0, 1000) \in [-10,10], \quad j=1,\dots,3, \quad i=1,\dots,N$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,3$$ $$\Omega \sim \mathcal{W}_4(\textbf{S}), \quad \textbf{S} = \textbf{I}_3$$ \subsection{Data} \code{N <- 22 \\ A <- c(-11,-10,-9,-8,-7,-6,-5,-4,-3,-2,-1,0,1,2,3,4,5,6,7,8,9,10) \\ C <- c(39.8,41.9,45,49.2,50.6,52.6,55.1,56.2,57.3,57.8,55,50.9,45.6,46.5, \\ \hspace*{0.27 in} 48.7,51.3,57.7,58.7,57.5,61.6,65,69.7) \\ G <- c(2.4,3.9,3.2,2.8,3.5,3.3,3.3,4,4.2,4.1,5.2,5.9,4.9,3.7,4,4.4,2.9,4.3, \\ \hspace*{0.27 in} 5.3,6.6,7.4,13.8) \\ I <- c(2.7,-0.2,1.9,5.2,3,5.1,5.6,4.2,3,5.1,1,-3.4,-6.2,-5.1,-3,-1.3,2.1,2, \\ \hspace*{0.27 in} -1.9,1.3,3.3,4.9) \\ K <- c(180.1,182.8,182.6,184.5,189.7,192.7,197.8,203.4,207.6,210.6,215.7, \\ \hspace*{0.27 in} 216.7,213.3,207.1,202,199,197.7,199.8,201.8,199.9,201.2,204.5) \\ P <- c(12.7,12.4,16.9,18.4,19.4,20.1,19.6,19.8,21.1,21.7,15.6,11.4,7,11.2, \\ \hspace*{0.27 in} 12.3,14,17.6,17.3,15.3,19,21.1,23.5) \\ T <- c(3.4,7.7,3.9,4.7,3.8,5.5,7,6.7,4.2,4,7.7,7.5,8.3,5.4,6.8,7.2,8.3,6.7, \\ \hspace*{0.27 in} 7.4,8.9,9.6,11.6) \\ Wg <- c(2.2,2.7,2.9,2.9,3.1,3.2,3.3,3.6,3.7,4,4.2,4.8,5.3,5.6,6,6.1,7.4, \\ \hspace*{0.27 in} 6.7,7.7,7.8,8,8.5) \\ Wp <- c(28.8,25.5,29.3,34.1,33.9,35.4,37.4,37.9,39.2,41.3,37.9,34.5,29,28.5, \\ \hspace*{0.27 in} 30.6,33.2,36.8,41,38.2,41.6,45,53.3) \\ X <- c(44.9,45.6,50.1,57.2,57.1,61,64,64.4,64.5,67,61.2,53.4,44.3,45.1, \\ \hspace*{0.27 in} 49.7,54.4,62.7,65,60.9,69.5,75.7,88.4) \\ year <- c(1920,1921,1922,1923,1924,1925,1926,1927,1928,1929,1930,1931,1932, \\ \hspace*{0.27 in} 1933,1934,1935,1936,1937,1938,1939,1940,1941) \\ Y <- matrix(c(C,I,Wp),3,N, byrow=TRUE) \\ Z <- matrix(c(P, Wp+Wg, X), 3, N, byrow=TRUE) \\ S <- diag(nrow(Y)) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,4), beta=rep(0,4), \\ \hspace*{0.27 in} gamma=rep(0,4), pi=matrix(0,3,7), sigma=rep(0,3), \\ \hspace*{0.27 in} U=diag(3)), uppertri=c(0,0,0,0,0,1)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.pi <- grep("pi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(4) \\ \hspace*{0.27 in} beta <- rnorm(4) \\ \hspace*{0.27 in} gamma <- rnorm(4) \\ \hspace*{0.27 in} pi <- rnorm(3*7) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} U <- rwishartc(ncol(Data$Y)+1, Data$S) \\ \hspace*{0.27 in} return(c(alpha, beta, gamma, pi, sigma, U[upper.tri(U, diag=TRUE)])) \\ \hspace*{0.27 in} \} \\ MyData <- list(A=A, C=C, G=G, I=I, K=K, N=N, P=P, PGF=PGF, S=S, T=T, Wg=Wg, \\ \hspace*{0.27 in} Wp=Wp, X=X, Y=Y, Z=Z, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.pi=pos.pi, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} parm[Data$pos.pi] <- pi <- interval(parm[Data$pos.pi], -10, 10) \\ \hspace*{0.27 in} pi <- matrix(pi, 3, 7) \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \hspace*{0.27 in} U <- as.parm.matrix(U, nrow(Data$S), parm, Data, chol=TRUE) \\ \hspace*{0.27 in} parm[grep("Omega", Data$parm.names)] <- upper.triangle(Omega, \\ \hspace*{0.62 in} diag=TRUE) \\ \hspace*{0.27 in} diag(U) <- exp(diag(U)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} pi.prior <- sum(dnormv(pi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} U.prior <- dwishartc(U, nrow(Data$S)+1, Data$S, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- nu <- matrix(0,3,Data$N) \\ \hspace*{0.27 in} for (i in 1:3) \{ \\ \hspace*{0.62 in} nu[i,1] <- pi[i,1] + pi[i,3]*Data$K[1] + pi[i,5]*Data$A[1] + \\ \hspace*{0.95 in} pi[i,6]*Data$T[1] + pi[i,7]*Data$G[1] \\ \hspace*{0.62 in} nu[i,-1] <- pi[i,1] + pi[i,2]*Data$P[-Data$N] + \\ \hspace*{0.95 in} pi[i,3]*Data$K[-1] + pi[i,4]*Data$X[-Data$N] + \\ \hspace*{0.95 in} pi[i,5]*Data$A[-1] + pi[i,6]*Data$T[-1] + \\ \hspace*{0.95 in} pi[i,7]*Data$G[-1]\} \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Z, nu, matrix(sigma, 3, Data$N), log=TRUE)) \\ \hspace*{0.27 in} mu[1,1] <- alpha[1] + alpha[2]*nu[1,1] + alpha[4]*nu[2,1] \\ \hspace*{0.27 in} mu[1,-1] <- alpha[1] + alpha[2]*nu[1,-1] + \\ \hspace*{0.62 in} alpha[3]*Data$P[-Data$N] + alpha[4]*nu[2,-1] \\ \hspace*{0.27 in} mu[2,1] <- beta[1] + beta[2]*nu[1,1] + beta[4]*Data$K[1] \\ \hspace*{0.27 in} mu[2,-1] <- beta[1] + beta[2]*nu[1,-1] + \\ \hspace*{0.62 in} beta[3]*Data$P[-Data$N] + beta[4]*Data$K[-1] \\ \hspace*{0.27 in} mu[3,1] <- gamma[1] + gamma[2]*nu[3,1] + gamma[4]*Data$A[1] \\ \hspace*{0.27 in} mu[3,-1] <- gamma[1] + gamma[2]*nu[3,-1] + \\ \hspace*{0.62 in} gamma[3]*Data$X[-Data$N] + gamma[4]*Data$A[-1] \\ \hspace*{0.27 in} LL <- LL + sum(dmvnpc(t(Data$Y), t(mu), U, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + pi.prior + \\ \hspace*{0.62 in} sigma.prior + U.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=t(rmvnp(ncol(mu), t(mu), U)), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,4), rep(0,4), rep(0,4), rep(0,3*7), rep(1,3), \\ \hspace*{0.27 in} upper.triangle(S, diag=TRUE))} \section{Space-Time, Dynamic} \label{spacetime.dynamic} This approach to space-time or spatiotemporal modeling applies kriging to a stationary spatial component for points in space $s=1,\dots,S$ first at time $t=1$, where space is continuous and time is discrete. Vector $\zeta$ contains these spatial effects. Next, SSM (State Space Model) or DLM (Dynamic Linear Model) components are applied to the spatial parameters ($\phi$, $\kappa$, and $\lambda$) and regression effects ($\beta$). These parameters are allowed to vary dynamically with time $t=2,\dots,T$, and the resulting spatial process is estimated for each of these time-periods. When time is discrete, a dynamic space-time process can be applied. The matrix $\Theta$ contains the dynamically varying stationary spatial effects, or space-time effects. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across discrete time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. The dependent variable is also a function of design matrix $\textbf{X}$ (which may also be dynamic, but is static in this example) and dynamic regression effects matrix $\beta_{1:K,1:T}$. For more information on kriging, see section \ref{kriging}. For more information on SSMs or DLMs, see section \ref{ssm.lin.reg}. To extend this to a large spatial data set, consider incorporating the predictive process kriging example in section \ref{kriging.pp}. \subsection{Form} $$\textbf{Y}_{s,t} \sim \mathcal{N}(\mu_{s,t}, \sigma^2_1), \quad s=1,\dots,S, \quad t=1,\dots,T$$ $$\mu_{s,t} = \textbf{X}_{s,1:K} \beta_{1:K,t} + \Theta_{s,t}$$ $$\Theta_{s,t} = \frac{\Sigma_{s,s,t}}{\sum^S_{r=1} \Sigma_{r,s,t}} \Theta_{s,t-1}, \quad s=1,\dots,S, \quad t=2,\dots,T$$ $$\Theta_{s,1} = \zeta_s$$ $$\zeta \sim \mathcal{N}_S(0, \Sigma_{1:S,1:S,1})$$ $$\Sigma_{1:S,1:S,t} = \lambda^2_t \exp(-\phi_t \textbf{D})^{\kappa[t]}$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,4$$ $$\beta_{k,1} \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\beta_{k,t} \sim \mathcal{N}(\beta_{k,t-1}, \tau^2_k), \quad k=1,\dots,K, \quad t=2,\dots,T$$ $$\phi_1 \sim \mathcal{HN}(1000)$$ $$\phi_t \sim \mathcal{N}(\phi_{t-1}, \sigma^2_2) \in [0,\infty], \quad t=2,\dots,T$$ $$\kappa_1 \sim \mathcal{HN}(1000)$$ $$\kappa_t \sim \mathcal{N}(\kappa_{t-1}, \sigma^2_3) \in [0,\infty], \quad t=2,\dots,T$$ $$\lambda_1 \sim \mathcal{HN}(1000)$$ $$\lambda_t \sim \mathcal{N}(\lambda_{t-1}, \sigma^2_4) \in [0,\infty], \quad t=2,\dots,T$$ \subsection{Data} \code{data(demontexas) \\ Y <- as.matrix(demontexas[1:20,c(18:30)]) \\ X <- cbind(1,as.matrix(demontexas[1:20,c(1,4)])) \#Static predictors \\ latitude <- demontexas[1:20,2] \\ longitude <- demontexas[1:20,3] \\ D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ S <- nrow(Y) \#Number of sites, or points in space \\ T <- ncol(Y) \#Number of time-periods \\ K <- ncol(X) \#Number of columns in design matrix X including the intercept \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(zeta=rep(0,S), beta=matrix(0,K,T), \\ \hspace*{0.27 in} phi=rep(0,T), kappa=rep(0,T), lambda=rep(0,T), sigma=rep(0,4), \\ \hspace*{0.27 in} tau=rep(0,K))) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.kappa <- grep("kappa", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K*Data$T, rbind(mean(Data$Y), \\ \hspace*{0.62 in} matrix(0, Data$K-1, Data$T)), 1) \\ \hspace*{0.27 in} phi <- rhalfnorm(Data$T, 1) \\ \hspace*{0.27 in} kappa <- rhalfnorm(Data$T, 1) \\ \hspace*{0.27 in} lambda <- rhalfnorm(Data$T, 1) \\ \hspace*{0.27 in} Sigma <- lambda[1]*lambda[1]*exp(-phi[1]*Data$D)\textasciicircum kappa[1] \\ \hspace*{0.27 in} zeta <- as.vector(rmvn(1, rep(0,Data$S), Sigma)) \\ \hspace*{0.27 in} sigma <- runif(4) \\ \hspace*{0.27 in} tau <- runif(Data$K) \\ \hspace*{0.27 in} return(c(zeta, beta, phi, kappa, lambda, sigma, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, K=K, PGF=PGF, S=S, T=T, X=X, Y=Y, latitude=latitude, \\ \hspace*{0.27 in} longitude=longitude, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.zeta=pos.zeta, pos.beta=pos.beta, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.kappa=pos.kappa, pos.lambda=pos.lambda, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.tau=pos.tau) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$T) \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1e-100, Inf) \\ \hspace*{0.27 in} kappa <- interval(parm[Data$pos.kappa], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.kappa] <- kappa \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} Sigma <- array(0, dim=c(Data$S, Data$S, Data$T)) \\ \hspace*{0.27 in} for (t in 1:Data$T) \{ \\ \hspace*{0.62 in} Sigma[ , ,t] <- lambda[t]\textasciicircum 2 * exp(-phi[t] * Data$D)\textasciicircum kappa[t]\} \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta[,1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dnorm(beta[,-1], beta[,-Data$T], matrix(tau, Data$K, \\ \hspace*{0.62 in} Data$T-1), log=TRUE)) \\ \hspace*{0.27 in} zeta.prior <- dmvn(zeta, rep(0,Data$S), Sigma[ , , 1], log=TRUE) \\ \hspace*{0.27 in} phi.prior <- sum(dhalfnorm(phi[1], sqrt(1000), log=TRUE), \\ \hspace*{0.62 in} dtrunc(phi[-1], "norm", a=0, b=Inf, mean=phi[-Data$T], \\ \hspace*{0.62 in} sd=sigma[2], log=TRUE)) \\ \hspace*{0.27 in} kappa.prior <- sum(dhalfnorm(kappa[1], sqrt(1000), log=TRUE), \\ \hspace*{0.62 in} dtrunc(kappa[-1], "norm", a=0, b=Inf, mean=kappa[-Data$T], \\ \hspace*{0.62 in} sd=sigma[3], log=TRUE)) \\ \hspace*{0.27 in} lambda.prior <- sum(dhalfnorm(lambda[1], sqrt(1000), log=TRUE), \\ \hspace*{0.62 in} dtrunc(lambda[-1], "norm", a=0, b=Inf, mean=lambda[-Data$T], \\ \hspace*{0.62 in} sd=sigma[4], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- sum(dhalfcauchy(tau, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} Theta <- matrix(zeta, Data$S, Data$T) \\ \hspace*{0.27 in} for (t in 2:Data$T) \{ \\ \hspace*{0.62 in} for (s in 1:Data$S) \{ \\ \hspace*{0.98 in} Theta[s,t] <- sum(Sigma[,s,t] / sum(Sigma[,s,t]) * Theta[,t-1])\}\} \\ \hspace*{0.27 in} mu <- mu + Theta \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + sum(phi.prior) + \\ \hspace*{0.62 in} sum(kappa.prior) + sum(lambda.prior) + sigma.prior + tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,S), rep(c(mean(Y),rep(0,K-1)),T), rep(1,T), \\ \hspace*{0.27 in} rep(1,T), rep(1,T), rep(1,4), rep(1,K))} \section{Space-Time, Nonseparable} \label{spacetime.nonsep} This approach to space-time or spatiotemporal modeling applies kriging both to the stationary spatial and temporal components, where space is continuous and time is discrete. Matrix $\Xi$ contains the space-time effects. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. The dependent variable is also a function of design matrix $\textbf{X}$ and regression effects vector $\beta$. For more information on kriging, see section \ref{kriging}. This example uses a nonseparable, stationary covariance function in which space and time are separable only when $\psi=0$. To extend this to a large space-time data set, consider incorporating the predictive process kriging example in section \ref{kriging.pp}. \subsection{Form} $$\textbf{Y}_{s,t} \sim \mathcal{N}(\mu_{s,t}, \sigma^2_1), \quad s=1,\dots,S, \quad t=1,\dots,T$$ $$\mu = \textbf{X} \beta + \Xi$$ $$\Xi \sim \mathcal{N}_{ST}(\Xi_\mu, \Sigma)$$ $$ \Sigma = \sigma^2_2 \exp \left (-\frac{\textbf{D}_S}{\phi_1}^\kappa - \frac{\textbf{D}_T}{\phi_2}^\lambda - \psi \frac{\textbf{D}_S}{\phi_1}^\kappa \frac{\textbf{D}_T}{\phi_2}^\lambda \right )$$ $$\beta_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$ $$\phi_j \sim \mathcal{U}(1, 5), \quad j=1,\dots,2$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$ $$\psi \sim \mathcal{HC}(25)$$ $$\Xi_\mu = 0$$ $$\kappa = 1, \quad \lambda = 1$$ \subsection{Data} \code{data(demontexas) \\ Y <- as.matrix(demontexas[1:10,c(18:30)]) \\ X <- cbind(1,as.matrix(demontexas[1:10,c(1,4)])) \#Static predictors \\ latitude <- demontexas[1:10,2] \\ longitude <- demontexas[1:10,3] \\ S <- nrow(Y) \#Number of sites, or points in space \\ T <- ncol(Y) \#Number of time-periods \\ K <- ncol(X) \#Number of columns in design matrix X including the intercept \\ D.S <- as.matrix(dist(cbind(rep(longitude,T),rep(latitude,T)), diag=TRUE, \\ \hspace*{0.27 in} upper=TRUE)) \\ D.T <- as.matrix(dist(cbind(rep(1:T,each=S),rep(1:T,each=S)), diag=TRUE, \\ \hspace*{0.27 in} upper=TRUE)) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(Xi=matrix(0,S,T), beta=rep(0,K), \\ \hspace*{0.27 in} phi=rep(0,2), sigma=rep(0,2), psi=0)) \\ pos.Xi <- grep("Xi", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.psi <- grep("psi", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K, c(mean(Data$Y),rep(0,Data$K-1)), 1) \\ \hspace*{0.27 in} phi <- runif(2,1,5) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} psi <- runif(1) \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} lambda <- 1 \\ \hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-(Data$D.S / phi[1])\textasciicircum kappa - \hspace*{0.62 in} (Data$D.T / phi[2])\textasciicircum lambda - \hspace*{0.62 in} psi*(Data$D.S / phi[1])\textasciicircum kappa * (Data$D.T / phi[2])\textasciicircum lambda) \hspace*{0.27 in} Xi <- as.vector(rmvn(1, rep(0,Data$S*Data$T), Sigma)) \\ \hspace*{0.27 in} return(c(Xi, beta, phi, sigma, psi)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D.S=D.S, D.T=D.T, K=K, PGF=PGF, S=S, T=T, X=X, Y=Y, \\ \hspace*{0.27 in} latitude=latitude, longitude=longitude, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.Xi=pos.Xi, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.sigma=pos.sigma, pos.psi=pos.psi) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} Xi.mu <- rep(0,Data$S*Data$T) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} Xi <- parm[Data$pos.Xi] \\ \hspace*{0.27 in} kappa <- 1; lambda <- 1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\ \hspace*{0.27 in} parm[Data$pos.psi] <- psi <- interval(parm[Data$pos.psi], 1e-100, Inf) \\ \hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-(Data$D.S / phi[1])\textasciicircum kappa - \\ \hspace*{0.62 in} (Data$D.T / phi[2])\textasciicircum lambda - \\ \hspace*{0.62 in} psi*(Data$D.S / phi[1])\textasciicircum kappa * (Data$D.T / phi[2])\textasciicircum lambda) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Xi.prior <- dmvn(Xi, Xi.mu, Sigma, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dunif(phi, 1, 5, log=TRUE)) \\ \hspace*{0.27 in} psi.prior <- dhalfcauchy(psi, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Xi <- matrix(Xi, Data$S, Data$T) \\ \hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) + Xi \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + Xi.prior + sigma.prior + phi.prior + psi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma[1]), parm=parm)\\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,S*T), c(mean(Y),rep(0,K-1)), rep(1,2), rep(1,2), \\ \hspace*{0.27 in} 1)} \section{Space-Time, Separable} \label{spacetime.sep} This introductory approach to space-time or spatiotemporal modeling applies kriging both to the stationary spatial and temporal components, where space is continuous and time is discrete. Vector $\zeta$ contains the spatial effects and vector $\theta$ contains the temporal effects. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. The dependent variable is also a function of design matrix $\textbf{X}$ and regression effects vector $\beta$. For more information on kriging, see section \ref{kriging}. This example uses separable space-time covariances, which is more convenient but usually less appropriate than a nonseparable covariance function. To extend this to a large space-time data set, consider incorporating the predictive process kriging example in section \ref{kriging.pp}. \subsection{Form} $$\textbf{Y}_{s,t} \sim \mathcal{N}(\mu_{s,t}, \sigma^2_1), \quad s=1,\dots,S, \quad t=1,\dots,T$$ $$\mu_{s,t} = \textbf{X}_{s,1:J} \beta + \zeta_s + \Theta_{s,t}$$ $$\Theta_{s,1:T} = \theta$$ $$\theta \sim \mathcal{N}_N(\theta_\mu, \Sigma_T)$$ $$\Sigma_T = \sigma^2_3 \exp(-\phi_2 \textbf{D}_T)^\lambda$$ $$\zeta \sim \mathcal{N}_N(\zeta_\mu, \Sigma_S)$$ $$\Sigma_S = \sigma^2_2 \exp(-\phi_1 \textbf{D}_S)^\kappa$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,2$$ $$\sigma_k \sim \mathcal{HC}(25), \quad k=1,\dots,3$$ $$\phi_k \sim \mathcal{U}(1, 5), \quad k=1,\dots,2$$ $$\zeta_\mu = 0$$ $$\theta_\mu = 0$$ $$\kappa = 1, \quad \lambda = 1$$ \subsection{Data} \code{data(demontexas) \\ Y <- as.matrix(demontexas[1:20,c(18:30)]) \\ X <- cbind(1,as.matrix(demontexas[1:20,c(1,4)])) \#Static predictors \\ latitude <- demontexas[1:20,2] \\ longitude <- demontexas[1:20,3] \\ S <- nrow(Y) \#Number of sites, or points in space \\ T <- ncol(Y) \#Number of time-periods \\ K <- ncol(X) \#Number of columns in design matrix X including the intercept \\ D.S <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\ D.T <- as.matrix(dist(cbind(c(1:T),c(1:T)), diag=TRUE, upper=TRUE)) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(zeta=rep(0,S), theta=rep(0,T), \\ \hspace*{0.27 in} beta=rep(0,K), phi=rep(0,2), sigma=rep(0,3))) \\ pos.zeta <- grep("zeta", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$K, c(mean(Data$Y),rep(0,Data$K-1)), 1) \\ \hspace*{0.27 in} phi <- runif(2,1,5) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} kappa <- 1 \\ \hspace*{0.27 in} lambda <- 1 \\ \hspace*{0.27 in} Sigma.S <- sigma[2]\textasciicircum 2 * exp(-phi[1] * Data$D.S)\textasciicircum kappa \\ \hspace*{0.27 in} Sigma.T <- sigma[3]\textasciicircum 2 * exp(-phi[2] * Data$D.T)\textasciicircum lambda \\ \hspace*{0.27 in} zeta <- as.vector(rmvn(1, rep(0,Data$S), Sigma.S)) \\ \hspace*{0.27 in} theta <- as.vector(rmvn(1, rep(0,Data$T), Sigma.T)) \\ \hspace*{0.27 in} return(c(zeta, theta, beta, phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D.S=D.S, D.T=D.T, K=K, PGF=PGF, S=S, T=T, X=X, Y=Y, \\ \hspace*{0.27 in} latitude=latitude, longitude=longitude, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.zeta=pos.zeta, pos.theta=pos.theta, \\ \hspace*{0.27 in} pos.beta=pos.beta, pos.phi=pos.phi, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} zeta.mu <- rep(0,Data$S) \\ \hspace*{0.27 in} theta.mu <- rep(0,Data$T) \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} kappa <- 1; lambda <- 1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\ \hspace*{0.27 in} Sigma.S <- sigma[2]\textasciicircum 2 * exp(-phi[1] * Data$D.S)\textasciicircum kappa \\ \hspace*{0.27 in} Sigma.T <- sigma[3]\textasciicircum 2 * exp(-phi[2] * Data$D.T)\textasciicircum lambda \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} zeta.prior <- dmvn(zeta, zeta.mu, Sigma.S, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- dmvn(theta, theta.mu, Sigma.T, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dunif(phi, 1, 5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Theta <- matrix(theta, Data$S, Data$T, byrow=TRUE) \\ \hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) + zeta + Theta \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, sigma[1], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + theta.prior + sigma.prior + \\ \hspace*{0.62 in} phi.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma[1]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,S), rep(0,T), rep(0,2), rep(1,2), rep(1,3))} \section{Spatial Autoregression (SAR)} \label{sar} The spatial autoregressive (SAR) model in this example uses areal data that consists of first-order neighbors that were specified and converted from point-based data with longitude and latitude coordinates. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta + \phi \textbf{z}$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\phi \sim \mathcal{U}(-1, 1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 100 \\ latitude <- runif(N,0,100); longitude <- runif(N,0,100) \\ J <- 3 \#Number of predictors, including the intercept \\ X <- matrix(runif(N*J,0,3), N, J); X[,1] <- 1 \\ beta.orig <- runif(J,0,3); phi <- runif(1,0,1) \\ D <- as.matrix(dist(cbind(longitude, latitude), diag=TRUE, upper=TRUE)) \\ W <- exp(-D) \#Inverse distance as weights \\ W <- ifelse(D == 0, 0, W) \\ epsilon <- rnorm(N,0,1) \\ y <- tcrossprod(X, t(beta.orig)) + sqrt(latitude) + sqrt(longitude) + \\ \hspace*{0.27 in} epsilon \\ Z <- W / matrix(rowSums(W), N, N) * matrix(y, N, N, byrow=TRUE) \\ z <- rowSums(Z) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), phi=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} phi <- runif(1,-1,1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, latitude=latitude, longitude=longitude, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.phi=pos.phi, pos.sigma=pos.sigma, y=y, z=z)} \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dunif(phi, -1, 1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) + phi*Data$z \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 0.5, 1)} \section{STARMA(p,q)} \label{starma} The data in this example of a space-time autoregressive moving average (STARMA) are coordinate-based, and the adjacency matrix \textbf{A} is created from $K$ nearest neighbors. Otherwise, an adjacency matrix may be specified as usual for areal data. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. \subsection{Form} $$\textbf{Y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu_{s,t} = \sum^J_{j=1} \textbf{X}_{s,t,j} \beta_j + \sum^L_{l=1} \sum^P_{p=1} \phi_{l,p} \textbf{W}^1_{s,t-p,l} + \sum^M_{m=1} \sum^Q_{q=1} \theta_{m,q} \textbf{W}^2_{s,t-q,m}, \quad j=1,\dots,J, \quad s=1,\dots,S, \quad t=p,\dots,T$$ $$\textbf{W}^1_{1:S,1:T,l} = \textbf{V}_{1:S,1:S,l} \textbf{Y}, \quad l=1,\dots,L$$ $$\textbf{W}^2_{1:S,1:T,m} = \textbf{V}_{1:S,1:S,m} \epsilon, \quad m=1,\dots,M$$ $$\epsilon = \textbf{Y} - \mu$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\phi_{l,p} \sim \mathcal{U}(-1, 1), \quad l=1,\dots,L, \quad p=1,\dots,P$$ $$\sigma \sim \mathcal{HC}(25)$$ $$\theta_{m,q} \sim \mathcal{N}(0, 1000), \quad m=1,\dots,M, \quad q=1,\dots,Q$$ where \textbf{V} is an adjacency array that is scaled so that each row sums to one, $\beta$ is a vector of regression effects, $\phi$ is a matrixr of autoregressive space-time parameters, $\sigma$ is the residual variance, and $\theta$ is a matrix of moving average space-time parameters. \subsection{Data} \code{data(demontexas) \\ Y <- t(diff(t(as.matrix(demontexas[,c(18:30)])))) \#Note this is not stationary \\ X <- array(1, dim=c(369,13-1,3)) \\ X[, , 2] <- CenterScale(demontexas[,1]) \\ X[, , 3] <- demontexas[,4] \\ latitude <- demontexas[,2] \\ longitude <- demontexas[,3] \\ S <- nrow(Y) \#Number of sites, or points in space \\ T <- ncol(Y) \#Number of time-periods \\ J <- dim(X)[3] \#Number of columns in design matrix X including the intercept \\ K <- 5 \#Number of nearest neighbors \\ L <- 2 \#Spatial autoregressive order \\ M <- 2 \#Spatial moving average order \\ P <- 2 \#Autoregressive order \\ Q <- 2 \#Moving average order \\ D <- as.matrix(dist(cbind(longitude, latitude), diag=TRUE, upper=TRUE)) \\ A <- V <- array(0, dim=c(nrow(D),ncol(D),P)) \\ W1 <- array(0, dim=c(S,T,max(L,M))) \\ for (l in 1:max(L,M)) \{ \\ \hspace*{0.27 in} A[, , l] <- exp(-D) \\ \hspace*{0.27 in} A[, , l] <- apply(A[, , l], 1, rank) \\ \hspace*{0.27 in} A[, , l] <- ifelse(A[, , l] > (l-1)*K \& A[, , l] <= l*K, 1, 0) \\ \hspace*{0.27 in} V[, , l] <- A[, , l] / rowSums(A[, , l]) \\ \hspace*{0.27 in} V[, , l] <- ifelse(is.nan(V[, , l]), 1/ncol(V[, , l]), V[, , l]) \\ \hspace*{0.27 in} W1[, , l] <- tcrossprod(V[, , l], t(Y))\} \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), phi=matrix(0,L,P), sigma=0, \\ \hspace*{0.27 in} theta=matrix(0,M,Q))) \\ pos.beta <- grep("beta", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} phi <- runif(Data$L*Data$P,-1,1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} theta <- rnorm(Data$M*Data$Q) \\ \hspace*{0.27 in} return(c(beta, phi, sigma, theta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, K=K, L=L, M=M, P=P, Q=Q, PGF=PGF, S=S, T=T, V=V, W1=W1, \\ \hspace*{0.27 in} X=X, Y=Y, latitude=latitude, longitude=longitude, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, pos.theta=pos.theta) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} phi <- matrix(interval(parm[Data$pos.phi], -1, 1), Data$L, Data$P) \\ \hspace*{0.27 in} parm[Data$pos.phi] <- as.vector(phi) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} theta <- matrix(parm[Data$pos.theta], Data$M, Data$Q) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dunif(phi, -1, 1, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dnormv(theta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- beta[1]*Data$X[, , 1] \\ \hspace*{0.27 in} for (j in 2:Data$J) mu <- mu + beta[j]*Data$X[, , j] \\ \hspace*{0.27 in} for (l in 1:Data$L) \{for (p in 1:Data$P) \{ \\ \hspace*{0.62 in} mu[,-c(1:p)] <- mu[,-c(1:p)] + \\ \hspace*{0.95 in} phi[l,p]*Data$W1[, 1:(Data$T - p), l]\}\} \\ \hspace*{0.27 in} epsilon <- Data$Y - mu \\ \hspace*{0.27 in} for (m in 1:Data$M) \{ \\ \hspace*{0.62 in} W2 <- tcrossprod(Data$V[, , m], t(epsilon)) \\ \hspace*{0.62 in} for (q in 1:Data$Q) \{ \\ \hspace*{0.95 in} mu[,-c(1:q)] <- mu[,-c(1:q)] + \\ \hspace*{0.95 in} theta[m,q]*W2[,1:(Data$T - q)]\}\} \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[,-c(1:max(Data$P,Data$Q))], \\ \hspace*{0.62 in} mu[,-c(1:max(Data$P,Data$Q))], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + phi.prior + sigma.prior + theta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(0,L*P), 1, rep(0,M*Q))} \section{State Space Model (SSM), Linear Regression} \label{ssm.lin.reg} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_{J+1}), \quad t=1,\dots,T$$ $$\mu = \textbf{X}\beta$$ $$\beta_{t,j} \sim \mathcal{N}(\mu_j + \phi_j(\beta_{t-1,j} - \mu_j), \sigma^2_j), \quad t=2,\dots,T, \quad j=1,\dots,J$$ $$\beta_{1,j} \sim \mathcal{N}(\mu_j + \phi_j(b^0_j - \mu_j), \sigma^2_j), \quad j=1,\dots,J$$ $$b^0_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\mu_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\phi_j \sim \mathcal{BETA}(20, 1.5) \quad j=1,\dots,J$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,(J+1)$$ \subsection{Data} \code{data(demonfx) \\ y <- demonfx[1:50,1] \\ X <- cbind(1, as.matrix(demonfx[1:50,2:3])) \\ T <- nrow(X) \\ J <- ncol(X) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(b0=rep(0,J), beta=matrix(0,T,J), \\ \hspace*{0.27 in} mu=rep(0,J), phi=rep(0,J), sigma=rep(0,J+1))) \\ pos.b0 <- grep("b0", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.mu <- grep("mu", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} b0 <- rnorm(Data$J) \\ \hspace*{0.27 in} beta <- c(rnorm(Data$T,mean(Data$y),1), rnorm(Data$T*(Data$J-1))) \\ \hspace*{0.27 in} mu <- rnorm(Data$J) \\ \hspace*{0.27 in} phi <- runif(Data$J, -1, 1) \\ \hspace*{0.27 in} sigma <- runif(Data$J+1) \\ \hspace*{0.27 in} return(c(beta, mu, phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, T=T, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.b0=pos.b0, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.mu=pos.mu, pos.phi=pos.phi, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} b0 <- parm[Data$pos.b0] \\ \hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$T, Data$J) \\ \hspace*{0.27 in} mu <- parm[Data$pos.mu] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} b0.prior <- sum(dnormv(b0, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, matrix(mu, Data$T, Data$J, byrow=TRUE) + \\ \hspace*{0.62 in} matrix(phi, Data$T, Data$J, byrow=TRUE) * \\ \hspace*{0.62 in} (rbind(b0, beta[-Data$T,]) - \\ \hspace*{0.62 in} matrix(mu, Data$T, Data$J, byrow=TRUE)), \\ \hspace*{0.62 in} matrix(sigma[1:Data$J], Data$T, Data$J, byrow=TRUE), log=TRUE)) \\ \hspace*{0.27 in} mu.prior <- sum(dnormv(mu, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dbeta((phi+1)/2, 20, 1.5, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- rowSums(beta*Data$X) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[Data$J+1], log=TRUE)) \\ \hspace*{0.27 in} yhat <- rnorm(length(mu), mu, sigma[Data$J+1]) \#Fitted \\ \hspace*{0.27 in} \#yhat <- rnorm(length(mu), rowSums(matrix(rnorm(Data$T*Data$J, \\ \hspace*{0.62 in} \# rbind(b0, beta[-Data$T,]), matrix(sigma[-Data$J], Data$T, Data$J, \\ \hspace*{0.62 in} \# byrow=TRUE)), Data$T, Data$J) * Data$X), sigma[Data$J+1]) \#One-step ahead \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + b0.prior + beta.prior + mu.prior + phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(mean(y),T), rep(0,T*(J-1)), rep(0,J), \\ \hspace*{0.27 in} rep(0,J), rep(1,J+1))} \section{State Space Model (SSM), Local Level} \label{ssm.ll} The local level model is the simplest, non-trivial example of a state space model (SSM). As such, this version of a local level SSM has static variance parameters. \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_1), \quad t=1,\dots,T$$ $$\mu_t \sim \mathcal{N}(\mu_{t-1}, \sigma^2_2), \quad t=2,\dots,T$$ $$\mu_1 \sim \mathcal{N}(0, 1000)$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$ \subsection{Data} \code{T <- 20 \\ T.m <- 14 \\ mu.orig <- rep(0,T) \\ for (t in 2:T) \{mu.orig[t] <- mu.orig[t-1] + rnorm(1,0,1)\} \\ y <- mu.orig + rnorm(T,0,0.1) \\ y[(T.m+2):T] <- NA \\ mon.names <- rep(NA, (T-T.m)) \\ for (i in 1:(T-T.m)) mon.names[i] <- paste("yhat[",(T.m+i),"]", sep="") \\ parm.names <- as.parm.names(list(mu=rep(0,T), sigma=rep(0,2))) \\ pos.mu <- grep("mu", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} mu <- rnorm(Data$T) \\ \hspace*{0.27 in} sigma <- runif(2) \\ \hspace*{0.27 in} return(c(mu, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, T.m=T.m, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.mu=pos.mu, pos.sigma=pos.sigma, y=y) \\ Dyn <- matrix(paste("mu[",1:T,"]",sep=""), T, 1) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} mu <- parm[Data$pos.mu] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} mu.prior <- sum(dnormv(mu[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dnorm(mu[-1], mu[-Data$T], sigma[2], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[1:Data$T.m], mu[1:Data$T.m], sigma[1], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} yhat <- rnorm(length(mu), c(mu[1], rnorm(Data$T-1, mu[-Data$T], \\ \hspace*{0.62 in} sigma[2])), sigma[1]) \#One-step ahead \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + mu.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=mu[(Data$T.m+1):Data$T], \\ \hspace*{0.62 in} yhat=yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,T), rep(1,2))} \section{State Space Model (SSM), Local Linear Trend} \label{ssm.llt} The local linear trend model is a state space model (SSM) that extends the local level model to include a dynamic slope parameter. For more information on the local level model, see section \ref{ssm.ll}. This example has static variance parameters. \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_1), \quad t=1,\dots,T$$ $$\mu_t \sim \mathcal{N}(\mu_{t-1} + \delta_{t-1}, \sigma^2_2), \quad t=2,\dots,T$$ $$\mu_1 \sim \mathcal{N}(0, 1000)$$ $$\delta_t \sim \mathcal{N}(\delta_{t-1}, \sigma^2_3), \quad t=2,\dots,T$$ $$\delta_1 \sim \mathcal{N}(0, 1000)$$ $$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,3$$ \subsection{Data} \code{T <- 20 \\ T.m <- 14 \\ mu.orig <- delta.orig <- rep(0,T) \\ for (t in 2:T) \{ \\ \hspace*{0.27 in} delta.orig[t] <- delta.orig[t-1] + rnorm(1,0,0.1) \\ \hspace*{0.27 in} mu.orig[t] <- mu.orig[t-1] + delta.orig[t-1] + rnorm(1,0,1)\} \\ y <- mu.orig + rnorm(T,0,0.1) \\ y[(T.m+2):T] <- NA \\ mon.names <- rep(NA, (T-T.m)) \\ for (i in 1:(T-T.m)) mon.names[i] <- paste("yhat[",(T.m+i),"]", sep="") \\ parm.names <- as.parm.names(list(mu=rep(0,T), delta=rep(0,T), \\ \hspace*{0.27 in} sigma=rep(0,3))) \\ pos.mu <- grep("mu", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} mu <- rnorm(Data$T) \\ \hspace*{0.27 in} delta <- rnorm(Data$T) \\ \hspace*{0.27 in} sigma <- runif(3) \\ \hspace*{0.27 in} return(c(mu, delta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, T.m=T.m, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.mu=pos.mu, pos.delta=pos.delta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} mu <- parm[Data$pos.mu] \\ \hspace*{0.27 in} delta <- parm[Data$pos.delta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} mu.prior <- sum(dnormv(mu[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dnorm(mu[-1], mu[-Data$T]+delta[-Data$T], sigma[2], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnormv(delta[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dnorm(delta[-1], delta[-Data$T], sigma[3], log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[1:Data$T.m], mu[1:Data$T.m], sigma[1], \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} yhat <- rnorm(length(mu), c(mu[1], rnorm(Data$T-1, mu[-Data$T], \\ \hspace*{0.62 in} sigma[2])), sigma[1]) \#One-step ahead \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + mu.prior + delta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=mu[(Data$T.m+1):Data$T], \\ \hspace*{0.62 in} yhat=yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,T), rep(0,T), rep(1,3))} \section{State Space Model (SSM), Stochastic Volatility (SV)} \label{sv} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(0, \sigma^2)$$ $$\sigma^2 = \frac{1}{\exp(\theta)}$$ $$\beta = \exp(\mu / 2)$$ $$\theta_1 \sim \mathcal{N}(\mu + \phi (\alpha - \mu), \tau)$$ $$\theta_t \sim \mathcal{N}(\mu + \phi (\theta_{t-1} - \mu), \tau), \quad t=2,\dots,T$$ $$\alpha \sim \mathcal{N}(\mu, \tau)$$ $$\phi \sim \mathcal{U}(-1, 1)$$ $$\mu \sim \mathcal{N}(0, 10)$$ $$\tau \sim \mathcal{HC}(25)$$ \subsection{Data} \code{T <- 20 \\ y <- rep(10,T); epsilon <- rnorm(T,0,1) \\ for (t in 2:T) \{y[t] <- 0.8*y[t-1] + epsilon[t-1]\} \\ mon.names <- c("LP",paste("sigma2[",1:T,"]",sep="")) \\ parm.names <- as.parm.names(list(theta=rep(0,T), alpha=0, phi=0, mu=0, \\ \hspace*{0.27 in} tau=0)) \\ pos.theta <- grep("theta", parm.names) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.mu <- grep("mu", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} phi <- runif(1,-1,1) \\ \hspace*{0.27 in} mu <- rnorm(1) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} alpha <- rnorm(1, mu, tau) \\ \hspace*{0.27 in} theta <- rnorm(Data$T, mu + phi*(alpha - mu), tau) \\ \hspace*{0.27 in} return(c(theta, alpha, phi, mu, tau)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \hspace*{0.27 in} pos.theta=pos.theta, pos.alpha=pos.alpha, pos.phi=pos.phi, \\ \hspace*{0.27 in} pos.mu=pos.mu, pos.tau=pos.tau y=y) \\ Dyn <- matrix(paste("theta[",1:T,"]",sep=""), T, 1) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} theta <- parm[Data$pos.theta] \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} mu <- parm[Data$pos.mu] \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, mu, tau, log=TRUE) \\ \hspace*{0.27 in} theta.prior <- sum(dnormv(theta[1], mu + phi*(alpha-mu), tau, \\ \hspace*{0.62 in} log=TRUE), dnormv(theta[-1], mu + phi*(theta[-Data$T]-mu), tau, \\ \hspace*{0.62 in} log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- dunif(phi, -1, 1, log=TRUE) \\ \hspace*{0.27 in} mu.prior <- dnormv(mu, 0, 10, log=TRUE) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} beta <- exp(mu / 2) \\ \hspace*{0.27 in} sigma2 <- 1 / exp(theta) \\ \hspace*{0.27 in} LL <- sum(dnormv(Data$y, 0, sigma2, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + theta.prior + phi.prior + mu.prior + \\ \hspace*{0.62 in} tau.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, sigma2), \\ \hspace*{0.62 in} yhat=rnormv(length(Data$y), 0, sigma2), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,T), 0, 0, 0, 1)} \section{Threshold Autoregression (TAR)} \label{tar} \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\nu_t, \sigma^2), \quad t=1,\dots,T$$ \[\nu_t = \left\{ \begin{array}{l l} \alpha_1 + \phi_1 \textbf{y}_{t-1}, \quad t=1,\dots,T & \quad \mbox{if $t \ge \theta$}\\ \alpha_2 + \phi_2 \textbf{y}_{t-1}, \quad t=1,\dots,T & \quad \mbox{if $t < \theta$} \\ \end{array} \right. \] $$\alpha_j \sim \mathcal{N}(0, 1000) \in [-1,1], \quad j=1,\dots,2$$ $$\phi_j \sim \mathcal{N}(0, 1000), \in [-1,1], \quad j=1,\dots,2$$ $$\theta \sim \mathcal{U}(2, T-1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ T <- length(y) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,2), phi=rep(0,2), theta=0, \\ \hspace*{0.27 in} sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.phi <- grep("phi", parm.names) \\ pos.theta <- grep("theta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rtrunc(2, "norm", a=-1, b=1, mean=0, sd=1) \\ \hspace*{0.27 in} phi <- rtrunc(2, "norm", a=-1, b=1, mean=0, sd=1) \\ \hspace*{0.27 in} theta <- runif(1,2,Data$T-1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, phi, theta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \\ \hspace*{0.27 in} pos.alpha=pos.alpha, pos.phi=pos.phi, pos.theta=pos.theta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha], -1, 1) \\ \hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\ \hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 2, Data$T-1) \\ \hspace*{0.27 in} parm[Data$pos.theta] <- theta \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dtrunc(alpha, "norm", a=-1, b=1, mean=0, \\ \hspace*{0.62 in} sd=sqrt(1000), log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dtrunc(phi, "norm", a=-1, b=1, mean=0, \\ \hspace*{0.62 in} sd=sqrt(1000), log=TRUE)) \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} theta.prior <- dunif(theta, 2, Data$T-1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(0, Data$T, 2) \\ \hspace*{0.27 in} mu[,1] <- c(alpha[1], alpha[1] + phi[1]*Data$y[-Data$T]) \\ \hspace*{0.27 in} mu[,2] <- c(alpha[2], alpha[2] + phi[2]*Data$y[-Data$T]) \\ \hspace*{0.27 in} nu <- mu[,2]; temp <- which(1:Data$T < theta) \\ \hspace*{0.27 in} nu[temp] <- mu[temp,1] \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], nu[-1], sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + theta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(nu), nu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,4), T/2, 1)} \section{Time Varying AR(1) with Chebyshev Series} \label{tvarcs} This example consists of a first-order autoregressive model, AR(1), with a time-varying parameter (TVP) $\phi$, that is a Chebyshev series constructed from a linear combination of orthonormal Chebyshev time polynomials (CTPs) and parameter vector $\beta$. The user creates basis matrix \textbf{P}, specifying polynomial degree $D$ and time $T$. Each column is a CTP of a different degree, and the first column is restricted to 1, the linear basis. CTPs are very flexible for TVPs, and estimate quickly because each is orthogonal, unlike simple polynomials and splines. \subsection{Form} $$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$ $$\mu_t = \alpha + \phi_{t-1} \textbf{y}_{t-1}$$ $$\phi_t = \textbf{P} \beta$$ $$\alpha \sim \mathcal{N}(0, 1000)$$ $$\beta_d \sim \mathcal{N}(0, 1000), \quad d=1,\dots,(D+1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\ D <- 6 \#Maximum degree of Chebyshev time polynomials \\ T <- length(y) \\ P <- matrix(1, T, D+1) \\ for (d in 1:D) \{P[,d+1] <- sqrt(2)*cos(d*pi*(c(1:T)-0.5)/T)\} \\ mon.names <- c("LP", "ynew", as.parm.names(list(phi=rep(0,T-1)))) \\ parm.names <- as.parm.names(list(alpha=0, beta=rep(0,D+1), sigma=0)) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(1) \\ \hspace*{0.27 in} beta <- rnorm(Data$D+1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(alpha, beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(D=D, P=P, PGF=PGF, T=T, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} phi <- tcrossprod(Data$P[-Data$T,], t(beta)) \\ \hspace*{0.27 in} mu <- c(alpha, alpha + phi*Data$y[-Data$T]) \\ \hspace*{0.27 in} ynew <- rnorm(1, alpha + tcrossprod(Data$P[Data$T,], t(beta))* \\ \hspace*{0.62 in} Data$y[Data$T], sigma) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,ynew,phi), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,D+2), 1)} \section{Variable Selection, BAL} \label{bal} This approach to variable selection is one of several forms of the Bayesian Adaptive Lasso (BAL). The lasso applies shrinkage to exchangeable scale parameters, $\gamma$, for the regression effects, $\beta$. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_1 \sim \mathcal{L}(0, 1000)$$ $$\beta_j \sim \mathcal{L}(0, \gamma_j), \quad j=2,\dots,J$$ $$\gamma_j \sim \mathcal{G}^{-1}(\delta, \tau), \quad \in [0,\infty]$$ $$\delta \sim \mathcal{HC}(25)$$ $$\tau \sim \mathcal{HC}(25)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), gamma=rep(0,J-1), delta=0, \\ \hspace*{0.27 in} tau=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} delta <- runif(1) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} gamma <- rinvgamma(Data$J-1, delta, tau) \\ \hspace*{0.27 in} beta <- rlaplace(Data$J, 0, c(1,gamma)) \\ \hspace*{0.27 in} return(c(beta, gamma, delta, tau, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.delta=pos.delta, pos.tau=pos.tau, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperhyperparameters \\ \hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.delta] <- delta \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Hyperhyperprior \\ \hspace*{0.27 in} delta.prior <- dhalfcauchy(delta, 25, log=TRUE) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} gamma.prior <- sum(dinvgamma(gamma, delta, tau, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dlaplace(beta, 0, c(1000, gamma), log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + delta.prior + tau.prior + \\ \hspace*{0.62 in} sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(0,J-1), rep(1,3))} \section{Variable Selection, Horseshoe} \label{horseshoe} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_1 \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{HS}(\lambda_j, \tau), \quad j=2,\dots,J$$ $$\lambda_j \sim \mathcal{HC}(1), \quad j=2,\dots,J$$ $$\tau \sim \mathcal{HC}(1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), lambda=rep(0,J-1), \\ \hspace*{0.27 in} tau=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} lambda <- runif(Data$J-1) \\ \hspace*{0.27 in} tau <- runif(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, lambda, tau, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.lambda=pos.lambda, \\ \hspace*{0.27 in} pos.tau=pos.tau, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dhs(beta[-1], lambda, tau, log=TRUE)) \\ \hspace*{0.27 in} lambda.prior <- sum(dhalfcauchy(lambda, 1, log=TRUE)) \\ \hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 1, log=TRUE) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(1,J-1), rep(1,2))} \section{Variable Selection, LASSO} \label{lasso} \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_1 \sim \mathcal{N}(0, 1000)$$ $$\beta_j \sim \mathcal{LASSO}(0, \sigma, \tau, \lambda_j), \quad j=2,\dots,J$$ \subsection{Data} \code{data(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0, tau=rep(0,J-1), \\ \hspace*{0.27 in} lambda=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ pos.tau <- grep("tau", parm.names) \\ pos.lambda <- grep("lambda", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} tau <- runif(Data$J-1) \\ \hspace*{0.27 in} lambda <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma, tau, lambda)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, \\ \hspace*{0.27 in} pos.tau=pos.tau, pos.lambda=pos.lambda, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\ \hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta[1], 0, 1000, log=TRUE), \\ \hspace*{0.62 in} dlasso(beta[-1], sigma, tau, lambda, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1, rep(1,J-1), 1)} \section{Variable Selection, RJ} \label{rj} This example uses the RJ (Reversible-Jump) algorithm of the \code{LaplacesDemon} function for variable selection and Bayesian Model Averaging (BMA). Other MCMC algorithms will not perform variable selection with this example, as presented. This is an example of variable selection in a linear regression. The only difference between the following example, and the example of linear regression (\ref{linear.reg}), is that RJ specifications are also included for the RJ algorithm, and that the RJ algorithm must be used. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{N <- 1000 \\ J <- 100 \#Number of predictors, including the intercept \\ X <- matrix(1,N,J) \\ for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\ beta.orig <- runif(J,-3,3) \\ zero <- sample(2:J, round(J*0.9)) \#Assign most parameters to be zero \\ beta.orig[zero] <- 0 \\ e <- rnorm(N,0,0.1) \\ y <- as.vector(tcrossprod(beta.orig, X) + e) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\ \#\#\# Reversible-Jump Specifications bin.n <- J-1 \#Maximum allowable model size \\ bin.p <- 0.4 \#Most probable size: bin.p x bin.n is binomial mean and median \\ parm.p <- rep(1/J,J+1) \\ selectable=c(0, rep(1,J-1), 0) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)} \section{Variable Selection, SSVS} \label{ssvs} This example uses a modified form of the random-effects (or global adaptation) Stochastic Search Variable Selection (SSVS) algorithm presented in \citet{ohara09}, which selects variables according to practical significance rather than statistical significance. Here, SSVS is applied to linear regression, though this method is widely applicable. For $J$ variables, each regression effect $\beta_j$ is conditional on $\gamma_j$, a binary inclusion variable. Each $\beta_j$ is a discrete mixture distribution with respect to $\gamma_j = 0$ or $\gamma_j = 1$, with precision 100 or $\beta_\sigma = 0.1$, respectively. As with other representations of SSVS, these precisions may require tuning. The binary inclusion variables are discrete parameters, and discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler. When the goal is to select the best model, each $\textbf{X}_{1:N,j}$ is retained for a future run when the posterior mean of $\gamma_j \ge 0.5$. When the goal is model-averaging, the results of this model may be used directly, which would please L. J. Savage, who said that ``models should be as big as an elephant'' \citep{draper95}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X} \beta$$ $$\beta_1 \sim \mathcal{N}(0, 1000)$$ $$(\beta_j | \gamma_j) \sim (1 - \gamma_j)\mathcal{N}(0, 0.01) + \gamma_j \mathcal{N}(0, \beta^2_\sigma) \quad j=2,\dots,J$$ $$\beta_\sigma \sim \mathcal{HC}(25)$$ $$\gamma_j \sim \mathcal{BERN}(1/(J-1)), \quad j=1,\dots,(J-1)$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ mon.names <- c("LP", "min.beta.sigma") \\ parm.names <- as.parm.names(list(beta=rep(0,J), gamma=rep(0,J-1), \\ \hspace*{0.27 in} b.sd=0, sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.gamma <- grep("gamma", parm.names) \\ pos.b.sd <- grep("b.sd", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} gamma <- rep(1,Data$J-1) \\ \hspace*{0.27 in} b.sd <- rnorm(1) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, gamma, b.sd, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\ \hspace*{0.27 in} pos.b.sd=pos.b.sd, pos.sigma=pos.sigma, y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Hyperparameters \\ \hspace*{0.27 in} beta.sigma <- interval(parm[Data$pos.b.sd], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.b.sd] <- beta.sigma \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\ \hspace*{0.27 in} beta.sigma <- rep(beta.sigma, Data$J-1) \\ \hspace*{0.27 in} beta.sigma[gamma == 0] <- 0.1 \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} \#\#\# Log-Hyperprior \\ \hspace*{0.27 in} beta.sigma.prior <- sum(dhalfcauchy(beta.sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, c(sqrt(1000), beta.sigma, log=TRUE))) \\ \hspace*{0.27 in} gamma.prior <- sum(dbern(gamma, 1/(Data$J-1), log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta*c(1,gamma))) \\ \hspace*{0.27 in} LL <- sum(dnorm(y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + beta.sigma.prior + gamma.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, min(beta.sigma)), \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), rep(1,J-1), rep(1,2))} \section{VARMA(p,q) - SSVS} \label{varmapqssvs} Stochastic search variable selection (SSVS) is applied to VARMA parameters. Note that the constants for the mixture variances are typically multiplied by the posterior standard deviations from an unrestricted VARMA that was updated previously, and these are not included in this example. Since an unrestricted VARMA model may be difficult to identify, this should be performed only on the AR parameters. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=1,\dots,T, \quad j=1,\dots,J$$ $$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Gamma^\Phi_{1:J,j,p}\Phi_{1:J,j,p}\textbf{Y}_{t-p,j} + \sum^Q_{q=1} \Gamma^\Theta_{1:J,j,q}\Theta_{1:J,j,q} \epsilon_{t-q,j}$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\Gamma^\Phi_{i,k,p} \sim \mathcal{BERN}(0.5), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$(\Phi_{i,k,p} | \Gamma^\Phi_{i,k,p}) \sim (1 - \Gamma^\Phi_{i,k,p})\mathcal{N}(0, 0.01) + \Gamma^\Phi_{i,k,p}\mathcal{N}(0, 10), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\Gamma^\Theta_{i,k,q} \sim \mathcal{BERN}(0.5), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad q=1,\dots,Q$$ $$(\Theta_{i,k,q} | \Gamma^\Theta_{i,k,q}) \sim (1 - \Gamma^\Theta_{i,k,q})\mathcal{N}(0, 0.01) + \Gamma^\Theta_{i,k,q}\mathcal{N}(0, 10), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad q=1,\dots,Q$$ $$\sigma_j \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx[,1:3]) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L.P <- c(1,5,20) \#Autoregressive lags \\ L.Q <- c(1,2) \#Moving average lags \\ P <- length(L.P) \#Autoregressive order \\ Q <- length(L.Q) \#Moving average order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), \\ \hspace*{0.27 in} Gamma.phi=array(0, dim=c(J,J,P)), Phi=array(0, dim=c(J,J,P)), \\ \hspace*{0.27 in} Gamma.theta=array(0, dim=c(J,J,Q)), Theta=array(0, dim=c(J,J,Q)), \\ \hspace*{0.27 in} sigma=rep(0,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.Gamma.phi <- grep("Gamma.phi", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.Gamma.theta <- grep("Gamma.theta", parm.names) \\ pos.Theta <- grep("Theta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} Gamma.phi <- rep(1, Data$J*Data$J*Data$P) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\ \hspace*{0.27 in} Gamma.theta <- rep(1, Data$J*Data$J*Data$Q) \\ \hspace*{0.27 in} Theta <- rnorm(Data$J*Data$J*Data$Q) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, Gamma.phi, Phi, Gamma.theta, Theta, sigma)) \hspace*{0.27 in} \} \\ MyData <- list(J=J, L.P=L.P, L.Q=L.Q, P=P, Q=Q, PGF=PGF, T=T, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.Gamma.phi=pos.Gamma.phi, pos.Phi=pos.Phi, \\ \hspace*{0.27 in} pos.Gamma.theta=pos.Gamma.theta, pos.Theta=pos.Theta, \\ \hspace*{0.27 in} pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} Gamma.phi <- array(parm[Data$pos.Gamma.phi], \\ \hspace*{0.62 in} dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} Phi.Sigma <- Gamma.phi * 10 \\ \hspace*{0.27 in} Phi.Sigma[Gamma.phi == 0] <- 0.1 \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} Gamma.theta <- array(parm[Data$pos.Gamma.theta], \\ \hspace*{0.62 in} dim=c(Data$J, Data$J, Data$Q)) \\ \hspace*{0.27 in} Theta.Sigma <- Gamma.theta * 10 \\ \hspace*{0.27 in} Theta.Sigma[Gamma.theta == 0] <- 0.1 \\ \hspace*{0.27 in} Theta <- array(parm[Data$pos.Theta], dim=c(Data$J, Data$J, Data$Q)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Gamma.phi.prior <- sum(dbern(Gamma.phi, 0.5, log=TRUE)) \\ \hspace*{0.27 in} Phi.prior <- sum(dnorm(Phi, 0, Phi.Sigma, log=TRUE)) \\ \hspace*{0.27 in} Gamma.theta.prior <- sum(dbern(Gamma.theta, 0.5, log=TRUE)) \\ \hspace*{0.27 in} Theta.prior <- sum(dnorm(Theta, 0, Theta.Sigma, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[(1+Data$L.P[p]):Data$T,] <- mu[(1+Data$L.P[p]):Data$T,] + \\ \hspace*{0.95 in} Data$Y[1:(Data$T-Data$L.P[p]),] \%*\% \\ \hspace*{0.95 in} (Gamma.phi[, , p] * Phi[, , p]) \\ \hspace*{0.27 in} epsilon <- Data$Y - mu \\ \hspace*{0.27 in} for (q in 1:Data$Q) \\ \hspace*{0.62 in} mu[(1+Data$L.Q[q]):Data$T,] <- mu[(1+Data$L.Q[q]):Data$T,] + \\ \hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q]),] \%*\% \\ \hspace*{0.95 in} (Gamma.theta[, , q] * Theta[, , q]) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[(1+Data$L.P[Data$P]):Data$T,], \\ \hspace*{0.62 in} mu[(1+Data$L.P[Data$P]):Data$T,], \\ \hspace*{0.62 in} Sigma[(1+Data$L.P[Data$P]):Data$T,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + Gamma.phi.prior + Phi.prior + \\ \hspace*{0.27 in} Gamma.theta.prior + Theta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(colMeans(Y), rep(1,J*J*P), runif(J*J*P,-1,1), \\ \hspace*{0.27 in} rep(1,J*J*Q), rep(0,J*J*Q), rep(1,J))} \section{VAR(p)-GARCH(1,1)-M} \label{varpgarchm} The Minnesota prior is applied to the VAR parameters, and the multivariate GARCH component is estimated with asymmetric BEKK. Compared to VAR(p) or VARMA(p,q), this is computationally intensive. However, it also tends to result in a substantial improvement when time for computation is feasible. This model also performs well when SSVS is applied to all parameters except \textbf{C}, though it is even more computationally intensive, and is not shown here. \subsection{Form} $$\textbf{Y}_{t,1:J} \sim \mathcal{N}_J(\mu_{t,1:J}, H_{1:J,1:J,t})$$ $$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Phi_{1:J,j,p} \textbf{Y}_{t-p,j} + \sum \textbf{H}_{1:J,j,t-1} \delta_{1:J,j}$$ $$\textbf{H}_{,,t} = \Omega + \textbf{A}^T \epsilon_{t-1,}\epsilon^T_{t-1} \textbf{A} + \textbf{B}^T \textbf{H}_{,,t-1}\textbf{B} + \textbf{D}^T\zeta_{t-1,}\zeta^T_{t-1,}\textbf{D}, \quad t=2,\dots,T$$ $$\Omega = \textbf{C}\textbf{C}^T$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\delta_{i,k} \sim \mathcal{N}(0, 1000), \quad i=1,\dots,J, \quad k=1,\dots,J$$ $$\Phi_{i,k,p} \sim \mathcal{N}(\Phi^\mu_{i,k,p}, \Sigma_{i,k,p}), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\textbf{C}_{i,j} \sim \mathcal{N}(0, 100)$$ $$\textbf{A}_{i,j} \sim \mathcal{N}(0, 100)$$ $$\textbf{B}_{i,j} \sim \mathcal{N}(0, 100)$$ $$\textbf{D}_{i,j} \sim \mathcal{N}(0, 100)$$ where $\Phi$ has a Minnesota prior, \textbf{C} is lower-triangular with positive-only diagonal elements, and $\textbf{A}_{1,1}$, $\textbf{B}_{1,1}$, and $\textbf{D}_{1,1}$ must be positive. \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx[,1:3]) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ Phi.mu <- array(0, dim=c(J,J,P)) \\ Phi.mu[, , 1] <- diag(J) \\ C <- matrix(NA, J, J) \\ C[lower.tri(C, diag=TRUE)] <- 0 \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), delta=matrix(0,J,J), \\ \hspace*{0.27 in} Phi=array(0, dim=c(J,J,P)), C=C, A=matrix(0,J,J), B=matrix(0,J,J), \\ \hspace*{0.27 in} D=matrix(0,J,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.delta <- grep("delta", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.C <- grep("C", parm.names) \\ pos.A <- grep("A", parm.names) \\ pos.B <- grep("B", parm.names) \\ pos.D <- grep("D", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} delta <- rnorm(Data$J*Data$J) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\ \hspace*{0.27 in} C <- runif(Data$J*(Data$J+1)/2) \\ \hspace*{0.27 in} A <- as.vector(diag(Data$J)) + runif(Data$J*Data$J, -0.1, 0.1) \\ \hspace*{0.27 in} B <- as.vector(diag(Data$J)) + runif(Data$J*Data$J, -0.1, 0.1) \\ \hspace*{0.27 in} D <- as.vector(diag(Data$J)) + runif(Data$J*Data$J, -0.1, 0.1) \\ \hspace*{0.27 in} return(c(alpha, delta, Phi, C, A, B, D)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, L=L, P=P, PGF=PGF, Phi.mu=Phi.mu, T=T, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.delta=pos.delta, pos.Phi=pos.Phi, pos.C=pos.C, pos.A=pos.A, \\ \hspace*{0.27 in} pos.B=pos.B, pos.D=pos.D) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} delta <- matrix(parm[Data$pos.delta], Data$J, Data$J) \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} C <- matrix(0, Data$J, Data$J) \\ \hspace*{0.27 in} C[lower.tri(C, diag=TRUE)] <- parm[Data$pos.C] \\ \hspace*{0.27 in} diag(C) <- abs(diag(C)) \\ \hspace*{0.27 in} parm[Data$pos.C] <- C[lower.tri(C, diag=TRUE)] \\ \hspace*{0.27 in} Omega <- C \%*\% t(C) \\ \hspace*{0.27 in} A <- matrix(parm[Data$pos.A], Data$J, Data$J) \\ \hspace*{0.27 in} A[1,1] <- abs(A[1,1]) \\ \hspace*{0.27 in} parm[Data$pos.A] <- as.vector(A) \\ \hspace*{0.27 in} B <- matrix(parm[Data$pos.B], Data$J, Data$J) \\ \hspace*{0.27 in} B[1,1] <- abs(B[1,1]) \\ \hspace*{0.27 in} parm[Data$pos.B] <- as.vector(B) \\ \hspace*{0.27 in} D <- matrix(parm[Data$pos.D], Data$J, Data$J) \\ \hspace*{0.27 in} D[1,1] <- abs(D[1,1]) \\ \hspace*{0.27 in} parm[Data$pos.D] <- as.vector(D) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} delta.prior <- sum(dnormv(delta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, \\ \hspace*{0.62 in} theta=0.5, sqrt(diag(Omega))) \\ \hspace*{0.27 in} Phi.prior <- sum(dnormv(Phi, Data$Phi.mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} C.prior <- sum(dnormv(C[lower.tri(C, diag=TRUE)], 0, 100, log=TRUE)) \\ \hspace*{0.27 in} A.prior <- sum(dnormv(A, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} B.prior <- sum(dnormv(B, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} D.prior <- sum(dnormv(D, 0, 100, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[(1+Data$L[p]):Data$T,] <- mu[(1+Data$L[p]):Data$T,] + \\ \hspace*{0.95 in} Data$Y[1:(Data$T-Data$L[p]),] \%*\% Phi[, , p] \\ \hspace*{0.27 in} LL <- 0 \\ \hspace*{0.27 in} Yhat <- Data$Y \\ \hspace*{0.27 in} H <- array(Omega, dim=c(Data$J, Data$J, Data$T)) \\ \hspace*{0.27 in} for (t in 2:Data$T) \{ \\ \hspace*{0.62 in} eps <- Data$Y - mu \\ \hspace*{0.62 in} zeta <- matrix(interval(eps, -Inf, 0, reflect=FALSE), Data$T, \\ \hspace*{0.95 in} Data$J) \\ \hspace*{0.62 in} part1 <- t(A) \%*\% eps[t-1,] \%*\% t(eps[t-1,]) \%*\% A \\ \hspace*{0.62 in} part2 <- t(B) \%*\% H[, , t-1] \%*\% B \\ \hspace*{0.62 in} part3 <- t(D) \%*\% zeta[t-1,] \%*\% t(zeta[t-1,]) \%*\% D \\ \hspace*{0.62 in} H0 <- Omega + part1 + part2 + part3 \\ \hspace*{0.62 in} H0[upper.tri(H0, diag=TRUE)] <- t(H0)[upper.tri(H0, diag=TRUE)] \\ \hspace*{0.62 in} H[, , t] <- H0 \\ \hspace*{0.62 in} mu[t-1,] <- mu[t-1,] + colMeans(H[, , t-1]*delta) \\ \hspace*{0.62 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, \\ \hspace*{0.95 in} theta=0.5, sqrt(diag(H[, , t]))) \\ \hspace*{0.62 in} Phi.prior <- Phi.prior + sum(dnormv(Phi, Data$Phi.mu, Sigma, \\ \hspace*{0.95 in} log=TRUE)) \\ \hspace*{0.62 in} LL <- LL + dmvn(Y[t,], mu[t,], H[, , t], log=TRUE) \\ \hspace*{0.62 in} Yhat[t,] <- rmvn(1, mu[t,], H[, , t]) \\ \hspace*{0.62 in} \} \\ \hspace*{0.27 in} Phi.prior <- Phi.prior / Data$T \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + delta.prior + Phi.prior + C.prior + \\ \hspace*{0.62 in} A.prior + B.prior + D.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=Yhat, parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(colMeans(Y), rnorm(J*J), runif(J*J*P,-1,1), \\ \hspace*{0.27 in} runif(J*(J+1)/2), as.vector(diag(J)), as.vector(diag(J)), \\ \hspace*{0.27 in} as.vector(diag(J)))} \section{VAR(p) - Minnesota Prior} \label{varp} This is an example of a vector autoregression or VAR with $P$ lags that uses the Minnesota prior to estimate $\Sigma$. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=1,\dots,T, \quad j=1,\dots,J$$ $$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Phi_{1:J,j,p} \textbf{Y}_{t-p,j}$$ $$\textbf{y}^{new}_j = \alpha_j + \Phi_{1:J,j} \textbf{Y}_{T,j}$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\Phi_{i,k,p} \sim \mathcal{N}(\Phi^\mu_{i,k,p}, \Sigma_{i,k,p}), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\sigma_j \sim \mathcal{HC}(25)$$ where $\Phi^\mu$ and $\Sigma$ are set according to the Minnesota prior. \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx[,1:3]) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ Phi.mu <- array(0, dim=c(J,J,P)) \\ Phi.mu[, , 1] <- diag(J) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), \\ \hspace*{0.27 in} Phi=array(0, dim=c(J,J,P)), sigma=rep(0,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, Phi, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, L=L, P=P, PGF=PGF, Phi.mu=Phi.mu, T=T, Y=Y, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.Phi=pos.Phi, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, theta=0.5, \\ \hspace*{0.62 in} sigma) \\ \hspace*{0.27 in} Phi.prior <- sum(dnormv(Phi, Data$Phi.mu, Sigma, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} for (p in 1:Data$P) \{ \\ \hspace*{0.62 in} mu[(1+Data$L[p]):Data$T,] <- mu[(1+Data$L[p]):Data$T,] + \\ \hspace*{0.62 in} Data$Y[1:(Data$T-Data$L[p]),] \%*\% Phi[ , , p]\} \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} mu[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} Sigma[(1+Data$L[Data$P]):Data$T,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + Phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(as.vector(colMeans(Y)), rep(0,J*J*P), rep(1,J))} \section{VAR(p) - SSVS} \label{varpsvss} Stochastic search variable selection (SSVS) is applied to VAR autoregressive parameters. Note that the constants for the mixture variances are typically multiplied by the posterior standard deviations from an unrestricted VAR that was updated previously, and these are not included in this example. \subsection{Form} $$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=1,\dots,T, \quad j=1,\dots,J$$ $$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Gamma_{1:J,j,p}\Phi_{1:J,j,p}\textbf{Y}_{t-p,j}$$ $$\alpha_j \sim \mathcal{N}(0, 1000)$$ $$\Gamma_{i,k,p} \sim \mathcal{BERN}(0.5), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$(\Phi_{i,k,p} | \Gamma_{i,k,p}) \sim (1 - \Gamma_{i,k,p})\mathcal{N}(0, 0.01) + \Gamma_{i,k,p}\mathcal{N}(0, 10), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$ $$\sigma_j \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonfx) \\ Y.orig <- as.matrix(demonfx[,1:3]) \\ Y <- diff(log(Y.orig[1:100,])) \\ Y.scales <- sqrt(.colVars(Y)) \\ Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\ T <- nrow(Y) \\ J <- ncol(Y) \\ L <- c(1,5,20) \#Autoregressive lags \\ P <- length(L) \#Autoregressive order \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J), \\ Gamma=array(0, dim=c(J,J,P)), Phi=array(0, dim=c(J,J,P)), \\ sigma=rep(0,J))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.Gamma <- grep("Gamma", parm.names) \\ pos.Phi <- grep("Phi", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J) \\ \hspace*{0.27 in} Gamma <- rep(1, Data$J*Data$J*Data$P) \\ \hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\ \hspace*{0.27 in} sigma <- runif(Data$J) \\ \hspace*{0.27 in} return(c(alpha, Gamma, Phi, sigma)) \\ \hspace*{0.27 in} \} MyData <- list(J=J, L=L, P=P, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.Gamma=pos.Gamma, \\ \hspace*{0.27 in} pos.Phi=pos.Phi, pos.sigma=pos.sigma) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\ \hspace*{0.27 in} Gamma <- array(parm[Data$pos.Gamma], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} Phi.Sigma <- Gamma * 10 \\ \hspace*{0.27 in} Phi.Sigma[Gamma == 0] <- 0.1 \\ \hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} Gamma.prior <- sum(dbern(Gamma, 0.5, log=TRUE)) \\ \hspace*{0.27 in} Phi.prior <- sum(dnorm(Phi, 0, Phi.Sigma, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} for (p in 1:Data$P) \\ \hspace*{0.62 in} mu[(1+Data$L[p]):Data$T,] <- mu[(1+Data$L[p]):Data$T,] + \\ \hspace*{0.62 in} Data$Y[1:(Data$T-Data$L[p]),] \%*\% (Gamma[, , p]*Phi[, , p]) \\ \hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\ \hspace*{0.27 in} LL <- sum(dnorm(Data$Y[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} mu[(1+Data$L[Data$P]):Data$T,], \\ \hspace*{0.62 in} Sigma[(1+Data$L[Data$P]):Data$T,], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + Gamma.prior + Phi.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(colMeans(Y), rep(1,J*J*P), runif(J*J*P,-1,1), rep(1,J))} \section{Weighted Regression} \label{weighted.reg} It is easy enough to apply record-level weights to the likelihood. Here, weights are applied to the linear regression example in section \ref{linear.reg}. \subsection{Form} $$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$ $$\mu = \textbf{X}\beta$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$ $$\sigma \sim \mathcal{HC}(25)$$ \subsection{Data} \code{data(demonsnacks) \\ N <- nrow(demonsnacks) \\ J <- ncol(demonsnacks) \\ y <- log(demonsnacks$Calories) \\ X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\ for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\ w <- c(rep(1,5), 0.2, 1, 0.01, rep(1,31)) \\ w <- w * (sum(w) / N) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\ pos.beta <- grep("beta", parm.names) \\ pos.sigma <- grep("sigma", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} beta <- rnorm(Data$J) \\ \hspace*{0.27 in} sigma <- runif(1) \\ \hspace*{0.27 in} return(c(beta, sigma)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\ \hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, w=w, \\ \hspace*{0.27 in} y=y) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} beta <- parm[Data$pos.beta] \\ \hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\ \hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\ \hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\ \hspace*{0.27 in} LL <- sum(w * dnorm(Data$y, mu, sigma, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- c(rep(0,J), 1)} \section{Zero-Inflated Poisson (ZIP)} \label{zip} \subsection{Form} $$\textbf{y} \sim \mathcal{P}(\Lambda_{1:N,2})$$ $$\textbf{z} \sim \mathcal{BERN}(\Lambda_{1:N,1})$$ \[\textbf{z}_i = \left\{ \begin{array}{l l} 1 & \quad \mbox{if $\textbf{y}_i = 0$}\\ 0 \\ \end{array} \right. \] \[\Lambda_{i,2} = \left\{ \begin{array}{l l} 0 & \quad \mbox{if $\Lambda_{i,1} \ge 0.5$}\\ \Lambda_{i,2} \\ \end{array} \right. \] $$\Lambda_{1:N,1} = \frac{1}{1 + \exp(-\textbf{X}_1 \alpha)}$$ $$\Lambda_{1:N,2} = \exp(\textbf{X}_2 \beta)$$ $$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J_1$$ $$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J_2$$ \subsection{Data} \code{N <- 1000 \\ J1 <- 4 \\ J2 <- 3 \\ X1 <- matrix(runif(N*J1,-2,2),N,J1); X1[,1] <- 1 \\ X2 <- matrix(runif(N*J2,-2,2),N,J2); X2[,1] <- 1 \\ alpha <- runif(J1,-1,1) \\ beta <- runif(J2,-1,1) \\ p <- invlogit(tcrossprod(X1, t(alpha)) + rnorm(N,0,0.1)) \\ mu <- round(exp(tcrossprod(X2, t(beta)) + rnorm(N,0,0.1))) \\ y <- ifelse(p > 0.5, 0, mu) \\ z <- ifelse(y == 0, 1, 0) \\ mon.names <- "LP" \\ parm.names <- as.parm.names(list(alpha=rep(0,J1), beta=rep(0,J2))) \\ pos.alpha <- grep("alpha", parm.names) \\ pos.beta <- grep("beta", parm.names) \\ PGF <- function(Data) \{ \\ \hspace*{0.27 in} alpha <- rnorm(Data$J1) \\ \hspace*{0.27 in} beta <- rnorm(Data$J2) \\ \hspace*{0.27 in} return(c(alpha, beta)) \\ \hspace*{0.27 in} \} \\ MyData <- list(J1=J1, J2=J2, N=N, PGF=PGF, X1=X1, X2=X2, \\ \hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\ \hspace*{0.27 in} pos.beta=pos.beta, y=y, z=z) \\ } \subsection{Model} \code{Model <- function(parm, Data) \\ \hspace*{0.27 in} \{ \\ \hspace*{0.27 in} \#\#\# Parameters \\ \hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha], -5, 5) \\ \hspace*{0.27 in} parm[Data$pos.beta] <- beta <- interval(parm[Data$pos.beta], -5, 5) \\ \hspace*{0.27 in} \#\#\# Log-Prior \\ \hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 5, log=TRUE)) \\ \hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 5, log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Likelihood \\ \hspace*{0.27 in} Lambda <- matrix(NA, Data$N, 2) \\ \hspace*{0.27 in} Lambda[,1] <- invlogit(tcrossprod(Data$X1, t(alpha))) \\ \hspace*{0.27 in} Lambda[,2] <- exp(tcrossprod(Data$X2, t(beta))) + 1e-100 \\ \hspace*{0.27 in} Lambda[which(Lambda[,1] >= 0.5),2] <- 0 \\ \hspace*{0.27 in} LL <- sum(dbern(Data$z, Lambda[,1], log=TRUE), \\ \hspace*{0.62 in} dpois(Data$y, Lambda[,2], log=TRUE)) \\ \hspace*{0.27 in} \#\#\# Log-Posterior \\ \hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior \\ \hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\ \hspace*{0.62 in} yhat=rpois(nrow(Lambda), Lambda[,2]), parm=parm) \\ \hspace*{0.27 in} return(Modelout) \\ \hspace*{0.27 in} \} \\ } \subsection{Initial Values} \code{Initial.Values <- GIV(Model, MyData, n=10000)} \bibliography{References} \end{document} LaplacesDemon/inst/doc/LaplacesDemonTutorial.pdf0000644000176200001440000141273215145054162021446 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 5255 /Filter /FlateDecode /N 89 /First 762 >> stream x\is6 ~{5$c+5U>2glYm%Hr<_O EMId4@"aL8wJe*щ`%&&BDXk/EQP+ڱD:L:*QVݘDsgK@ec@e '!k= m9:D .P`+(GέKu 5ύTk">RxP `,K@Md,z Ȋ!  J*tB3(@VF# qd=jƻDGAh]PzdìO0XED1&ZƁXDN #CV!Z)1l=2d@A3d@c^+qo1-n{ P 4CC8 7hX fetM0\%  1PddTs& B:!4%!,p-7>^h5J@ &ٛ|3^M`d|Fj:Yj~'هe^K̦PCYqhuju>_$ߟ槧cǻ],"vU|/a_ry2r9:%~"n`6lrT xo,HT&U!2Jta0jUbIeJ"E"czQ)'tRbͯf+'ڥh mĻ w"ULx/e>e4~Ѧ.m,#dn'·]٢x.]{úp%\1r1TQs) A^lWE()n<(-IVTEu]TEu]TEu]TV{* @}9v_^ЅPw>S9MQ0_ίc:×ӣg5b>>W!ɿq}tZG9-ЌDf+z`}zjmG~q>yԯtGw+n }p+fV<=|#wȘ0⽋"OK2.ԹDž^57q2pg^h_L8{t]MG 3O&$i2ۙ-'O&jHNx䢃Q,7U@?&c2iT\"j?MNVrXC~6ӒEVϰFIIjTBwG1r!\AhU\rLT70.哳2"~d{~vfldy+Q`vN{b5β5Νdc2IKw[Ndlulu=Ϯ߳KG?b^p$%385lƄi>ńCg0LIt4]eiM{?Vhͩ+ :&iMJ?)}ϤԘlC&;'o"oB 7'p3"G~ Rk9d0o+vϑ#W\^04\G‚2ԴĂw0`)a$%/juWʵ'iIrodTyR$P\puC.j \dJ-7Ҵk.~ܢl1\",`Zx)M<1\ հة-ۢQV=0t3H2a0!*RUUIJ שRPTД ӥJGkTݔ}2E%Wglr4;bsWtU>/!GU)hy]Ye<])9MR@#<HOR_NooWU~r< DQ!Ūy1):t-@n-bE.gRm5ˮXKjCS̡,4|4-ooVs"ʉj]uw4S6G7_4\\!SɊXܦEef6 6 um{;?M&TmRv35Y!?~qUMP5̀XJ6d>U[!'N%狶lZ@̮.!&gȊB`9%9W8/> |_ PRbcmhycN*Q&(!<]M5*TznKbτM.0 {f -{jb I7id!%7Ůi_NӠml8\~fU`儲9@HژR-V֮OG0zӤn}ٲ16*Ϯ^䃮H *gmWtuX&-6wkD:QSV~l<779)BrX[֡Hd7/^倲%7 ģ_-<) m7.l 4XXLK/[bCX !(x 1GF< r=i%mVž3]v@G.=´Seҡ# `"2+Q Bt]/͌R2W[?crWgùH`G4.۲N{[]dbnxjuW]h1>ҙ`\a6,T:=/'٣4qy g_VFò<9{SBgZ)] XoqǟjM'K-99 1'y#ٰ@mH:pj2n`srYtCoit}zM ?U望sY~[;C:yENѯ=M rk[[ͪ^G3H+A @{M-Pܦ$-wTbSO[CBهTYvTl)9q(NfM9,e<ܥi 9񯅜d>nAN8DNpTrBCH ImRm׸Am4p[/Ģg ;twD˸2C_?~-ph)t>9}daD3mo0 pA}qLtRg聴͟0݂m憓n!y'(̉^r9g<%Z_,'gȌV*ef#rIr+q{&j5KۢZۜw{wmnrC`mf170?E@۪>]5$LP_CU'9Ca Lհ pۆ;Xւps)}0siy6Y_[`t9~~1R4Ɔ~ ہq/h,ea->\ dY߾`Ҫp33t߽^G^bś䷫ d-'6Ŗ@O"aϐ ["10+#C\~=ᖇ 2ɼuwªim2|݉WNs2SNNܤ$~;nOp,dpDMIào4 CDRD5E޺Q5}o !?9B8æf4aϿ:jՉ/P)6AVgX$pvq Ʉ|6r`)L,6aEyXجz''DPendstream endobj 91 0 obj << /Subtype /XML /Type /Metadata /Length 1988 >> stream GPL Ghostscript 10.05.1 bayesian, big data, high performance computing, hpc, importance sampling, iterative quadrature, laplace approximation, laplacesdemon, laplacesdemoncpp, markov chain monte carlo, mcmc, metropolis, optimization, parallel, pmc, r, rejection sampling, variational bayes 2026-02-17T12:00:50Z 2026-02-17T12:00:50Z 2026-02-17T12:00:50Z LaTeX with hyperref LaplacesDemon: A Complete Environment for Bayesian Inference within RStatisticat endstream endobj 92 0 obj << /Type /ObjStm /Length 3518 /Filter /FlateDecode /N 87 /First 797 >> stream x[Y7~_P$"`;'6fNzla`b-6jH% zD 1$$4a«@p7$,1^n,#N)5$BDc*q(Az =Gy:_d+ yMjDZHquY ͐%BIm_>-on.%6q엛-qwl=/3}?Kbw'{} ㋝[v8_4pݱ+!tv?hv~2ݣ>W 08(lwcHZSєhnIS)McJC tA[P% ` X;#26'{l;Ӄs0#y&87^a&% F§r6bR@!Gm|#. 2my֮ VW3sG>‹*pE趎Vq;~g17#[N4؛>M`cuOubnV]a E7+9A;|k NDSK<,R?vԞi5X}2*Vrrcm] qrЕf<͔05NC\UζƬu.VO &kX1۠ ]&]:hI(ngea~fvPM{tjj>ea"JC"ذ;R䳈p&e,7mZ{|JKx5'$MY)v%j)Ay.x_]xryWӦ_n򫏗Z߿_)"Gwklڭ7lfhoD}by˼lXnnxwӻC@HBnpYybOB G)_|mMiw`,.>R=w|ݠ-?޽ƁȬO7v;Š9J'f#w"rF_<=t/#iv6!IlȾ1U0) #^qKRE>@=htX{O|/c|dn$hsѱv4,9`5F-3#Toml=&ݘ\V2?|?.Fg_p>`-opJR^i 83&)3@cCUCut\1F̽G!5ӖOMfZ H vusazv/w^/_\w{~x}x8XS X. 5ρA0 Y5#X9J) s\\QQ<B0~&.G?,aZ-j -^Pjpar廕eD=qdh#4c, (*I syLQE}rO*ܼA@lM7=!8p  Ҕ_ Lve|}kwp`{om)H9}$> stream x[YsI~_Q3AD``X`ؘY4fd#9RuXd Uu|UYyTZE$SQ0U.[tzY4 Rxrt=RbZS a:J4]gIB`;z$fRLKɬ(hfMO0=` لUhSe@k22g Ck9,M+\F31%K55Py {Mm"v&UtZK擣bAQY046 S,8Us= Ra&<ĢHu\FhQF谽*e1IP(m>){e2789sd?)J-^>紥!ļ-ܴr%juC̚L}"uһ|R Λ*vhx 7T\NƗI9zC1\ @ `HsalʼsAqp^ 8h߫χaEzfyZٰ x>N:LG9)7[Ğ|3/z53.cj1V@nL6Cm mXk;5m2;^z-F# .zyQ(Dz)O(DS!PxTKqIbnKU!<(?w1 Ƴ#͹7Lj]-]]F4?yբŕ""N#D ph1@U1@>ZpNe>'#thf%l-Oo^?;8'_Elh: Gl#}LZMSYl%ڐ .5᪶YUg,b 'mCVGJڎU9ĭq7—>x ǓŤf|4<@E5&w..b6w pHM!p}ꠓ41>pH@B Hnlf?<þ[qy/QsvA&39W!hk̐c#`^c-黂#01jpA˜7wL枿GI*)7$p]SQTU(4PdVIL10I|STc~֗񍯢ʁfrkjUpWUa ޓڃ>vq^<8z͢J+utfzvHҍ>ShhXcٚҹNg]\s_v6k24XL73ZakVgn(:ZȬBV'YQ]d~dߝ0oٹR .,&4-lCm܈TT7Vq '+ 5`Nn)A+5,'.%BIsF} ݶ|)۫Q-&|~{u; {x(j4ϊHYtH)(w|jxfooі&sniT˾2\&,ũu6Cp!%v$Aӵ`-1_=,hM1Kn l\Ѥ|d#[꯫qYK ^N*$ÐuMڒ 8^K}[7n~qx ,e{ҷqx&*lWj-X|',B|g\\CwnƦm.9`rϪ_zyY^N%&'gTZ*'5‹QPSj3?}-`?Yg(ĺf+%(<ϸ :JZ攷omϯS2툺86;nk&MAU<|Wĺk^uȤr*˷TўF @lMuhFTyIqRXFwn*=DFendstream endobj 270 0 obj << /Type /ObjStm /Length 2401 /Filter /FlateDecode /N 89 /First 815 >> stream x[[ܶ~/xIӴZ 8"h[ǀҮّv8\xnrTi[(ZhK NHi5ʆ_*a.L'!ӊ4 U 7UiXY0aAjƄG',(BIJAgM4k 6_,e̊WTZrRBN8d6Y)h)d!g19Q  gLJbb.0P+ -T:p)CADhE0SꌄZ2bhPEB44ܖ"PRU 99H+(sO)@J񷂧P D : jxbE3pOͿ#55G kPs"@tʰA k@[oDb 0H k򻯾 7߇ AA!x[{~w1GYW_z{_}wx|?|<00{,0{uሹo^}}~5߃ !soKokoG|{-O.s wD=n'FnޖvR.u mE=Dv8Q':qԉNwqq|q܉Nwt]jҥ#c'XDi'J;Q։Nueҭ*"Kκih '~ OAC:{1v̂VzM=S-=SO`ɷw?;4:4v;?;NDLn5ZEpq_|͟;BU##PX"c NOo>xL> OxZa8BF+iDz]lDޙ1S\f'iEZ\'9f$S) bd  0iq8؄2=+ ay`)c0M6ˬy ^NFr:(=6Sx(b1S]bdyIn\b/`j筻udO'pVcp),eϫβ3?re#/)Mo̽R` {d]1gR!\%g$&HVEE=GҶ5g# $ H]jk%pRW{fp"!x&p58K fpXe1 P#'סSi34XmloR7XnNgg^#"P%6˧ʇ(-.qOqo6 \ ˬCHj/UE5-yDCi4zS&egl{JN={}yebZ\ya/ȧX_e҈lu#bXٶPm+bh*9 CN ~pHӱZ,FGd^A#l7ؽ#upMa'k{c*diKg*lQT YΰQ4?֜A]_֫R)/֥* {j7^NKS|-ŮM;N*NTAku)r$q%!5C{ncco ܯ<Y-EGRX2*&yu<Ōֲ\F x"`3d- 3"#$V f|"MSHĖ} L3Ɋl݊;&/ce̱&݊cj4 6CY,I/s^qL 9SywA;T~ؼk6؜g`rTSʯ}( !7/^hxoȡ>9xA;A{ܟWLR B8Ȕ1`TnyW.Ř[ ^NYfZbll& .NirZ7H(gDs|Vf/l*!Iu[!@~دAb/gMؐaG틯Zܮ_eu'L3'8'*%-Vxg0?/l9<$rMC@#p0˶U9a .[$?*x {b: uU8N07'b_S@H\R|׶(2 _Rzig60ʉv@<,lv̉+7' oz ܖi)U=JlYEendstream endobj 360 0 obj << /Type /ObjStm /Length 2554 /Filter /FlateDecode /N 89 /First 819 >> stream x[Qo~cPg8$E i6@ r - Dh*ҹv}r{W$5]-f8f\p1ZF'QЊ+dmr5&Xq멎(.0Fe\.1 X)8e{ȎĂ!B 1*&\L_ !xKB Ga{0٣ Y=*NRNڀՉ ٫N*aJ.;1ۣRPťdJɥl쒊\\R)Aa BYY> rf\ nB @5@ CV#+Qu%Cы2~CJ5)!` O0N%avJN3٣ S*i֧UhòC5EL % 5NL0@F8[7G)H)$,` (IUKO_3@"bN9(T=T`m n@3\f *9`|elP 0o\aM61EgWW׻[f5[[mmnWNmew/T`ֆ7^79^:C5Fk={qs}r@_}6ݾa?O?nmﶸ}_ @Cۅ.v ]8ͽ-Zvjvjvjvjverox%/wms CӋy#bg]zrR[WZtsdG]8* j 8]5]5]N5݌ i-1:@, m;;1X}K7!k )ǭLbmhp2G96V{[-6Vz롏++)ʧ3c]'9`ͻ9aA:1^;EXns|y}z{ MvCW[-pb C`${1HR 0`yZW&/3` U9r\̦tF R ty?3lئ6 #&:&[N t\j\m-@>v HN^ɹ0J6bD;T>t}ᨍW ~ÝV"1ұ%յ$qulOi.Z p;iE dIE{p2{8{'K_WuSe>+UYe)ۡ'd_=+Vwғq&Թ|HNCdɍ`a#ఌՎa{!OXEP:؉ EG`>=iF+vȭQɸ[A!N^P[L(wMX2p58霽 yke6X ǂbFț ،?lZzv1,wfhE{J@N~EcN N$,I ܾfWd~\Nm,z/z6;fbwy}5v?ny}o._|g$H$$*6z}_<տ`y[q46pX1"yS#Zp8*L/$Q;B؎ i>@̟8endstream endobj 450 0 obj << /Filter /FlateDecode /Length 5211 >> stream x<]oF~<>y s؟dv`/2;ڲef$Qq<)VgƳbwuuGo"7ۋbBЯfEN,.Ģ4eY\m/2+>rkpM_yaT @M}W[h^L%*[e«qmB꿦h]ƥ.+kR+;Wfۺ'Te%rNPoLƈ=C9:/;|6f)pJf;*'J0JXHPhw#`eq0gWaX =Kzy [#ˬi$ -t/gpnfK$ՏWf'UZR32# g&2Q =FWDnle,u Uf?R@v] @scijaX?4\aplvB< aUTr ARJ`H ،TTz_Kq Z3l7NwDNkl} Өz:Jɩ*gsv<˹4Œ"Jd<ꏜx `V$/y>og7'ccAۂwTe024A q_ȅڒfLZ\*.wvPgz,ve1*>2ӘjL)9rR 랑l(Rz? $7Zœoׯ A"8-7% MSzg+9pBtCLxXCAg3ߧW@Sɂkj|xXB4@ "ib`>_8ƃa=~iL \ڱYԁNd^𹐜M@ޟVu_ti XollP{ZI^Z0w`wLc$.5i7 m4fF#n[ABDL%3Fs랽Bz$?jR2sZ/0ּ&[Zl髰i0OY!(U{c vVvF!"PME{&ڃ%f3Zd]@=ܭQCvdמåTb3èR"Qd&4"jEkLXQ~|F]DPf杷 .Sa!}| ֙J0I#qD'g( Q!e|T?F{*q&!dn][)|SоuQRʗ'Ds]o?@G@/5-A@='WudHιvKXH7pƫ4NpqwrJ͓4nMM"y.403~^FR@X\3:vQc4$([OF 4!n9^M=rr +%IA&3ƉW_dl 3 iYeib]Ujdžۭ~0DL[n9l= &![O4}@.Zθ:.<+r.j0:m6r.6/bR2I,gY( 4=Q4XdIJ>äb(;st#R#"*i,ˣ(Q}R_ TYpdЈ6`xTu)@ʀ,$, {`ic,e8&-Ig|vWU~vr ~[]2Sc6v'"=#H vϓeȪYLt"\u,-шhd4NbvzP8U>A,f2ѯPѭ 3\Ye)wOBaEaKy@u!XH:upڣ*lgD `)2kwsfY]Et 6TݝQۺk>(ւJ]i\m M5 @Хڳ)q W~"c_ThhΣzm`tDfvE$ ^tҗdX+}_ 0#;3̑Y&M?X{9Odnzзk}q+M ^86 VѰ =X*Jz499|,3J@<%!b| g*oEܪm3. To"7{ÑU%4aC46AW3ΪݓӚrtZlЪ kׯn󺻹omטRjKYơRj_XK'@%*8c7u[1)|A8C_.)[D3LSW. #Q z (iBzHZDjMz&+ w4RɥU@[P`:!چh70%:=ޟlPlTbI܉ oĜH2뽻27TOzX@ewJKȟ㺱1c1yǡÕmf,0,dq#oMݟu2dSj |0Y(hy8IF~ ebY͈ĶRM4h  #R' 6MIfeZN899!{|TNPxjSmrlL$}V:4x6)]9|tC\_QmLf(A* EWڍWB9w962 NՋr[ }AP=d_,_nA< u \ #0(a֠d}Α@\i+RZ.U!o]ԧ_XʜzzkXC#7{AXt*4شݓsJM{'ƗNOf:j5|M~FUt6:It<ĂҔ$tV#w]]~8D˪\H#r!q |e>\ڻnWÎ%r TzQzEVӗq_)x<]&%xZS|W;bN+哅0!z-qKZMH[ *^(W~6Fx |@^K J:44.ln}}߿P_Eo?޼?B?oNouUcw3Z:Y>^46V)~ ō%([”Ke>08ևSd+(j@x?kN90fT"O̤I/+=pJr}h-Y_¦S@m.`ڤq|HރJB7MD }41&., l2j\M\j`|#WEw!&L=Wtj!dZt%(oT/;DC2(dȦ*̺ܺ`A?Ϊ1lXuk޹2 uUȉe<"ʻfLRp6/4, e܀a[E5r1?( 6ǃOQ6Sl@lawJHoi%T}+O`ORg[ԧʡ$].xGTdHdl}Lڮ4zGT.P:!ҡ hHW&_pt[@8M}՛)ejM+8> 5ҵGSfca%4\7›>*R_9MPBHendstream endobj 451 0 obj << /Filter /FlateDecode /Length 4106 >> stream x[m6p`J7kU|rikлk!kg/(ofHJ,&M%r8g̛qYq¿Q9qz;\}3^t||j𱰦pBz|](tY^O╩XL~xDˌP(_GSxQjrYhD:DAPէvGA+t(+6Ϧgm|g-VD "QF44SeR Uu^/fmYX6Þ>~YYk>-5}6bT6Zݺ'ߖvXVܘ6rhYcH5f[+|!B8$)LVp}H(dycs }5aPxNgc! O9Wr)+0&UwӷSAM_,`mt/o8ʙ61)JdUf>U]0@Z^`|U`Ff݅A99b]śr8E FWiFq5 Tk#O*f R.N4~10JypKu:Pim)awDm@A6[mkc-/^^k,Kҏ2.͑vwfC{F//?&SM h3k'&mcp )d!v,Y{7uS\,8.*Ɋ#E !SQn&/N KeΣ9 ~"ƣo'Sm#(mF6sgay\Vc \J d^~:Vwԯ܎AFW C ի/;{ȕ*ea+1-X_#"J$,^&=(S"Чc sE9ʻ{Ş:IL)df'^lV*Fz`6ςm#,4~r牆-QD@W9va0)U? pq}7 3]8N7GHn 3摢ާ}mJ]s |~R򐇪z %;Un'Tt=抰 xyu5 h1zub؆UUXgZQîv*R^>kChmÎQPIHX"\!=k"lޅD k7KopdH<:R;}DdSLBd@i3kbf ltY_Q0by=GI!Ƥd &+ N] h jFkugY|N Rn#"i2GBTx+S>|0hNĦƮaPx&-QVfYnu6R#r%]%H}*˜Nq8DeS1w j#\S|Vd)26BwÄ2:ǰr}gu}%>;ZǪ3^&< Z_oW3rx+N?b3k7 }>>t//~%Vb,v/q* vZl5vOe?Ghޭ3cJ !mfj팕g ˛u}^v_܎| Q|uJ?IAJ#Z":1`QǺz ab{2m'Կi#r,_'I&a,_{uLLaɴ?$;*ZLXx~H&k<y։5^Iv;[5ZSYy0vw~Tγ ' KGJ+b$K|>{U`]DL !ex:-!g&L8D$ǡQn(=nS~dQ0elB@]֛-`4y3T<<(QwI 79~/q`@-? SYT_Oj[`Ud[p0I,K+i`e\ΦԜAD9dԒr+:%tS#=,9@iM֟{Hp~(RwP 3a;6rLax%8 b*OUTmܛN=LN:bPVk fq}VtUR m x^/Х9ֵUwh_דxa9'ѠnhYe KD{XUU5e;U#AfCV;]+Bچ稍Nрz*9<@.˦mVܡR=3 NةL"!P? ;$m. 4 M2>YeAdCs!5_7ۆFH" !(},@B]Xѐ=Cb}HYkku<*9ߩ!NqԜWGVA}O9-u.u,O$HbRSSiAˢq))$ӭ;c*t$q-~~=2~"C7%Wu!DxxT-_xQb6*JAcE$$X LJ)7VA={.!S}pcPN"OGGy̌"û,d _z{lE C&zKYo#\6x ((3ُ0A{6A伨x="Tj[C' %-WZL| u?^VXVe, vx$mҚm|JVݣ'pYc6D]<\39Mf#1& z[a`8ֺi3Wɖm{,vh{E)])t{to@'۶dt{{ nay3AFH"lAݵ1p._JQ`څU4Tp uiq參I|Ox/cը$A.kbȂw} 1UJyUڰep)G[ z­zV;+= б+Q)`[3 HlnOK@,s6{9!Շ#Yػ7hGokdf½Tg`֦\mJU=\Af}#ǀ7/ˊ}}1~G 9 lw(z4?7iEendstream endobj 452 0 obj << /Filter /FlateDecode /Length 5358 >> stream x[[o#Gvγ%~ iN׽j `n)mIj4KUwU)ЃHv]NwNub_uwn.~,}~y?&Ouh]^_1b挫2˻J/}m N\^kwnrhn j-Vx᭯_į&h﫻& doOZZs/६=-w^͂ Cs=_$S}>擶oV([Q9"BLi|\dJW+$E6u!g_|4:|KѪ0Q6WuWv~WZ|8UׯM$xUkmTf.qJn:jULoKgsT&bz9 N1VU>Q, Xbh Π:8 [,~\Z:%A&iy[|.oU* %O?h["}Da`tjЎ\q#_#}h7uÄۣ^*>mWk״h0@Z4҇4X~80R9/ m~m@]I3:*|ڇx-|EAA IW||q;|9ReW{}ms!6{ 0jn+(wVozfFN8[y[ vwK[],豇[OL'0 8å'ޮ[vOU7Rp.?)@ֳRz<g'MA`JBjYHr۱יJ. 9V(kY{uZj ɢx f-e@""Mtlg2Xe&(/_`DTuR15iJ0pӴaiQ^/_6t(S-#𯿴u)Xg%xel_g_4P|0Nӫ2=vwq{4 21֠`v.-h ihSZ3jG Lt~.fx.F#4WDtF>Dv/WiӄJd#PaOxo1bU}yy ZlH" vMH3ۀ* KG;T8\%J0L/0 N3MN lϡ>c4x6=S?fGADS@3h:#XnG#uuϊK:s-ʟ#m$ نh#WG*1[pE'A1g{¯IۜS8 #x?Jz8Nk拥mN'dACmEc<9]LrdڀMZэ]xӲ )>WV[L`) f(6$wTOy_>ĩrsUa*g6HmޟS? l`w 8XצQ"&%%0ll}5$h dMX[Kڈx&}^[$"k/][S!CPRE1(iKk)n(*L%Pw `u1MR&O`yx[[)|,GhJe~q݆|2;Iq!M\/OLZoUowF̯co9{Հ3r `d>IDO2M"q'AtEGB]m$ԏBJ|˓8S:zro gP0tI5*$8rE7 =ITX2T*csSbWNKDKJtW"(kXU,s2m TvTW^3i6P"2laJB:)XWHN);^ҙ})zМxBd{=l_wZ \~UJh6rAOD2t9(UԙPa Q tݢM“ʫ shFWDzÇQkcS3}{ տҴM{kOŔW|5@]\e,!KkXrٟ"]w(? #KޜTAeQI=fMӜɸ%"=0o/!%Ρz PYɂ1?~: ` */:}Z1W'; v_ê gF/Μсͤv4=jdY2'%3C#% <9TS"pA dZ]UFٛͩ`@{ep `p‡WK`xW>+TUk\ ]:g'aő,ݳ$ 4?iqQ)_h zzL3KTj0.K\Jl1˭!ѽ_@lʹ5Yt :)Tjg#{NӤCSQ (``G(J)irߦc'>rTXjp{ZTYycP;q<@cMeVPّ |]MҸ'k]ێ+ gEw3 !o4_Ej?FϊDzNqJ(+ \fqDtj![\c#89pWG}/t~,K掭J澉M$R;ߝ_Ī.Cڲ7K[HtY,'P{M\7)%LF^ЁvYM?f> /S]k8){zEllXQ`֑U2Q952n*נii; (66%"ݡ[' `}b>C',M\@PGy<:KL-AƙzLMͤv4t.]ZTv GﷴP@C͎p.u_5Q 4 zW})C2Bp{#9_zM&kNWt @<G^uc.]e-nتQ6-ݺ|L}PO=f{Wԁ|NF褩;z칞._=q*OfOС)EqZWj8yi<.v,kd.q ?_?>"0yT!3dfh R`U g@ؾa'vklc^Xn*`-ٸ3y5/PguX} ʅ ðoܸGpqb}wX%Z{}EG<R0 !E/yy<t7Y2k680-TD58 ,U)cd$CR7.shh} ) ^D\~6bmXa?*fuw_ż'{ͤGP]NqM=Ǯ[ SʓpԮD~Cp^Ӣ@kKҏUv@D oV];uV M㡣jCC4_>9WR\xZ~*M5 uS+@OJa@-n`k>j7͗^CX8}O)e/;ܖڢ<G@/Q/MQF Tia_ޯD' qɂ]nVMWպ=M L6HF'< E,Bv&wf)"׉OWg-L*D _=-c 2BfG>~h}ZνptX-iG+ymj;',+Xf& ]!zDzD҈*oA=[׿ܬ-7x0Wl@%V2 F@*N0ls!GX;?f\mՑ<ܮ6iSj<ٯesVfM;ԸIF,bwPSCd6gsLSG (ZÊ/𑳅گRZ Ay:)kdkDHrG;ĵZ.ѽD6 !MU?nDZI!x %+Hf,!HkV*6Zs>.eC-) {5Ǡ&8 SNXΟUAwjD *19@j.DU5GVcT>si" '+^(H#a:"k<Wt_zzQ-(| 2v!yU㸝Ԗ@{:o(w? zAo"@8sՁ<)DU2)jr<8v /W3 XT;!nc7It.cx.4L&Xn7A+[@!r3T* 9PF<G4 ѕpI󲴨Hv:rz+36qf{ 0"z+/]9t8lYmmmE kTO>T5ozӵE,|~4Y,9%J=ΛЋKY#Zp0lR>or2"endstream endobj 453 0 obj << /Filter /FlateDecode /Length 4195 >> stream xZIwFtt40zr%X#)( cP@Ў맪 ~: z嫯ϓ<'9׫dy_Oӫ'.[fe+]؂3[B${_-aJKl#,^P,-^vzr.UXOCawhe&-5,ag\jVu7EV4SkDc,(YMZvɛi)`dAf1% .͏tMmJn9A;KvY~U a|Z V8 V\dPMu갠 òF v,L(=Gisk@r9hMeaSe5}d BpR)Fv4ad 3j|ϊL˒ѫn``zXulߢJD$IKY{2WG&@p.'X\'Ou}]' SbC#[wS~}`+4@"yc{{#DКDl1? H!Ys5uFUEmOKDB&Df˸ jsKN2rQQp.%@p38$:DHNޖ]g"3DA,O,dlv0B@1 VhB*`Q]t5P< 3=]ߐ+zdosv&}a A"΅V#7oV~-?#;YUy;YWix5[g~_p qK+׸saXl % ;N : T D_GvR[b)zoI˞Swu`Afj Nw:7)64"EJf:e2d9X6{Oa:ſSI$^@ld*(C .@ZՀ!5Hz$SJ o-p lX `~VYriT7~K~P>g0Tn%FJуA⓺BD#n-l= 6"+5~O\͹ ȟZ\hS];_s_qV)޵]IwCMMXb  qj4ԉn}OII@\o|{hFaқјgzuf|[fٰ(YW4?uY2-Z nwW[_u)B)8|oLRk T0қD:aB__3K}U{ I̤+ P#9&$l[g]|O/ Н&"ry#L&R\Dح2✉X̣ [<ڿ?V2U'n&gx|C׆NdW8,w&BAY7(]/v=I£ӵO7S7 լܶl9N'͇z K(1wxL#h g{8K9l}q.uA$Uʧ H%$jGTd IjJb?, vei2D!JBTW+ͶI%%Wi+<0|'.I99hnђH8*r'/0T^.p1>oڻu0)60;@wс6:$/2 :K"֛jkGF 0Z [E<, ֛Gr[3Ym/?j?TcnGxEԋ | L,+HD:Boɤ͏V#MM#܀;s^%\9R@\@H+.K;K%2n-@Hi}m3"D¸RF0ȋCSV)@B`SW9cU#6ӿɇM /M!|2~Ɓ>hCSbadUQIy1~j٣IϾyTHC٭)"z8 S>g?T j壥?f #a[}MFGr;S 2LafRymɍ3W`Ӵ3kaJ>3Agս/wh&=k ۺiМU>an ̒p8z@)\S85ԉ!vf&Ƣ_V4,Pyy Uh E.<:B˳"0 y9:J. ⍙v"@/{0ߍ󆃑,2vu1=\뀰gu8x%EX_4I<jErVQq+nG몪`J)nXÆK80YW@I prXmEz C5-+!Irtx3@9B0&dd 6JǓ;9ְ1Տxg`xxS1(θ (RZRpgR+:DS$B]+UqqL J r5L!yj)gQ% WO_ Z',awd_<[&3l3O(ޅp4Yѥ Es`p8 p6 DԲ`e8rS'6Du \];KB}aJ@t{,k54$Ψaw■ kGсzJ`̯EKHGqoo\$GUsByy]xC Dce©DplBMeWޱM16'ܭ̥,6;=:Y%R wf-$sRVϯ:(OnSݻ+*҄JA@seݼΧ\p@QZwvpabtx1rf p @QJaZ}5Z]LlEdx )&r8vlW MpwҴ8o> vդH*_XʼP!Yv N/U["zwV ];:l H_uo `/^g+eendstream endobj 454 0 obj << /Filter /FlateDecode /Length 4374 >> stream xZI>oVco&KNDzI.qsϰ9lƓ_ZfAP(U&e!'%_/>M EC[9kRMe%N|!ɛŏӅ$Bz%̑% %\..H) kPH CnZ56TA ?j-0+' 5R`vCuU_!T pw9^lYWәֈndQ*f"gmݬ8h8@LWbMq'3% +[>cxQd&Jf?VoKNY W ?Ҋ\W=,4 -q, azknoΙI ̨Y%Y+qhË(ʉo_Ӧ] U7_h܂r& su#f'`N) [UP^WWCW_ұ:8Nf*LUJ>UK+إ3h0*4dhA*(}ep$ @zOzP78e}u]9%? x`P-NdNh)/uf<]{uGFOLE=py*z~nmw/Q*aB]~Im |DnoC,Mg 4ECqޮ_y[38ͣY';FJU8әh^\.ApTZ/:X\hF)` ?:qulWsSVm>_z7]U{u2 q? ['b]s .7P`/;r@<#v0MʦAV 4mBʳ\7Y9 ǔ$2U :8RpԊ# **"fLzǵzځi{4OdC5gP?K=I'w>껺4-"J}&*XfH5Y=<{ UJFuVzf(һLn٫(6;Qadݡ]FhYmJ-W\`iN+A&dwE!WfP=(pRGTCs&t]gTaDJڦvI|]ET Urr\l<]7kf] ?2 ]-ʒ0/e]ۅ|Al`N^P0hňJDSB![y;([##*@m20Ny$k  uPd5;N;BN~hJx݃k KVL#P,$w_]dN/B+RKI3#u|@w'1QJ\d|H{Z^ {HK>\$. ZQGFo0znJTO"#$27iJF FZ+OM+H ]F`Ozg efyy0 OuLᜎ`]YpK/Y v4D9YK(* VIqj И(Y3Y_(4ѻ&go(yO<,Pr(9zj iK0[ :v~KT0mt{a:GwVؾ5CaKf`!h5>0PO(͆2'<)nI=? rfq7g:DyOҫKKW@?qNI}g&k'd~N#4g*!qTcw> 8Ȟ2-]sg|VZ8tS $o0I~τz&EMi"/,YrWr+V8a H6>3$/,n?Ekr>ܳipߊP_Nф:h/ɪv{"v#:]=nni| b 厖2;_/F!K ؑ{6zr`Ac]KWE3d6 BM^<ח82-y$k[Hi3?^.'w2f o\W񪈣`j˦$|Z'jn{S^bNk ;\xRRendstream endobj 455 0 obj << /Filter /FlateDecode /Length 281 >> stream x]An@ Es7&VU D,2 B}ME҃]ϧs6_|s͏SVϏ5uʮ0IVӭ_\q|E<ȸ{ⳉTMiI>_u!p7$~qOM!.*&AfVLl&`S)TlȬH6dVV2+R+jl[6[E !D:,3if6Eqd+"v BF (Zbd0^{MM^'鱮7;F1e2/! 0endstream endobj 456 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2102 >> stream x}UkTTl>3^tfcRʞ,OOs᧋ČKM n&#S0M"@ܬl%K5uB:`:4~GhHOSաF0M=OS'$g$MIQ##~Ckt]AYcI2255"Yj6EmbJCQTORaT8Ny P*h}.cVBSi-3 z7^]nC?O3F_dרВ PEISCfd,φ|`?jrtq04*P,E#~ҕZ8`ns$\Jz 5qeeJ%o.[DcebV *r-DK=!DkQ|zȟ%'BKԝ7:x]t0|:8!Jd֣U(G%^u ´H/!.i?WW^6Fcx%Ue; ~\"^D9fS9,r/[ ~눇6M~ `O?\ZDJv>hyFq:Ҙ"safqa{zT.930| xfS'=R%#n75? D&_WVVJG 'OcisT{z7q U ̰oٛRPO,W[Z+Z逪vgd Jyu$`fl9ᠪ'"GAc"u܍<ٚJUDD@QKu4UGj9hjBcG\;'g(8P3`GK@/,YA ct)2-w`S7,^s½4*^Q9z8|;.K˛5/|7WT_'9nC]Ԏp|vZ + ,Z+4B5WN,_/焭\Ov m5ڵu*&LDf2+:w 1sPP)%dGi`' F^1bxB 1td y;@W+ wQ+N8Iqd?旙%=@ d0_5[MlQq>f^ ucMo%DM=Y-<7͆zvb)K활vi?A8}.{stX  Fq} V0䵹<7P|viU-z&d'Ay4 >gIN†m¸W=/cxC[rP^XC;z)*:-'GR]LKf?[Jz6B 2ye~*r]y:.N3F)8jzh-+gf˶ٖ|TZ0hig/t~p}xw?'cɗc_A4hnSБԚPV{ Q+B LgWM2 MbR %Wq)qGJ)o.K?"N2c%V&\mzҎ\O'@cCgSQ?Z~G] !~~]~0hk]lt]Lç/ 8^ ͈¢) x"1vc iOVW/\qkdmRRQinm<|R_ 7rendstream endobj 457 0 obj << /Filter /FlateDecode /Length 520 >> stream x]=nP{7%1$G)3#;E!0oWeu]o4/V߯PK}fhy}9]~mv?ߵNwҿ/ϓ>c}_nZsו4._yޟL_"uc`GZ$ {\p vO{(X$# hHNE ,l> T$m_$֐ȔʘʐȔʘʐȔʘʐȔʘʐȔʘʐȔʘʐȔʘʐȔʘʐȔʘ֦"g;;8;9;ڸ99ڸ99ڸ992;3;2;3ƄFGƄFGƄFG <(pHA"^h)**)**)**)**)**&((&((&((&((&((&((&((&((^B\x6/o;|l[]nZy47y^j>endstream endobj 458 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6093 >> stream xX XWD\B,atFM nQTpopaeUhv ;&q$.o5f3D2o-L&yWTߪ{99_c֏dݗ aۤ[D{88Bdp.sYV"jF.ym]3&<Û..&Mg98̟gkPXTDPO6Ovx?, pp u!lk<]Wy:,Zbcf{\h=K"|}c.;doDXGujR.P&) ֣}o$6n]0հaw?D㠿Wj0I%6MdI~נr mZJ ~iڰt\ZqP C\j-gbv+2^ֶ݉XOR+(4PLS} -惺ucpQQfG&7,e[^~ ;27\^̅m*򅛚_C]udnu^:R@~=nWu^GF6p ?py\g~Nptݡ;=qLV~8Td&~tݶx%gsשJ +w7 fjaRaFY#Zb!Z: S'd*1}&6'Tq Z 2_9GvY:~ygY? f&jEaD$FdQlw%b,5sob"htBH^Sa)L+hY@\o?wSppOYO2@!pՠQa([ Y{y *fG佟3؝\i 8"dejuU{,?ԑc/x[^4#ȋålJ$q0gepWx TŁS##tV܃/xVw/DK KMVt[ՊέVUZV("s| l!]U+6(%L<]| NVE(&wDQew%4(UϐwEVuhÜ7}r9kߤPC71aa&%b8_clmE[97I^leZ+:P==k߻&EpSkk"vX!oMO2AX8JӠv~1H$;ɤqXh ;zR©]ƨr9k(SPp'!Ud+ wo 9~g #qȞ4U]15'v/}&e Ue!$W'@9؝7 NyRl0V&+Z1xmmx**Mlxm8Hxm'"~h ʾ8%+Ͼ.lQ:\!䗪Pp քQV?̧R=-pNj]>06689ep& ;h;wf^V)e 2 m]wM&6n؏^/H9z_*"^)"'~}TN _R_g1hF8{n~ڳo?|/Md}6 o+3J~݈hcm"f|Lvk%Y#bfO^OY~+;H$cSZфuUi)@I/QE|gMZW v~n+C>J!Oo8o%yB__gPm8h_NA|FF.C~2$8GQ8{˻Ǥ% MK }fC!!|>sFDK`7H̠ʦYvEh!i 5% );OH[2mr/h@T{!9[[yas7W}X2)86"Kb6a ky^/FB$ElIAq$m4R)`N+=FnZQGq|ݣ8v;A YٺLij,vܯI,2_ ]l3+0C*YrӼ%;$V(AT @9v-Th~d *ʪsrb[$ v1C n\0)V:LbG(]Y1L]@NJBUfr%[A=>6=k%{!5N*Z$r ڟSmH]YRio!V N '^$)-*+>2Q3^'E;&hאm]cI8 #8GЁ8Nz9PE'b%8ifs XK{*gmŵ T}|der'(F?\|[ůu o'0= 7+TȀg+N#MLHnkS6I 0=R(v flVLT"3[2K_f|}LE 2E *DE}Nlj7lئVwV/r#51M>jȘHbj|퉰|Ult?%Ju8H]{0ˋ߾{Vև j4-M8J(/ԮsP"#9!_U_Z]H5,>xR ۝m1'{mJVj߹>*׿REǖ@#*4R=< 5]IJiuB0ꘃ*b;~4c5ٞW3ppE?*i&Ǻ^^8-cRi*2 zk1>WiZ]FrZ [c7yk% X*Rվn?yH&OǿȁI0F{Lѱmx,KΊ֥넴ua R>K~ڙr0Fo6^3ӑwr\B)=xGp{v5,oGwA4ulfY:KR9ğ-}>d<&śZwMuݎ.>@ܨ,@ddDSU5(:=T Y3JR2tIz}xcδzw*-nXOuPOj"SG!fӈ& rȊz"$Q^'"sWEbR &@3ĩ-!#FIO{L]fI:ܜR/n?;cms9wmYLrtdh$&N<͜wO'T[/h!81>vquPѳ?Kdb^ h^+[W  iH\ewE)5K!Voͯ֯$;[Ѕ͜嚒J}fTS.pCY!v2.T>$S>o)[m 5;fl9̡T`emTT!@R'I@ j2qX*h ڙAsQU^W _OVA\[< o\DLdtsE$ȥhu9^uWŵz/]IvE=Q719e.쥺l2s~C /-1w^6qioucslJ[0w_$*)cbřl_hC>C[!~t<'J4D#"%|=R_ >%*b6uPq:\*wBB7vn&t Ht.6S 4Q6#a"dޠ2Jk y>>S8??U/n 69Y|ehao@u0W XDwO('!@(K!p?s#ϣ9aQ`ͼGFlݐp<˛1ɇĞ35p>ki8}P@[nZ_۴^i 6l,Kg3KXiD9 ۾iIs(2x{tRL!1=<>Q^<8$%'<ҥr+6+8_%:8 [[:*ꋇTvL`sFM0n:h,kdG7ܹx1m*g*`eg҅}Fwf+5CZ4yJVI)TOЇgk "wt_rRʡK:{x.i*w@^mqQnPT 8>θ֐O핑{~~rKNwGgSڈ-|yM݊b. y~ꉶtR_)7F*8|mUVM_륾SUݖٳ8yv~}Su sѦ{8kP4Q~XD0~6ձeG%_6 +wW)TVB׼:hW`׳&X4 n?R*MP!Nh}4ʴ8x\C5WvK14)c{|OJ?_yۯ^7B 2/BM!O7*k  En9_0Yl`a:̲}VfVV>3/থekzCnސm9a .Fendstream endobj 459 0 obj << /Filter /FlateDecode /Length 289 >> stream x];n0D{7Ȁn\$\@V S,}frCi]ny=$"1uc1Ln.[7bpA'w7)?k~Ji>wI._8TU< C,$Jf\W5UXGX+66w62@"t>2@" md>2=Т6aтeVp]:u=> stream xU Pg{nhF./;E 5Z@SkuD-))5r)ʕ%MYSE!iZaUia}T=v4i}V(]}0!oDz`iv.d5CMpN\fBܼb OѿV-ܢl Y@b7k@NA0d0}!8ډSI)%NΩ4Tu"$)ՅO@u*fC/I!c1R6 a YJW#&SWV+l=𫠾)@tu<ĕҺ y3\/Y+W37͠QK :EG5 oIijj-ѭš+ʉKgJ])wŬ-{yCa1S i#"E8EQvDifX3a5;veyylhDƤBN9XP.讔D^|v8ZaRt@;%un$q`5cC|ChwI_=ۊW]:8x^Q J#C̳%w b{`VhkjCsK㩕|X0eDG9@&\TKy~ [{2W-(Sgh=ά8o|Ji- tD;ttė@ϟD1) *6&U"xx- 6HsQqdC:W w~wPEEK33ͩ!%ळWGR+Wrk9Gآ5y27dxf삝|$7"W9xݒz8ա;`,g%/ SdR/sF D%2G$>[s&@2)0\1~VW9cz x Ƕ א/BބT;qbVi]JZ_HL]'X?H?-pEf?X2sŌ={[:vxoTVjlK$aY4/.`uO;Nic8pu_^>M9h˩J3ִLqU<>~hY.;x:C &a 7+O= ,wn r*xNEa@Q&%Oۥq>Ӡ/M6fj$2bfL.5Cvb䃑q9ڵH]5 9q=- dHP'uu;`U^fحd4?.,~s)/߼ M V>  E,T*pOq^l !S8VIssǓ|mp{hm] i3WMTt'5Jq3`1O8o  O` D٥bZ[RJ Ð^k3d47llEr/ͪendstream endobj 461 0 obj << /Filter /FlateDecode /Length 655 >> stream x]=n@^ Dqߏ ؍A PPa"N/%χgeܻu̷~M;˲; |Im\wo:[>OGCun8۸c2wtOΟ*gSE> stream xyXTfo2 =ػ^A"E^D`(ì:0D^b$V,I,qs'yw][@P|r_oG ڸ{9 &3־Qc͠?9I u|YM?~رVNVsY-qt njɸV[rrqwruZ3[6+Vَs>nqg - ^$qiӲp;pYmv[5v^k׍4[Ja&OԁӦdY{R j%5LfPC'PʆFRé5ʎIFQzj.5@ͣR8jO-&PbjL-P˨Tj5LͤRT7ʇNR=/)keNޔCR2,T??%hj;IYЅZGHRkAL"a0WffwDKDp;Ii[Gu.鲪w]Suo{Lq{MU ;_*)gl,K=-Vi} 9wg]8 `@*6]HvjU t,3a6b# PMwc,%T`tcWBd{ͤ 9IiJEB$vnAy"Zif7˵LFvY!cՉ$ZzۂEi`po!"dnuoZ A3G&WU qW@Pb- UYQf̯*(7󢯥o^SZ$2WrKYv6,|*h#4z1GJ--jKJgZK/zJ A/"&^evKzqE d2ݗ,8 Y<D5C,)|VZYn_7}{6'P9ZEM_4[$)znNPٌv5 9O!ApQX{a/Q'HNKo `kpN8xd/}\wB !F+JrV tc~X\/F3A)%v#֞BKH#W{ N{<l0 Sef }Q\r5XԯO ƱW.q,dBZ1*6wc8ZÊeHP Mqk׺GG%^I;M}d^k@ct!Ro*o GWh31z/ 6k=w|M$1+Z8%r!E&<>Ħ"^8{ EIYu24xmTV ƷdP]͒@@AM[[n`$i;V$VkkoACF =hȩ!C̷@LNA"v((cU:M7ȼ0r:tB< 8+:ۣz[cm֢8Ԗ7>D&)4:6 H)֠ I*cb.N"[|ߊ`YHF|Cx/b^γy*sT1DA| KV h ;P>~ aCTP+(T!NFN5X+w-).kfC߾/v'G^?#vD$dsNݲYd@z ͥS>'9GPg@BJ2ؗd zzJ]\,2<DV#`ZlxD/n/$N>@S2Nu-3ܕdtp2^et[(|E5ЂV5{%u _Nrp؀i%mZ䳸#2h><6Y@O޴pCYqW7{ ex= ƣ1W^b'R\!zOTvDͺ͖$qmmӷ)3YԷəvǩ epE\Kᆐ JQd~4֫ bCqjE$X7@!XgKBC0Fjr\,-iFi+j` S;dB t)2Υm:c& ):9DZ7m]ˊ)`!eCg*-o*-?߸MN'|7ís>{ICAPhmB &8>:.|@I QqtNV2Ih='eF(¦TMZ8QVf{"s4%R#IM Ir#(uBwG 9%t; (ayM|i(.Er:^{$Haf~[ÆML_yw섚-jYE푬j`6QJW~\=g{:ʈ3\rp"V<9P wecz̼jjjFS N+?c)k;Iޏ#S)ZO]'fIɛRt؊h fDA6x{C60`ͩ-J.Y5AU/ڳHY1U k5QjrlUIRzTD_rYY?02Ռ8dRf_@:H76VJ rrA]?(s9y}AWUsoK9bcwLJ[ ]IoYB:CMd.nFuh/h]ۥ[>u6| o5ZI+}C\<ڃ[Y`=kZ(d Eo8}* @K6#Pr;F2#9wMxȇF>H<]4wClA$tN oY:䔣>踭Ď Ũa .13)t^y=rѨV4`UKR|3BCr(o&Ϝ)c|nvc|^ I}[DMB]$1$Hb}-vf}h zD%[I(ƿ0`ח>Ž>{Ajo57UmSYUJsWFgTط{sgbuJ%N )i?<]ׇ WLRRHZf6=9 ݤ뢷V|d#=כ2VL![1CtLg2p]3H/'Y|H)D\TLBpukX9$AedIj1)O)R$]peog% -SPn?zH,#zbTHb $6y;#]ǿQy^s@aOITYJ")O'%+'kM\~lJFԫJŪ WA"J^=#}|4Q/t?ERcDh}n`^e~d\neWB z"Ax4KB<ONDݍF=;$W }C( <gǟб}AʓGBd4Ի֬YLo# bޯ̓<6:1< Њ2S.k_C+dBєSH`Z1@b,uEݗ!}6I$N`Rds@i~)Rs4ro,Ĵ FH nU89b,qt`[u.YppC{uG9v6JvmjXAH՞!&QYӫWoGvץ޶V%OLC4#':?(1%?΀ _g`& uu^&,N/ !.F[p=9Cd S:}uUߠ_Yrg$䱪sv;2#B'ht߿=MlCmjF7&$O?!cg ̊ >yt0rI2blz OXq ex"L;WURpR:Kn/h0oY N+#Iv>L r_A^ :^@$OЛ!XӨ;k=+un1?b}<_Wb/Vu*|kq/XKхskv҄ gs)/ _w7/ϊ{~"W+BZN[P^hKrє4 2JAA 9u5j4:qAn^Ud&gi*D"瑋<]7WHt\:I+ ,F *MB*Qg_:֤)峏2 |_s*SQMT@]@L+l!2lGb&JUE$16]4jLoyex7;+qwCQٌ; 7""S$*`Ő{tmZax>XKw~؄m T!Ə6n}mxY{\UO\RK[Cؖ(r|vз-ol}#M KQ@hRRrQ @[_Q%ﳅvz1FG'wD>β==ɑH*{n0 Z׿Q![b2 5I'sQTw6Hu/O;%Lex 'Wi ~@rB+jjc19 4KZʈ![~} m^!; *@g i%pKAf+Q)HLT(!(\|< 0ylW2{bh"I"915H|=L3{ߌ+@ Q:Jz3^-o8;41;1EׯxĞ? /-hY4(h j@dK??Y͘.lf9^=rޙ2-Ⱬ4u^=!1?r[l [vkpɽB&=l*Cf\ɩT[eޛ+TqxSū A_t~HV9e a}=# PmC5p%&bjD9Ϸn7BEyg͆z8ѿMpMt8G|+EHu2k<݌6Eg}+CtP/BZ>~$-= [$Ƣu)QWC=}L;Q@c24vc"bhL(gؒ$Nȿ q2|465ʯ?y~Kzxf2wX 6'vcs樴ZUV}YG{D:(dDb2CZlj{(9x-fŬѨD&z[\>hxVjuf>?kCT^ycdԌ' ]o ehbLz+kRlױ;ޫl.WF޸`\OeSH?T6A-Ma-DC/Cp [/Fqxxx|RF'pwHI,bD؉em~ƥ[C4p?,1` dpJ{*driQ?d#YyGhqƯ/܃mhݤީLЦ <e4-9G):̥{?r0O&?|p}f6+>@c[ yѯcٶi;yGeWn(`.|tuؒVzκS]l>[}!UvVXKzx&+yz~¸#Ɋ͐$+ ͅ`~񰂐<1A,u{_Sc!h@MD |ySK)_ g}RS_pԇUJٚQ F4`+O[R#/^31u^Dv(-~`g9޲g<q|!J̥`y9xbo7\)mQ3&hD|_gL< 0زlRL zvey֭weڃC{ѸƱ~ٮ[u<QvZSNo1C sfy~s+u_q(qx͎ {ՀE=P$j1b*v=6BbgenyL`RicX8QN-1Թ]%1Mf faJj7 n0tC>7Ue(P*bQ vdF?0`sHF'hx=M9(Xٜ59lwA;h!7I%B(gG&0o:藏Ε&V݃uܼ䓕:_v6]۵N+6M^UߨMդjڔ(COendstream endobj 463 0 obj << /Filter /FlateDecode /Length 178 >> stream x]OA  ~વI^+\C@gg,^M _9Yendstream endobj 464 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 538 >> stream xcd`ab`dd N+64 JM/I, f!Cg0nn?G~#_PYQ`d`` $-*ˋ3R|ˁ y I9i i ! A Az莂Tx^``ac8(}  <s^|y҅?|_8{! r\,!> stream x]ԽnQ7`aɺݸH%yeX^E>3"A4]?<,۰q=Ͽm8õ?s6poItYM.}Oo}3G/ܯWǶ/ϯnM7DC4Fo:DgC ]!qj:ĉqt{ƹgC!{!vc!BhC0BcEId4&QdИDFe!&c5b1jk&kFjk&иDNC9EK94.SиDNC9EK94.SиDNC9EK94.SиDNCDXϵsz !oAok!oAok4!QP" ΉɒɒɒɒɒɒɒɒAR$GI %9J~$$I%I Q$p)`X4Jq-z ֒-XKޢ`-yނ-z ֒-XKޢ`-yނ-z ֒|Ѿ.>n|&^a^r[Oi_ _]$U> stream xYXTG׾+pʂ.c(DQT{ݥ,{ ؂eMb#FMKky]`7ߗw3gμP(@0>?ཹ<|;a[8? có4-Bh82<VF{yxZ̛;wu 9HC|,c?bctzYL"mŶkZsشmwYm6[ X&hmuȺa6}d"G}Oގ>|93cY{fq}w{/XLZ:)˖NQMjLmPTj+5rSۨw ʉIYNj55rPs]Z]ʚKޣS(j>eK-6P );jeOOmS#2ʘzZAFS1Xʄb7)52Ĕe@Sxʈ@[GIrV;2F&7 BiZA/ 1sB#G.Y1'o4Jz3c&Ie2]ּiek;i 0dlYYks|A"z‘Q땬`߽['8G"Jm 6 V*I)I CWE7FXBQrz\rr9&W._e TPIE`!f?8{_k XB21&9@Q{_֑aGAP_P't[7:NY< vTW]8 5'u,lj,-?Za)UT3ڥ¥500GQPm|Y~+ R%T[r?\#r?x +hƔG#Eձa43aξĽKu-(E-6P}+?"Bڀżտ_T0l׀Eՙ/;97OA0K_L 1VwP4]aE5>9J8Edfd@<4*OJ\k\K<-\ҝE θ{ݽa0RZqIfPpkAL<3M|%T > DGyņλ#fJ`_;? T$3271y(G4cl+6UKT+X&' t T g> LD;#<˰wE tA X8z=% ^F4zM<%S*$gj#(7NR {˟~y#uIzP>nQ nh9*kcFmj9xDk`',C {D=Srر.A ZjȦ S(8Kk"p~RP;N>u!j3>}f= ׹!~^UjYCE !HS n5198GMЋwF.;';3аh_}y;_*tBgpN)(]/`O  WIQs*X'iE(DY\XZ̥J ukN(I?^C C"(RDQU(.<<;8.U]{ĭ5'49(ie|9As95w 򫉪/k.Rp(_,U|vwMãw g/]ym9vo홌kRxDD`ؒH8~#ݏ`J'}= 3 TSs٩x,p4 +쁫VX6HӴg#jƄ2/OZ9cGp@ٔ}0MX4L7:J6 "yIb9uF |x:ن~l8<}xQ.#ԫ d{J0R C\ZIΫnAO k tp¿ɼG"]uu-ޘU,SnW%Ki;G` ;MY +=9",NJII↿6&( !3ߏ f$G HU {"02"hߡݯ>qQwH5?UAHQ?JO&q1ݖYwgI_s%HUzTܝ\Mx|lb OhZrɥ=_fMȇvu@ `6O'.XdCqzn|}0#fSD;/Q樝=T;yBXv̎-qIM,N*F%4?4+-(hB!ѐ?4 V1c:kpkYPq9흘-#)qw4# Eyբ*MjT 栛jHSܿ yw3┰Yxoji؍H~!<[]XvߺֽQ=C@ ķ6 v|ZlGtV 2[Gjj|FdZuX6u CW? o*M@"dI\؎m hZu61*8Bn ?#OT}LmHvMR > +]5i,S9`*rjeSv bQm[sAEyV?{ͪE{+dV@E%#XuXuq o›~ñ+쎦}!f-bPbf4JF ;1.4¬á݈yvN &D6g(r SQW"뱁i۾8zΥ'_<{;"U{M[udeA{{5P^"B>@ v(xx~l*GftYʕ~W+I,8Tr܋StVvâw}+N(PHG#,E"95ȇ~I/&C7Eԃ)C͑E;:m`7YΑXח3/N3݌ 3!JFOUMT|sQ{#e_N]'q-5"FW㕏ߴCR?63Gȯʧ¯9b>q/˖jC}Nn52WVJ¬d⠒B7VsDVVP\[bK*Z|==]}^OYzȆNJ{776C[2#g:=Q,I0.Fȓ&Xg'*h<;;Qg1`A-nj/DʃG\w)2hQi)HDEVrq:t>'za YgmjADs ~֙z^Q_[{kPᆶ6 ,X*+aI1IQ%EEV敕rkrBfC W SÆ40 _9rE"<XFtzywnQR6$|fDYrll )NʔcOrK u![#9|A?!4q&p8f\9G'=}aSQxIJ%ܛ*j*SJS>F̣{ub(AxcBbr C86,3xlqJȼJ}J`1+Mkχ͗EէXnW,M.Lnnp {;F#ϨQ—oٸnE$99yT`z<{>@x^O/)a7#)ߋ CPJFN]Az]p{ 6!~1zM '* G WGx&nk񋫄(2;0kj?Vy#+lz?`Cdyd-~  a˧`a0 {a ak>ϝO>M><)r W oxBq9)'E0!Ɔn3|ǃK} cR-qXm{[)3Q){g_^Xo^0T]`%2N.@Ba2ɾSA-Dx#GޝE-\tlR^$+ I {Tꯖ_Ң˚/>FGeKNxiYl]̱mzT˟|FMN x Mu+?ɐ\k v+›QʩTT0x1ڍ,.r<*)9"HY`bv<v|űx>_* 5> stream x]n@D{}@7k5v"A(d0ErNbY{m^_˭XvΗyZc[wjywe}&۰lO߆uB;mL?4^ c[m}_sݴyO%OΟ_gO{c=OƩz'V=񰫞ɸƽzQ=8T\^Z\^Z\^Z\^Zz"i4P=(+_#a<)DFFDFFDFFꏅMd$M1QQ!M1QQ!M1QQ!M1QQA0BpŀE6X,".*K",".h6 -&!6Xԁ`u:PRjARpi`. L¥SI4` 0 L&Ҁ)$\0Ioץѵmr^/EOu_lendstream endobj 468 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6602 >> stream xY |Se!4\AH̽AA`XTN[ֲY/i4MNfᄂ{Ӆ -;eETqfތ:ܾd| {~P|9##x<6$E$0g֪̈Ą(O_ӹp?Ç1ÏO#f ~xqSRs3Ι3o,܀fH2 g>E0#%9 2&>"16 %6`s̶-7n %d?=pYk)SWgeZZ&rmnԺ1!q6moIܚ:Y_;oT"FOtbAl!f[gP9b_GRSgn2PVZl'p#?ޱxgpRMh 8dJrdNn UyHVH^ʝk Z`D {~uqFG-nk-*9ƊҺޫc ^]EB&w7ʹP'>m7y]RChlG䕐 . \;Ty!߯JШp}r}*@S4;:.xiN@qk6QΠDzٗq(QA"mVh/v?T7iػJ]Fŗy߄;{rSOS(o} 'ɛ2:sXⷞ;iѦ!s]0Y,={=]"4PD5( PD\$'89O! "sJQqKkpi4|=z:F_CiоƊ"jZVz~5Y'kq ɔ/8!:aDmbЪ-Z[#{ ~ýX h->nF3LǭAyn6Mv0`o? :7#Rk^xst،8 >MDz?]-޻d1Z)+ @PE\|7us ^lhl%K yYnЭ12|B+ck0C݆:XDz:&T%i3TgZytCǺԙ 9tz 8]g=yBUw9K VBjGůC}&[K6iڐJAbN̦" :tb9ddk9Y/2* Q"U/c2hP )wAQDբ@sA'SB}*PiTh+Mf||I^pf/a0ϼg q]{~=KJ)NFW7խl7QQ܋MP]`Ġ%eJO>J>Ju41 ٧ф7 B2ґbANeT$ּ⃇"FF>ł& գURSY,ǥq WJ3SŽBcb5A!Aq]g)LL`@LC9H $ vA TJ 5MɚW$GoⷑCA3wSԯ?L;2q.jvA&g%.jkLA, gr29rUTΨLrۚ1 B/ :ьR0ETgQ+EsA`9ߠI@-2A?A>x@jl^TF'.{jPR1 DQiR#~\,T\`6>z?t3Fl8;[JwPj|gk>Wvݫ 6M2 K|uF E.U$ISq\D9)I +i;e%^c)*Oxnfm"iHIPDii ߗ|d{KKU堦 :SU|vJ1o!|tJX:l鴷Z;F@$ H 1~ĥX/3047[PDمm~\(bҜs/#{333e6UMե8פ⊸[Zo5^,ֲAI0"\H>^>˺xxw:4f՞80e9w؜c#csn _6LvdAR̈́+A.m7F&De.߽+IΕy-]3(ԼȬPq@nvp\=܏du*FF.GbS$.j eG}2_Qx:^{ 'x=&7}z2pM10H0vKWJEBMw.QT*i7咲\oOL`ImyI-h{!y{R#pJlWfah .w_{=,s"AMu'v BZ Mn}HN(iο`s_)![w,F})pdTf#i.6V q.Ս^¤]tr}x|Z+\y(vߚܴ\ G|3HpdN*[p- >e/]TC3dcnl-z[nEqJ.{NvX4ԂBljY,rΦOC(2Ks[@J0Fs=>ūxЬոy7yVx2X8^CK t@ &R"(`;}FڂuxtTz1dƚ̕fje.}\2lw.ۖT}muh-5`ظQ[ZS9qfߡc@V@Gؓ*röGD%PWIyf= ybkrhwB6ltL@52w۪\nnQ? ["=?ks9_ ̙dnKMW! "n̍;h"hX#u6hAK5czxwQP2:=/0'"DV$@h#]Ս%TEG2d{ x{Y|!]Tҩ$\d|1PZ܁~6ƯY:81Q P o3XZ9>1Sa>o1jAltU߳i]<pvhl<>Cwn߽;RZcOw<SBz5WKĿFDmo<3 xo+ rmFYcXE֪Fڎ2ib}o@ !"M6kpk\AR C;F^w^*H71ۤN{jbݯ5怦—Do+?R49I@|`;z@쉛?>5͇M<0]jȣ8ߗƂ 3 !ʧmCs,J[>ොw:M5Di IՓen΢wЮ>.u{ʨt4m2 QZeMuB忲}ͮ(9#HƬUq44!,O>CV>B"rKP%zm)*)YP\<0<>JK֤$Ikh =ģ8 MɕR dg#a,=k4!_NT:$&~TTvqF'*닧f8H!Vu˳.|#0ڇ4ƍg{} r%@]Zgv$p=h I4bɩ%܌\j54CbQOYE2ɱS˕WQ}8u3BԈCPl2Xio$kdǮ?zunts{rlIl&-*v|w>$o>=}CǪQoP`/O$K4UnHr ә}DV *&AUtJa?8+2\QMt$&N(Gc=]<^M.Z4P:)\uy@kA*dCIҤeNQ+#Pf@܇>UɚT5#_cԌ8&[ˊ.aw@%TCL,7S DZgUJuVK{F)8bT ޤ7!?FJS! rIS3AR ?>;;ZX=~RǬXE#+Уh4Ir](TGM9eHgPk_Eu̘ wl͘GOendstream endobj 469 0 obj << /Filter /FlateDecode /Length 214 >> stream x]10 = BB MPnÏZ[J~)N:_p!c|u~pYUۃWFMf݀չ|{|d籸tG16!f޸hCc$Z- f6 !6H f b\d@B\1 !H{A~}R0MҘ4EĄRyKSnendstream endobj 470 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1564 >> stream x]{Tecl5`~ 6ˌ`& a^Sn lcns2t"0.S!Py;JyKx,2y=)}yy?|y9 p>פֿW-PAZϏп,OJXV7( |S~ѭ} psj*"!>v~Al]!1UK^AS9ILR%h~|Oba*~{vil6~.{?<&v+ZN&ÎvC.xMGS]= ?hʫ7CnA~!T14_p_z B'*7Bar qQǟш ?}l~TXLl ʡumg1%[.8!=m63uqhRMB^tZWfWVю"NjX'{)ё!5} hC]Jiէks|!>$s$NWopY 3hA 0$  t6.ft*> oϮ,6K B4.RǛ{kdž{m_#bӄhD. c>U&3(JPXAcGk v~"q\~sbꊂ-ِ_Uf]VTX;N݃37:86CJQ6>kK:VK$gHluZ5촂M@JdrNjFc/GcH7bTL9& x.cn鵣Z:/@ 7+6RRs@syOc)Bc h/}~ ~ f6@!uk";AM]x:ȇo:Z*2)6L.3dG5Naokw5UjZe%7ī{cG|쓉$wtW0=@އ%4z-b#'<:Y ;G@CL8apAٕ[SUdOR4]qܒ<;s~aFаncZ ETg6\> stream x]10 = BB MPnÏZ[J~)N:_p!c|u~pYUۃWFMf݀չ|{|d籸tG16!f޸hCc$Z- f6 !6H f b@BKH+$ĵ{A~}R0MҘ4EĄRyKSgnendstream endobj 472 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1514 >> stream x]mPTe%iYhw7E0eP)4V`Eyi].;""ۺ e4t-FM{a4rug:EgbJ$)^OJ64ٺI2*⧉g$P_{'? &c@4% ˊru7̉|uV:!RB!߸8?W)ЪWD&EW\,c:+{F6fSS&WIy>EM37:ŗbͧ(@)CM * & Q>FhsqxHR&],z&%BݢQ<7*OsA đh R/.ّHl+)|>o\)i_%yqK[pPhr aZ+wpҏ<fjem'a8o/vB'B ~]ɑ+oY*&e8Cw].WF^%!vvZwe<%wTjb}0(Seʓsч1%Iߋ2p5z{F#ѩ3=mC]KZ mɳ?B#gq*3ki孪Bs꺪:N}0"^PzgymY(NA%uWv2*8^ES#~̼%cI](hemh+σ=8!N:/x=5]NhܺܵRiHsuiWX]EZ xR﫶&+\EɷAekcmO{9 4y!_+%/K^W `ّ ,9x>TڡѼu;O{xO屙pA*L:MUvRH宱t]k S1vӛZK\Jka$$PA/n7w~gNe ņ YxVwϺJ;TN-7gDTWm:M[} Z*h 7L\ͬS5AM`'7q›߇}'"loښԵ};Cg#g$d+b{ʯE!xi F 1xEqY :-i!]w=|-3xϼ*"_}TоǕOlzml׃c.@xAw 20"ANMdU ',[]H6Cj!P CeVy0ްu~7*Tc*gf1I2xx\ OxjR_҂Ʀ=v7ad";gmZ-uπ֣6bk6=EQendstream endobj 473 0 obj << /Filter /FlateDecode /Length 553 >> stream x]nPw?0Β,Zm_@%C `$^_˭9دӯzk:O9zfLO6nӷqg O:m>pjrZr߭oG;> stream xY \׺ɌvBVmݩRJEY@AaK%a',(V֭֕jjU+Jk =v}=Gg<3g޽(H4hJ7eWn>~ 0ca"ax/vlCmbA(kzs %)!;vG8M:ɓNv:-;P+xӲ)+8&p vuR:Y}۪5E )C^]$<ȥQ^1V^k>~n;V*֍>͓l:m1蕙G8nEVQ#)Wj5rPXj5O&P"jLM6RSS(j1rQoPKe? jzEPAT*GQ ʞbBESJI(AIޔZ4@T˦nq_qw\vo`Afq8ܵv?5QoF~C.~22)#,61ǥ:􋉟a(*$ *_yg9U"( }y]yo,i(MRoj ѣCsWɫ-UGqX&٤ͪJBߔ7ݥTaYTs#b)r=1Nx084~p3r omQnvh$I|p?^e wLE-Ojq[ 9qqIx]8 Wғh/CNzJO2(9 :[ w;3Z< xzOGѫߡP9<^ˣIff)wY쟶;8a/RHop5"ph)g-̔N-l*>09g _ŗJB}߫?]8ӳ0%CċЈ@tOܰMï?Œ-D#8*7Ջ׹8G NuROwUk8 a5ᜒ"+-$|ažʽt." }^t-ǟ/M}2i<^xI_NRC3I0XO:8uvm \ _ \u#V[[Vkh&iwRJ8QuL#sB|SOӏLr *VJf$(sSPRO_G(4,kc(QM_WKnK1KyEӫOp`]>@i]P*/{ 5?i쉦ih}(ENGku ΄((H%Xyt+RhC$~A Ү|)9l'XEYF?t9,Nmb6_Ӛ[Co0̼dpMC5?mk\Brxuiz#7Jx (AM^i \ݳB!QMS2,AULm&d9Vj#t[lH7.Ec0efkr  Y{p>>}GtӵF qm}H !QI~ ecP5!#xCtfQ iu}rTޠIƑP~J!At귻^4d&5@RoYF1 !=/= +MOLWc!ss *+?w(뽭iއhB;zfO!r5 ~~pC4!zC{= 73srEٮҪ& WWͩxzvAaU|iK.ʨkfPxS lRə\w :;<' !!ޕBm~vZ|lLy zmΓ<[T6ٰM$5D@f\RJ\{c$pk4Ts߇ƌ47oUd&ۺl e&B7㷼<0^ RֆzGnSO o+Ф=yEG Sp0ʫjUPUca{?zhlnT&ȱ!Hz *޾vmF:iGiJKLK2p2k 5p#5 > %ZSI\#,0ؕ10zKvЪ!'>hzt% Uhp$|<f~ED$Öv0TQvW =t=0g da 8fBKxa ס9ݏzR9 K?89H w΋2!M*BB }!1iCQhS GB#OTF|y2Φ/}xy&+Y`g Ӑs"ǯǃ zBDITxEr-:5Iq$9@ث]a Hm'l#]S ivoS3=O%o0i:TV,_N(ЛLfwz*6x ޕM5g:X^w? p0 :afwce5:zwk>y|,'4UhU2;mian ". t5}BIt~+Ѽ.㡹jYDMr1zv7xcȠ (+Jl'c;BJq$Mi+i8ǃe}/TQFz'^UBݢ&yx:p%Wל  ^ƁL iXiIBʷx3eZrVO0lG_N}Zi`4ż[ɹ{ &$CpfL5iœ|s,]qLY_ ?LIJ*+(0% 86ʫ {*入Յ``B;<L5~aKw$uhU3gzF> pgt衄m-o/?rq3:΋HqG=i&U'pI4i\}%pye,Uçc3<%w0"[nxķOY»r-Lز0r%Pe)I1A0w xUESDCLNfIR,-m <ʚ9)ʞeᰡL9aX62((<<(2#JE#7 ImohEցrJ)D^g޲—d^w˧.~'&)1TSa)5t)d'$t \uJ׽;6P̜:znGFTOYLvl\0u&4;I#ZZѐdMY\~qbWHj(96E p.,TŔXͺ-ľܸ9;C9Ĥ(` bgV FDKq$4M 򥆠Pq>`i{]!oD=k?i(R-TsJs P x6L5Z23#U ᩅ2;ʰ#o_1:?w2udcbIEO&,)Cb#klz[⩯CQdv9&j%*k4Еum+5!ώ1~r@3xu@=ǁ~lZG44%aTFy6s^ʵ { uQ# k?#wϞ.޾PR{;MtQB5/=;Dz. Wh }HզiN?%$ذNtMVP9֕=5*^MdJ?NdޮROШtZb)&e0mRA^dY 24Әː\&(@kVz.c~ btK_ :$vE|L6Ijd%[z=hXlƉ6kg͠3q_4o/Bk%Bbm~ڰ?&$$$d󝹴TH`R3>rfF~Oot$b!L>XSx,A$CngY6KV[bHRY"?#>Ϙq[i`B+ϋP qW{ DSҚp3ΰ@u0QhMّe:?>>MZk!f\=w`0!HJN|e]^ոS{T@ hH 5w?ʷ`21pI0&4i~#Z^n23LRb g&Fa0Ɲ bMpZ 0.w)ya.9^ k/.^S4&bf![%2dJb: h_M.ڬOxQ -&NG^BHfNGDO`zԩRskF+RIϤqW/֝ɾIKFϛN*pXIO,7H!FTZy} Q] V%yRubYw>믜9r򘚚}^jr6X˰wOjô4LKҁφ=\œ`12Z=S-fg޾1hP{YP^$y>jd-l$B#+&ASsN_AZE*$$n<Y$I/;B^A@ ̜ƣ'y xV*=!^^1hoeSdiJk!Q著h;mw)az2#g:mFg u )Aozx $bP폑-6 ,}sIܟھIn}}vNi-Rľ۬JJHZZmYS~8W"7 ӎdz)qc|VM%9d4'݂"}#a1XYǕ3boݬ#}],uȤ ה0JI!-"L)+:J_ . x&9H3-Gk ˺ ʘgIixbM2$mJhǿ^S:xEOʥKdk>8jgR3hɭmHJ.RrSH9TcGZ}Hفo'U$=7M#wn-h%|}zM iAB\Q-9S&{C*C3v3o,}ǭg@6p8}md~& 1>Wm䄂uF1tޔ>o^ı?> stream xZsƒtڪ-6* =$;S) 1I( D=3 ի- P _u~\AyNng}ɥ _z~|}wcaM:^jRuZ׷qg֓~٠B颴0%'׿(ŋT'RӯY*#|Q-'/ROL4)&'\+ꩠ,.KUzh3_<^W{_[ao7JD@,{LsjZO{=Fx뉓R?Ԥ>]jq Ұ3R²`f )VL0d%q,B+/a(q>l9,i}[/g,/ۘX%RaS| 24F:R2>ʂBHw|"dr&DܰΫC+aYuvධ/ݘc^Nſ!5}6`]!G-$+ViΪGrRsl,X+|R@h$@[VS?rc+O>K^"vZ;zq 1 l,Cؒ&4.CKSXƁp&0;޷ G,6CEX $j ip@-cDS|D͝2}f#OS|!a|&*ø W}!xNJ0dXu6In,j[}R&X 5C%QY @UwY3\:'V`˂8a뎀&el+lz]3j?o 3Sӏ%$~hwtfDN5NLK a"tՊ4e6'Bhagpq^6!}&s#}AjޣN ]Re~+UX=|JECArR%5y|t>ƒ%Q5`6) δJҐ]7LB0Sk bMXہ,S 5K~#D竸gmL"iZM[?OnFm%5ז!bIK]5'C4hrDͯ!~Z/0Ct ,}>FQ oھ5{| 9`<>0$"G`ݸ&lu;x/Lw K$pRaYό͟r"qճ%y9{g aaDz5RRy ;2'@'ORgz%IIc =CiK^1=/=SюTr^4ܰDױ=Y *Ə 4{dg6$'FSm=I6+[r[u珩[T8g,PB %40s/1ĭ[]?#}o38z?o1KN|Ui0mS":e ɞU 5XT]>Vըڐ&'P,ct8,argS[`Gy%<ud@<ĕOp((.9- mTo&> <_)vH<*%U_ .a@ӶNZrelOI "Wt >m{#L e p}ŁcZjTFVPtpOT<4iX`guATRZ|zroޘ/}aYj9zN,{vArN\jm[_cCceiY@&c~=o>6V9Bt;v M1̣Ҧo]ʪ=;.FEqm6 Be8PX=ǎ^eC90aםmڑeIlx .M #?E61yGX Hē!&ȁ/}&E/虽0Sَ# F]cȄL,P8e8WkC&`c f, "x\֙Ǧe |,čU'o >Ķ7mXM"-miwZ5[GS9:E@J@8"]n#^U~3̿<}GBNbdb ߴNx4Tblt*s ejGLAVqh0{|#TK`lZ}j& o'Lf>Abg JgUs2lWUIYEREJ5;ٖwOWxS`QCsnnpnD"H\;Wܚq=v+G%3GcԠ-we9$o, }Cx5*)!$T?Yb}Vck.tQvcg^=8XOCp o50R\')9%u yMѩ9@~$ڈ嵹:xCٺzL<ɽ,=v}bp Ʋ;ƻn)(IAaBg>nӪq4V fNpU*xhS4]9V<~CEC$ux.ڰgs,o-VyNÚtEW-B?ǓBHӁH *SCAF ,&9c~M ҍ_Y0}[󭦳E=Жgd.C cY4MgIa'(m!\/f?2 `WMy1dV}n@YC5G:W\Rtylm+^x jř am|'e|; +̀> stream xZKsF9ToaԻ%kdiHJ&qXs-~hP2ofV &)GL@Q,q<9ӯwৢ*+~|ǎ[mJSjrol-֕*xWvZMʢ¨lQ_OjJ%cszю;+[Wԑ++]]4N5pYt%ap&I J;.>NItpg+qEkQNTO44dmL4/RUH60k~=J.l ۇufO&qp e\q1٫=2:=&;, | ԬnMڊU cewm^x]iPrV~UE8|f鴸aWFO,oP;8[Swڥ,JqI>s]њP]v4i;_^r)5^#e-`QV/ha",?"'S$`oTm2bQr8Y㩐z̚*'DքfdM i*;|n+uY҂ sdzmPkm h nۥ-QAJ%n_׫"-+!u>hH$k7d&:|G{䥴 ?`+@aUG O 4#ei?N/ܱz*EAO-Rd㹊wٱaQAR`C2L*t^ F^V@Α4"^g0p@B/710!~Enm8%MXadNARҞW^Ջ>h x~MP$MأpI@ HGϕg8[F)0Of8;l{ʬG&QʼnZ7bq`!Ze*qF%Sg{6 7xJ>eHV lCXtZF"}G9CH+b *1Ƚ`!ܲAf!E(@--kmś0T`QUʏ$ʐ]KD=@P$ˠu2{m4M)hr=B|giG"*e#__r2e%PtJ y4Fj_3赼O!< anQGh 66sVIՀ{}9hg"|l%֖cO:9̹lc6IrkߨV` SweysvYH K!@DmS1gzkv֤F0j#ܣ!P:OGfPJ RyڀVnw}"2IlHYIȏL%c,ݑz"4<VNHlE$ZE-0m67lw>s6FQ7y񈶤>~e؈R=X4|wLnyW;pE}G^ <5W-?Rq'uْLY٣{Lɼ ChgGYp}$`跩-v3e{ ՋŃ ^fKZ0aMgkR{<*a17OZ (K$^8[X-# Rm4{*,HGdTq|O9,<sddTKʓ<ڲT>m穹j'֢ʀVJ>n^EիYh πh `x!"h@afa  aJ)2_|ҋtihdVрT B v# vaC\X;=.+qFo *~閽$e>i.u;[%A.sCp!~ҟ`?l-K3I̙Ƅh|dNfX0jR,^ixR6cj1 12?GXe~CuJ]=gRn_Z2,/K>`@,Le-D8[Y,.w;8 |s ׹ DEj SQVns%5SV%r/zXVx8j9_uay15#YMLn"\g3*IV.T t:w:i\0Z Le`3H?XkfDb _Q"+B бOI8: / B+ֵM]2G[C=- Klq} e>0,-pְDvǺ>6l|(,͗{/QO#9Wۄ:^[Pmf7v3ĘðɅl&L=6 {*zp'f_&"m G̲g&~.S4R!9Z3d,:>k]UAAVOu7{- ,DB D}J]ü4 q~RK4)lj<{|С<{Kzp[ 7<x`$/nm[VB4gmY8Q9 0\2ٲO$|`%șo( 1u}qPk DKl%c|88M:zuXWt 2,7#a(•7ͧ&|&k[ F +U3PM֩aqz"sU= {7f/SXiC v YY#[V/V|jws=BRrryeoG6#sbEª {EBoz 4׸P"hC$+k-,AARD!Wu `D_{~#^C&q3=8y!PťboµQ*>IQ%yL1) ]( Y}8VǷ;bFoc8^ʐ>Bշ.:F})l;I=i {HC]^7( ~8]h@ H&??x_endstream endobj 477 0 obj << /Filter /FlateDecode /Length 249 >> stream x]1n0 EwB7r\%C T@L"8 983;?hd~lym6esR",d~~Rendstream endobj 478 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1861 >> stream xU{PSw!$*IJV :]+*EޯА@0RD% y@|Hl|PKEng:uvg2N?v;`A ߺ-CYȔ+DGft~!!\ ~PŨ2 -¸deeJVZ_*::62}K j%$[ QT#+$[EI+kؠLRK$=iƌLɦ4W~G1 U(+So-,e+0, ہc`;1)R-/mv, ,#3hI87IpBH y}V (Gi6>ᄇ]jv {Ľ(=;׻yE!"e68t Y\ӘToE\J 8=h+k76d1E&rfT.%񏙅,f9,V3-4k"xP_ UVd)Bz:np QGxRil. aTԯ wÉE0{s]"efG,7]ߘ+&LOtO[ "\a1م$[: F X,Z!fi 0.. k H /^ ЂhCL3 b? Kc'җ5 >zPZIϗ2\EZNVuej WgDvqz(ſðH" c4^~]^[zG+{Nk˱~{@c .c[EVšaMph4L]pPJfˎ*ON{Onܓ_xT^7~n>fn0LjF$24\`T;Ii6{̓]>5B[khN$h:O'Fv'8N~A/"JmYg9ߖ4ԢL g&I)t% –k졆Lmz-6?9ۇC'߆xXlp.t:ɣgz2ZKv66Udݺ\$f$\={"Nԑ17 Ď e9YPᵻ(B55*贏;C.|Y̤?ǂiGd;~v%h(qK}]gRNrU`/}wQ/ ބV-LF>'*v;.7}*GRH)0i*NtA'rzpbE?00K>[p@(lş֮ ^DLr6@Yq^(T_rMp7_~Y*~X*P@\k;BF>xL(PVYGǂ3>Vn1$<2+o0dk퇾> OvV TJP^}j锚B)PB> w} Di'*Zo=1'@kifkv>MQM [vn0\X[56|Rj\N][rV/פlK^ƳKk#{)c6$t\d7JU篾nCAOGŊ- 'sS;xDzNJcw*/{nG䞳g[SHӪ-Mv6lGm߱ ~t)\v/?;!y,B:;i;V mendstream endobj 479 0 obj << /Filter /FlateDecode /Length 608 >> stream x]=n@D{7~l@n\$\" S-}fFvC`$xoHeܺ:jn,ޯغs{,ñ.: nmXY[|߇yOCuj0mX^4uז鿿ܟ8ϟU{\QKUP UXXG֡**gֱ*#TԉUUAƩ{\QUA=HPxUP5/R(T(/R(T(-b.d.-b.d.-b.d6T"0iX@h4BMFH˪&+xMFfl4qvI`7) &ccΝ.ߥTp |SRp*8חr.H'ErywaBTAQ*H QD! U(D 68l0 l9s`!B`6!Q`r!`b)ߤo5M| הo7M&\SI߄k7pM&})ߤo5M| > stream xY|֟v:d\2D4QFH0@H!@ nz6۲ٳْ{o$tmg<1;&c_pXPdGL_6[ln[}zZ@POQkuzʋZDySRP ʇZJmFQUj,<5OyR.ʍb=DSԣpJJǨǩ)HʛD i]ffvuSED#m䒑ƎJ=}1c7m0qݖ]e ?}{-7M%qi1&_|ylcY5ˑBgoqg/񹂭UL=U(ATG;V]F ODC=34ij)i4iMPNީoDWi6 m6 X!MDXE$~}#(ɂX~ZXJq5?;wBɕ]7+08p4g fC^g1j^9LHbM8s+w}<{Q=Nþ=}j עAN0yhj._Exv\+Sͧ|wBar _`qƊ~hrPo\º_ќFϿމ+Suim ZcM=*QlJq-A5KQ; ҏE1CmaqgAOY/Y㬇*(ֶvΔ ;j5AYg!VEy ݍuStIjjn 5@vd(sW@[ OՁ7g79XBoRu6$:}4r'Ah1Y6\ (K3D#]X" ]}jE"kUKX@4-Zm06UҴنQ s >= {?Gv ZY$@$b `/.seîAr/G$ZP@DۭQĨPMI$ieYk9\C(Bj6Xg db䦩1؝dA 69' $`5Ԑ@ss$m6F9BwBaėhe|Oņk`O`Xk<_9{䆍'W qS3caWkߡRm|꠾ \-x_\Lr&:i‡`g#FЇQMk6jmle~ewC.AnnqDqOxbmɫ6z16 QT]j;8clI j_m $^ աiOڟqRy=SvLnUnq,ё6ӦĵA!Tz^=x'̄Y~+J#nNH<|.XՈf5xXnSTcV+ TQm!Av(74ށm $c'heRa_nAďI#V?bGnbC6 AMf'PxȰ{"-s'닗,SvӞ$Kd8c$تއis/^Uzy=~F-pge6e~t wO/ˊs8y } ^/:BrDN-TI–%Rp?lD!亐dpB]ď" m"錍/5QD'Fwk$$k{@Gl>I/gkok/XL %cM&DאVG*l|&B{*ms>Eg,.E;vfIe:E0ݦ9EgD:4oj)/ dFF?1::P Bq?G --e(˯ctN@,LsEAbP?FeO,n^Vւ@aRH_f@jMTuZqOka~O^^_W/%,)zbn{\.mgXʓ^i W$XB&Ju0>T5U;K' 1tQkᨗCaV<$$"{ Bj8 {(f &T}06Fj5H! c]=Jϸ,E/zvsw 1)h(;̓aԑ39l{HM2G;x6l%4r o s16-qc7QWZUPsme}V .0ԘrmZKK HwN!: &[+mXkW'2mN6.YwKiA~ -m~仄|_fM CۉhxC)YBVkjsHH#fD<NMcX7*\ʚεWCN 845./$7]_WJj4WI@ j G34~'!>j4M-Ѡ&VdeC^%o N@#$)4a r+MLɕi',Ǔf 7@SJ[PYTҔXO :lYz.%4#Z-xT3<2ZE.aw4&UFeJhF,2מ#|~9!HZ_HOtL\tީ9\GS 5zRbJ1:Jur7M&&TLզJfC|~?2'-t%o?\$؅t B@8OH:ihheա܌ N9} h""ku[Ѩ}|3轕dwƳ n5 -! Y8ͤg7DNhvF.tC 4VZm %=w|o EΦDhpAZ[V+Ҋ~ a^| EV~5OV8ɚtv ω[A;tջagޒ̴DM:(.?k\yoDqKsfFi`JU^:{vP[.h,3167+[23֬c^NUXB ĮY pD9p;Eg8+} vX \ŵua*i(+dQjx?i[؎\pm)9ޫw H=G#?ZhzLH_w:3l3JTB )SE 4ڬ=ce_ģ %{; C]hg1I9 QroMTY]UҘ%2ЏbM yve|;2=7dfsge5uPIBt'|ؒRC|JlhskUXVVޏ~MQv46߳*nIDw3(G5q&6Qa%¢UK뻽\q"453lmpᵼʼG39G7ΰ:(,+:pZ-{wI4CC#V=qY-P|_S8Dz0Ixp$;+/#aAi2I .5':ЇO$wJs*#O\_w:b:+ZtTxC8ָr#L?քvehFG}9Oh[4f?F )o7R9~yv4L8jH &84"qM)AUPwS"6xQZ[VZo]-3 $l?qM67mwex'O=4<˵W>m@;O$iw!ÃUs>ljoF9c7k;MB7654@ -֐ҟ(WܮISjӃo'EU IxMTtҪ+8MrωބT'v&mY8zb.+C ,UVrY.ZtIJM9gz_[8Ddф=⏉Mb?>k^{kИE8 q%&y%!ԦJcK^In2soFn&+ml };G۬+I`Mmlc3c T;Vz,W ?sEG6FdD㵜&Zg:NyӦۜHI}#@YLj g !oD;9(s)&~եQ/NvsD&:`J3)ʇfEԴ#*v1Q݂ #ѣ6~O"{T{;f^q5MI 2 :;ި:7s;cW-STo1*I@Ʋk$]\/]@/Ě@[ŤH'I~zy LnԨ5j5Y?\D쫯4:bᣀ8껶s_|v5c _o:mQ7ʊ.XO 7/ژ:gNDdB2Dsp I-d*c%'hϰojC8q#(R϶<L&c3WەgE f+L&PilH%$0,hb'x&VyJ}}2 %䬗SjKh%DWxԋ~ tc0D#{A hmVM;GtI:i)ũƒh]K,z徻X-`0ޣfpoĆjyAv>.B^J c}jIYPKSluRi̕*t,kK6W\I ލ"D8Mw ůV\E)##m_$Dizl.]=Dj^XϠ`"״ARVN6XYBE؋×WJOPU`ԗ~l W[yjcZ E> stream xZv7kYx݀svـw%ى%'g͢%RT'$n6%+<1U٠H[>H6PxݺuП_=NW{>r_>|_&sBȜ糽 r- ;֖mlvh4O p`|ǔ7TgyRg|;X_N$gM CJWs,sH:hkowma9+7m4y^\ P (ؓz{ }V޷ 16 ;n&5BQoU;'Ʊ{hLfbb?O +9;-?w'$aֱOc9N9M!璵~ 0Fxpri?’`Pntgd !?"LĩLjZx[9,j7D[2q8A9XL{ b?5{P=(/k{OߴSn1W" Moc2S(!"UlZƕ"ǰOU3ڝ!lV{VSR낸2~PHR '`kѶi򬽉A ͔f q՟U R?'r?լ Kz%Z:;-ۛ9 Si(ctȫefLY.?[Z?!;&^*8J0`0#TzZvqbt))֒  H ]r$h|b'ǡI)=2u ug{C%lF֐U q{[6py_ "${r܃ٰuH m!(-R y {}NdтƠtWٔӸ}P JvPE\@*=W2tFJP&80J3f`@}1*yaHma-]ȓaa.yjwšqqH$q?1q%EIDMpLAqtgQ8a׮`/S{|qČy|I6z1 k5i@y`Yԟ}c9&BY육$Yvz$ԎP u;J H3\ wg3Gap/ щ) e`eҧ.e6iRðzFը-3 bNy-#rB\߾i'AN4M'-B^Б9P!OQsv?Uο&^i?Tj1~iC"Ġjp+:I("0g_-TVLD-;(Ele2m <8 y9b#p[IP䂸 @F>N8V 1Pg9.I"/ 㐒؛A5el<2a{J '\Bǭ(If[JI2dY"*p ixR Xp-e1§'LSJՏ˭U?g4|nv|2+v?CAb%]ΟaD\L(]vYӑ a48 8gϖu{W6ފV̷0e2\ ̀C'Ie弋酂-nv'^"*bD)(\bjjˡGMYeՐ&Cy$׺<2-BZI=Z_% glwj]D1/X`-rR]ylps6rۥR",!吶7u P22Jk!֞up˚b˺rYwɫ+Y:{`_0Ϡt%Å6R(7BIʂ)|\Sl1#[n86|@] =V4+.X BfCnE((uVG`}qeLxnCLwS۞w^8D4XkIǑa݅>~@2*dTMjl,&;KXB:9cq 8nz;մ۩iʗ~i P~ 8`G.›ܟ˵fk vxYQ$3_<?ZUIzBjְUI|FjIƅ -űii*u9m*:IDQ9 ?E"} 2DXFe8ʹʹ#|)IN-yش2T7]~JwD28(r HF;w tN亻: )r4qG;Tz4) RUw?L }}EfU˞IJ%A*Pou6+Z$I2l,/%|Qҍy땿7w'Fm?n ;S XƿxB\Bf]` \5 h9?+$endstream endobj 482 0 obj << /Filter /FlateDecode /Length 258 >> stream x]r0D{BXvQ4.$q<!Eݙ Z5ϫiB4cyVb3m΍4Kti/|}6p-޹8xVeG57gk9pr~kiRԏ]OAe8DiAvcPY۱ z" NAď Á4 rP=]/#/<Gqd}UCZ9zL> stream xuVyp!6HRHvP:P &M9MLK!ْl%YJOZnٖl>p7@$$(JKK!?`'g] gox`8bNS'oTV=Q~+s;Yِ3GlP y/_ͬA*Ա#p`S􆶫eB'[ V".yUZmPjٮ"n^*ewU#5 ycL]+WsHe{e;/{Og*HNjuMfQzðͻ2Go ߾ Jr1[܇q[#t.<~ʗm'E 7! }hr8aqt?)CfhZEUד]ggPm3=@]q{'gHvktmR ;20BM=XtC(G? jD @k]hůⷉOb @S/CTtz|4bnHQRRdV~skdŠ-∓kvӠ!MLzkF 8hCh'*}⋚cze2D$qŞzJЉG0G/l쓏в5khivHjU!(2Cƶzm 4@jrbw:N`"?' &,Җ3}60HPYQ_> N"Hɗ>: @|*mq[j sHC^B_m L}7C AߜgD#ofZHooHV$l> stream x]1 {^DQi\$|aQE~8)v]쑂~Ay` [@'';zQj<_8>u5* IHϹ쭕[V> stream xcd`ab`dd M̳ JM/I, f!CGO]nn? ~#_PYQ`d`` $-*ˋ3R|ˁ y I9i i ! A Az莂 A^?Cל.g^Gؚ vg_S V͑ž`euedm{ؽuov/o*wW~~wa(ohm];Y[̞)yȱC8s-('(jSfm]/ʹ%{9^1WvWo1VI ݝER?p=lksqp. zz'Y7kYI}&Le`ϻendstream endobj 486 0 obj << /Filter /FlateDecode /Length 178 >> stream x]O1 y?Ԙ4 i,$P bPS؝ٻݛ5V #ƪ[D:d,*,gI߄> stream xcd`ab`dd N+ JM/I,f!C[gPnn?ڄ ~)_PYQ`d`` $-*ˋ3R|ˁ y I9i i ! A AzhnrTxg`ac¨}  qkw^-ϭllL_/h^udkt^ձiU꥕KLϞ5!{bVoVQY{AnZSn'<<^߽wݔuSV]5h ʾ?}17/w<~$.S@w_>.|ԧ+Mؾ>Z_7o}8,Y>m߯3{Šjob=Vߛkyݳyl t/)}3Ly҅?|]8w!r\,!> stream x]1n0 EwB7lr\%CWx߸~jDgtjiSq[ezmX==zR^4L E'R{ZRERREv@;)НhO E Np҆C Npƀ2ԀQ6]#k~mՄG)V} ݵxN\yɒe@ Z`oendstream endobj 489 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1779 >> stream x}}Pw7,P@SAZOk*=^ bO :$^@P KQWɴMG})댇u:{7sy߳}&VDdyc[0$QBT e`L(-7A)/;(y9*K㣥2ZW̓fNJj̓FUҜ\Ev\KJ?-]FZJFj)j}aX8Lv2ݭۢⱣ>l?vK6bX c$<|j-ibl }Y xQ_x >~`,„e.l&ٳ ޓUK7GsXJ |78Wh5 :Nvqbf8⊕~U*>oěm5lf>c͔0!wl&C(D 3PQk#P'LÞoiZ( @I?K%暺Tn1KǨL1#T7,WQ@؞,뻮\ j Pc8l#ԇ9p^qE2: TKVFS~K)K4/t}@4+4 ̈́Y{3og,E X \P2AU: a9cS3G{w*)p'Gikxƒ0D>@4z08)pΟ{I$+ !_9%G [T@ʑ@ܧk@kuݫDvw5A j4Yynb dr'sa/sF #3ȇ _@.d-ɞtE^l&mCϟ @Zq;n19qո]a?Ԛ&Fpm u, ٓ벪ބZx vhwD$s[xEgO ұ(\u_}rclq >əUeZPPw8C5]!ߤ*$/5<,ͻ~Y?vݕ{kh9+SUIWgTCTI:TD6'@!z0_cw^Qڬ5UviG[=.=Y`7HJ_lN[Z%d3R fNp=g m^Sg4>m8M됅& P4Dkj[@?N!wQ鲷67R)4(&&`4QPJ\gW.B#d ry6乓pFx\>D ;Oēn\SjLS]]%N {}^ʶ)}lz#v ij+)n;Yct]v3Zᔡ&b#bpڌ6.n;Xcg.ffNޥ)t+;`}Lra:N6l F b鶶LX[[N}1`endstream endobj 490 0 obj << /Filter /FlateDecode /Length 225 >> stream x]1n0 EwB7NKdhQ"QȂ }?iCGt.yG/6G l/|/6l3|58o}~ 9͗+9R"%oKڎ8 @tIq#Hȍ5IFQ&ʢ(XpKz<㹯HyVaã5.I/_uuvtendstream endobj 491 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1426 >> stream x[LggYve\X֑5V("`A +.r߂,;., rS.oYEH4&Mkm3#R2|3~ىH$vUIVnO?.802%7;xjaDuޗge"WxA7J*o q)ܶ .<95GU撕i\x .BU(fs*%2}{1QoooRX:]+5=EERQjFR۩Pj7AZ)gJC=HtIZss, tZS`6]5ii/[aܳ. /c[˽C`OJZ$SO~!cZm$*{?j]!LM(>/;5 I"qˍ-tc;,P%!O9pdY@ 96AW] uFwY7hmj7^=9pzByg|6^{GbbXs<&Ս \ź ߠZލ[gH$M|I$v:o^[[Ȱ̙DYU `x"u,'\DHshUt_з:_t]{/f S5Q,#B 9F+f{fd2q `0.8YWİSP,[M{ 34TvF:THҒ0lC9wGC1|b> 7<~G ba<_]&c0mk/[c^J5g߂vIˌ}ρ7Tx+t{ْf! mfھye ozIt盛 &{7 ~endstream endobj 492 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 b C 8QC_C;ɾ;,:K X&׈#MEUq0:txf w=|6UVBoh )jHJu 6l@Tr48o1Ҵ4CN0GS1endstream endobj 493 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 364 >> stream xcd`ab`dd N+64uIf!CO/nn}/}M1<%9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C5P\0000103012_i eO_^Pw*ˋ T\)S^m. =wnw6/ i^O mӺvKc?{oi~}/.cA<_qsg.a][%${z{&>&20}Sendstream endobj 494 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceGray /DecodeParms << /Columns 156 /Predictor 15 >> /Filter /FlateDecode /Height 156 /Subtype /Image /Width 156 /Length 165 >> stream x10 տW)ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*Naendstream endobj 495 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 156 /SMask 494 0 R /Subtype /Image /Width 156 /Length 3976 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?Z( ( ( (MVQiqOHq)g=@ZL4Tk4m+ĮH.ʤZjMm,PH߭oQQB ( ( ( ( (C)hWO"9pۊɎa <@ *MwpHUZ*F  }TuniHbA[ui/7}8ɤEFemn!f/$[ڮ+m?ST5MOm Pc IJ +n5 :י\Hm.}'#Zz>p-zoԹPte:`IQ4sx]d9kF=m%Sz\&݈uvHؓp#H8'$Ri:mty-+uDP0)Yu724 ŠekTi66K_ɟr# }Ep~-{ "pT@C Rp_ AfD T(af$  %_◇MF8ʸ;\@?qtmkqòA'Y6M8KzπXS?@w;Fk0 9euղVV8mOj.Hm#G#%~^O2NbHE2YY*"f=jjiĔzUczh;GGz1SlLPu?5#)n{Mn*L93Riba75V~Ŀ5|CyI(&$08s֛v1Qnw(#-1W1c6:hm$W(]񆒺΁wj)ÑZ")G\:{_: ԯmz xɬt:pIj:Wcϖ2:IE|է\-*J .զV*+3^ډ\Hw_3*YяJZ~g2vo-qjF?5N+X`+t҈m**y7hǬ|H"JcypA!&rŝUgf9rA,ѶAؠTpz| 5pYHR=ГAu8/Ҽl /Ҽ#;xʨNVxI9 :hkx'[rdBdʞ ^4kGuu\ǦECx%kIS>?Zj+[CK:ޏ6P9l$hj( >)Z GHWoOEuOW]CLq4lp,>l0.A]_Gwx$z-nV*s$qZ>黂*o>^[L0Ҽx]I&;^&q\泠u\11NIҚ7s@s[+9Ӱ< reoκ(Dc2}=>qn[uq _s@zqÏk⋻RтHsJږxKjpbstBB 2M|Ikq3IQJz"$k_c.q ۂWn=>@|W.o>`;}s^iHZg4RV`DaR"uW/xlm?kdTPF4d`A]do>{:#m(XTƬuFբ9& O>:^om׮Y>?ZddErAkhLs2:v5Zsܽ`\taPΈ;=yGk6w_*cڽ7c%f:(HSJ+3N$I8{ڪpY%O&?qknC0-+ֵAkg!6<;wo+G{8ڡݳ#;^cxylHny+#˙ZyY^ܱ"s>_^ o֚49gRVe2]߄![ c|P),js\~G)fR9;8:TӺ6S,CԬDw1O(^/g,Ü*9C49\TDF*OWcڵ-cOҡ2]7':@^ H-[!OaY8EE yb$[8DW+,!ݎQYQp1ҷ4!a޶@`S EPE%1 HTPj>((~{mTk9,Vcd Ԥatf{ͳ AztpPQwN-!zijvS.vFN:('@|P>؜򩡚9I"pV Ԕ vGQGRAKTF`a[k匜2FzgK@ fhy Fl29)˩ݥOT,۰e+cON5s@6.*J((((+mBsEn)  *Aʞ[h>Gi9ҡ5V=vVqInAs _By-޺jd 0EV5^ S ( ( (?endstream endobj 496 0 obj << /Filter /FlateDecode /Length 4376 >> stream x[K)9t348kAl'#^Iק$Ei4z~U]ˤŤM1Yr#w|z{oU^>1g\^)3]}7-('*;ԇfh3|WҖY}K$ZDD6y* |;盙"/ =)X`;ޗvڪ̯R)x5[)f3|\Ngao"[&'cUVpbpbZ"2//Vx(?y/\zhZpLh`5l_5)1X]Jo+s&BeuDqxoJkeq.{hwә8*L6q?yJe>J(\ 'rd&Tn`szKʬ+t# [Db Q we.AۡZmRٻz0 >JXV(3m%*Om99F 6~ԻCDu駀QWK8Ao.#n+p`xi}$N_gQ"AxK2XXp4.u$UWLq7lfvLZ "K1v : <A#Z4g[&~h4,XZUY%g0# B@G`UE=6 beB3pi5q󑷩A@XjPF6: -AwA=/HUfp ;Z8S|-&TĠ$!%`[O[x8ǎCGKj;>I~%O~gŨ|Ҿ9{ʡdҝ˙E R'j Q]6\#RFdp4Ӹ8DHfJr.w0P5cӞ/OO0kΦ7"Yp2u͖Usg! ^ laz3Dv/cXR|OυzJ͕U@Zc5&\H 8-:uߏjRhsu)Vfw0v4~Z% |i~I8q&$SѸ!^9x7l:;\?M1(?fq7&DܨK+uO z>L1H^y ^Qҡ;Q/ tU׭MD{`;q17ȟZ#|AT .A{ pZ#PbTYV EG~> 3hhIt-w?4CLNH+Yi:h'[8Rc?mZ)>1O=sr:CI'Ϧi3γڣyK,LO:4Qu>FkD툂ce{@v9*\I!X96oFcWHXLs fSokg}8'Q;ƉёIO%eTl!c tJit7_'N o^Qe@J0?F`&vt s1, Ap`'H6WsR]o $Ok*L澫aRej*X#hڙZjXlXK]'4+pKϺ'"sjRK\(]>kL+ "`9wUVY8%"%;؅P-9:lbw#]_jSV3%@Dkb ee~3|8F'O<4\N%yvp7$@-jk0{9:s4G 0p6͔3ϖjL8Y $~` ?Lpg~(GI w #UhvE,! I&LI}"L2,vNqֿb' Dp71`Tɵ7g >|χ?Prr9 B )— TpOO(0ݬ]^_ ȝݖ$d=,!>mdwF q x[e\..^WXeT E>!+.3Q8Z){`C_,wvH$:p{ŕUeEzeIC˅Q6 *iu?Ay ]a<́q]k7BW)HR6bK]O\]{1Gʮ>q-prh3_l-1P7zC _׼se"H,9MOlyHYأV2 SBPힱ5Ъ o؄m֋%1# 8dy/0qjy*O,9TdlE C*fqNnoI=CP,{2"DrXm( a=ɵ`~Q!pJܮC7ca2#-d Ll̚s sVbVx~S(R%ȅ (C4tv. p=WRUW*e1ƼL! JEIG8O._3_zKʌ2TBCko^+L }|xJi_.<^t&11I,kz*@It ?#PأzrK1=:L!tLYsy($/.IEt̷X/W%bf:-]ar{\N"|aB!768eҤ5v%Orm_Rmڵ NK*>S(Uht);BWK#r/Qt;W\\r^̞hdC\~zc]c4qBԵDi9dq(/B]#{\8*I1N*4ݤU.|ZǶ6!?o'ه'˪e?D+Ӟ] pD] )I҉U@$7u zQ}I >'R[q*)jrE>q82^oX͇n(K嘲R^lUr Msߩxȿ:f 2279w=W ȮMWZM֦G X|MF>Y'7$f),c/-w͆F-N GHt)!5.еuoV7](UH"~ W*נ*+)&o Sr2SyYw* &6\Mn-6 )T\!A<sJ> stream xXo=Uo+Z_-&T\_3KrWb~0ܝfViB)*]<^}vu_W~OĤ.W ]0BK.]I*!}W]_e4S/뿣4ʄLRm@zsErPY A4Iz(5nVL4\=w[$K(#?fo_SnEby]/UmomazzEu^ 9R,.+3gջ}h]G$վ꫼ؖŧ.I+D 뛫i~$>./h!ooɷۺ*ᕑ|w*pe`w_1|(~B a^ @#z,hv R'8嗲}^e:QT4#?k4M_-WTjtk0!'g~:}%o+pă]gX"H@|M#{"a/F^T"^F ME5LAB~N~)E QuQyx]ѣIMw]ur[@`v7H=Ҫ]>@v K\g0*A΄ў)BD HVdR <_ f)|#![J@n v F+C0030zp#޿& K}bNsOuB3Ad5"{I]uQ1 @MNY±GES*L A`&1m0RQb`Z` C>dV f 0 \=G*ʓ!/gMDOL@.yKel[:^'4՞~5weq!82hu2L%alEi#MƣqP$ssL$fRP#ZoHg9@}<=? p:s^o偯Ef濦. .cF<#S"sqq>e vЬ<3T#v~\r/z a\Fz,g0&Zۦe$c=&n .gۻ&7Hv@VĻU@7O(&S11h✂;E!/Wsh.lԡ}{x07Ǹ}hXD(@Bl0},#Fg$m o!$EQLޣٲsw؂RdfMQt`5&K!Xx1֭Zsj )L;|9+p 9g~|ea*,[M3 ͤwW,צ(XQaAX)MTJ06k ں4Jd\t Kt02$=*oW:~endstream endobj 498 0 obj << /Filter /FlateDecode /Length 2248 >> stream xX[s۶~o胦}(tb vƱI84VO<"HM%!mw 93<~7ٟ3lfj;Kd.|qfs^Lbn,y'V{t< A*b 2g 1B`Q trB2!ЮmA8V~jҫZ"eiK*0WBpQI Pl=dR%7Z"20X, LӵۄYj&I8Iǃ6WmD }ڄxDoF66;<G܁VsNuW.2|$FBT@K[JUanj\GDo/NB/9-qHS1ʡ>tIFuk~?YdϼB9-@/5VgX7r Xu ǑReFwTt0}O<7wH>6.ۅ&)nz֤ #}$(wzb8*b-fֆo){KSjBI' O,di#OI"j3؈ FXb篙G)8Bm~Osnn[5y9Gzh۵ΐs_WͱDVqͲv5j endstream endobj 499 0 obj << /Filter /FlateDecode /Length 5792 >> stream x\Isȕ/L."p^v$ HV6[-^U$[AU-E _nNo'~].7'25E'{ pv9%xx`2纶Su!=T.n춡 ee$P:Y#_|aӽ0._5<*7_fdmz^YmsZUg֚E1oxPVN2wYkԔj 2:/+Dx،C-l4,SNC/B!J̅/%^цd |34._T,D4 nLt7G6nW#)& r \NkM\|Y ?4kNvr9ob^դeM>|NaSI6(+y(Ї$th7 |sUfUDr 8%O0 U+uhq]╘cbYĘWtvZh!V1=Lq5X;M~㨮 5":q.0C[NxUe;ܗ|h;O2GGh" -s8zwB*Lo @)vP/u Sk"RN"<h9]rrC S,%-b5`.,JŹx6uߧ:;a)wɍy/jN鵠 ؁NQWT-!yr 4rj |4zv⏸>)dW'b6.,cVN'u} ei=^ဧ&QZQQu 9/ NO%-4]7 6}qьi}&1U\w`Tvq]k& aĚWBhw0LJw?|8O\ʷKp1BtsQ[ÀfCtC)>U -flK S( p>fG BP8MIԴ!uiZ PY"w]^^Ca)̑eooGFM7?b@+TTsxJqʶozE8dm&ԥM)WXu% 6Srp]?xIڧrUg<|Jr">$lW媛xzI^!\O<9(Ds3C< `lKTdoStD1FG Su &$ꚝw}\rb>aV!_x&}- [:7q"kx frhTpB4Ot3p` ifE .3]yY*~3EEm)HF'  y&p<%/C6|cGr){ֱX( Av5w^ΠaK>ڗ&$=TChcβ%6ff$GNqLd8&f0݄?ψYR~Te 0&mʚH~=^Sl3 o41(3Z"DsRQg'SqWFK/!{2y؎q bEMkQ$h a˺N k:ԑqDIQX0={  (D[H+YeBM }buhi5٥CqV3R6nwu4@X lF<fDt!d kuaBPQ2MLx?MF:ԍX0J~hbJ1k2o I;sp(]w'c! D(5=W/hWs+~cHhJS~_\X|mI#$dUA(dIBA^ξJCTĵ)X! DFAR04fu0BRd.[gߌGSP:IdM|Zܲ` | >~=k<r@hZ1֮$!.̫4}EkO}0?FcsD #~v<ʓIeA}x !Ctg*O﷩i~6Hl7SlAzpqrHP1T\V*ʔG0gDIgNA})IyC m;FW97Mxhm'p"|nz0(jtF[m df Iȇ\W(o^\]: EmO n &7ԇR1^N@ JĤw09{Ԁ?V[^\Bko?ܮD9<`<>پC^ 7h1eb# @I\}19-oפ Y蛯(]Ae֖ps?ǘN΋DJVICO_O)+  䘼D/H/MkZ8KCG$^֕ 1G`)mtI`E_rA$?#ڕ>r65>PjO԰1f0:WD!2>4 @e;V@!!ruD+v F?vS6m@ u^y#L5u1&ᦤaߎ]|`L$ M1w 9/>ڰLß̻RA/a\ ͅ$6 F>xv Z*[ʀ6Lss*^,5ҝ\L [(HD2B,8o2M tv(M`CDPz&qnkq7BxR#7lL6hcC$6z9TY"OÎ{~?.PSbBa}r XxVOΏh p\eU](43ƌZ4`y& /˼?BYM#b# 0mHw%#5ff-[K>68@34ﯗ] y Op~o{>ma3G .=J+`:3;Q 'Ռ eaQbKIw:azé'\j$@csI.ꘃ} `Eh}owhR3tu" SUYu).^6"h@:rE(3_/x2^bKÖB}݈MdO _rR$ i6DgŠyA6?S4%H[U^zmjkŃ1ۅl2AZHHxpG^mUHf$h\K,Yc K^XC:dB-Go,N+?Q40Re;u\@sCպa^J7ûT*%v*͔f<Sm.+%[Aq3Pendstream endobj 500 0 obj << /Filter /FlateDecode /Length 4077 >> stream xZYoɑ~_y ^am<1ia5XV_얆U-ʋUGd_D/x˅.TWMA\>\9R:/qMPvul}w?w^xY_qQ^-*i 7ŕ֢\_^)xkO쇇ٕԪ ޲v݄ Xsؗ8ղE=(-`0^#};/HW A}I+)I7}N=Yn!8V7>c6GKݴ]}?x(զ# oAޓAjU|JZjO387gTf 7{8ꏙ=FԀSNR2?_rrdžӫe3-f36H}Ao *j zep 4G bp:Oi%gV˶AB8jd" i d|H0{J3e\ZE^ѮlU'i,Mx߃<0( rXW1#z)"٪9QlNTz8ĘA+H0.qR?F֥TQO5\,r=bpc SLU:H8HPY"v[||^&Mk-v^VH%cr;"=#yZ' ٭jǖջcuK$(+d.кCpf#BG"q!؁ażGNj5D}d׏Y1ى!؇k9 a _S_"aEM@zz֝nT 6WޖzT*ٍl#E(R\˹@( 2ݚ%N6M#P#lsnK4 x!8ƿԞoV. (wQ0Y=w݌qR|/ͧH'B}}FL!3t{B!vV<.m 1\Muj ã -2Iq#M%x^ 3t[g-t\e[yEŧe.F8cA񬐟ONJGafh/FP&mRp3ʹjT}ZPs)"5&ꠐ7q?jcJF49JD:U~fXo?"0Tp d\:2>}`6\CNV$,}R.Hf*N"۲MB_0:B1¼9-1v꾢eyf͛~?5ij#rAJmJDrcDU`fGEbtc>|kDS?mͯX0E`6Cܔfrl.nQk*V(~_Hx?͢nhUNbŇ4f"][2!+lN9$-j*Y5]1>kZŠ/eQ5߫ Ftg;!K7ƎQ:bx:A"q/F7e@O)rZ'^b)<"7R!CkXC.Y )&G~].x(@gJwdvυ>]>8 @D )Ն!vRB6RWe-t~)KͼI%:,_Aw0ĩדBl *uY:8xj-b\ՙ*>Mk' f^`B7Ȅaʄ|__95!-,ǧe5xmPQ3:8Q*Y|nF *5mUm2kl4y#H_`A&LTDŽhip4CPWʇ 5VLNau_xdB% V O/~V2A#whjc},'0 u?D&}"w#7@`aw)њ:m6#=8<-1#vX|&RBWKUA!K#LYLǡ+ t?/4HESJ=M?`.1oT,Q:&%aKfhT[fjatwYذe+`89tH-m-ܾA@*kE2VHRӉ"֊|Sd_T";X%$ĕE)8K"kbJ먓EJ!Mcqۡӑs%"sp($[DJXSd!ѓ͘'oNO}!(b Y054 O75P `Hը睶A$zx2jN *ߐo/+\A3lW%^xTK@kQi0>Jdʯw]q1X:8#Tӗ2)Ҩ0q7ӷBp4_kwpW+X'rv1^udέe4: prŋmTuĦq]3S2#O 84 ]Hp{%)MM +E'b?Ue^ N\;G#;B|BJ?S6!"LaP0{l.[|JR`jxM YAOe/wje ub|(MNtU@{:wH#6~7׏/ Mj\\npuSr/zu?ќGIv1#P-1 d۷ -2gDkxCOX8kIm_[_o+A`0cx;)$.„7nzZes?u41MPyz`,V)H. +NWG>z~CNn2W߽R0dNR<& 0(8q4 B F8 bxc &toH0)x7t,9Pb 2ȒH2%BaqHKJ>n()ޔeQ "-j`-'h1 RXmKZTS\At @LJP U Kfx*f(Q1'z09 +ih-ji]IU=v @6"8) `^۫R1 4/SJJNJJYpX@RHzEI |d׼$\ʂO)hsH>}|抖AECu^*^)"gp'Njendstream endobj 501 0 obj << /Filter /FlateDecode /Length 4292 >> stream x[Ksʑؔd٩RrdqV ڗ]I̯Ow 0=]:hᯗU).+^T.~ef{~U_MՈ˫ ?F\W6\^m/ iWۊRTF\.~.kr ش7%t_ѓ6=v [w鋧a7#/!Js]J(Ue%4Ȅw+!a-_s۰aadmÆž?=0 % C6ӇrN^ Q6H<8c_.\,um]u7G{s&Tv7 !RJ_qBQ#qҟ:v¸XeUY<]`U>0VhS/Rb~S7+\݂Up5FVYpc.iRkSRs*zJKx@ET'v!-|7s:*[\Ztcm?Xitu+)m$.A%ROn3uڪb/=dNLqż!~&[RV8K_Lg[%̀ Eң8TKg}F]\u! Nf(ِ}‚Myڅt=B9o(!@;$P0f@~iY#zWs@Bf.-Rg}NǤCA_{=fq^+`{ztkɡ5Yi~_ag<ֺ8F{oF8 48Mc͑zp4 ޹O_!Y0[`z8~ c8>'1הy կy+1LS,l8C)2`5 N[CxÉo&;wo{g+01ϻQ*В{㌎bH3M%(b%tbL#2@0oњ>}9& XD ^rgڏ8dcr{S^!)\NXk?{yKxL`Ix(\>vڥ?Uv d8I9Sz;BܿA0x4UEv0N‰x3ӎL!.=G|b)R kĬ bBhM3\op-i5Ka&8a+| `)>ic-Eulb kےlKFpʁ8K=%0ӄmXOca!CK0gQtϤ[yac~!BHPy ~]ːbDN2E({1Lzs\,T@K:a6~C0(Vg죏6@~O"KOr3%,"GPBW!xcH)'cã"^ye?=dz.'B_ln~܆}YyKc8`4%BG :?FrxLWgQ+ A~d2pD٤}: ! ȹ#|3S"t8|`v l+cO[DIKZ>ȼwkٌxlO'˳ruh bBjUz~ W!X]G0).hj'B5p=o 0q-/6͇}VeZw[0RȚ5^.r<Ŗ;.@Ux^Ju>=L S0xQjMe6e/Q$Gy f`P/ck;WIvC:! VN9!d,#_<3MϼJ@4/[0,|l2V2Sŋ& c 0s !;!kA3:Cm:cYWT,tH4 ~I҇KPi3)PWA@8_t!' u۰)+`h̎@9Hݽ6kYܵn0iRԜm{_G,E=[W "V:Sn+e8ũX#xL^iɣ6(ւnpzTgubRX% n@@BC.ڃ}ꎾDKqj4 r WKW7YzM1}ԡ&"3~i{_C -1$(r8vkR7GF4 0Rdv; IgIU Dh2g\TX2lT<)ph^Ru*꼪'̑(3b "[U#: w*62u6'HZX1ӳf*OAT=#>9^ʗ7wCwQ$P`{(qUДҔ0s֮FGₗ6vZb*V]?c {<ʻ\]E EYjBV~&ԓ`7Tp= ]6M'3 1:i +)qS&OjҲذG^!9\JsƘN${7P%XlX{c(댯1m>(Vݎ>sr/}2Yc㟨qs9&N-]X)HŮby?œ8/I=:*)$R ]LN)B^qgroGx!_A$Ǩ xKD+R3f{u6]J[Ѯq`M`y=M|UAA\&_hPqq$Zy؊PNh&c'mub&2jv9jj vM8 qr.3w>LNDToe$esyϼf.KT@> stream x[KsFrdmu Gh6#nd7i4ZMp(l$hcꑕ/3?]s?JW?]z{-5ysIKx)\_s]*8ѥۘÌՏwinRosX59Tw5W'dS"I~PW1$u^ÄG]{\-: qLni|$P]+ X3hȞEo2(EW+L8;פC$6j ~:U?S]Ӕn'`pl#9rǃ?|Xce+e=脁rpL膉8܁=*xGY=;yy'Wb>@ r?P(`mL__-f zW:^ ?(_~$z3 &#oF93!}̄K x 98ӪB c@}I ;I:.ez@hQ9&qoL,+`y41h%Ud}D *B5մ́@}+Imw0c$pYJ0L["AH/X'Ӑh+Q%[^^z$,))?Qi^32EfinL%JaQ-'H 2Eoh^y6G> 9ފEG3OIVWů.KiNs/}Ύw{b&325ly#^2 0 ' s#%Gbh%+C1P88QnMp3 &*]:4Udv[-Ui0,:<73;9y Jm5巒d "}Q"dpYmTeB`t>&+6N$׳JZNx& 'uB;0%F1SʌvFYc'Ʋ S,MHtˡݒ xc6 Z:ĕ%,&{oFR` В9S 8su *~E93fJW` Jȸ2F,z0P+W )_E>d_`H'$̹jcP& \7E'V=Y ļy()b@d!j 85+~8]^*b90Y'49Kqff W#YG<ЅZI4@Nlk)^kLI*]>5 89I;X3rVP8T' 񏫵̌)\b[j6S]z;j!Hi꣖XEI>fp&դۀ)cz O$t{(೰_"/7s2S橼J{x@pax>`ŪsGl{G D:d} xEH7QC^^U-zf%fiַj}Xf%P>Ju͌8'w?nQq}g :$}Kw_3V.yرn*M"sp|E>H'|;%Q0xc# PgP8fi{6~Vf˕Ґ ɱ!Ez8h>}QoTpUW>\Ok8x*[`J%]%~xܵ͛w4wɘkMr-a92{bpVX̠Ue_A,NaV+B9bmpF}r\u`"ɷ=4 yCT5BNʐŀ:]|]h*~lB6dSJep.ק>.FL2Zt'@'ګhh6^R[q9NǴ3X*(ܽqcpZ:}"MY jD(2cGOrVyH⽇Gun;(7\Qf. zrEvf"2 ˂>d$9XxFڼ{]wʺ7k]8"c ߘ1k\V/T^s_̑m[31['ne'N"d2tS-@EJ)<ڂK7T3,y@~xT`^[WbM p.cyϹ.kU=ɢxOR//yui'S?||QuQ`ypkd t502̫(KyS.U L_ 7+G$);.GS_!t0> stream x]=!F{N g-64XhzC!Kp1Lo~OqͩpA|g?@y{LB# .f{p(Gj|&=>,.QtJ.+0vjʊ1XeY vhO\XF):IB!EҵR-$uoN#a,;5ZL]Ss풄xg|endstream endobj 504 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1199 >> stream xuRkLSwrQVKY[8EAňϡ˜XZ-]8`D:a}Ύ,kԉl>Fh m#դ@VyM(~ĝz&r4cǚZZhVNZM& Vн‘nO$ B`b@%r( ?zpgٻ[ K +m-m*B }U.qe |k} QN|N|`{(EwP> stream x]n0 w"o@  y.7ھsbrзoS:t"}q,;vy\Ӳ=w3/iX9ʹa+}}ol߆;uzUIq n\R?TpiMk ЁnIhݑDGR#ԡ`-NhE EZ:RRyR^t":A=x-䥐GkKA^6h@L  s8e|ds&>st1%nu,F))endstream endobj 506 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2287 >> stream xe TTe0ܫ (3Q!,B3 ELFDFdf晹|"08`d,vr[D}.KV{=+\](D&:6;SPM.$.<)~"eBRpw=Ĵ/? <1a&%HS)P- 媭E`jurz.?=MڦZz=['.T[S47U_]ZvsB&@>-5SMQ3%5cѦ%aK]ZGmUT45zr^fQ^KͦP5Mb5[JmK](e1+zJ&=Qc`; t.*,EkY6]bV5}Zk^H8 Kv2S]I̼483Wy0:xD B'tC-[Odۀft,!-HE8  l[G~k4%Y~@ 158=:g;:Xʥgȏ7_|n1/;}1F=:>1R'4$*_-0d0sp׈o=oSSi|0yv|\4#;|z|O'|;No|[*$`.\+t=|]v[P9F{@ZfZܔf3WM4P_[<FyiLoN{V~zib7=n m}㕻ه mxOkovL6 t[~P5ALGU{=/j74 F][Ubl]dHhQPY$CtTo}gXt`u4߶=7"!]v 3ϛ:Q1$(wċqз%'pq&eE)|+oblpߕpK~˅pG[q1_xj%+FHYĻgjЕ]˽I\ʈdD6L2|[I$&JD"[IFj 0!˂ɼPy} !\l祑yd(=ep vzMlDE֋s+sHykoOB]MVb9qȳQ+<+7O ˧6u&hᄳrMxnt׸li6bZVc<_W_>9endstream endobj 507 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10 b C u$@Uu8K结ϲ=>(ul"~H0X ô2񥃐E;iʪB A#EN?iǙTPr48n.1Ҵ4CN /S*endstream endobj 508 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 283 >> stream xcd`ab`ddM,M) JM/I,If!Cg<<,{O"={3#cxns~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+kaw(#/c`bdd?U@'.*sdaLf.^$8uB7-dɵ[9\sy_={&LY3gɽ=< llendstream endobj 509 0 obj << /Filter /FlateDecode /Length 193 >> stream x]1 E{N @3jИ"L ,Ƞ}US.>G V| yK(f=L:2t|"p,]O Uubo2%jIX+jS uHR#jEBAgDG, (bC!y\-%+P98Q -cendstream endobj 510 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1165 >> stream xkLSgO/;⚹s[ܜ]۾H r+XBҕR({NOC[J *rh)Fӌe ]Lݒ}x;&D?lɖM0ouuڪ] YZf9)Y=-%+k@"xfHRl@b" ֐7h**uΤn@MRe5FmM%WRtUcXEmS)RERSyTNl*%+#` "a1zM2L,`kr" 7 B#q)đ! ǢгR0vwvf;rh-rǓ+DHTF\-0lWYwAd&{]- ttfg1I`|}L_<9Cr>)l YUSL"KD#K"5hi/ xw7<$ìNkvI^|/\m.Y]" ZY>kQpXB#GF J~N TAuSXyie:&.L/" Gz\tv,+^O4.7;ƆF{OSCƸ'ÑS?xnRxCH= Koe.ZQst*if; )|P^R媎TW*i ͑!$vLS64VZ4Fخ0R:q߽|d\/ [|p$_ÿ߷.$DI˿&9QAq?~vlG`|IBһ.O;VҁmZn5CABK^[O3T۪f|,1;;`oku5zȄ{- k{7}g? .nzH8$a"N?%=T?]\OĊ$6ms86mG0/ \Kendstream endobj 511 0 obj << /Filter /FlateDecode /Length 3942 >> stream x[mQ@bˠ n8(3#J: wfvRӴ( ;;̮9{ٯ3Foٗ?2Q«,J6?9l΍K.Fj~~ZyaE}ח%jUś"""ʥ S,Sw8F񘥔,/ 9_ [qR0XvKe^*?[VվmqZ%?h- ~U I9M5ڌ( &1pJ yXSħ~F쬽^wC4,)Uvۻ oKgnGn9~6Dk)M7nH\=:X_֛mWðr]vj$'1Rv?0]u=H)CDZ5gk`me$X0HDNv޴}",٫]߽XFm}eoΉ|n7 E?$?MҺC\yD?JAQV>} T *f-LT6;P4R@|ͺjj5SYu;ZGz !mm=Mpm|?Gcw=7kMS|p- W $Zf}6˔+2ROVZ,%ʨPٻںf0Fxm!v7( MIdqKDރWf?kkex(3אKKag̎ Q΍jA8z[6Qz靼ħRqѪ.U9E%_, 5JHQVHc^@W{<56c!Hh)S;ZֲG&(`gƹ,Gs9H;U ނF;;@G=3'hY T LK{-yۗV)I-1Y4LY[%lYKOHiϐ؎bd%0MM+;*qM 썀HK = I *l0'm>wЂq>]rn ԰0(0W<]/uB Q`cgb0:Z:L*hrGys}FEeQB2Q҄8u?2t9=ś4_(L\1^InZ\re4;wIA~YrI:Jf*DfK l-L;d<$+hi "őlV'D@v,G/pScnDyNMl6F>ɶqam1.TIQ8]VX>A N'0~F }y>a'j=7afQDrear]jld>@Ha(1Ya8|{jDTɍJj}A:3|Z [藾>CR2@(- ,enʵM M ŁG  $ďA*Չl^DrtMzJ&!.J>$AC3ItnGWgF[k1wϡaV#{FAW΋n3!zRԆg2~QSPj,8l7jo}_TWóvA#TnA2a ҩZdǕ*7H9Vĕ[KX׈,zM#c1n%Qqz>w*ľͰd Q,$)A~y@ɴd_CXx} <׀mhC4ʏia7E*Dۦd6gV} W*Ijc0v+ C(GΞ@@U>#%S$\FɠCc-9i犌Ƨ p[b4.򃠲Ʈdw}2N#dɨ#3_~%^狥2gqQ8E Z@^~0fG;LȮP%z@FqmC]zoT;QJT_]^p\"=w؟PH2pd?Ho(Qb*(5圇Z9p\՘l%(wLڶw fAR?T][7ϸ%)B\fRm"Tٸ.8ޜl NdlZxN$=ԟ--ld¦OT4Qm3tN4YO7 # uc*};{uʗj%iȅw'=̍5q(&EYGYe eC77=*'-K)9޲(-`5ذ# 4 (Y7wH<(P8oD; I9pb:t7EUzFo)o: ~|kZl1Gu!EQ;x B 5Bһ" ح䐒)Jwq<6ڙ.n)i6z)O]7ߏ _5VV7WN:οJHhbEeW"'j'" 6 ϕKg oHzNմ;08P#:{ATXoFBUn*b,}FKnjOԁ#%3QW?G yfY1\r[H)SMf3遣r1z|_Xb8ڇ {jTQ0[U˟Vc"\H֮iwSd0@>DMMAkKrvwU=!:p꨸+Blw=5Xl"!l޺˿Pf[R.0J<ytz@ўv# (l&:6ú .q\I|?  ڽ/uT1ؙ'^Trp KC UHS>pEcO57 :y9lݾc;`Cv4"xjKMoQ8u~tKo!J:Jluf!ħG>6W-DrCˣ"I7 KQ\ƧޕΆ`4}%MusprDV.]1pIpri͞$uϻ5UWܝ'˲Kg &S>'aod9Yendstream endobj 512 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 Ԫb C 8QC_@g|wYu`A>E0uŭ F,m1,O)x@I>Os^%NRP`b\Sendstream endobj 513 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 399 >> stream xcd`ab`ddM,M) JM/I,If!Cg?nn=? ~-[_PYQ`d`` $-*ˋ3R|ˁ y I9i i ! A Az݆*ZP__T} f`璞޾i='NY;wƴ zxx:endstream endobj 514 0 obj << /Filter /FlateDecode /Length 4402 >> stream x[Ks$qБ%vvUzMrzTzg_DÏt5Q@"3嗉^6lh..z!Kvoh|U&We.]]U>|zs>1ծ]6Zj_у[_=MW^bRkejom\ (jw|X?F۴`Ph~Gm:6Pڌԫ՟o"IMfPP;mZ=\0uQ_T-'۪w,P#Q?$aucԙPW)P[WZ+];GLcYmW+HolSy#7G= Uw7^ɕ鱻Y]2ײ2r 20aeAC'\O)ZLA+ۘZ # v&ŠMҞ}]r1AWp.=m)YKg1J7Ƃ^UGz$Cai OKߢ?ݼ(ʪ$+E!Lu9Fn/4pҵsvGYT?=}I-\m|Ox F #5`O#Lrì[t"S͓;>{,aGiYKJ,7+(i>wSt8&c_N A`ëٽd(lNm=en = Ġ o[ 3K{S6_+AILa)wIJhtCrA|}4 cq v3\6ώ mw`7=yٶfJKp1]4>G8ZYȈc^%#-{ξ/רZh+}M!4T) &Cz84ňf%Bqh9$ګ1EI*yEˊp朹Nl](g5ou)^34ghe>NbI~cZ82j@yȇj;҉rXIcw<3SpcN${?FE/k2M9I7Gt" *θ촠dC"D?㠾L{ުCĜ@ d#d+9@k(bk{O$ekD HX,G%dB7| h_*ЧJEk_-vT$?;9\62-M)S j1{ I3qϋW|KSxH>08"@rm$rHS˚?C}-?`"91򗷇c)] dqM%}{YJ8i=ZQ Ů~Q빀9"ŋXjmޖ94XQ՞b@ж:'x*W@AI/BYt?(ìa9dR%%&gh|I 4n$м:4{5f4'kЀv R_F;`u_J~>!ȦsOpWJדpk@v6=e|Nqݺ`>H`kѨ D%8d/! 1:Jg8Vm_dԫ~͓.޳y@@fkd/Y6#V RBqEƒ9t&cW)bNt,$j^y.H^,mb8x4 !.~ޞЌGiV> z;WTl0K-* ?)q /('L d6n-K6il,`⽰NooN8V',ĊV|,ӂ@<I1S] ?N.6ŖEm+M- R SUV9H@b]$ Hɓh!S,DW[1s" C>@Ƶ>̢T/!d{Zb=9O@S?slHT^8׷Ѐ7IpVȽuܐ̡ڤ2XIӆ1þFa!=5$~sȗoe拫hEEG"1Dϑ'BH\|)ύX2Ƣh;g0PףwaR^9=dvSeЖ*1C N#j "oO꾪C hS'0R]nc4r0-ƕ䫔0n%LK7 h3ctLn%P'}vΊaq[Nv__b=8앞0{ fnJ#qJgnt7L-L( IIɫΑ.$Ԙiu{/OF 40r4 `G  WWtjӨ){0?d\%*j+˸)W՚J`!cRgPInCk3*E򛥴=@xv/9۫w}HM"r]6_=3Up7,dM_2ͽ1fsy A36⇋M]u_.`~׵5\mks8?иeX$ e~}kSYӰ\|![smϷoQL~U_.3_-f>oȂT5# gZ @5(,y4:2 P;rDcOi|ԙZɔG_Rl@NMˑNirN?H/ @juvԝ2KD2)/At9+ñjBdIk,$^Sഡ/ÊGp`>ߤU|aP,z 8)7)AaXGr7C']D * ?#s3;9^;sC WN%RMz]OC%{\Y0_6zbABR ;%U5јpT=?,,|?r]wܐAy~_-ZN.ѼRHHSh\]Cq^{S?<H蒊P ;IeTk(Ե5?؟qJbL]$qΔ$.6|R*8oDc Ðc^$J13ȧ y ~hYts' 8aŦ`@.d<4ћk_ÄYk>;7@#qN1֞jB2jn֑L n&gOnBg3)kpž fpN=@1õff7]W!' xK(޴O D oEĖ9WB3t鸹a7tht+}0?ykN<󨲴??yqΕFWͮ7㗩JF1űaʊYo᳋%j1FN+ZRyB $; t}IfZl nWO 4TFH?-JN5Dwr~9W߂n;ՎTg9$BͤW$  S%A C eTUd\Q/4̹l/,vxnT&sU" 3F|o_]Ot_U`"̡ۻQUάw59 Oq!Rݛ,~.w\{/+endstream endobj 515 0 obj << /Filter /FlateDecode /Length 3840 >> stream x[Ks)6"L*Ld)'Rl1X9@\ R~A~v{f,vuYTy{UWY51u]m/.gU~*]asF 5 Vr5xY-RźZ,VWK[\Ӎj[IknK4/8d㙖qPORqUV4xXk\Ì0˛nu~뺫/^}h.6]SRI/gb)U݇_ŷu[wn`UU)*^wuwO_6m`~l]t/ﮯf߽)_dɪ(6ɴ^ +{xXd* %mJeeE'4֝ݸ:y {9X.mAbw?%zyXr OtcM&1$uiD~}'yIƫRZӛC^eYPPMVRwp͊:n57\knfPMTMgR'!Ji'v,sI_ K|IhF;7 Y[+Bg;I1<~XNcsgKzN8!550WM:I~$Y*4۠b"5ɗ \^!C;Z ۰HhIauBf(^fEӅq`3o<֣+WV<?m%im57 `G KMj$e2p47=8t: e )Ɗ]7Y2pwF:f}¥6LԦ,)h`>񡿺˖3̕njZPi1va. ڟ%<4(7n%BL#HYS*vdxH $!I$FOAFҝ}拣 ݇a5(6F#, PVB2r]n@xqEX#x'L F™ å? 8<+8}$q2ؙ͒Vx-%'CHbra{v!;XJJ擯eU|xn 3dgUz>KcP}M ;h}N-SB$.))~"(!AG&t@%TmL5Uk~ >h.$ˍtћ: (mR^Dmݵ(qM8*:fflC h:~RKYR;wIMxudoCVDzN)X]P*G$> Oo?'a;lެ4J{:{.DR*J:)nT1-*v%C_劃T}Q1-R`]f0m"dJjw92t_!א[><"Y@~{_c񋪇tո% ?Cy@ޏ-k>G$O+]A8W'QSȱd7:i\,17!(mqR$+j 8`8 qXԚM'5x-fw k=VC?9=a>:/ʓ=I>6CmCsLoFEPtW_*zWlBtLx0yw]~Fp:Gߤ1};ʔsǶRDF3wYYJi:j:}a"Q 49)dF$be`znm` !CTRL>z5gY 5;z \F\A& zL`p_=o }M7ƞ(ZQ};s/9Y*'6B ), ==g:yFt]r5>?1SК 7MB_'cQ?Gя@)p'=<8HE=㤷[Vjsa>˶"7X*V?Fo 4KMmt:r%pp bK{X}x$t>oF׉F10^,)Ե/ww(S-e͘rL-Aq~#<i |0k)'5</&ڕ3k~i&h]4ᨥȌ|Bv`Vx-~zhrRoZ~! 7HrNKR+t X~wM <ƹaC(۴ir^d-\H+FR\zD(07KRU/?#dQ)\䕷6h=Og>;y}h #_8)QrbBE©nmPp,}X( BO/23]6̝^/ :M#I6pN3\9qSdvc!Ԋyny˰CLQPyO؇ͦ)SmG0 )OUwi?,7(:Й mC!.e!5x:`ʃU8it},p?ԝ!J>3"Op[Qx>BP9< KSr 죳6?/~#pÓ w3'af0U Xpo9#K0 !auuflD*>u9xp)ۃ!a=_"$GOa@ pOɢj,J>Q_]$΢?b~}5k}}'i7%>iHa߿O"{@~*?}yf6͌+,e={}$\| #4B35HjiI/-xD .$},}UEzJЃuxQ4>!T }EgV5(/뮯?U\?g,> stream x]O10  J( ]ZUm?eB:gׁ\^0ud".~aԳ 7ޟfϦU71*uU%;k%C2l[Y *!Tr48o^cDJii 83 8SGendstream endobj 517 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 279 >> stream xcd`ab`dd M34 JM/I,f!Cܬ<<,{7 }_1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C50\``````(a`bdd?3qG߷0~բxy؜u̙[r| 87mBU\XBy8L;ódKމ}}}&20fTendstream endobj 518 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10  uA,tahU@p' aKtp'w'e?\v #z|QDZ`ɱj01Y!O dgϦiʪC -A#EVO:=+Pj?%Λkĩ4-Mr{&SA|2S8endstream endobj 519 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 332 >> stream xcd`ab`dd74 JM/I, f!CL<<,{o$={ #cxz~s~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡻ /,/I-KI+)6d```Tg`b`bdd ˾*p?nv.WVUUY!> stream xVKoFW*kַvZ rsP$eaJ$ȿ,M\琢H7|;h =@v5Q:͂ :Bͧ~vj9#{VCg(Y!D.V8-IFhFld{N7h;R9+ҫ1:5}M^gӆl8$ulZ76%]lu/Zo%Fm>]Nz׻ov[mإ@OovItPPv^.7u]W7?ݮ?ôCU]םlujti:l^X:8h\GH]"]PzAkG_B_מXUJ9?oz<.ǽxvr~ և^lOMb cq}ٴOFu_6^Q{bw9BcC毦!93!53N$rUs c_\iN٣ m8"ɴ !$ ̪$Ռn!">TTC@;Ot"St`F rSQ]d'15ǖc#abLPc`ӗxk16&m)qaP T0wqsK[]\ނ> stream xY[s~o&NdΌ{nҕ<(DjI\wt:~0IЇYYp/>\Pufm_qV/V[xm|uCї[)'/MߴvgIVjS:EV/۩0Oױlc iaWvK-:gǪjO`}UeXA} .羱{ޗE^~Tn_85}t2b韧U~ZOcӁUcF4cr,F KmvbcKY bl[N~IPxjM_=z>TJ][ڛ {f&I1"( S%w8ʻE$==oU e;qWoo8CUW݃cFŶ8h59nzl6V ]οeL+sq|ezAI :g9 AES8!v᧓gCah&F4ǧ {[śfe$F㥈/&XSw;\ Pݞiӫ>j@b؟cu%}UfڣvK^T-ca) 1!Tnkxp]}q -\ڙnE'(7E{ d،.8γ+HSw֐9jߴ/^V_,\ 妻Cޒ+}w柯^-\J?˃__-y/]6ݷ܄`9īTNv \:C[, zgЕ#ZY ㄑsMLm_s%8GĒKϫ`aD-͋^90#uwZ!o[+GDa`gR .:͏kW8?e˛7̀eTZ! ٞ2SRj?>3TZ3o܍1 BEe)9m搇y"P[krƓA=9Q oP H$߫yy r!ꯓiEe&D̴ϜFRڊJb)hM!Ԁz!#b݄s/+RS}t#Hܘyl~81k?\uƢSN/Hxvktɱ.}[9DGCg(Fț!ܴsxMAeDP8G*sΤI[TQvKpYQ>WaZC2T[G0gsy.a BA 'D RN\t/dv(9X|ۙ4ֵA^L³faV5'A׶(쑰tt!3|3Qd6|JLmV([`Ug 2vf*KTMW>*].R*mYCT'H y[7,d?=KB-c<4Z-b*p Ni8QfNpRgpJ̣"RIF51Ϝ=(rlTpC9HWy(I^'͡kာkfXkί:Hp}ǡ!'A4:0B8C.% H9Ĩm NJoi/;<7n$2\~Q.TOFGp̆"`cM@&Ԅk3jL@l>8lv0̎@Vk8~ss[7c5)]FcѪgh?OpY*}v:tږR!qͲR{3>yFoC%3U !ȔZ3jźD s҈,.Kz 4AWM7&\ IsEmIѫC8j$jf@UHw͓r`*' /cG#Nl v'Kyigiu6Nam|1ɲ SMԏYaae6|Qj_j|W,5pC@~;PPjBp8JewgBzkFL߬/K{endstream endobj 522 0 obj << /Filter /FlateDecode /Length 32611 >> stream xKnq$" تFBЂ-ֈldԢft *?q^povO_7|y k}㗯wJgY﫮+ݗ_]W}oW^?UR_uܣk/KO/___׻FIﭿ\Skoi_x~Gw}w>oũ֯2Kѐ S0`_}ݿvQ9U E^[OIi>n ׋Y[2~e 彗e{>g6GjVvU-YY΅GU FTBXefHz ~jjv.="sRƳK}OV+8/GȰ]^֫w' ֿekHd=D52>EP{X Ϯٚq=|벏= uPWK7^ڬ [z3o3Mk޷w|oʪ&kVE6B(3.> 5+hr*lvjU۩=|2'7/[iÌ5{zvUGY ߇bBN7n|Y[TxYqW^C2wTZݷ^YpnPGeMէ.^UWjn92'zik9YĀᰀ~ӫ8]:`OfjY$1d{SoRTݵeKWy@kKWZMZo oFn3`W#zjB q*wƸ[peClIۨ&Z_rHlvY}PmFY(T PF#ֺOQeBvu!?oet+ $ՍaFJxК#v*˔hluY$1; 𑫿% D` CȰ/JMջ:щ Xɘ+! nt/u\,S:dXY٫z/ħխJ2aҚZl ]. [zDsI܍9 A+4aɾfTu)qS)I0Ra[ F /_ZfC-c[^ɝ0̴zZKZM#FݺMMOkI,q>NVu]d^ PݷD%rWJՓn^2@5ȴү.{9Of d:=FΎ= yzQi9%nڔu\pR@cE+.dL_CsK0b͗mD8z[2]+>;M7{=sXþ*{_ eC繍n^؍ꂷSR3h'aV%FWs7j}&Dwp-qfu;oXwSf񃋞'Nɋ0}ԝq`,yJ/O:딤ȹ E;ah7;b[lE0qMˀ\>z33_p#9Lw2Qis],G]~ \/80?N=єC]F1(C9YW7,ԚG0A&|evi[NyUϑk*܅ŒC%3fsf')㪉I= x^NIv7p-Ī›RSPa {e1;s[9Sep7lSģ /*nV0ZUO0SX˞7B泇;4z&Q&'lש.h/g[(i5LFMI3d;8eb;=l~I:0inȫ!}x :5$WוeΓޯu!n0Z•>eq>^~dXnij&lʊEr&~wƊu,HdW KF`\6_*cCQ'_6!n px 'ZK`2nabϓ˖LԲ..m^خT=?V_F*]pkJ7G!~y"ұ]h׾u+Vu[b7ɥ4){7D,7UVټjbMü^肶}?Z7$.#tUbXw)&cۦwaӫT__Zd!)7TYX(܍NLPڅo/K1KZ2 qSPi UVȰw7fX]Lj58,AKk0U+*VR4^rzJ9 Z--WY͚}}5%lk< ,m;7X<9]n,;,QsLH&&/bOfБs̸a͎$LU^SFF|.L`6qR7ݙwG75M5 ,{ QV-z^Qtx + pKa `jR6 g/!ye.W/4lGuLCNR=`![aNaQ W^U7Y2d[M2y7.^7i>*^%N|i«R³/>ۧ3료0QHsdxu5ڈ2É᣺h~/Do<~e>;ZUMɮZ- e{9L8͚Q}Z_>o]RoA[5ax͐*Yvkq2wŲ ׻$icƻ#};#XVYM*̏)D)(͙컽Krb\(%(Q*]*߸KHO;# =٦hjs.+_#>׹~Yi3l^J:[.l yQ*6w)g{^BGek-kTFM-S*h5|]][sзV뿵G36Ǘn経v 4{0~?6i,.}O?/?. 2.Bö2٬WaW"ۻ.қk~ovcx3l,0ހPn6:`a2Fe-o<o1exZm[Kxo !YHQ>& g/7x.0ˤw,cPbIʛHyr d\DyƠ-d.Hy%LC~~5dނ]$Ђ|7 @w3% zd9 nYPX*|pn<` Yv2dv; b mew)w 6-V!YUw wӶnLVVw38BFS؋›!,?%} >6j7ѱ!ߔFAƛoH ƛBAym [|@ͩ ʛ!,CہHy3|1R"Z9o۳Ay6n ;-F(o@LY`@Т1o-6'#m\mm%ݰ4eHz 0` z*Md9R^n`b\6 ! l'mUL#7ˀ6.Dwۜ3ݎ@o #E7CX&Mb$9" o}۱/!m6G[W&8o}rf iqi1Ho}rf-$G쉤cG#Ho&dtvGP<37C'?2oB/"nDZmͨ9dֵ5D!߭qw냛w@&"I[ o*   "H2yū ԁR֌F (od:ɀZA)o!mF"FHy;RWm#(o'2 Iy{3=R)oGcv =YD!@Hy;݄]-68o$W`ǘ큀v9o{0򓤷RdhoB@rX*!1m@{{A^,xoRՓ@{{ qɖ@'ʍ ~H)7H a p#9oBΛ!RN |wn1݁Hw;2Gn[ ib Hv@ E }"Pdfp4x0OB̓NěNspO#m"zۉLy3`cv m෽ =—p)b dh6B[<3 @?*2djx"Hn-iv "O[Ar; ڛEndS Q5ۻdG aiH'%!27 7$1[ n̘!> P77TnBGqu;#s'ujdXZ 4[\E3- FP5lv_FD̦!hp\-3~md. f"-3C| u,3x&9˯F+Ձslh"3x\]T#;Ȃ]w;s3 hipf0)Lo.!>"ujvYD; V Qdհc ]wC&~ol7oO ňx!ÓݴeQJª$_d!sp^pfwamljC{)KB_D;-knA ug;֬P3YTv>үj ae3XL%^D6 LAs׸l Udq?|Vtj=O'@/i:v#2u#:%Oسid5[/so9~黌cNXh}{YӰe,lޘe8zr:')8d=tXbYb虉x5 #5Ύ98^,@,ٔo5Y87;iJ}R:^Lvϖa 6\Y¾!~h92 o~ pvIghn^EƉ2qe?##LSe#~ >I;λt9h  !?oLَAbf)v6d4{4腚@͞# l?w)8<%BT}!A?ՇgKf?olf=$'Kbv_@ek)F/.c0o/侢%&&︪.B26y%-܍% g*ϙp=ٛҒj'TMȢ[X[Ɵ8đc.Wi|M}nq&QGeZF $U!7zޑw.kIa/~m!# XY|A!vccdpme2:DYz$LexFO!hd_{GV7+]rFBB8-~ }Cl q6"XS890hjڅ6@ɖ,6 y6p 5yxx+?,ěGqVސD_Gfh[4/93 J M~qE7ⱇl }]Iu՝즅=C$&'"Utc9ɖoȓMAK{%Yf 3 )ӈ{ /$i8* e3ў0>뗩fK*} j0q[mgqD Sܣl:8g_fOt.0 0v9N-0 ڐxʓZȓ#ڸ4w[A9m6L&)M ⹲XԪ9L2%f7rqH2g!NӞ^L/EӺ ,h#|,Iví`;dw:N;kBv3?ei$ٌ=ȪgϑqRw}~3sw` xo4 E٭ *ޫKc3Z G3HyZ 4xO~MAR%~3I#֏~2F^O}m cm{aT|puHvANN~:C#爢⍏BQ|6hz *;hzsM{0>_M63&Nӎ|&ngp G[4`|ehJFr^la%Mޫi΁VnTa).b>on-d02*`XGA/ß#mwd 0Dڸ8hV#9b'lB+ImBo^+evdGc.'DJ:Avjo{Sm%8V"f;5!e*-ہPCFftL_ʽ&G&Gp}ww!oA|Tۮ ^X$+WN#@Wà,d@dVdv<`?J;&vvsBD"w'/ daDonö2yU%rs qW?!Q^T loVEL}?ɁOr Or'9I$~?ɁOr'9I$~?Ɂ/OrOr'9I$~?ɁOr'9I|ߐ/;nf\Z:7@qvDP-JA*J21/ZFYt+URE@2L2D!L,5/4G)!VnּJ7:%ۘ{fڥ)bHYJjw@n+!MVʖ(B)!β R6?:9Vf" ?ʴ륡7ᶿ.u *c g;oZJef9  oBx !f%^Vȸ.b\"T RBeoj(x-G_*z1uiRt,)L%;оﭨm(B@׌ >B&I!E 4":EB6ʨ'M!^/H!^v(Ѓz:xкP7 Z pS|L: (WJ^{ ^}x]8$^ku S7]IFޤ]̐N R2nXo,+exm <N(R=lUx; )`&n>*&IoPx"ГkЍO5"a7@uk8t5Q"*8~2WO^pA$k=C"o$hMjCםg˛ vk{<4xMkz&^U([yP׼4#S \}i.u}~5xiZӨR׫4xUϐo+ ^I, Mf I J%-_91ς 5` dbD'Dx}dIBJf34x4*h9FHԗu!yМ^ p&mJf R׼{JxRw;=2) k\(x,`'%^w3tMH7ma(("K-^IkZ+=C)ǛJf+X:)YH%\nIצ z$Y^ M1%!!ăFU53p(8Rp1Uy:чkc"ЖIR! U^_B* @OH2!RMMTySҤ$U^wL̑FN䝡k[}k }w\$jIU^>TMP5ɜ%*PT:g%;DySdB(o_"Dy_*ĝ)v*Ze"ϓ"o)y zQpiYz;N(=^snkƋ ǛX 9^YfJ)d%9ބIcS9xm~(x=8.čTqXr>6'uL54ȣ5t))5^VP1_}iqkGMZf(?^H7$SF5^_*r")^H7؍^I׬MxSz4xR⵰{ x#HIO%^x_ 2xxmPxSx5OBVk' ۠뻛M6{ux=2pw弐:7؁Htx}g/C^shûCk Ytxe&I kap6uxm@|`FG]po¡GTx}qW %kOW!Mٜ6)ƛ`)?mҠSO)kV@x6S(ƛqczPx#-=^bP3zW x D*=^wV fJGzw) };C7KH&YM^ h ,M:B|65gk"R嵮|A;تTh^O9,?L=(˛Ĉ Y^g0pU$"3uqy^ہü*y^}IwM"<DG~q~P;{z`x<'sRBpaWRBݥb!4RBR/_t|Q/%j8v4v5ʖկJ_{HlAM*|R7݉Fvv"=&ѕe;; kȽmlqD\$lXq$l큌 DrX*Hf;Nd\^-lB2ہv"qUK%l!R'@;GO!m#9m"N[|8m9cnD'Ri6bxഝȈ 3?9m!퉌U9m1v =rQ 9mc2bjd)2j;$VȼHRm'"bFtĶ{|26Bfۉ۫ d>ߐ̶!mWmRëzamBfہ v̰UObm̶V Ia2vRNdSۄUBzLBHm{ 9m;Jx#)f̍9ڋvVv }*"#K!3In{ @R̗Br̗BJ+!/Ԙ,v omBfxVydNI1W%rc!@6VAf_ўxUbm@+ڕmT a@*'2K#N2T&vzaŁ`Hrx#d"mBvہ(aDo;wUgƌID !í0(nOD3rĔYxJcSF4e'@FLBf⸝, ߉JDp;B蒥r-@ 6c۞fw!3fJrή}nT"䶝H~m;* ?)s9HF"K!m#bF{m֓8m(lYLaq|tZ`Hj+A^m#"ImEAj;$)4L!ǒ!H%ןJ!|H8ɜMYm% IVt:Vہ(⌑@ɢ@j+Y<@p>?x}PXm/%D*`YmE%v Y6hmd*Dk;BVܩڔ?l6xѠڈRSk;vJv Jg_v *Gb̫gpEl;mۀmN&nF@n[x"=2'P 'rہVwv }0QMp,I./ -JLVn=:2#q".AbO""t'2x ΢826.2X<-qB+lkI+*D0M@0^}S$tb W&XC lTRJ*@p>C&h i ^Eb]B MX׀ XO/P!P ED- /NՖKLtb iPO[BwdTP!bP읲(k" 4 !tb \ub[ځ@'F҉ua >.gC.o5 XIfktH(8k4X@҉z ub /rg٤knJEkJ}}{gCK)ָoR익Rc)n^Fb ƢRK*qT*m!6{bGMKJ;*I* s|9<!ChLJPm9d rRZN}$f  $ ƺY`A0п`FC,fhuZL= n TDX7nt6cװ=!o8R+Ru;NꊱW̐cF[l/cQ(wn+풫4g~6ynxbD#چdJ 0p4ޓQzIzЋE~D2/&Yt.fY.fY/ɽA/vg-^{T-*`;+h ƺ?{JID)InRϙeݣbm2Mg}c#CR(򥊱<{N%cL J*ƚK O*ƚ#YTTs!C26rdl 8Tq&$cE6$c=m$T($c>$c}qT)x.$cS궔x%cS'$c#NHFNu;|&%c=v 3чbl V ^Vu9@|6ccmLQc(9$>$$c."d={H `]xbt&zR1NqpR1BqbʏD-ak>~,W)N[1 ҼQ1BAbNpK\4$c- HvS$c#$c-4IX+Zx4c퉳 POϥfM!_ C~2_MXhVc#^XI0.Cz]ҮN*Ż(eP.z%?+P*7Xr֗9ĺb^v2 *zH3:>$ X?d4wR3Βf%\){-j~f Ԍ5#CJXCZ H#DiFvЌuhip$c?)kEwNd!=o4P2 .FKst3%c YdnZJNFKU5]6%Pؓ>I2PlPH X0)k-)FKӐ%%cc'($c=A cҺ@'/HXC(IXu`IԌS)k9EO)kHB<@͵ 8""9]Őd!d|8( k&)kN)뛓x?jI.Dc (Dc .Eccc4DcD޾5c /5ccO64c}e{KJԌҌuI5XYgR3@+h"Ɔuh76Ԍ@&7P266%{!PbrA!XGP A7!b `l B06{""cO`nb|E{"P=&:mBX Vz".v@}W*%xn tQR*#G9K_RBR/oq/L4q.D@F(e#QИ@q#كe}HJA;TcPg) R8Ki(eVr>HYpjd|<ȳTӤg) Rj"9V+ճ-4^LKj?*Y騬wZC_ TY럑ʼ5?S)T7y˾L\f'rKξ]<ۉkŭ}>y|oy|y|y||>y|'Dӝ7> (#l@2<+: ɐEBuX2[jdͭT QJHb\J L #+5'd,0A֍W$?-DhBBR1,Tt(%,ͽߝȣ{/etdM[LG6u\d#}Mt(nc 6b~_? Djr1 9 WୖYWZdpA F RjD簀&W}ՒvSղvD$][-.rjyX4`CZ` wo0w[VOH|ʔͅJqj)[-2.[-}>![-:%![ D>B~Z+asR~CWv]:IF߭>&): ^酙!4F^U[P߭E\|׻').Qz$RR#2wO̐Zn$# jI9ʠ[-<5wonunIҠT߭ud)B~w}褂w}/ ޅ"?*+VKQ jҩ j) ^DxUq$ bK@ZRoBw}z(ouumzx6Dx{gK@ZuʉCw`0T ~ovZeXVKqj%*jɸi [K)["\pwT"n) ZN^ ,^l|2TJ¾薉¦"m(»j1}f)B6?BZBq1Bw]t ^_hzP95x}4H_`}#4x-'olOzR#n) ^64 jҎRק `]2CZpYꮐu^PCq[s!Z%jRjhba#x()j)&jo54֐ B{> Jn ]@gOI!޳Cw GAn^`]ËO`B+5%qZ*>B]r4P2#F'dx2>@׻6o1SL yPIVӈ`@S7ez\FjM;S)G U/Y6SFjj0 /Dxap,.b@qqF">eK)?Ք$L:HG իu4RϡKT2aup(,Gޒzg90J,q_,[^v|//3V^@4.E"x 5 L4US1]B$UrdU wIwAg]N]i 4jnu}# w}$Wuǁ ]d뎖t8(J}ϡwbn- wI`P}W#㲿cw}"i3BS|׻vP|-Vg9=i,1w}eA!J? We.~I;b5;IS]y1wGtJjVLF]W/-\e~9pdޭ.T0Hڻ~o;t'"]K dbón5- n`)[Mb =w,JWY&ÍiGһ|H]_Ρ5J#QT,~w/aƊ fp]q »2g+Ax'U w8v̏ ̏{T\tw}@Ipvlդ2$P=X0LAk5UwC@uׇͫ:m*]S %B`r9_U ]nUC.]/CC ݳBt* nJ <jzDgIW"PX;Bs=i4w NAs׋J>Z8z[M jյE[U[]?Br#:Jx7">2@r׻[GO v5^ IHz`uӔ@r TݷFU~(9𠸋Yw$f{._4Cp]ΑѮyK룊T!뽖-]2%zd+o꼤:(M]!K1xdZz +=gz>?sM%-M]&4G mܮK(rn~_k7RbPlw=Pkן&ʥ֮{3|6v}M*Ԯ;ud0Rw?Bjk.I v,|aL?Bj$v]E9u@l*?ee!E7Rn:`+(zTܮWjlzERWVRr z`DXjH.K@o^Y=E%w=φOyP:U!{l QwחOl^HŒȐuK@5THm]ȍmR| 4T)),`=xM&Vh!u)`4w!w!]ؼɄCڻ~_w&OI{כcڻX )C]?c@z_c?һJ!~ W04~RzP pcһ p`?-tO/A;l(J8={]OGG2zÁ6u+EqvHHDnXMrJX $w=ru x|㗷f_ӓ2вe 7e&~M#L]_uQv&Y븱\"Eew}1|󪆽YzgyUww*DgK\SrTݭ-ꮇ&dDͶ3q>2}U=HF]&+耶wBugv 1C.¼GfA^ N઻\/^a]H]O%RwUHjG'lX-~ O)~w{oq ,ŸQJQJ]*<]*߸K%FEj{_#>yľ)34 `R7߉EA"P(~02I"E&M,b潃X<# `1}R HEA6 Rrg"ƕHEJT2DVQ"2*I)݃U66=XEIσUzXEo6(UUlhSD+R>H/ZQh6D+JU d~$کM(5xE@ZI $)%E(*2 GV#MlT7"H_#MTyE"yE)(Y!*BtuQ+JWs7(i$EqRkD,J=A$.)bQ.f ?1Ei#fQ"H[,,Jh̢-Y̢$}04EbUE(l^VDX"Cȑ$(bT$=HU/(4U/iESshE)%JVd 9LI@ eeL^Ql\(_"( :yE'7!ФxEpv ^Ql+2{$UeĢ\A,bR(XbU f^,CfQȈ#@,RޯYDf2L(#{!{Ӧ9&hEUyʂVv(";۴,hE iEYj%A+:ا ZQ&aЊ?('VnA+2,w:hEiE9ѦVTCFLsWdʐXd ۇĢ,7XĢ7#ؤ fQa3EʅEY;Y9,Y/1eo3^1fYσY},YR̢3_A,2 hDntJWGb!d5Z)9+:~pӊS$? T'T{Y@@*LEbF#%_Z(9X!(Ό(H7(kL"%H+$Z!dVtJ~o(KI#xEY|y !0xErWt $N"A,"U% b# EqT#XEDA,:iR  bQ,T;xFACE*9EX}"eڔɦqqCC(:220A(R( ehD(2&9E'BNQHi6(a)ZlNFRdx`"eZ()rh(N'2EUVJIq*>6HE@RQ K"G@(w e RсT;A*2eH*Z@H*Z(z.RQBmP RсT[VnA*"(|D"f۬8s*V#,38Enwп,%@u|K)CxV{ C9'bk*/>3E6,d'nnKG]e|5̔uJpJ"Qu$ ڥEPG O3*t"HcCr yT6#Tu6U@D<#TuC*Llr(|WȀ:Px+d@}'RئT@"T@RP2Pe@ٯJiDPG0( %  -.z)e@8")Λ-BoR-bwfJAԑB; Q=0 :dJPG~Txl'Ϊ$賎i!%#TNf6GF Srʀ:8e@agd@), NPGlj|PuE#sX8Pn#He'#spj` 6T #PuzPuR? Y:ŽPG(PGxcL23n,u@j^ڞ##RrcOxJ} pGנu-Z->~ PG(jL+T|MVbIs |8Z-Ee_:PV"eqBՂ]l V v%!ah`%=!Z-E:~B$ :VBB[ jR(V mh@(p %PGXP$ Z-ŮyD"u n{ nf d#@^"H%Pϝ?maQ[z.O)ZbL)P@e r=$ f7+ٓZDC ZPHQ-xRR ԏɣꇔ%E(zh)U @ HR!9Nm.hVОNs PB)НQRH5ޤ@k#@q0%gVg׀ @=K$ ӐRJ#bwƓHG<(?%P?WHEh`&@=E)Py \ %н*%нW$%f)8@}7$W"R8Do%P?@A 13jA ԏQG3ݪ3S4Rh0cN(V6d&UwITBt!SxlIVKIpL6U_ 5=s`TwG.J9{?w/N)ڮT]-[uJBt!b]3Iԓm 7hmEzj2Ht۝%Ѕ-Eee=o%D@0.Fթ.}64@r]tL! PϦJ)Vhz~zR8KQ3/J'#Kqgf}Ƶ4@)gi!zBt!b Ѕ$CBt!9;`hY](2 [Ȁ.B IBt!C 2Hܓ%b2 PBt!d@]AlSF4?PuU@ hm%K*!o#4k]HUׇ#Poib@Iu"JW#PBFl9!)QIYw=E@=mT@m #J!yU~*x4!T@O Er}HU ẋ椚d@P 2$ l+WHsҲtm(ChF"U㗪mPu; =ܮ LTuPuG?ل} hmc:%!](MPX(n(lKTr㠒op7_$noK6EFQ{7i$>2 wyY4Quu%u $D.wmI4:=c!Y5S͐^JB5(8Ev9b$}ٙ gֲgw]I/x#kfwK⤙6  f^5|\Ll$JhO MsO4'UKF"ofTMPiIDYFN Z VcR? "jTmCI׭HuZ *?Á Ҕih"!RjTf!o gΉ%KO(|3'%XJON!d }R@g&'e/#$1i" llKOJH[Dn2 _'v\!m6'Ah3K2 G5? ]'yˇ®&7$4qQJU \gHiϐΓ柔񓖑 h.#a3gHIjϐdw'ϘD:JL&?}U;Ԭv [^ph!,L'4 VS2R6C'sW֟!B)d%/?C^ ymI;n'=g(]Am$g(C K4Z\÷@Zs5m*ɦ;shk i g4,b=iD!"TG!TDXƳw0Nߡo u4x\^%YKƿ =˞p/#C^sXS<B X 1Xʨc,X,I@˵$ U7c,,Z,X,^+gD5( 0ia^)/ঢ<9(۾|ZA|ͧ922“Z? $r0A@uZQ3ZXZ]i}֪5>1~z9z\ Ȗjp\jp\jp!-eM$n>!p Q$5K֘^ďBqX`h9 e7?<&>~WoVLoD[l1uJn/2͓[*ٮO[xD ]y4\q*/XpmUt3okxzY (9 dk~Y@<1Y߁a\5~V+uuIsdL 8dH J_fq0,\"lAǁTjpw-La2{X3MQz>hB/0KnFyۣNQժzrb5`T^?$ ?$sOI^5H*56p[GFIU #oߝ$b~31-}/`mfR݇ك܂k'FleMs {umak#pL6s'.kMgxM,nVhZ;9Ao]wcCm~tD]X͊v˃A2쮈bGPjP~EBA@SWQ;g6Ǔ*A--fo'3 #b] ~\ 4"lycPxݘmorZ͈y1ֱ3Cn#uyUA< *;qVy)TI>NdDui^gӪMOQ yfGL<~鳾пJJOVn=)O#ۍ,8BMM{v5JBUM;]RpmXÅt5#~:n\3',%xhs^o;̹4m62e6G\XƪH&ZBRi% 4ǛJ+y =.y!H~a|mv]amqQ;Án׹L\n8{JICh6ݯ^Aɿ̰FE1KxOv|zo jj& QP6cG" g V]/V`u&@0?-Pr%Jzsߠ'l7O-ʷWn9Kv/e̳)ҫ8w5oAI@@QDɼ_ȚO Y%i5Zu77c rH6/4DSijS3 8R+ #3VQ8haݖL)f! ZP>=> stream xM.77 z ~O(ѓJ%ArƑ:3mZkq%w8(%F$7r.?z)ߥ׉OSO%N)JzkyW/o%=ƫO5?i|WoW~k+o&uKګU)jLh+1_Bz{)ҀruLmWZ]9iGוbjP_vWnP+AWT˩M\Gٳ,3^.;ڕU.ʺjb.EIq39Fg(k\kY5O~$>-4벛㕪KUX=uZx۝2_w6e ^=Rvyܸ^ͪ@/%LmIz$S50T׍8eAAɨ' VI˫^Y Qʪ™J U[JGZ2S^c/Re5O1xgFyo2e$/ OƔA6 +YzEW%X*fpP*jD'^U1#WۚKRQ?;u3Ju ]H y+ J8s(UjsufmRn6U2{֌/׊$0M)Y-(]Aw> cip}ku>RZuP ٺV.y]{j$0eDHց3Fr57xe}Rg1~u%ZX}7 1i&{Cj ]ʊbpU9΃:bԎ nzZi7JRfAx=8RQexZ?>x`)]ɨ!Qʞ~}U>хhVrUi}6U7 þvW|hOϟh%W_x|+0ޚ܌{^w)ޗZnM~ڢ0X#zQzxZ j Y/tz;I^S&3 z&x>%t$c2:>\{(LIӃ,p'KjLq 2J\ˋ+H+~Ex\j2Jo_T:o"FDl~z-\zM> avPJ:( ^KYZ ݰ?dฮ;$#o/c< .KcbTɕMb`5K woWeO 6fvXЯ19;ycq{ R&Fx΃G=7dYR\$6 tMxΎyrF0FM)ш2HMfmN(33Z5*brޥ 0յj3o{WZ irCSMZ$?BXgPu{Tи\7,')>!*BZ3xaj7e=7COܽɛ`^;f J 8۞鲬3V.I:er"j;C$&-JʈRӻˮԑ(M0$50<(V}3`A6<2mz%MU9Sfco>kV40B7Z P+\} o$J(nz&&̈́҈4QW^VGu‡^kܪ{.-mG.RH,weWr K*@ȈRxz5ΊwG|TH2hLmHQ%OSmgO;o2e^#]iM{( FUMA[Z}F>za 3tch|wbku {:|&p;Aոa]j6W:RXdøtLc!pl#55edt;3/n Jm׉ 5e} -)Mj>Њ>h` +."NVZ7O$wo=PS o:&-g'L!1du*gvq?g>v{(laX{cG8q MQ<ҭl~62+Yc5>ˆ%Lا醘4[#lKFyrW˜,So([T_7>Y0MQfAC"2,Aw4zRͬ. zRMfbբӦx~rke,Z 013G]Z1Az̃+3tv4<(/4ߦpZ+80*'nU7o$cpOl<δ&m]KϒWدLPlB_܅B9 1+{ i( ߅BمjZ@>jlP^u9մW_#>>À&gPҬ?RҼ{e*(em̊ G)*Rf_Oz_E O;4âZP;?)j\Onk˻դ|m}?}ob2Ƞdo_YGg߾_Ͽ\{eY |dd e; QC!#̍m(ۭXS˖e{(`,[Cv(d0~lȲdx =ƒ`6Sf;lH!eQ6k e;lU$ڻ8NSP',v+ c;pl@ٲL $HJ|E %v*;?QlO%PDm)"J|IV1~PlBP" A6S@C!f3rbN%3J]'d;lBd;6eiTo孀d٭Mm%}1$[E QC!ylOeΧB,ۡe;~%RvE-$[n*bF |lLN0ۡQ afsS DS|`S6Xf;laRFP a lOe֧B-M0۩#?&Pa4sf;l@- v(N$=hC!P/<ٶTȳmH7[RlOeQl+ۡ"|D )轉b;RlŶ 1M c;p>hI` c;blnMaQlrd: -a~ a;Eo>D 3?fĮ$&"!`fk#Z6Vke(B&0bt &Iڡܬt Ek{D)tT84е ];:k tM@R< ѵ=rGBND@bZ텮صSilE]i`6/׶ x-R^/vcvB$بl"ᵝ x-r7E~'<h{Wo4D)@X 0XѾ䧂+:*)7 sLɡot瘀667g0mn *'6J1bhJU~t/P10a }1weAظMD4-C45&[c;MhJy؂ca/IXQ6crΘ\#}#:|X$8?+vL.G`LL\WL.yqRЮ\z1p%c%IiL,!k6Ļ4h@iECgH]&3馠:j6-;G/5{,إf(NaS&sCP]vu^fd5nxQshA|֐`P|X~M q 6YMiua~Ll?nۚ
 O%I;6:0epkYdfm;;UVu|MqWC?1 l' Iq3vK,%qԄ:N+ҠWD !qǂp|W.⍏C㍯7 dF C\/#& Ѽ1XJ Kk)0˙n)·;.Y .n;s \y"%*.ftiۍ}˪Ii_H}1][LL+ܖ}2 _wm4u /8|hw˾}d&)lykLEk&^ѲeƖɂ0Ӱ1̑R@7:QvvK8ka;< *@[)z94l-8sRG.%W)pb)f~b;݌|_mM֡/q0oJljS୵K\uZ>zLoUX±>q2Sӱ,RAy 00V'/qM`o^~X'+(k6$m7nc[$OTV8^ $*l.]]l|P<9z=t@,V;>6'^vf|)7?ݹ獵KmlR&#~˾o$D6N pqy2j>RxR>+3,ytb&)1Kki)>fE7o)w{4H}hR ha9q .Ic,˶`elN?:n= dniST;iϳi[%4t.kW՛ lՑ0D7ir녪6'RegY\ܻP!m&tk)L4-\KW/E;3q+@W<#+[tiONd-`tVIhkв5̅w$"2E_JUȕzI)Z^,eOXH!Hs);eߧ2Jso)āpkWk Zt+5PbRu)o0hn.UH7ң# =j-|14۷Cܪ쪫RVјxH1|w f3 Pl5Z8*w$_G%՛(%˶6Ǧ}0зS cAdG3=o=b[|Iz65CO09jkq  R|n5m]- hDK=t}֮̎WmYf2SEϸ2;Z3ٖzz+ӣ6è\@ևd PX+*Ze[0 -H}ʼnrW@km5Kb֌2{jLf 7+KՋ֧4$HsaVz,gec45?ClLfu)}hF+A:CTBA -~]u&HWaL.ےQnZ[d[2z37\%o ݗ~{0AzG34xR-Tɶ`ytiƃ9TF CSL&nomr%g[/®w,iVb3GfҳWn$iJ|Wnd4%6)9t'sKA-VSlUҸzҰbZ)z9ҋd4ŕ(po{V) R*qDƤwZʶs -!,U5%/*[BR_c-!E NkV~D_ExēȊ^$- 4"g 4xVRiD|㶄?K–b /uL֔sva4M)< ֕Qt*s]0߇#C#}dHmfvJOQ ܃3\mhP,Q?3-dGOq SR536r6:Wne>דС0wOVY.BfGc">jTzW&Iަ I T*τB-&" ?GRȶd oL2_&-%-*-%M`/\ GF5TG<Hqe4Ju"Oz*TF;lLT_V0SAT) SKc&0i+COJmeoY]FBc(kBume*M;GdO}ɯ6'P˟/++E5}뇭V|?-m}f`?f ~0>f`?f`?f`d>}7Jzrtv ~ lT9Vjz(Dbe1,C9f*Rx1+<Wmx2RX(%&cڅ;!ZMgP.ٝVdY!bXi! !׺˄ ؅BمTvPv!㺥ro͓YF5urlj}Nf|2}0XM ?S TZK*=J1wlYg)(Rt/Ry=RD)wZVkD/ߠzQcS[r6K^1c<eo%[_ÉHX_<wA&ݍOCJtyv ͓NB_,ʐ[p ^g\{spny >j(Ox=u9,} ^^8 'iиVǭkDd \M6T^G 5p5x5d k`?x]vr5Y} \{gu1̹x:G:/ℭpF< 8Da wŮ޴^t{ D o(Gmv=b7NX/;p톽 z7{EokE^7^2\J1ʺ+ᆴ^YY_'vI`=C]9,:_ OU?8NC-jtTJ!x= jnRvtA[Z8{5QqCz[JCrEw$t3;Cz] hY u<>0C:ʧ֝nQXxAj!! :F%Ȋ " ҫ4^oePD8㋀?C.^?5P 'd`pͯVYW]nĩh \mʀ`wgτyB=tVNأaIݭ0A_u`kB_MRc(8^N_u2>!}]C텭Yg ^uD(,3 [$Gh 졙 ->8l绅-$cMLLyd-74-?΃߸N3DV+oXi&ŰJ#\[{糀-_8luQ)f:TħUa R+>e3loe #Bh#scإ++7dip50^B ^7jAS{y+R'4'p4^,=..csK`!atK Gu1Q:?:φ6H?Nݭa 아pm]/܁ћmx=w`2 aJq1CKEoY`aCڗ!x}e-*)eȥ Le-G?-x-,P#֌"xH|"أ<=wa\{X Eza>pY"u;uCplCKq.{ e#^m][ {xD{o-2Fm-j,E`{ӗa ps`o s`;ԯ/vsU;HU>u$AIF6 Fa VBa9 k` *yHG׍ue5O?T:W}ȥk o6n>vz۠\X Ya-M^_-D0iGBB`0"uPv)a] EiqUء=Rt=іx&sP"k쁏/զ!hyyx=Ku&Y {`o {`~5 {`\0 wcIw`oi w`BhGnᯉ:Z{Y-eXΰ*^37B+VX{=c7R;}%6H,G\!|A( Iac !3V4Cj}ka=2n|tg` H{oe*2AoCc>_=m)큽;WI. Bw`o,#(8܁כ 0g?*^ҊV:38#=3:qe8[3:J]_:3Q+pn ?8{2wuCe,;C],;\gQ!#:E_~4!01G 4N{P c@c`Ӏ}25!1z{Y-ii)k +A1WƧQyCpo`>7'P;y^= "LmEb>e|oСϞ{!^?i {D{j@~ xKrh k`8TQMg[Ogc+VZ` >l lm7[-?_*TV49o*mw[`mw%*-\M؃$c\I TxG{Ӄx6p8w Wj a8hdH<Ѝ/}{wӰκ>bU#e݃/= "F,:)V:{n {勁?𑲤?wq ؓA!;8| pR|z=tEO3Ea~éSy `@C1K= AwhqV1e 0J?7oeǨVK.}\ /j[!7O[i\m">cp]}=͊&c+Y94Z{ bGG"]5ǍI!}9ha _4Wti яƗk`x\֟NMa /Bg7{Nq ,dQJQJC]*]*wt.k(l''[᫯A{q:7" *yZ퇭XGB'کZoZ Xs$#F19t|]>JQՀ5 VϹDݘO-V ~TłsC?s ~TYl@w(V=-D KPНJb 08HV@C!Bw(?1v(Aj+BBC 2t5;at[!F_91S!Fk0] 9]EP7]|i]| 3 ۡ@ ,EqD AdD($En.t;I;1A)(H]D,Jg4."v`t A)D:;ǂ袩.Z` .Z%AtM[DgQJekD:;E*.߀袁.袡 # nw*k3AEw%(:P!E6.zFc)8:urt%F)u6Fn86]kSl[`tS41 .:Evctʤ^0btwF׈>xu+.zm:L ]%. dX$] ?! iaJ(1 NvBJ(eJg#1 麈7%F4 LJ%@B2PJ#Tt> n(B]i+n;pCPX:uej}t1K׳ޜXE芥lYpgyE*#XHw)`za,!Ji zQ4IKn$";$]dp!I6t.rG"<@< [EJ('('tWR"Bn'm4X.YKxb\#@.RҙB-1EtXMtf0:;m*D0ҙ"d:{6Bv4PȔlɃ&4tEFVs{pt;fBE78Xݦlѹ21JfqtmJ]dvptbst=;rt]qt 9ȩGgʐCt=t1O ]H:weH$&i89(>IL@t} wD`6(NS@҄BIYGnMBLɯ,(_EDuu E 3Qt,j@(:CQt1[XƷTaѹ2bP+,nO0 C]Ӣ-!Fg)ZP]m OGgSl^эE]LG뮂ѥ o9\qt{ .Wat,n)0bYƃIyMщE .滃7۳ uZ]̶oNb>8wpt1/ΔJdqFn͆J ҹB&z ̖8.:A fm!@9Iʓ 6bt9(8tJ  . t#2M4GtCnh0hh:m i;tCcA :!4akw͢蘫%?ȃN@)Ky6<7tEvƸҤTPcܖGƸ2M2eEZUkGW[((YdPkqLI,t5nt£ܶetuFpuEN^LT|W|;/9Kںܤv9" E|7':0KQ( wo<6)+|tu{puKQd+t+4ϙ+-N7t֕N@ʞkMm7')Sj, aj `j }aj%BW[Whd)|:p]J 'F)I_[V[^ںBA.E[ض~c[W*v Y c[W`l[mKJٶ-,Q/o9/Нm].mt]6E+ٝ]tucB:6Mx#m] (z|_*v)ZIk[G/z;rR4޶-k7mnv ZHoۥL֩~|]Jm}K4֑Kvef޶+Sip[' s[PJ_aVYV^ji^ZBsm [7Vȁ-v~Aņ޶(F?U;eɡLQ=mU{*)m]Eho;J1i\<]ao!W m}k[,V70akU)o[{Ө52F桿-R83 n n7 nn7 n}ﴫ/e&=[_$݆Y9Fi{[7ѹ" px9H o<"_'0 {KF8dNE|aZ?7PY6m}#0~װ]Jo.m}~Zۘ6mfH{ۥh-JXE{[_tx {[_D| V wrSlC{ݸ%VO_LoE8SUƧftZG0 dz􊄷mބm[7+vj}-66i`n[ Z_&U'an[VoYm]'sw\~L`X' C1on([+ã^i&[W,A[Ww [W`e[zZp[y֟ 5p[_[49eNjiB {:@\er7[W֧ [W=qEQ_OlIm]@[?hFpIG^0Ri֧.ǔ290I[WXOp  Ts8b28%KP8b" R1+=,[K7[3ln1]LNTnqΥvϷvxpݓr{p9nXp9n8BPq r nPpP:8Aܞa<WQnP rR]6BWYj2vRRRB9JY9H9K=~W֯ .POwLX})*(X.ۄo~} Uelxg)vjG)\ǹ>}|}}?}ONjmh~8o>Ȉ3h& =ܪ +T2m P+Tg4($ZC$N4/vT( }U&НeRx[ B(V](F+V{t}̾C]9 I0|&η]E|Z-p fV(~-p 1DEdV]w V6bG! I(+4= fK?^hIo0~> дc]6|D{jyҮf0+έ? pBQ; I7WGh5ds?-$`fBKREPRK9K=6-}~ur'mT̷{}p;G\pGC&BT|߳7=Xg)̟4O(u/e}ͭ!Cʫ'o֑7ޜmZ7jKJh[+H}E*õ|LJS[tbZݿO?_٩73>k3:ꚥS,6H Ϛ-7 }An&hFt-|d7,A)4s+|5 2'k`smsaOtn1fNIOC 31t(B5 ޮ-FFŐH>@-2UBOEhk Da[&&կ7{1.׸/:.7a*=r#++\x*׫ aU]:rڝsMC `ʽZExZ^OoN)"- mᔋ^ ^Uu;zH8ďN(t}L:A) C:)L%] !p6N2x[|jN;)ߦw,+s8zЕd] *r% \ȸ:#:zOp-\mNe=r}A=:^l&ZE&=} aL_R:&_zVq&zK4B[@?[;MN">UOG8bzBcM\oj \Q.^8ѰNeZ\I\/gN)j,n{p)Ȳ΅SuiTA\&m[*z:.)|pʺbkh \>xp2< rmt Ƭ4a#|r.W) 'zi'(OPiTj9 2a7D^?rsL+X:gSo[c Vxtʵ${f&a2DeND(M'`uVr5ƹɵJDWW^@U&]&C iX'.6ֵ_,mrwV6֎ bXhk 0y.{c O\bXF\[Q4&Mu2O\&t0S a8zN֨يߕ|hA)ۈN6 epʶm r-G&3]$#d^ {FVuhkKؖ( 0`'B]g"&{;"(P/fnhL\6';}'׿;F:*('1L%f듙rM0rS@ޣ'ZƜO=qHOF9d;ё¢w4ʵ 0~IFoKf]_ښ$z[(r2Q(\[HCI^w8(Zu(+N3"F 4ʵd ܼ?tw}4N[YLH,aFȶrm$r-*p="$rrDn|1F^\Ls9>,zW 0ufDfh3؝e{nޣ%xڒnGXn[];b=1rr &9| &2"(M4TLI͕qo$lC*% m06[L(tzS%Y,E\ 빠 m'wP(& +ħ.c`o;l@ F)m\ %. 6z魀bIB@o6`z ?>%2[)m3C[$޺2f@oȩz 0戮Цg1doGoe֧dVHJG:oe~qo? oۡs >] Jԛ߶28g6Ű;𷳊 {(C՘GS ܭ5oM E!~"VoEino A qA)Q"o .Ȧ?}`H G}JHHi}C egp-xo$6X 7kBgA - OLm۸+q;mRLАEf 07`߼{& ٷ=}S ط==`߆l-6)oP!6JPk5R" R(L0oG;7(^9UOo;zl'lv;EuoJ}ޠ+A e@}moG2Sxߎ~oFMm- X¯[coe/.& ~Co1 mtfт]+{\û3!:|/wo% vizoZcka1r iL~+{)@ +D~^_oR"0A c Aieom/C鷲~SZwoJ)%CKE& oZ[eA)G$-~;Jߐ{pU2+xdߎ7(|2!Jko O5;ro\ m *E\):!e&m 05 hͫ] oe&DiAoSRA f}o'<4[a+&EI]V E[̭ oۤF&m6D\)YJfjz+{>RR<\,Ƒ'4M R!VL8RcR4~Lb[!6{Pw4y~vz`n:i@[  ͤ_*vvEىNʾ):(戀`0OE ^!@aF'an-0_Y+MCYؽOqV*S}3S&aDr=+|j}6EiSHpy[7B#Tҥ7pLZGRm27µe]wlDR6z:MbЦyeMMƤMۡMmJ\j˄e14ãM- 5n\j @F?T.{?7* &ƒFȤyZҤetyeRkkxb1/Z/"Zҙ~!0´Y.f$]kx: ̺h{jALjp"+ڋ25k1Ҥ5Ф8ۤ֬mhIZ3}*Mja& LjI¤Z ֜WhHڴMQk"]1QK"}{\~;ZcZEr45Ep81-jEHȰ6~ 6yң֐5ң5bj]56ƞ6aSkl?iSkl]iS:7$MCɧָ!N6'HgNZУTM# ZJZQ -gCZchIZS0Gmڎ5/"$_x,;EYDqXZd} iP $X!iPkO =n__a. 81i](,=IM ߷AQhPkn4*|!/5Rσy=:iS?eonDsZ v50![lH-_wz055%ۥ9E[¬~tMkq5_)KY.!$ִтiִͯ= kZeooڋuƴlChM{)BZ)aMkn4H5 +%Yڮtx5wZӺ+\Ӛu?ZڊL~%־L{i_pLk&?rt3ә^ i>Ӛ{y`MkUykZhM[4şMkicаu8g=)Ƶִ>Jpr{GpyӺA9&+V޴,PюHSjhopL$BJBQČ [Lh07B^PP0! 殡 6Um'қ 6¯!bpzWj(-LMntŮx,3vjhӺB:ӺGCwZWK{C6ԺIreT;ɟvo!ZWtbbK-b4̽hP{HVd6cƈZ(j% טi*%lbx *A|Z* i)χeϐ%ɤh+-L&EϐN'˳<."˳<.4k#ܨ j ˲J̭0=+¸7/3¸Y;G3 'V,1s#vn\zjAvzHon&P;"BHa!0v6vJIzr_4:vXB .TTD9$0v8.+cRa06&C %ۤĀYi)^˫Yw A0vV(I{(xqU LV٫!pgvq1˞W}R*9KTUK)+S)ĀK̥<}rr)U(e]t_o)wձ|ՙg#;Su SB:ۇx!>ۇxo>>ۇxoC}!>ۇxoC}qoC}V'_Ql= Cߔ=2JMhI Ypr^h* Y@jK42!h,f 5fP%N1p!lB@BYx(dX/(da 19P^h: Y(a娢D4kztc.ϛgĕql^k]6{{!-QF{[zoU^/-^Ba > {"r! icvAzBLgzzۆz]$(daRp/TgG! v/ =/7NcX?-$aǓ̥1RVRꢔTqR.3]Y;`OWrwD>mP~J%c)O,ѡGL+Z 2E;rvQj:s! 2= K[.\KZR~ݸ* hlN}b}~X񡛨s ^RD^c-R^ؿkqv%Z/`%pvBxÛo߿X/:ϷM )3 /M } چ9K=ے*N}Nr\:NH:UO޼|U0w؟^Bn`O~ywǷ^?ee=G9Ӈ?t3Ny"kyhƒme:b8 {('ßr`2\A/'ìr 2pBi[MU'#4(ʰq:8=cٔ6?9ʭiP *[#lx@Dk Ǡ0`t)0+&2TT+wrPIWN2\TeQT$($Av *2|,2gL+e qEUy1IPDg:anf̖'cqX\a'fXU'㮈K~2j'c^dxDwl -4+h~K55dŪ%?EBKb5 ZXַOy~iv4 P?W ʼN exhC=2d(tL2jl қ 2a&AZ e8t>d(2oK (d(۹2,[Bv#0ʰJ 2Lb 5BteX QCM2:eØ1#;O_Z sSDrhd(MBʰ!CË"B9ʰM2 ~De8EA{>}"(5*TSYv e<"}8;M1n eP?e0zCپ `(uYAOUc ecz$CY=f3 [C@O]f(p!8u6XWǔbXEK"QFQF%F ԨU=Uu)'(pu~gd( 6 n7ʸ"]#AZCNPF,$15 IL}V`(/T|+&1sc#F c(oJAqbvzF3a1e  ;VW>*iB(T,+V4 +Pe4 AHP exĹ%Dl|Mk ~  QxK?2l!s D1U!%\(Ge Wt(B%ז!ʸ QFMd@'HB1fTHo@@E&D#D/uQfoCaeE:#ʴ%RF?vXB}D(cj$5w7Yz#}>r%ޅs%dl v֮!'OC613ay(*y's/|%WL|2p{&Ul%< :O{R{. ?)V'}):V"!>w# adt4>RuE`jxsPoUd}O#"4VGeX6%@X+a>SC0*J2Y8MB1*b/+2 (̷$7B<](_j$Vd1ѭn},TP&B(}#4I9n|K[A&BhU*&BOO!1<-tM%vR(3QD31k QtAeE$DMe Q>Q@ҏ(sWT6Z ʽ&(cW(x[ʸk(c/\6ʨK} P*ʜV~\ I̵v} cTu{X-D(W ېB.TB1.=Jŏ輦ɨMeVx#"~2g*?BGק{)uit+~2^d7}B'cs:] ~2:(+cۋ̍+N9O#Z,yP[ O'[>\ۍ:'?jqXl6`$&Ros$wQ|A 0>ٻcOƍSu|2x'ck !'3ni|=h,C|2[G|>7OdT'r,< F{S+'=7ɘ fOf*'>_dT'3JA@9Xo2vQJ2'@:LMxĞ%@7P(gO '# z)PyGL7r's!O;#1rg$Z 4&<LJx2^7Yg{\n|;{N? h*RhqQD3mUqpv6d[E-,8dQɴ O#148$'ϭ(͢@'#P'0!5:tGX##x J2PY 9f`b(աQ \^B_*죒;(#3aad!WHUn-wMCfH|K!s)2*G 2_2qG|[Ud(# k1Je\\טB(O)!瞀u乑썕'O'#~ɌQTy L7>8pH(CW#2GeR8A~^1.ݙq3'B=Aj@Ny; QF QF =\@RIQF"(cƶY@#)L< nQƋJG"D Wrڛ\(b2|M'SP#O8e61(T;)o3C)PF 2UxPF)^lVZ'd(Ob(sNi\jHE2-HZ#3Hŷ -P@`h"_!e);_yu>GgXQ=4.gd!B#eL(*M9%. @<0ז&@]_:ers @OBdkL=Ke֘zWfO(RRV ?ĚTʥ#s))s)cG)+s)G)+sgW4]TK.}"X dmzJOFr}jiOM?)h]ʵԎ\jT Y\JʵscuM/k)\\(7QbE:Z/VW?Yf:?Ud _c@֍_d>{.Q+rVHKS`;mIِcݻ7ASKc75 ]9ULՑ: sg{0A!:(]@ȱ|"@Ef4ȏN0x^:(Eʦ%[G[¶er('v-N!-U-f b9&`fosMV pr! >װQ޹QsP俢wɠT&<;d%;ǤRAn\*%Ǽ>ƚaѱs=ascu(s[i,v&YR8K͈9(yvAYgh==EKkxK{.9ZYrύsy.9Xn\r0Ř+sɡ0ϥmU-dhܰ<\lV9fl \tT~ IcBڇ[eX1V8x;m8EA4 p%Gc4-[A.97a8' 9sPT%'m\ja[TA9(ZWh-[ROeQT1/ȓu.ba˞{u.+sӒJX"ֹֹ: Ʃ:w*r:5s+asֹ.[2U 0eu }Ll\sPd[k|6ve5 o06oJ-N9a%ˢbvB9(uvΙ*s1 \sTԦӞasp%7ᛋ|ᛋ|7nW9#VlLYwo.2ćonWᛋAU9o7sPw.m޹'󜷿6 M΅iϾVDzo:V}scߜ 7;7DA/Q|QoJon8Dsᛛ'ec@;;*7l.|sCo"4]^.Jv MsҞ}!š97Ρ^j(r]VJS 湹ll~3vM s{+=7)vՋ{n&F\*.sh鞣2rύn\>l{nR{n;'x잋Jsbk\lX \${n,=\=\='sN1sNa䜃0t;p9p9pE:sf9|!9|!9xXֹ=a˛ mGxB޹aWw.o"w$s9a; -zn{m9y.x1a <<0<Ì0py΃0F29aP粧D"Fe}n E-se-)4-E\Nn[ a_X蒧aam"BW?{~XilbM%O塛aKƯaK-66E5Ltg]h] ]tpE\7\tA%Fu\tCXe]E/E蒇aKE/MJV_u(ȪW^.}I6Xa{4KMXn ]u Y,FwQS9,>|tTTfWO5C=ݫdNݔ2[ ]ʚEG¡Ȅhݤ(ln8D tÈg_aB7)%oZḚ%o`ڮ]<* mKN-=uХds=t;C=S^SyXZÚo-=tk.KCWB5Mt!Z4luYB2]5V}k=lu^mM&aXm-b>LtNj.:nRh 7-f ݢaFA5&Acum Xw?"VI.b<;fB$@[bw Б|1$_w(1z bw1cՖ}071 fb-j1cY`x0v)bw9!W}ۊHK.f 4u܋_$vSNr]xwBw1/$UݑY]̨ t2A 國.S~ L~^vL_tY>w1a  b!墤Mm.d##|Ű]?sLD&bl-+Mpvbjw1T]-.`l.bHk r\1ފ1mfWª ã}*#S*fj(LALsYev-)ZYFBr#pDF}FFXc)ݱhXsn3wKX.3wNg+;\Foa:QJ7a.F"wsH$ [nH`w18Q-7x$23{Knb8 ώAgL.z;/ wFNJU$Y &poR5Mv)7s%Hŕ (6ـ]Ʋ+V_rv>SoWVJ,nx4N]8,qo8 x'rZ1K7|Y.} A38vXxMH܍=B0W7ݩ>e^t!3`U{]8du>\2m@UdkU]*XYr`5} h_5n\cvGFv1U'Uiت] աW7-]groW`#x<\l-WޮgLO䝼]v MY'nw $j `.gJV i%~; ht2S :_iДỵX9uUH]L0:3‹A:prb֗>"ȒQy$bAWw?nd_FA?աov1f(1Ҹwb`N.XdGb#fjV|--ĄK]DQnK:Gm 3>^v1) .>EH{z^UQtˁU?R nA5.vq4J![S#=RQIeLW_Y#0U1,>i#.>/] l9]!BaBc.ttQ%+^6k+` w7ݰo;ĸ1n7&<_Ager/2'P(s'eܛKIJ!PʥAϥ̥xt I\/g\W&Y)d@J+}̀Og0)VUgJ,wf(YԔuʥ񹔒r-c>ڛ!\`* Oh.57睂'"ԞK4{Wz'dSu8VR0p+M-˯M6u^9*M}6yԨo=kΧz}gJ]_$hY{}qhzFs[Eۢw[nmѻ-zE轸-zEۢw[nmѻ-zEۢw[nmѻ-zonmѻ-zE_~o`)[_Ve٢[wfIߔ=e^ONʥlZ5JYOR֛GP2^|G稗jZB⼎{1{W)+{U԰F2z)G!GP4vYF)+YM%VjT*6J𥐄ӹwd/U=RkF!w>54zͥٝơS/,h~rn}e 'b!SxE`Be Y+£UӤ^3'Tk R4վF_TBfmfsdv-?^piz<^|+}9HBRs@L«w/oțrm"zY||{<˩6d~=g f?_/_ W+>ֿ>Ǐo߽~ Ly{z3r^R7oD }!;endstream endobj 524 0 obj << /Filter /FlateDecode /Length 2557 >> stream xZ͏ݸ Ga\}RR=4={xf1/&S-۴%IoD")~[)o=_~[w*4$te]]aHwKWƶ[<(uN ۀU=q>Hcbo>~~LJ;lLTWA >vڸ4xxƏRy8Dk:K_]or"mCRCL-t׃rMY(mѽփnn‚4PNY*FbsA!u[KռNLvS֖zdS\U(J4S 3dc{kvgV-3ʼn.(N-6*Sw*z4^;Sk.|p&8V\96SvvPѕOʼnPp^mf +_,GV^N,LqfY]x`a! = cݙ)N [JIl8򻱸+^I==3FARD E狱{YvvXzy_Z! `Z LD`Cp\ +)՚Z +EBf@.X D`Y#9C+Q iayQ9kpc*CݽQ@)k/&!+gqraf)r Dc}I ;&F? P2dEIĴY%CQUfȊ(B5JC]!ĸ|r#sZ~X/?ޮ< ۚ0 =N5$ZpP$3ijXrਝʐ VH+C$i 5C6X*D!:YCقlJ`Cb Azwf#N<1y&Y~ә6މ.Rs/ZG,Q$&&;-'ZɕZ@2'⻒8Ω ] $U኏ߝD(]ܣP`;$Q-]C*w5':]`(r/Dς@ Q/%\S;*U>"Z hBi5\{bi4l'ʠ /.@V}OPg%P妦^D/ڋ$8T٣š ^K`1i`+956uT -AcXS*;̈́8|2ka΁ZaC*Jy]g`"*V9JDGrVW9m!"UB::w -] r W Q\Qit|v6i⺿ɺHCsйѹ3@S K-geHRXe< y\a4~?#8LZ>ᩰqoZ5/T =ICaaҺi2IV2k*En \@&p+Py(x d2T'ȗF3NERp^FCdyVS$Ip(u*͖ 2t+J[-_ = J(;fsFE*ьcqC%fCH[ R|[.xUrFE "w%rKJ@#o>|{J<{J<g*L6UZC%v6샑u^CDtݫsHe#LAA閯JD֮J@$*a d QMM,RBWbP3680)!zg^~cb89vO/? qR<[z{Cu#/[/WP嫜yJGk1_GMrQǜ<W3 `gUVuL{_ H `H\'2DbYZʕ!,8C6X;V%^x%PQ4_ sx[`.6CCy/K &zY\[|=h Hn+WJ_o_L?r ]EgSveÐq6؈]<~;c_X#&g}ѳ Fp"xr1Y$(OnX00N\aӆe I8W x čXVEc3,ŌȝW1)G;|t1𽓲c0&T+1\Dc!z ei ,w^aǤ2 :a|:\!]cDdFQ=?r Yee<)2:҈W+oVӐ ffYyj6iŎHKQBruы9> stream xZKs딜/ SK@HUk{7v-ZҤDRKQvgGhػ.<M_7@0k0jwa7\tw[dz&Ec."u\\.ѠGgiM~i!Ҫj`y_n0RSjv}h}tߗdKUojN!TyuN_dpBГ` bchC\Gy*QC߆q5뀉cDL3.5?\\MSmu6 =ތ``-A"!J02J6( =D`u5V"p&J N"60W NI\T> ! G*@72NtJ2 H(`3HiUd?'HK0 k.(0.QL O Aɍ~Qʜ%7D(hWTq#R3 HG:69 C(nx>vDG{>Փ: J@DdUQ 4%ؙF4.l&E_Qe 1V* aWDcg^+!'Yk9KNfti.U3"d$F?@ LAt^3! A*)WLJb StJ;w&LviJA(P~xGzN'Oചe';a$A:U}ЉBef cVZnH`HQKnA &[ӕ38DT[(I=*;N++']i'"'gn b'W$䨔+rbFN\7ՏIڶ׫W-Y3u>(k^zr϶C3drr>dt? Tendstream endobj 526 0 obj << /Filter /FlateDecode /Length 427 >> stream x]1n@D{7Jηbq Hr\,L\)RO7X^_~WN{}~cm/uY㩝I>ǷakO߆C}x9wxS}߆Z>si:w՝󯧩8)l8)lXxy8ij+8D8> Ccq v^Ӓ]- g+)$r읳v7{笝39kg|9xYhg\bRևAuXa}H!> .!^,.*,.*,.*,.*'XLP9Aװo7 ]þ!ߠk7t |aߐo5 ʅCA O=ӯcz@~Yohnj/;Qendstream endobj 527 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5179 >> stream xX TSgھ1bM%m^jժתSkmҪ.*K%,aɾ7 Y @DuVvܵ9mgzv/83p!=|>|Pp8!S|$6b?ipd稙Ϸ`u~ycs!?;N8 f+{/F?6b@î&tgAЩ-k! Sr@Vqǯn JdZ#jrQ)Ɯ("[s$G'7 d`nl1BM -PFs ^ P(v;%c}'eЮmAIVU;\tMy<ػۢwt]-!%2rHed* U|t5MK.m@+ʳU9JYdT~^#oZUz 4L*&x uy썻|4$!9w82B:AWܯ*b %4,@F#/t*/dN@qfF[!t;yS_1D4\D_F>=0ڏ  ; Y5j7{7\E~h,z MV aW ~ c[.FOҭ{[JyB$nL7M$³Hǘ @ 0tX} \ ɹwѰhݺi|cWZ5(tn:7r g-8^s^{?7@"aG֧i Fwqh+>Z)|‡AV4Xte3AAͦ9x:D29d(jzhлTCf>(3nD;tpfI47[)`8`#01&Fkm=bi^x|<`hʂG>+\(E1(~Ukܼ7]Wr.lFJ#=fo@ ^i^P0JȢYC8Jq/w<&\#ᐾCkC RZ- m#Ob:I' FS:d>9hole$X 96'nbrXBGHf4T^|@D9bs| JX%TE#@#FUH/xB;AM:apn ?mO= n}=W=sNhbMEA1^s,>\ ؛,s *<~\]0l[B@H lׁNFT'XU>C6&1zuS"T9QOٮ'foHUSoeĈLT j5Qq=WLQKNi^#JEWGUi[U~!Ȏ-b /)S<:dS,'YK rcͮq@ rK NĊ9t'|6-M/HHU5#UI(sȰVl|=_ brui'z[<,FϪܼyg6.K=D$ʔY :A+ Z՟ց("GM#XlI`3_?EFI6K' yw>UIH(,>؉^3/"$ⶆAnDÐ?=U2\*JQNo7o:\z;[ ɩKii*לUuhX{|LNDŽu* 3T@ ݱIX<kh.yO-Iv:G5mF P-B{R j7Z6uAaL+FQ(ʠ&OUD>~st94Y5#vgGWat78?\!,|ڤ *q.WL <'^a[ *{=^= ?v6]{`oN ľ4p;߳ʒJ3/,&,nG$@\j%ǝGUiS ڸ}I]tәcMǡhk!-RJjo]8O:6zwEC#\+Rae 'J9[ zFnT Fp<{` >H(2N՘a`S *&<5co L ؅(@hS2)CŐٖ¸mvr NM GڂQ6ʣ MVY{BoA#y{VrqJ<έ]cn4Jg:/zφz^GT~#{1VEI8OГq>-X[WHWdyۢA LnY\6<Ǒ75n<;@CW}n=^'h@o;{ZAdPR'(VU5zCCY$3߳m[Iŵ?È/B<<߮Bbz:nYx@+jw:wrrN5B4]JA JnqU&qgx^G6!笴]PD*JRӓ"ۥ7vᖋj`G s{W/ 5GOI\Walȶj0~k`zӪX1u }d0ZsGk(מWZgqcKn:@H\}B'_ۮt0!C E&q^ zqۋnQF_܃/ۋ/zW gS۠B/jDnn*cUɴJtr'ݮNg.IM|Jm VYP /}X4{ tg7;HY^~uMQK14oߏ2Qڈ{)!JȐSg2\2 rA!Z.ifjha]zAzB81"][}[̮-PY>[Bks4}[\#znx|.di)=~q%΁E0[@=LIXue1dbi ÀM3n+R4)Eg{RM16;6; RNQ0L[ Bq{8F@=o[+# Sp8R 'ÔY{oH3dSi"MZA4t69KԌ{_.eD/{fB=!؃9 (G+0߀34\? t7H8ezj M*Ъ^xw*m(|>akvZ#q81ORFs,'FTu|ZnneNJe>2p q('4c. 3*ho N6b]n9y' jɐ=K*oɨsj݊te,AԢݐ h@krꚆRc')=e{K+PAw&ӫ֬BƽiXE%.o'qުE.46``@ƒWxcOv$YR.UV~vcc9p;ou1rJК454pÂ2t%?Gkј{ҿ}ܴTP `m0:͔&Ý^QM`0$8h?IԁR_Q,g 'sGmdJ3L!cM endstream endobj 528 0 obj << /Filter /FlateDecode /Length 6942 >> stream x]ݎ\mW"h9>xml\rѫ=#ZU ~SӒWvn4 CM6dX$U=4̈́鿯W/WaW?B˴͋odnSR6/W_ ԡ^D#^^}=nz qW7)8w yRy/ȵDPC. 3 !ʅD0Ɍ/ 5 B4,8Q=rPRCXp(Bv>H]&̂JY9,"00)9XeQƠx#"*i:"FDRp% ̥]Rw.,(-!0FF`*n5Dʢ3b%wLL@"`Md~^9"x!Ȼfe@ix9FQV,F&.yqwIscN2IYatÊrB7H`֋qS2բRTC?[ v|峊Y$EXK4 H{b 0PplVZ^$UUŒYU(ʡ2a.r 'O.Nh\ =`#CD_9Ą[ƪQơ.祏uA+f1 Ɨc6lRus@\k(tzW}GS싱/U*+n pJG%XT@G A̜qcd+6y@A sOtM`EUY9tSc&P=SdUf9SaKFq D ݥPagp(Ad(EP%A7 )4#C< ;p8s 0 9ʨ+&az6KQʠEǙ]kC$X8|ִq&]kG)jF9Ԧ4DdǪ]_>#p1rf!Kf^H6{CG}Ξ;B+}dǪ(r:AJff*A@.U#0 A?m #bm x, C[$p5*&J۬rV25ުFaZ~Й9&fkC Qb{9*ݙȊU \Q &UkD#J~fAFÇ+fFf"m`F4&&{> X&.YAA %%ʯ$~oHbKgC:Dp942E".1ȅ[p({#sҧD p_{OZQTC? 8[b™7 F3' t`0p\+Y.1”0rfq[XL0~; 3m_o6_^-pYaWg*&xTL8d6TiP >0-DSGedFO8~P(5ep zfM(aqM+6u}S)kNAPc3s-I˔(ܑܑؐdZ <5CwRR5[8e؊?&>BZ M &JeZR((~xw+N&rV ^^ @Z،&?AN79#ݶ+$LJgv}f$s&aI!GҪF-)&1qiFB^k}Cƥ.?DX iFFB&Hz <]X1U)j'n *&GyX!Lq-5\y!:^REYY% HWP1qR)j*p 9֠jWU ˳ {vSv]cG٫憙d~r) ma3k O%uTqr@=Ra*딣D&$J9x¤҆ھM3K` ݰдJ%(pTY$SeJ,ڧ( LRݭOwI#lj(- knDɑl@iШI j/H}a &JiX]JL}ONdI+l )-պ#(* [iћF`|h~&k鏆lRcZ",0K5cj:ENЩxR~ Sˋˋˋˋˋˋˋ/Vq&߰?~>ZB^8<Y'bdLZ.oa-_Y_?(I}ǵ"*B0zׄkI#T[ 7+/G*,CbQ/ q=qt_eX*yL\Q'G2_5d_ߵgX`Z5TEީxz|ѓaXP/] t^tw}Cf홇evﯩOO?{|xJs~}y{Ս}wBˍxkitkfqƱln~&f'_or??_BO$ŗ4|u 6潉4Ln0;VoRr:Kv< ÔLbpxT#ҷ:cgFO ֜$Oyû΅n/uB߶_[{Gc,ߒ nFm9y|:n^?mfgnn'mTsM?ѷpyNuẑ,2agO{BMLʀ"a+4/ÇU7yx! sa޽mJ{e{m9G#öcy^i;n@^֙vzF);S#2g-/kK(<eK9aߑKdh'`O7ѱdQB^&U9o{_2<~ψn4(-)0iaYɮخphDOe%٩LIG:~KrA4-ߜOM^ʿ7@[4טj?NSx&P5&>Siac\C8 {y.+%>nuCS}$/b8 6?|_^HIxa>ܛuiYDC[[ /\lGԗfr>qp\؎Υ tB }{;=gVFh#R0Oa8YXD`At {P#vݸ;<_) wR@k!!<r@:n_I$>~lXxů0s%r=nWW m%x^tR16*Ķ"S8>HҔ.EJǧVB.̩b+uĭ-sFeDdݺ`RTZ/:lLfn`)O40~T%d5[6 ~Im0={nrnx2>[T[?_]Ϟ~ϧe!hu|i/-?<8ݡA;-)K)Vf$=tǕ Pz'VcA'޻Y{Νr noQforҵ̺Kn,SԞ7⩬d[~65Z3oG2L(L͙+&L9k]Umk|jU}fh[rî6$ofJ ]jX| ?S>㫷5?g:Ӿ$!Ywk>?1Qőɧ Ȼ^˩ G_/" $-(T~VS}'ٿo(z0&r~S|dert9kwǻ^[v󘃯Ls >|v6VuXspgnQI%L(^~Iǧpܪ/R> hKrIsg=}Gv-8MC0b [\2oMl25o2i#wۻU/et=wb;T)ai#4f񗡦v}}0 @ѷn=Q'ҲI9,u??5ϜGm/u8e@g֑~0g.ה{-)'*GDP?xkD~ף,$N-@+בa?>h@ǹ( ({7$#&iӮ˧k;bXYqO-rTI,4B9\jI O[nGv֏k:ϗJ˃ԳNőK-TY?p@jcEOIýET/\4GNoD(x 3uۉx;Du)i{amtvi>@gOӮ]OӑNFF纁&7rڰje4\?qtiʿ6l;U?@^Uendstream endobj 529 0 obj << /Filter /FlateDecode /Length 5205 >> stream x\Kw6/L kC: 8ǚL4MblH|2OZZc%H327;>8]O"뺪 J.LYl1 ^Q}p^nȳ\ S4pn}x>m(ʼ2ϵ.7 "b w/w# 1 SN1&LFj6g*V܄6tC@rVi9zB4h[Vqkf{>ͶHDcDT Pe2F-'^Je6f& h, @F)_ dzYӖ*r;m鑈Z$|:ӀDj4˽IQr>_K>9{G( UHACPId8@M8~F;R%Z7Ee߾K>h=y)7ۜ7h`FQ9v .͝AaĴn}qxpU ְG>@zn׈`]Dc06:*Ui0w/Qr|>- E B3 $ %;8 P'm+- l!fUB\oGy$/4 czl`7ma4v?#3];0(zEd1ߙ!KKQJ8#}J%&~0ztc/[ upF<wE>WIs#xP&= a hw1[?)TJαYoކ[{[f\hWT1,\(`Iӷ!7~~(Hs")t'%nfȱ.-D3AQ?7a/&mxf}앛HPRHnx<1+̲*-7G-m\u|5[/e Og]نAA@8X/lw4)zqύTA 70 ڌAtO:W tq3Wj4K|_ nR.:_8ر _&^N\a];f0ѵʑrqpl›L¢G{$~UWL 7A*M>!h}!/ǤcOZI~X&P躀 |,:_R!RpLj>_)d>]FP=,JQyÇE( DyAI_ 郓]E4Q?pӫK ?r) snڠD|;e)mC{7\A+h,Ć1e)hW̳%?IIs`g;z u<=uҕ2ݞ2욨wRMoc8ufwKSTBLS (8[U&/ /cd|=$RPțh?#T+eٺU{x {,0.@4LYݹXt;I݁k|[Fc^H^, \s]5Mo,26zs/v%2Fv~sS[\@ڛC piFl  .۵Z@6# t2a^ Ue012҆ #]Nz1hd/LA4>eAhVM=3ct/6q H #ՕI{#S*&v+Z|Tk@E/W9`gMhz)OeKd]8U?^AOO qF B~oz 1ﶜ*m^/EP>jB6 ,vZYj;SKqW" Js$tk{z=K PO~I7kx;녰![xtǹuYwTnլnnւNf:[? yaK!UѩүEʠ%^vK. Vy)cz.?y!P+^yg!% wPu-OR$[ˤB.}^S;mQRWC K_)>xV04N'C䙊QhcMj=yKR͞n(MevKNiM{\NGq`gbh xg;Ie7n]*nWp;ܔCO '„Kbpr.7`; 륂2#M6Ws`:MaGchdSyfwpSP(Fݑ31QgY?RI2c7NڻL]7emT= Ų=NK=.VRf#&6vyu, >Ɔ5ۦRT$|,Ҽ c!20=-7NӺwdi]G.fyъ9HзKx]ԈD D]t`zp +u9k񭶢Lh1KY5%8PP-eXY^}aɾŦ3B&%rKoS|s IGfBxIڷZԼh 5oq-h6AMQXWhtشl*}3UiRV699Aӭ:5kH#b6Q3~)v4I5w{';LC#q-W+]{q SYi$ h5M0OWidFf8*^]ޮ?-8cqw3F|=+GDE]VDZ]FRs&Yf ~ޝҐ{J2\Id?W D ekM5T5-^)W2Ғ2D=Ճt7/٩Jo-w2/jRJ/p?=vѤJT&&a]^2c̱R%酶jQ-*0lv7һqN9EkWڹ7YHFMQQIpx}rpi?jbڞzB.8Br ?0mxm8QZ/e]+s̯\}%'JHk?mK.x1m%!6z/^i:F}yBph&" sru} IFS;l\)V̰'wzkKJ֢) =,vƏ}?l>*`ބ8 iiԆ+vMMvg) J.?iPNԢXR C2y nbmԞ7@u\c C%Tpݔ:zQitzypム)++@%}ۮ(Ҡhu])B F(w) J- 9T/ Kn#BeP2ğ CƛR[ۄ$7&|m JDyPp**{Ywy8(a {#aZ,۵(,aQ*\e9%L{ء#'5 ޏ+Ք$RV%//7Ekuq_I:t1pTf _n&+쟗 +(ySȤd> stream x[IsHv_pt=-Ȝ#qLŌCn@TU˿o%@J D{ ~Q¿fw~n?\xWWwxmSzm/ں-/~)~TeUVU8vl.7\E+uYھ+\ϻKkUYUԥk|KkmcQJכK覸 x;UuuwkyU!*FM£[6a6-xⱻh$7ů=Oh*+0닇nש)>OxAc?oz cm kӷyQQ0F#^LY×_浶vn!8ƶ5Ѣ kln.aZ{f4nb8dAiO^uP)m<q1^&"MSlc@(Rv;/rw9j2t(5=y.N4Q)yEnoS! ͙=`8ۢ m+PP-dHåVGr'ԮZˬpS mh6P  h zbcv8fyB: &)uRC.a|kYk"޻I'sD3@OW1$ 7N}%hSK3$LBk[;OaXK'ly-tf']G6o`l3A{O{:,Oz< [DD*oO~ŷx 9;~x<`yw?ojKݍ}Bjk)Aøv&_=R;T2à=hMuWB38)$6,Oa> SXbf "(qw'~9p8f=TxlCuTҙՄfO7QӖ&gZ.-&jg4\4'Z<%Oz-G]ZFܷr@tk H8: -_Qo_,6*T~w>DB?4ebBce$o-Axmxb?>Ir7{ `>@*՜&.dfD\abgj<|{ j+XF!uǮ/?6.&BK~0fA1MJHۨ,s:L@eH8蝐PgRIYUaGlNSJla}`U+UL@AXπlCdW-xiinMb8Գ"7>YE vqUuԀwi@`a%³tЊ\ Uh˷"Bt bS23‰=`9nuۊXdYAai0,"fBj.0`2~{0 0tU!?YDƻnwIGSVs%u;qa]_+L\0K $\ϊUkF_*5͟4bVmv:Z6a%1a⋿V 5+n,p}rTW$l]EG6|¶bYB mVG|OUpzˑ%"sFQlcw#v:~l' 6|k^=\+ +2رE B/gـ##3.fq^`e!cG_'\4dupeE,:>V[I26J;qnb%}J#pՊC:NfE3 kYp/5@lM'(fk .0,t&3%Bx gBt|8ÑҊJq-ed1񂣤ojCm[\wk{UΨhӑ DŽd@0PQ2hv,^6qL/6*AJ6f^@Y#0c%DBD33lDbɴXolV߈ Lʼ-xDϏs RuASज़2tn v+P2T4ypSN;0C}Db2A K2&^6SZIx|]y).mXX Dy-}P?{7: 4,zMi>]/`T PxV=I/0*l+/6-h:/|Ȏr wPD}U(*XQ x^AfTƗ |)2B94!%F.=ݺv$_Q]U.j#Wr.̡Q1F;䉐&umU -X>nRx/R, +M0"9?geY4pd+3h5\Zhz>(G {Kk?f^u6&FI-ԼT MN.qmX k"@a5(*u?p ZV2OBNJg 'ry5-8*aDJc aʟooʫ_- UmyM ĄNS8u"K&cV;0'cֿ^?eH8˱jŦ1AOn*S)z%i)מ@Ngk̟:da~nLlO^1>s_ا)TI}鹦ޠ$$OUx!uqyOw˕_=ZWQF%ַc8PvAk?tL|4>zK8[馒 5I40wDB1;Df׮mh X9q`19tKaW9 ,/`&wŹhh [n{,i @cT/MO^st36v~ߛbS9 9Cp~ⲒVQcZ}֋^6.eq|?o/JD4WbGE]Ss{Ė#,R(PQ$}':'S8ViuS0x>U&Ѐ{j#3y?H~O ': Ym:w&p_*3Q.y{e-+EB]Ku BfԖ]/) LD0n-y?xa oePOyfZ7M5~Dyu(/:9 aCՐ_iQ{ݶ2G_.hM{ٞV lFX R5ťq%C+@سOo4xX&m,=Xgzb=v֦l QyQchYX"">ۂ5݇qzfXh0柊&;q3+Gp ˠqmTv]䇉GqK8I9*@&|Co\^hD9E5Woh^>N o˿(s:M8C 뽢d@a~ Ou0Bt"p˄31j/৸! >`ݱ Jn tZVTjL aecbSkXt=+FBu ͕1d@w&?;/*q 9R&kyi3d>/^ǗLH{xl\bSPCDg!D+KJ?:XCO>mJ5YayLjkJ^Oyl&^LS7B_@Tpa] xteAoʈL"r;OZ1y]dC0bj~ߣ+b k6\'^'c:#„C.9Ji47~<&ĈxCj?9!gYL ZFz^tGendstream endobj 531 0 obj << /Filter /FlateDecode /Length 4586 >> stream x[Is:/tdM8N7xv[ч>Pv-z˶O. YZ,DŽ"DHd~W۳3AW]oj৲q~q}cy-Νqezqo|[o7?ݢ*+P-6b RŚnL-j[?[. _3]2LT W.˪}<(%MSgmjWbXJ Z~ij[)dv(oo? WZf󴍄¯InN6}|z<8a˜WqJ¢y/(.1? p BX"y hJ][q@PAWZ!:4p~ ܕ^ KC/"M.v%|^lrE.\Uj%'2@b H38 ra:=EG [ۯq6l*V=oOp.+3N{f"|{ϑFJL䕘4̂ ecdA;5T`ill )0l>_Wf1HQZ.I"hlqֺY8KLx:lnڽ Mng*2FLdш5l-. 6${z"kt&D%d/nd9[{[PD0dp[Gk֞yA|sýۄMY9 >yRGXSҡI%Q2739vLz!UO<~Z?zsm4ĺԗz\qui]D,+Cqwu[S/9e>t#ɜHTq=Edh=,hbbW!,ܱA'aKU$/ɠMC"K}93AgUeY'N\):@zPt =pw|e`cKICRcukv6H\7e]S8e6 ~0dF|@IsO>R5.E+R'0QٌP7fDF]gp-fg[ $!5cƳ'ϼRQA~F;r'KBxҌ%6Db>{÷0F[q$m{1$R\@yu!jq͒Y*/n A^ _M{ ٌos7Bn($ף&q],BY|L_N=%EKiį]H4 G8fv :id$ggŐ +Y%&8ʞЪ0 @uƌŭd&aT`ءFccG20 9RXh.X ݗpkO-dʗT]b,t(kd~c]H;B4QٚzQb8 06*kK(R38|a"_ZO]@{[I!鼶1Q'1c([<dfEE-ЮtEG=4&%`Sjau4|IF삎X"d2uh4@1}ئ8siLEIx (OI6Ub$`gC$,B^7ZnyQq鐡IКCIu"AB]R5q~e5r\:Z01E=Nۄ P*Y FOXvN`ZV& !G,Hf"ǝͤP(<N T6I"ẝI"gʧ~۰^! "bÑ'8:ճ5=:ˏpI1%"2p 59dѝn`GRLx"|__$CѪE2 YU 2}V8hM1-hPXݺU &q5Lv^xoӓyN쟤)iC|%) TOeD|.uzOIuΕKu$|4wIy_W\`NU)[ hH J4T{`MoDMbզ/I2 Dr),{K+ Tl*UԪ1z & /t5+zDdې71 [e ?N36TT|OWꇋ1hz qŞ%kH?ti1 Ghyrff⟌oq:iMB5 iRK˪^#6&e?O='fFP'Gsw{[S>(Κ:5aHv3_SgfmxϘU3&Cܹ!Ydy4TÜb셬KOx^.( z"4^oמly}b"p*)9yw Ӛ9Ew\nÊ'6Nct8m+ K)I)t{4$P\Pe=&B]72 f -c&0n^ I}=xK Ҵ?z*Ow!obf;s<[XbWs NFƵg"ϹxG6=!0w-rhN' K0vcTF86Q8֖rj7e2V|c9AߦcXEE7YriD[i2) n@"_Hx ,EA ̲}|=c}ݾHgGd~J-{8DZ*M{Voqѵ:_: R5^^b0Υ$ͰoRav 07m{>v|ANޝ֙iS=eBNs08=ٜeB@"iŸ˒U;~҄=p﷫&͌cBp-* i= 2u@0Fӷ:P8bJ(lN3 AgOnN gO@<=ap!V|:͵ 0VWH` U|1*ocL3xcI("Uw3Cl9Q?p}kƍp3y@\l˲cZ=_/> stream x\Ysȵ~oJ-PE@WqjqbR)}M-IBL~} t7@8Dg*yYu~wәoO> WeS5slH}+eί7gUYDv=O]-j[VɠRr |:+٥֢*}~LY[>ovJԵ)G\9yںvp8Tga--Lբw7a,QWӚJBR#{9Z COC{ mwrvЏ[kl-;XإqEBޟm._\]0˝|hvN6ƷXRIgw),e-/*n$DXVBo5.t d#0'útM->-RqhSMwUX*.צֿL|kmꆤ?Kh8tTX!BƎHe))1+.?c羚I8ԥC54SW&Ya>ČРB:]"֥(pO#£ qFUyqiYtunH4e+*QFb":tڄ(wzV(͌= [IYJR޴<%V0.srPu휗i4癅FOL@%ФB_$߷],l/YKP*UuDE9FLċe,"H9poel'(A=¼CXM`D;n@(^ҒT>]Їz*ApؑErlƎKwh5še?7;44!~KL@kJ+TȥҪeyT%*{#$!(2Gh۲OڂMέ$}hJXg׿Pͭ%^N&{`%bЭR%  TARd >F\WWhS Q?Gev1`{#ݲ7(TE/@j;j|#6$?ma[aMWYCӸg [%B<[!AT N0):T Zt8I!~@|beHl a}߭ߔuF3lnkQR@1$[VGb`/qD ; +xnRUI9U)'m:7*3NLT/V8iaN¶Qv6!XFCxL^p:MYz ƻdvE]lꤽ6Dx #ODc6PhDԹ?`>N\a Aɱ7`R ?zvZtNCqu\NW¹T,NwZ, 4o#l`\%t(W%|-,bælBQ+\ >Fe^f߀*֔TRL'̢rTXMHSĤ"|R?eҊ1`@ 8GS;4)Ztb.o-0~sheM~ RJhM<}u9DTؘ% Ga,JpdӎdM"aw"6z5_;b6ʎd8aTc'Y`zdCag;oL:* $tOYfe!u|hTiߣ*% E;3Go00&( %ud_aLzm!dK% W[ipQҸ4Gœ/ڏQ8P ja[e1"|:[!:dw)`BөN(7?.uځݝ Q#UerwTײfy;F7h9c LAm1b1* SR39h B#LgXwNՆzIIJ(L/_>°,DKG.>kbg0ШEq|8B=N)}r :$dh_*̛.Qop& #͟^c܀}DNItB+Yeїu1(jÀ-`u.Z>Z,X\(=HB)*Z~@D%tz,uM+[F8P,zbGѪظ|O<6DŽ|[}׶Cm8__Pqfm3JL|Ԝ'Uz>P#;9˱6`~0)ץh%𐋇hx dKzqI(pm2*nsTv Iz8f-6 ^%U<4L6r EtI*O'QJy{ǃ3BlU |`V5i9t.ƚWLNwZJTI ;."գ r^0rqJrN,H[p>+T8z6GUi0,UG@F֎ڬLd4F͜c М3pG'?#].!?*-.Ƒ0('(z!܅2@4=N-^ 1M0tF*ݴH!MC>~MjZOG.6+ R]i< yZ),=OL=b,l3Jcr9v>x JVl|a%}BEufrxZ_C\(Cj-d/8,煹ͬϩ1,@;W[^+/rAw7 -vpa_ЬI)&yZMuzJ׎It D=8 ~--}gu-̓OTE/+ R\\*jBSd|B|ЅoEqR^N8erI%wZTǹJ&Nsq8cp&^+׿9Y.0|PÉd離)^/}tlIKit}-ӄU}2kSbHy Q:h|&Go&(t_ ykO،H4ݶ :+k=z.԰^rBWМSnE|Tc7J_y6*Q)*WSLJXÁ`@1jeB!a r>(b'-*aqəvEDcܹǝXHhuBB~v3PMX!FΉx tLtPTlkJ:|a;r6> fn5I^y#~/].Ҙ-v>Y}M쌏c$.NC> A {{|[4Fs#5;ӫ H'd&Vq +'|Wt! 7Fߏ/)qӅχ a}7"r'rY)*>a}WB_  5endstream endobj 533 0 obj << /Filter /FlateDecode /Length 5290 >> stream x\Ksȑ/bGpCE=Ğ<=֮5h  _8U@eMR ꙙܨ?/gޞ>:Ͽ)MS6s]MyMcE)T=OVpWbPmݦj{V.Umj/K]Ç*i|VE10aqsqijS֕4jqw V"~Ea*&~}jmXN6vDn$ 7Y[#4+6vǤӡa:U|j ߤ/"vvaDe66gW V*M1ޤ_ LPaz7Mg۾7ME92ڧrD$2;u/"0GtW~MIk0"Pf^.Z.3CiE9&L ́Ͽ^8'jJar`B7$3vr hAgL{p 0}hʸc 񜗒IN}AL}ӋAKR( %UŻvaٯfՀgqxӎ0릺DX{ ڒX|Fң|0-^2!4@_G0Fi0~G$yg yQ7u@~Q-p4wH̓mhdl۝P!Z"nGȵBAc HG't ]s)laܵ}/U5*0}jڛ$6CBN:iضطcOZ8LtA7/7%8/n%0pVSHZVC<)T?6;-$C:*_=˗309a$]!pD4%ђjFD@СddtG8q ÒUZ9V#5q FCwPϕM8MQTmۆ`^N=iIPqv)h3ON<97A"H,*͊"ᅧ,ӱv 5" ^jѬ>`gUʴ 6RUTj4cy= dOǒGƤ\}D 0=Iv.Y6ZP܄.C+Ģy`] Zן~>; Ql\AnńpXa{]n?=%uUm]q?"Eu m~-&%T(8Jox0qi8d`# tvF^sjV^܁䀉dֱ.BpR, DAFqgt<#CDtpA!0S 郎/jT>R`&aRhK(u`I:?d!Ծ#IM]y01H ,k3A(z-6I1% g$>IA; $mS>p2+b}+@?HOW-lY8Q8+!ιZ ,Ku4:ƌdZ94r!=B۰St.'p@{ {kHE΁< tW a(ҡ MyZyI}"6^cљi҅~ 3ht桿}L4*ITrAt19DJgQQBՀ@ ƑcPD^M ryF" 2c`=1,Eu-B* gi~$k6i&XZö Db[qϼva66d1/B\gpRa@!.> bd}*e7؊bsyfXTc0mS[8Q ﺾ#ӼvY'7G Y)1ʲ ~ۙϝ‚pq&{8:4PI@T [+}X?a= ZD3i-n؍R ^GfOrOVlƻӶY$Û6~Yt.4c;("JCY*|U -stYYET رQG+K1T:Yn%yQ,:}nj]-!yU3W9tמR`N'ބVaWa5FWf}cMi" TE%hLڐx\eM:_eaZ֘2Cq)ߨ1Vk<(@U#Mõj-t9e~ ZǍVn _,4yxRI|61 vk," CA>l6MH CllfVb04>F d2حpv0g~0# (A4!֤@^p <}y\q r Rh w~cP:"yn,L3iI]׮B2vîjxDR.3o?3~(cxې=#[8f).-YeHi_⬞lI;r;FMYOb[H~f1%5 >R*B #sd2ubUXa1!P\2~m׎w 7)Ee;/dk#>3:#U͡fDx7C:.Kʆ׎'!4" Ҥu>g\Mt({J9eGkڞI˹3 IwhdU<< 觍mdž)* ?U 4޳Gf΁8 (PwܩP̖@άcR]6-~v@0.%j%g{͚1 BB>x=US6 Da🢽vϻ[2j:y3QezɚVzcP̾=pݒA7c ::%0`KoO$51dTh @D- ]wq-فL8fa#"6;ܽ.$7#t _%SlE^()@6/:T^#y,kA.1aEy0"K^Um~$) <0~tS ylA]N3bìs{}+sU(#]mTHf.^GYR}Y1/i6ԹYp$b=+.Ο?FO DҷՖ[U6霚%0aKegjv'Z7Acx}'Ea ξBy7Oqtv{w}IWg#*)4_HN8m"nPa %p[b #?*sfE+ )7v!&E$*Lwa1z֨ylO% 6].#57I6v}**g~ch9f Rk5l.0!6t~}d .4ӊg8ew5޴W՚:MoMxǩtnS Hݷc{<Þ(灦J\(TTx1 B&CyĥLrKwu<:p t.zdz;pX#fWI9Fsej - sNGrďa|WB0H Q* e}|Cu-5-Jh@D9IP4iRɖXX0eڑ=8vXFh*7WRH$LgV",cg ": ltx& t Bbф26Mjrǝ{#~JOE|lDJHru;N+U_tO&5#5YRAJuXj(֫PJD*4^<3xЭxy:)nLIضir4COm +pg$b%G[arDJyfZK,4]?Y!(76K jiMpl~>xGwh,Q+J#Mo 'f_9B9<7*?e6qW_ތP8CWK N\KbfP90!˩;H\R'#3Yˋa"tYW^8E8}&j]6uZN?'C'/y0Ҽ?>wz 8tMCv}f[:+{fv;hgnW8t<**.9hNj$Dfi24endstream endobj 534 0 obj << /Filter /FlateDecode /Length 5067 >> stream x\IsHvL8tф 2cw{<֭H$L "KL/*P$[@﯋\]/*_):w_ej)Z]_ukm}ڔ7WE^ƫΎͱ}>w5VUYs\㢅XT2/| l2]n~VEaצ+O6,3هUYuN“J>aZ[¨~L O oVR鼮L8tX leN@P4yOl8򗺪ϭukqpAW>kb&Dsakڮav k6|>i)aIו?eS=kܺz\`iZVU]g; A|R⽐$*D)=@J <9pVE qIYfftH`@,T) 0*aq4 @{H;hywK 6zFq*ɴ\NBu+xIf4eR'h$M=טH۳Il u vmN3b@bclvN'RǻJxB3]~d6Vq|0Te4S> y,6:UA!2GT!M½&2+-}KjaKF >N۰b Vy7U;[-6 }çD^{pI^8oms܎)sXp0@S`MyxѷQp%PNKDbin^Kdhp݁D Lv.@4h6<d߲s;9h@06P n@x6`Ca>>Dk:LuXndzIT l}v7`F:QhPlG恆6NRG GLҐ/% Bm}16''IIktN! q޻t8 Maax$%YJj4ޥq1)(gV K7-qcmsM")a/‘ qc~/)rߙa@Rj+wHiHD;" E X"nZiN@ S(FpJѰ۩=Ƶ"滫ЇA?nd;D7_ 󯏣,%A賚-jиY৏ϝl0)I Gʴ2\s> f8g-k!M]F+OXwn<I쫜QK; F&mIP+@0?9Ws:Fo*C^k| JO-c_$fIrHɀ*ĩ 2|ޝR@\T{_P9ͻQ>m==ӝmDOʤrGTLΏ=(3аc#D槣(\̳qҎ-NBrԤ(qo J./u9B}NGY 'ջqQixg uZT 9ęOa)`7|{W4ROaݏ4&D%Kt6"}!JPƠU29 L}l/c*?P y_dm(f<0!E!'1OǸMMcV`HzL6 ,% Eɧ pSluS{ !i\UjK\)QRͽQX;<4d!4!7Ui?y18}Csuj}{6)1rlBR]^ZaQ!Iی'm7 3ys+n/+ meb[5ome^obbcI?8|h<=g*x49 Do9 c5&&R*`|Y7+/٦yNwy`#R=+ X ^u*EP.Fƙp%d.ƢKXXoHr9 ; uW"rAs!/e}ro͵`N>< cAƂ%cMB$K.)&A5͕hPM28XHi@~-.c5 y1J۔v͍ŧkieմMpWt*{zd]*d"iC<4i G0 6vmG|ޥixfF` ';a{< q(y%ܗ"B D=+e{afuh8JYoC@Bz.h6|7%3"R.X3 40hS!]63$ѾFe9R[.!J C,SZI%<53vI&a6%]iABYuьm;[Ih메|/a:,0`q&yUWBH^1)a}N/{ w/ģap> Og@ $<3igBRLZG1tF%Hɒ爝XO6UW$` xrXue7bPc/goolV󫓱7J^b. L]mg:R7ķ_dhT`je:SK OHtB^ %+?HjEx Ha!-43 .PH' sߟ 6qt;8A2vJ Adt7rz1]G_W&TTטK£_)^ZtT"^hCvQq"bdcE[%%\ Z,rqՁr.LzOrk,P_3ƿ@PQ: Qt5R'臾N4K's-Y8BDIGyvt|Po$/ߋ LZsf@mPsMچ!ܦclx)g&El΃DRgMP 2`6"R'Jgoҹ)sPLB;]~hkA^^#ډ4nW5pî4߮j] endstream endobj 535 0 obj << /Filter /FlateDecode /Length 5158 >> stream x\Iwȑ2P~"܀ɯ=myVqE V%Jk?*t^Yu~wLѷΎ/-|UU/ox:+ڜ{Vݦ*+bq6]ݸ⢕X6| _^n.>0FUe/-b ~W|4M{ll%iJ׮8 ?\[0 Ru:6k{[ta7׶ѡںoEgm#=ƫa>d0ra4rsaj'Q}}̶^DAj z)]Z=j ↍;G@H{ Ag ոBvN1xH?ܮ`LoC5ŵXh?oE7`o$uj]. ӺbッdLU\&SSFEݘ#,0l(DH喝AUza8<źL00t>$*OҨg]_CoN֥;~׍q洵E g31U5ڏE/;Y\D_F+2Y2n'-P|Bٵh .j˷3o X*) tlŧ~H =ma8s@>L+Z:h/c뤩.8zBkVy7Z0 b?lbhRT6n%GJ[o'mSUک(h8H; N#(^CBHPa[ҚXG$-pXC,Vr.+rRdG]6(X,z$YCT:,g ,,v鼀,zv V1%X^m#mܫ?R$*@)d`u?%I<˃'}a#Ҋ/=ۛ֌MR>;)-a}LK3gïCrc)ZOt`z܁)mIytmiM<2pQ-0ZUF.` _)wv3& 8Z^L64M(~*OMSz݈h@uMKDs)aͻ'}kǜ{*!Y!w!{D̄9 9%Z8߭ZV{'Z#xٴ'x׋(T?mR6Ji64FCiL>vMWդԻJy5-mT]J7lFGH<@Ae@\xp8vMmEh8yבCF 1hr:bXQiYVʘQ$ m8ǣ 7,A 1 3bl-O; N)]HF3 XCƎ P}r Gn/c=rH2 Xʠn.cԧSgP5^$3P1 EkS0{0hm$Ӆ0x;p jSȅ"+5ŒBT$J{G &`}E >ux Cl$mU,5hL6rq3Omh2L\dS}cݠ84֥吸meCIHLXkmX`XDR=tZYH.=}Sc'śr0ƐJqw=Hy yM$챨$ &#}q]%D|t/WQ%\T+u̒Ws+tεcA>:>!q\"Mwvn^Ne)I4*ne؈ N(J.Q;<鳎aV=j3SZ!Yw"ԯF\(hbwxxX:dR&^u+? Je+Xl=p ^L>rDgs؝c<H!I7KP'nވS0pV)YzKfP\>).NQYvF%^,C4< [Gb(w(.|t$!MdH7I5BX"ahNj2F8ijȬMg K{j0ˇoJret*mH` U0"HgcCo0q&oLw,,1jnuq>>m.+۲Ve=g m>A.WMD܉?=-4XO6&++hI6ɓXhx*No㪘/PTµЛ{<Y81G}*mX.?cUԠ ˉ-52,-l,(&UȪ'J;'n":=LU/ц->11^lʮYEPgUp5UWk2k*l,Y:f&q`u(D:}e$\}_1RNvsj-Yyϵ.t%l4>fu8ymE|&e3rofdu QSczH}*[Bʀoݭ'`A}k!;ǯ5uPAhۻotnc+>_{ ~/`7 Y.*z'{gKd,A 3Ou2j<ccjT] \DP'K/q@ĵ8IqR;*\Rey"1Xnծ[+:)LzGµO{(/[23y])E ՝<{*:8c'ww[YoÚX}yoK_{m"#W^O,jéw|mgVcNjMSS9hæٯ!WDwEmS)9E{]G Y_z+ؚ< 14IBCXӠKl|PuB<_%FI_wS)Q.? U-:Ǭ݊%eoWJKWݲkx?ݻ'"!xE^o{e [HIucվ%wva6[<t`w#JD]ݫmf8d~Za˫rkJdT3o׽aLږV:L^OHS؞7a?afo& zi Ҏͥ {UzA?\lQu`AVy|ashϗ` ?*],vЏp0@ Fendstream endobj 536 0 obj << /Filter /FlateDecode /Length 27489 >> stream x]9r%v߰_F H|$7lnb/fuAMLs=bslGm6=Z9Q!PL$2xo^/_Ջ4hW1Ge$݋<8po>߾z L}z?~q]48j ^}___޲vw1HeLQQ2z yhԐ_W{α>RY@#ؿ| ] D 2<8Gq:Qy'GCG#U@[G7'Q%gh£3$I0(!M=y$=:җ_8=raCD^a00E5cZHĚZN Cr, 0f%WO>0ШS.n^M;T:Ȉw>"5D*i9P/L=PXܬ.)?95W!WCzX$Hl Me$tx6<{Adƚ&1 uJqFslHꆐ&dBR7#S/e F!M2džn.Dw͏e~QQ?y6$v6͵!cG* (&/ dHm,̷!÷.'CR7t UXx@TBd I\R%6H^U\6JȐ QU~oCRo!ùqļ/u1FG\숗{SGNV1@zU0QUIDF* D5 Hiš I]FR$ }#xUsi*N:|~8^\y4!1Bc7\Hb.!SW"EsqHUC7&S%)ΐgI=pHϐ~,pH$pqK5)̥fsnS1Ū,*uXRW %tŤ941~Jj GN2'ClD0Ǎtzlvr6:j4 8t"[+NdoU' sZ֊y WOE> GA@lTPiD^OB)ĔSZT㻮!w'R/}P@Vj"6ĵo_k { Qk-ķO3_>^kHap1j?baGzot=W(ݦ|/Kuw9P̈6߾R|i3a);KFq<̯^Mܖk~o|Mb6c6~]}wß_5k~qp؂&/^+|fHR`*nM42wxx>ށwx!w܁r>:|<;qGr>;q!w܁ r>;qGr>.|\x!w܁p>z|\o͋~1CoǦvuQ~aXPɨ6; ijӎ.789XxK@IM> N8][D*,OMD緷":3vm&vvG(烐i^ч ;3\hf@>MI YTNGmZNm?ŨM:9;jjsPHFڜ5LFm^6xkdj25jS75jS4(Ѥ0Lc25jSN`@i(9[m"oS͈^&fSy;kElƩԩlJiElvCPr'm ^-Mͦ2@5q* UiF\Ԛ8!37m8^f)2l9M8^8SCM9 ݦH-6Ԛ\l0_@M.9O$4,{IS ΰ7[Og؛3.ON/lA}@ +sm|<-)huݜo& -%V"T4UFl&yJNZKL57[K 6$|EχرGX?ˋ195(D:T| &ys:]'3L9fl|Z>wi`Pd.epwq0{[?cQ+-xFk24'1Rt!`h]yF _N7fͥA.1C0,H26j)ki.crʧle!}L!r~"e<RuҦ=٫cIY`޲32&4: dґ]"~}M 䚋́0DwBz΂6E~ROKʋ\>@)jr0i=xweD<L~?ᅯcwk~1}ӻ8ƻ2>v9OO&7\ce=H7 usu g̍^ݘlGܝ!mS9sc{~3S1-ΎCߐCmH<&Hc#XJ!=iԫmAi^i$=_0E?ߐw]0ҨS+~욽Ÿ ,Hs ϳM3ĥEU+>_W\Cgy:3C i"K;e'KNס<Yڑ懊DBd"P/"K;4|\G o% o<b"K;)zY*H%'K;@"K)y"#2RAP"OD RrIRA.<Yo7K"D 2pI9e"K%daDj^2Bj =_d|䶄>\rQIfē晦lYa!Ce8( ki ^=#Hΰ)OY7-dJgdīըfO rrIjxGHUIj H;BS#$"%#EZX2EJtiGjkQT@AnPFlo4 2p]v[=DP[;z nad/ -;3+HB ndE r ]*]2׉S\1d&#׋9.7#p"+P/{4\o9 AbHԫȑ #~6 h(D@Af#R f$JZ4 4rDbn$D. ] sI} NeХ@e̥Ni$s6>A3wi$d:_>F 7%2xZNLO6S6'k,DfH=)i6e!0rrՉ\ B#7:e@s>rr=ܿt4]eOV^KW&gՉ\:}.does\l{?|_VLa5BZȺn(pf+ԡPܬgW3k݉T,;g[ay'pj#pk5*w}ogeUŞ=j!Uy%{VV3~qe3b|T G*#=)Z]߳vie+-l |)ly!*lXx;^Bxr+;^W-x;^W'r+w8;^W;r+?x;^Wܐ;^q"wwx!w;^W;^Bxku! euV$l;zq]e IUUpb쯺ᦟr颥4 tHLRpC}9 ά y43%>Z~@ 3@VeLv:АJv_ꔠdg έr@<頌#H8ʏٙ3h@zrJG QrрqC[{Ie;BBǡ%qn*LbGMUYghꕴEJ eItѦb*Z%NU{oJF)Rp8ԡ0B2DZUԫql0}:x9/?VN>ZC udԫф]iDx*PynC2h@VJa*l;{xJ;}-k8c" 3r['@M$8aNa"u'K<pG-I< 7d9xxfٶ$)E;EoR[,G 䧿X%"/v(+Qil7JTm2"{@`65BJwXYUYZ>-p=a \ ߖHBN-2pci&*')#$u 䒒l)ia6# y% 鶮@GmN]`2۔)9r=3,hދZny.1;oHSBf7ZV4 zn؉lVW5DVXYWDVtbe+C9^,׳Z֫e9>V R{w" 1qVz%]j"UY {.h ֢k4j>j{/W&^V4]_٨ʕ`4ʕg ˕IOxm_XL>]re]LzJMjedje ynF~Zx"w#rG(x"wxG(nP|yG(vP#;B!wD#OP\wrG(n!w;rG(·#7P;BqwrG(F(R2p M ~ 2g2>{2>~ n,2l}MG/'ݏA2NF%> i""(.w sʵґԿ錳CF9P4Ut##Z<##.hGi4V?!;2vv#zi 􌨮D^lz'*ݺ.GsTO+*Hʰxy" yܗ:(FEJW{q9G:b2]:Q$c _L<I0]=eȨ'(SPZPFӀlZj( Nj|/ Dt*PrrSgͦU^ lBXyon _2Y)Sy'-N7:^Tx Tx"I;Ekb!iZLQ6:H^ 7$r7^h4Ur"/Zd ɼ H=rE^Hd%BT2{*Sp]B=B2Ğ J閙==p*̞ "/$S $ue^ K]=BRWe۩m'֣́X-5azD"GL) TXSJ)ֈHAzvG@!#%m"UHTC_$B ۙB2Oa똄RRC&> B2ODi,%<WZz")2")&zLG)fz,G)."BxDKލ%̤&)%?$%!<•E.̣&fF<)1@H扈ԔHMԔHB"OL,DjN G9X%/&u!(3Whf*)32S0 QtRSa*5RSa*]Ԅ jCL*2+3|xe&I2*3 Q43@H蕙TIM+3 Q~(e*5)SIJBj Ԅ}F/ !ÉABovx(5RSc.5Bo̥\jj̥\jBPiflgk$|0R\*\j>K5)̥>"壑ЁxEʁJ͈)+RLTjLi4S9pFLT*/J͑c5rd.5GR(2՘?'v`pģf=\;T#T|F 9/Qz+l6g|6Z +oj"η6?`(Q: 5Tz*ߺ0]yJުvkOD|ڧ@\+[VF~iU9{2EUlHϽ-,_eКYa.yϔ/C0C{ʗҧYLz31'+!t>VgF~3_Nٯe`v*^x*ޡwnP;TU\!wܡC7Uܑ;TBPEܡ C/U\ޡ'r*nx"wܡ CwUܑ;TqCOU<;TBPC/U<;TqCPſde \{-3ԧٵPw27c?A-]]f>q?eELN7m VwvN1sznlYڼcCwB.{cQN!G URr .{G EDrԀ4%dlPt;j( .{G RJEh;'T\Ae?i!۔'mT\&CW}H69Qq[T\^&m\2GȀy?:PqYh(I9*.I^zK J2@r*M(=6B 6쥎˾Sd5ej.{O En*@HQIPs{jLB7+j.%4"WPsy242<%^5#D A}5_(S nfE%12)-I)bNT\+Z4_ˉi(h66:2xc" .w.;b<8e"3p8Qs{iQf[qQs{i!& @ſ#ҕ>0o'Mڨ Qr]Roz-%ٲj~*-KRoT inW#cyBm̛:rI.RGnFVh,\/udo=[|iC&L*I0)Pyb`G R/aDT\jBѹ̹B =6fKB@2qD&. ]H% L\o>K$Ie.Hdz ^)&H2OB2qI)= 7(UK2OJɹ(2@H9Dr.<'VxY20s  K=DA&HP *O=^% RO$;#]SnٯmetZ~j U/Vj?pyo5 i!&['[]5[B}MطfM2Hj=\M"aWVl*i}y k-AK)AyA*A.HgdwrG^ax"wwaxGwaX;°#waG # w0\? # pG.0ܑ;0܀;pG# rG^axwrG^a!wC*;MTWDdeF1mw̹]LG|}qS+g *9!gHБlXi0?4LƦ ?k6q03 pR6=&S)UXġ PqaS&)ʄ3VդH87!EB V6?YpޔD8o*0ҨWd%‰ ~XpTbDWaCg2Pkq+a]FhHH5܎(AWqTH#YA?iϳ8w8?$c(4( U64ShH%4U~xU879K<9i46U6:NwH;61;YS|3:\n"˃.L8W㦨ݬXD)qTeoU7Lt5zVڤIYpLu;Bj12iQ,ts_Cc)q@Hrc+dH4rD?<dxaD8mR֣BiD;V^"8w5P†1Xvm*c;l]`É|/5qchqT552^?u25ߩpk0蝊Vzqۨ8aJa@Yx (/4sQ )JYXtf(bh $p=pŽx+^THqE] I[quQzЉ!$)40ˬjPL"+aShQ(I\m68!1H#+KИX8@cT@c#(MA ~ 4,p C*K \!lJe8cJMLM_ '忦OL"4#$)SL!5L*Θ@HS̞*ϙ=BB̞j&)ФDS d6 ӧ%O{{FHSE Ȳc[ 6 vH`fE΋.tgظZM `X1t6rCI%gzK1rcepLOj4T6=-do#K'uf qnˊI^^ӓ[yzdϕ^ ~GDղZz5Bp:FbbV3D{VTLVfj SGV'dd8(NO&oze2..S߽ "~^2陮 kO*k?V*MO*O*Ozws/Jtx"wTQ'rG%^x!wTąQrG%^x!wTQQ7J;*B xG%Q;*JpG%x!wTuTV'C 'B"O=RW+qd$QXaGQ}!3ei"j+^ !B?y8$pH^F@ rH#/k Q6?TQA|4+pH zF_C)f2)bbus?9!ԥ{b)X.!$q >CҫB"GX;$DsلWEXG6e? ;6&Ngv!,':. GʉY r2 ލH.KɡB3;@R$cI(ƹCNDfFHyQ z)XJcMF{U Q?.h;c#!h4R&)(o'VzTj؍IQꇒHN-9"JW"E_X~NJ]l 0컐K%~,WxRpq}NUD4٪=^^mO3*!%Vp슞yw!(;աD2no5X@\,j"VV3~iͱ'CAWձptQu~W_vوʎ[{,_,IߡGܲc;`9*"+;ҏ;f1c(pr~g~3Sk rn`x!wrn`x"w'r^`!w r`x!wr`;pC  /0<;0 w0  /0<;pCKdFwB&dP/yAo29cD2gQ/yMё:: ʼr;}Ȣ^9(}5 C5Ador(]ɉz)j@Dj(,&Q/!WCdosP:j@zU9(}5N~AdopP7MS7M<~Fd9Q m37&{n77(4up9 'GQ7RBKMJiE~Fdﯡn9¦RGB҃L37F\iJS7&{ Cf۠r:jDN gTN>zLF5N!G%EBdo;Q:nW$N&ۚ+J'{F6!^ڈvHaME5I]fn mMMBO+oH)&ٚOO+&٢n;6mSN4Tc7nP>OOF5TP&۲ڛOTP&šdBc)KݖդJIg Jy %I0@R7Tz)J*=dB=+@HpWa]2^wBb7ߠԕig $uPR̺L;!Ե*|P^RN5J(F;nC![ΎCx7)̻IWT8‹7i9Ӊ,,poXm":E>\sr.9j۬}q!b#^ͦ!~ziHfKa `EY hv#̳!*2K2]B\; #3vuQ$dE1ui!>y3П<;ʸ_3yRX\4.<5g/ c=x@ё:vm_C ݻu;#;ƅvqn$26`tˆk8/@ `~" y-@2R^TB83sO8 \a693k?LK0gp߰1$+{ǐy4n#bӉ\ !,tM5 ssn!Ld>+ =!C\@ԙ.t0-ƙ1 /zIN"Yp"Oq>~&/tx%Nj<wh&d*.t8ܵ]3ȱ_BVb 8[т$ݵ=NDV"N^iS7Q(NWpt OQh]'RsI"̅Sz N)Ke7En7Ejne7EySdz d:E.<3u!gNd&rQcՀcceD e9YkX_"WwQG*d/xuؽ G.d/ {Zuc'b=~ٌq%uT(U~B-=[<Ž5DBJ%Z Re D|kV[ ĵOڞ V !wCWa#=Q]ߣL/,lVЫ6?ZL4ϩkyk;NqC8 OSܐ;NB8 r)!wqr)S;NS<;NS;r)~S8wq;r);NB87Sܐ;NB8 )bfv3:(f&^ӸS-.F#܌'FL#dH1B4W4+B-dY:ۤ[+cGTB α :z2yH;cX"dnxo M TFϐJ GY9 2\pʃ2_N䬕(4Ô39QUY떨@H8! H ]MBLvQV^m$ue f?oYVAq0⽵kNz ykG=FHIYp Y #[+8(pԃ+'րxo7*RJ37:β<iBRYVHl>q0g Jecd3wY^8!#t2Yka$+UiTeMBA=X8enjR$2  'Yy+?N;XpU`QJX-ĈR¶щ$(izmsWsd@2Q0$+PnGT!Jn|pO8Nyc #JB ERI(C<"hH B"waG:#݆R3<>#JCGX 3@H">ݐDv✇ˆg+yc QUk0\qЃv0E:NS"*8Wi+. 2K0\qЃPbEC)Q4"+NzO u'XqpЃ;x5^ jWaÉhJ6=6zV+G΍]:4$ǥ1 DOJPqzU7XP?5)/-tl N!Je G*F0iMi5jLt .8!CZɢOcڑr84f.`;fLɞE+2mE6j)K'K<3o\xf_#%$7E.I<3o Di,egMMx~$=m[xa$´)o Pc압 u(H%%̛"/x d9+H%WM[9 鷤Fʐ+H%۩̛"H9 )̛"H K]:EF.I]:E-vQH]Rg߮X=# j Q71Ŝs+ܓi AAu//c&X*fUd bAoEDVԵ:~ R^V{6߾|??~͇?|'E# VD{k7%lէ7#woP==}'G"kj|rýaĽޯet~ x9M|;͸-m}'ǫXmF=} w}qlW}ǥ ]Ʃ2,㕿{]p_QA&8@c/~O ovX@x=7կ}oo=x#Ӈo|آ=ϲ=v}'Vއ/7]vh&iDOk۳&[.z~>лy߁ӇG۴+Ov`>R8x|>}Oߺ+j{u/øK/O|zA_G+Oj33X#xe6)zsf0-J^wu=gs}h+[߬ij~~j43JϨ}?2ͦ^^&8upu7)|'4Mx޼cw"4>]a52?C5?_9=h?|=]iO0 HHK?9;oo_Qh#G{y:p<]Jր53^0|MէPy^Mx&T1NϨo@UW9s?Uz+1Wo>\;.g߻y5?LmEc>k}{o?ZJsx瑖X> L3vpz% 'b|asz؞.2Y^;&?'s3\;s>?4 kgW0_4Ӿm[HMͧdMyvG?uxb3_bƶ-1Wf0kᄒZBr7޻|fZ˯~|ZãHz)cXZ68gu>g \y:oءb76"gLJy~)ky~l ;#5s 4vϾlj^M>ǥypfǻ7P;7Saz"ܟ?ZbWFKO!g5N(2 w> ;`(?v2CwsJgg?;|rIk<.cpmv5d>mnK™!:^1Lsr:yZ0>ȱekb\b/ nkjD8?߄\aٜAڸ`6屺^|F8WZڊV-q]Mœ;<ⳡà-^xnDVEcxnЪٻNb!,!wH/`_!^9^QPٛ?ۮF=Nd}> IimuaTOU8[2Oиډ @j~ne0UϚ_ ?ACMU63 nOpc;Kv*"#UFTHf-vY>yOڜn1VeٹruGyN6'=o[ "/¾!p/u& W 6t^";-K:=YzT͸q9jv:p =xTӜPm~tŲӶ'%|jޗc] cAy煋$c*y/hzoBPN2܄a+| C./v ? f5Ȳ> ! G%U?a@Zo4XLJdvWP獝miQ;h&+zr5pK&󑢊?^<]yy ͊1GÐX#3@/ɐ4ߚ-"|jAA~Zz wQyg Mo2KpAiM0{oo]a@pofq!C愒1B;1r:UaGxbl2P&W v2aGD,Jɞ2KgD[kU|FU>@R_0ڣ "'wԿ<ݩ)Ӿj]h9X;$n=_fݘ1eqچݼ8(Ra1y8 ݳ۩84zendstream endobj 537 0 obj << /Filter /FlateDecode /Length 5180 >> stream x\IudPNF90r>FVh31L;taS"~K&@U7)QH-_R]U_ݫկz~wW2~*C+F]ڗA۫e0fUUVԪ Ec߽_]oj|SnVbRm]Y&Y*Z/ Ҫ.}}um\xOCGf)[ ]][liG5u50eMaToj_ƏUL4ma0`i*}|Ol1l@1#˭$vOZzٻ(#uvcZh͔_{9^ߐY6C~8.,oke<2F;87G 4iAQ hJ))RpP; !\//}ۧyFNcLuo4sIikm4Iڶo(h"pUxF?:9ۍt N0@$u!0qWv(=eA݊׫k0jUn:PdXaLE#73* lq2W^8u J1uq|<=؀@]Ÿe)Ѳ4Gñow3XS+ ܮ62I#a`UF%XRWwNcndh vp?Ӧ<"MB< Gta_,B(^99K X,^:P&`v1 }]K"lEn.ȳ+Q9OVFa k&A$5}2S OW[vZjZs,S$}8%.U̼]U(z d>t1]5Y ӖL9i^- `3˜s~7MfrsG upr2(It’`f[f3xws5nYG$97RnH ̞ef(=Gw)=h\$;:ȖP~k 2&ۤz !}iMV^P<\VC:> GLdz3tpŷ Hc׹EyؿVk#6K>qxs8 ,OSakκu{r' ph't{0HbKj,'cA~V.3-T\*[g>_⁄вO"sL* ڐ;|`h s(4[@މT8i]&Qx~^ 8Kp54 9 <׳Y~ GbܹY`JrԁI[Y#]  yԔuQ5GiTác/AF?ɖz铠-̌5E_#CC4@\򔂿eXٷW|2a/4ұy.ιbߏͣ15J"0nuιݒIytB7ҸJn*D%C%D|Kwﲊ54u% pof-צ`Z!6o͵asL'QO:,UXJ#J-B+8@-|cr)x^A׫ʟ6K Tr+RAf4.Ek_"Q>J 1vzKN*XiX8}&w? {]Gc+xIX7/3e~gݍ;渟e=lGg_Y Z*71! |AdUT:fjhϽp+oo:Wٶ烨C.Pz峔̊N[{%|&2`t%V1Ny?\x0 B:Scj(>Y󹳻| פ$NzMd1i0;I0u/endstream endobj 538 0 obj << /Filter /FlateDecode /Length 5703 >> stream x\IsFv?mPܰFvL1mY3a$aBUMz-| T5VX:4Q{/\ksYEyy˅_/?]__MOl1Cn]^Y]vuצ /\0jޯ*MBc)UC뛦wڶuu]ũ\X7Uv+WCGݑFSm!}!8/6w (vӑ8Eݸ/Svi~>]2Z~2-+]_x2.WˊY[ DmQ`~*~^H]5L{6S2E(_t ^_;Xeve1㊣]Cw] Uvֺ̉75Mye:,~ ݶ+JX_زt_EAӂ0_e7nT&6$7(nQ2w+[uVWSg&@I%J u&;t㠺qe\n_WW [pi70bS S >E-Y!wa\#\d@ m/܂.7H?x(9(t!s6fi/QiڀeׄU7W7 !Og-E#f{0Úq28k"iޗt6WoV=NKGeJjIl`Si%SYy&vEOb9}oygجq-ŶUkVK]\PSϱkgތ-VCЉ*4olpƿT㏣jaGގ-X*zhҘ,ڵ%>*|Eo@?k;d6$B +YJ%qJMw}z`D.TŃLڌdXk!3ZlqF=i i`!4jeɥ/o6NMel8S+ ?=P*moئKjR-W_MKP/دkgK8i jL#kOV7ƖD?{$nT0s$y`8d$vZco72^,3kSc9ֺE鱈aŰYmXԕi 몭AVk Ri[4@F LRĠ& }PZP:X 7dx{R?s|q`dZV@ YдڬF)hhyA ȳ `wj̨ZaoRoip"WOߴ&ruOʠ[ѪKRd47QpUED %t/>o"+ڵh*w~d$JJ\C.sנ_LMbG`,^)́5vXiU=*`cJi)?0-bn#Nk tqhW#QDɊr'VE"-x>Uߙ:)1BAo* p?{0 .bGo[= %qHXv*mQeiըT' >cѪ`[Gpq۽"ywB*;pBjG0~LXF"<]uc-fwC&-P^Iðy2q. 7c4z DRќV A";'3=;J38vlW^Mb&& z#m$Ջԭ3Ci kZ;k)ŘͲ5:3—0@;X7e'@O{4ԑ#1FpS˜LJMM6@_`+: dũ<i}^0π>ZrpKF[x2| t|]IQ uE.N%4 `_vCr}J4֝aH +3 C}f s.zZ.ȓdw#[dDt .$OҘJ)} ɟ8N@.jmhm|$4 A ~lQK Iq`Mr6D}X9+77@vsǗ،NT,)OEڃ&, "mar#)>v#:xLx'Ex#l)[K zڜd)  _9 qc`#@. !Um"H$/GXsqsPSSB= #Ŋ'-=XfRՔT&V6/xKE=:;?Io$(▀P~?g~`fj/c9n떌cڅs5g{:stL:(i8t+r%[B=g# <e@g0Q>8X󢎓k-'g{sfe;clL(] !Nx`C"ϳȗB\ ^[?Qh}e+./tceS?t@?\PåS7_`3@7,~7r ]7lIXF\H$ӎ:SȄJD9|eVi5^sP]`zt6=՗aQ%AR+Bh>o!0$7einQ`ܙ[ lhX8'u<ęDN2VdA p/S-tpx)T[O Lٍpj9CDž+M;rlI0t,`7@KZIR >1x=˻Uܺ{j1v83}3I"ϞEiq;%s@xPS46cfӞXi"OgFۅ]q9VN&=GE~}K^aB}i> K'j]9=瓑vu|Qho|yvXbDwtaϯIVCamfui3Bg(Em͟ qfZC=4V7:#4k} *ч4oY))R =D駆cLLU/3% d~6Rb'E,dFF ߡq$3ȀWh.~noXj&8~^1q!./o&h@endstream endobj 539 0 obj << /Filter /FlateDecode /Length 4264 >> stream x[rʂ`R"~$.qgeq@< LA>; 60)R\p0nw繧{>W:/ڞUg}{]mry*We:9wykWYai#T7.g?߷AjiVp+mS\ӅkTxmbы:g^WϚ0tTЮtSVf߯. pivGӰU cnr=gtvŻu+V-B ~HM[%jj}Ԥ.w0;)|lXU=)foC\>Jal}/|qCՅÅ*_\uQdw9Y B)JPt6h4zS⪤T]jߟ]'^т5$Ѿh#i8)5i;hpphB+eD\ 4 pnVǟJktrH^B"M)6y$rrZ#Btx|l*rI߳U g^O LrBnKvPu 0-dnye1_V 3QdWx2R2hZʂ߆$C:8׋rS mPNy7%pzfh=ޫytHmߵ\o(;Zű'aw{ 9g;HD:$kvcBʹZH )OSb~06(vv8hUzPs:ш>Z2GC=F1Ae5BE r4Sy: Q^ua=At6}62QAE uVZo2[%F˙z)rCE1m zt|Ośx)v4ƤBD24@ߎľM݁` !)_Q{~>&GQ妍*:~=x>b:fA0ږ1[>&}(_rY;X@jw jg(j1Z;c)9-*Zb}|^Mc 2*܊DSc %3oNkiYeߧiɈ"h1 a$`ۉΫ1y@S*>š6trx4/gLbv:nG[xn8j#$pӿJaЈ JCGzpu{Y=><\|GS(~Ja{^ ś[3PUikDCYO4/*`*|E)sӻ'p<s̞ *&TH65#g滷oզLATM7PHq,BmUUZ4!٭ԨN| 'a*k5'RV7ZNv/,ho]jDֆCEty522 pX|i@ZM|RvM+vNhTFи/I6YkN颛}FL|m"95dT)"^^Ǚ@_72]XUcNELV)Qۚu}MFJ5_fxk!2TS7o,j/'is 1yy$!~EqBZeLAZ'3OerIH4/ 3feCBuNlT _iy$"vqqhW ,z'bJ$G; :ʫl| jlybY_ɵ LpY" $7sq`j(sMԡ;MyH *RR7$RXXZwDffQp:%Оp1 @_:&&m,–3 yjVU;Q%E N""0)}„:cħn;GLe{kE.EJ,X*S UL~X\*H; <C\#9muh}&/yܕ!~͗ZIH ]E &,H}#zJ:VYFWE 0H x $}3Up6xٹZs r<:w%z|Ml}DJBqhѐ_!Z%4<}-q$2@v@ lʘx}=4@R:qh3jMdM}J#ln]7ͯ}J!Z'9Es|`+-G1 y:ÌTV}J݊vى. KM<)_m㱌eS`{ yHHCt1˃p$őaçnw \A@e&n\HPRR]RIOQM!w͠4k DkG~i@]Gぢ)g^բj'")cXy1, Qg` xw5!ufDOVZptHiuE|kA_H<@z]76qX?$n&q /E+aIQOQǍNm/\h|?t)Q,X. EzqܲzP Y400!EID~=FS, 戰tb, s_%N!ᴋxXf2ok8YX_׸Tk63/tOQ65|K?I،a3i&C1 &Oc tDz '*S=X@T> GSZ`Pq Md2{ !(a_?$L1M OL :[L/ظf*#pR]GZ̡7uq{o@j`Kni"Eéy_dG;Y#6V kUg7hOJ0a`Lzpdu!+xiXm/I !߳19o%vfҍz:xM~R5o)ڑ{3{l|> stream x\IsHv̅7Oi7#|⊞Z(J- @v[AU\x^oy׻㙢_׻?^)OnQ:Mypaw~;Uձ;OkT㛪;^տ㢵XT[C _ݜUF]\|viԵ=4nx~;^\7m?VU-ث~9vើXׄFU7/b .n6i!n|R7r}P}oHxgwFmn?DJӔȷ/rwni]ey{1&mwH$S'/NTjӶfn7(U}}dL.=m>ѿQRvc~Y: $1vr8Jyd:C.xBDoUAVqבvDk=0  IvtF`<)!0gb;ĎCk']Tq8( ]}iVマgTw7.hG]lu!$VL{d9EMeZn[W^"ƴ&rK!C#E{~IF0)Nҵp_%| PUP@])ڥlWs•>H\Y1 xiA8)p. !X7 .R xc>md}螊/iԑM7!ڎ9[`:"qsuvQa1鷰!V'3 4x/bCk2hjG46节1wڰ4 znخMv;R-MjUx!{0г#9%b&5^kA4:ÁP^ (x9UtKp0 tP=+bK' x-|#v|hyO! ~[+ n|@qswl*=k䗣ݛ,ANl"*#/jlJ_mL1Z',]ףrdjH 4@w[][P4A͡ OH%m[~$kxM Fv @F@fU i4Z%TwV!l* @f._X4e 4!W G`GOH8 p m&ͣ uvq4pD*S,Z4DS&0Q]SɳbPACɣtx?5 n/NyX~D^=[[(-PbÐ Mhu4kߊwibMДAP{iG{.y\MŔ~V';kLLZ@?MwvdVp _u>ScŃL4p[|>Y\fO$\ԋ1`MӠxvOj5ĆtX^/\GMi`:)*' ; BLc&pH<@5Bq@ALG)ƣd ;|$k3Pb$`E.J!K2,QxЦ9,aHbR@oAW6Ѻ >2)g` =.T:7fzausN^WD< N7Al&%`w:ka?]8%qmS=#PrEwej:3nxF2\*!>pJY=7 `*TV:^Un> 6f&u(-ֻV >:xD/]:]#Dԝ-h_oNXaQV0Vyabq4~Xub*2H&9_oيW.ցMc5Ad( #ső:r#=N_,-%_3tDL`S:_Y+e40?l.}kRТR {*i!$Y1IpDet D`uNy^&]^tBKjQ\Kpl6u\ k Ylib;D*]Ci5P@肷{|$f/[_,ÑY"6׮Weuq8&8qE/>-6ܠML);" vKp*L@)\6E$`-T?(7*j|cBtVm0i?9[L&%۸ DuU/n/F҂MƙZ9Uh?rGWZE@*pX,vH`m"@ L.\Zk?`dev@SH8DOEKatD=Z} C*;Ӝ82sYj+.4mʝ*Zi/'4Z7/@!R9Bo7f3Ke㪭v X({=ܩq! +u0,H˩%)p)mjqV*EŖ)-hlyE5xb=vf?`(HoF}*b|=SNDRxųBcRI 5PL&z?Dz;jq߽-<0Q*RAy:n;aWP.[1I:a.z&eIt%w?vDThI$[u*Cifӂ1V@ٻy%f,ybJ#UҤr0DW^4Ǯ^FLb@iՏ|,GI8ϔx1!xvYN]uo D)c´_؁ûoYf_imeFmBs0er4fTQr>λ9h $@%8=D5%[pR{ ص[ ?sY< <%4e>&hRKUP ڰzw꧋;]o%8\ߖ&SvE?)02 +2ޛpt Lxt>[k)1tvA0UB;bjҍ6,¨MnJIՐZTi2d#h˃N]'Bdye%+=Xp6ϟKߗ&O)qU\PÛ4G6\ύ"X,N[ji;Y"^fIx-L97ASaKpa&LDI@[̱d{NU@&8- 81LB.pgZ^@뗩O~l H_@Wh2?ц7CRϹY=KVʹcMC^qE2}Fg̖A"W躹D,MBzpB>_P7":|\7[ky15y E60̌\x~gyzndt#jdxzD" ڥLt>vxv[)o14%Q2c: N dD,1a { MŴ̪GO"I" eixnkY[E_N9,ڸ]V#}cQWR3We4endstream endobj 541 0 obj << /Filter /FlateDecode /Length 5208 >> stream x\KsF{on47w ۱ӭ=@"EM2Z7UU; PϬ/?Z-R>\.ׇˋxR.ujqys}ԢT"+dEbwlmdkg*͠n0j+V2ҏTe^&fΖerhQBVae]\YIT4-~&g`~ج,JxEq  Fx8nCmC ˓jwfܧkΝk _j1vfkw;K ΒӾ n\i+}Z/WyA5&Ek+t],5tc\x2W~Kj4V]i%M VniLLz_8!EٟKٝ|?>k0&7y>F{kݺXu' n /{bG\(X_F8(lxxbIAYF DrT":r޿QMFL+٬v贩eY2uwIUs PD¿_^1:[/f  v|lj7M01YdvKZv-A]Z[u_Er:Dr FI=Iu7}оҸQ A>c}\wM[Kbl4P2 A.`B`h Ikx t2)IDɵujj?E iOmL,7Ab3>rJH[Z'Ub4O5cgyT=VR߉[{ ԃ"5^Iwٱ(" M78Ryfx&[~F>_$bGN itՈmlbC 5́]m9ġk,MwKq.gK:RI:x/bӀt*KƂG'v=)c0 8lMĺOuڌZւ\0.FХFyI`-8#~Dx̱U! `sxijTg+XwԥHϚq %_ l) 62+~@r-Ȋ/ {#}b#a+ G̅y6^uѐ*hHyݭ@ETVJG|!bf/XҳDCC"1$Muk: u 7$A]!7?u/~wA'7eo<ϳzE+_0f&Hb/Zp`Ⱥ,dcu@o",X޵M Uz{§\tw`HlX*mZEqC`-ƭoV0&: gA8ˑӀ*& %]_%`7i0VuHઞ6*lD)rXۡ%33f\  69FM Lb\UƉ:z]RѿF4Hr ~{:K]0N9 GT>=KFKv=JJYn&qE..,HWKcA&IOijU>< ; B"V&B>-Aʑ9Tt'$O-yh`:b !z}MҜ.CLxΫZ rwR4)5l U) šb]_1kPb` *oSkxLki21'?fL bL[:*}5+TSBxK-y)Ux8QԽ&Gx 0hX+c wHviT7*b+$@s:Xy.̸2 V׻Vu};/eٲؠЙZE a8`Gk_M&B7=H~SѝA9LɄte ll)%9a?yM'̄񽵓<ӛP$g1$Q\` lZ 8D=3t`fO}#FﱋIr8:sYy7s&씲Z=/j44؎!@WbLV`zro' =3~%i沔rfB;!A^`9FaQY uq3YτpiDe7Ĕ4(8|?8C'L{uFR,uƇ/)<8/i%175OV]"xwױlfU0Zr;I(ݤ?=R>c]p4)̐m}d`uXP1Km ݴk,@,ŪU>U:kZ _:WN4zTiM@8LIҾh(J_~'wzX_> vZ~ K(=E '%G<| h|Oy, esQRN1봪?>cՅec\%ߋfOy`IgsڣŝS`f4%y@'auxDYf"EIOL:jOTdƳumrǫK/0[y&}|}8Jv{rvh?n>_C iUQQeA0~9%)^h(T{`Ia`7 Dvfԗ0 4Qթd GMVۉMc5GϕLȬRgɻO$E2-2[w[;5T;(0Q͵4Wnvn[}our ۽>`y'rg*y+FA>̗>`&INЎ@ .{mZhPQ̓~UMgkR q+^W9PjZob3A̋O=%= wj2_,0ƭBQzOœ*;@OX5in0ç#@0\ d2PJSF*`ؼJ _4 W= ֮0iPZ68`PJ@篰"GV(IomtaeLNKuهig*UڙHRQe4f%%2K[^,0{Ŧt'i߮F1u)s|o}˜D-HT2K~fajOVzYͅaq 7xLU;U/S:5i Њ@= f[BXU<*!}U/y缀eqnJ8[( hM4@ Уso8of&r_T];DtC6x/.ptXe idtb,+"ٜɯ{|Y1DApEs>?FWy6Wxq `ijM1?Ӳ\^d |y[wWM#~zp"–5?rLQsY.ѽQ߹l\O!Mn4Er3J4>uueCm* o8Q7ϹP1qKC)&V5xj (uaZ*4LP|W:eQá#! LZ$%jŐJ2;cCԠ 8"w&+ chN(ݶQLNR8ex 0J>M:w @Ƿa\"v~4Uq\[xI֟lqAx|޴,*Eg4bcnD Z3kKk{Cg(bwxSE &y-:+[ѿ_|xn[dиEƭ.kj tu[.0bet]~?*y8] {l,7sMw[NlsrW`p H*Mmzs7췈t@{=o~V>t\ǫ!NУK1LfhMh`T6jKȞIVqYfd;ю)0$!d*h$>kat5S75KAX3cA0"AaX؟J;@[-'Ika끈UV*rZ~Vp cL:i$ʖx}t2\NL'[+6nqK_lnr"/ e'ׁL;8wcGr1xM3 VvoMw{˺_V޹QZ'?oPTuq!-endstream endobj 542 0 obj << /Filter /FlateDecode /Length 4875 >> stream x[Iȱ_xs#BC|x$OXcYcHucMؤZw.U@eԖBZrrr.K{{Q^^_P.WW.xj򕹬m^^^V(Wյ*}qh{Xոh-Ţzq; ҦTj孭p*Ksv8c+~xN{Zg:e~~z?zqW7R ԰pH׻}wԍ*nyol{Gg/r<;K2/6)[y_Ó@s}Ob^8Wa_}m:#9ۣ^kC ܯvF,|mfWV9ye]tᷱE;css ["F2ŭxWi@mK]6DR镅A,Pe ^]mS 5P:}Tj*AD6wJy R孒3}qC;p C/6ۨ٣,4í+t AQ[b6fS nPpz獭Fpkq +MeHt,y4Pѣh(]#I0ՁH A_ ~YOF5 :濙؄8X*F9 ܤ$Awl ǥbƤ/oz ENF(SsVן@)'n8->4@NgsiMtěicQQj4UZAK.4F7<7Hwq QZҺMk l! GrDġkBoI/y|VU$2jUGEY)W0__B4eCJ `:MY#?+O%!DjD~xX>t99G{m*Wˊ'jM{z6A`8 7%A@RFܬ1vӾxv+S&PHi9ho&"/2`3/ssp2r΄O0v @ҨS'#EG^Uvgc+?oӬ5&AdGv;jׁ/]\ˍCބQ5AjE:6W4h7ο :Jy8Sk uq} (]T Yil.#5y+2O  śpRMO@ɜHܲ!iO*r<9[uI NX\>FiuԠ\rKa+'p v/ֈ9=AMv=Y߁ 2pnq\)p$s6'(*"̦ uXM.D>?s(T|IѴƌ+v-"(`38 Tq_G0zALH eD6( Z|c`<ӈLw]ߏ9JvFbW Dضr$ฺH hd~YLDWAB!N@M6!Yv/0hJ5b0ǘ_ܴۏ, v$g㫐Մnt6ѐlw,ߧ] @V >*5m>1c|z^c 3cn=JL+y.4x$g}Ir:ݸf)l3̄4mCP(.l<}wk{;SpYHc QĞ?`e:8dc(aB:`C2XeN,-e^bw8i0Ì& 50:NSQ::MiMR 024 6(xmSAI`w)yۻ4hA]1x~xuP1dbH2eavgj#UayAJi͗fХsCPw,uFgJ?,Ҥ覍:xPǕuw{n1a%pc!CaXA NBquṖ2;.9)hgMDPkT \-9ٺ,wc4횞.(O t]w32AIϼa^]ɛu<0fmM|U1ͪigLf҉ťj0i2w"+qpU/ FZX@~l?tvS9/wڐ^gEO<j~l,u'n)RMxzWEp "br.!-2g& ¡fYu>nڎއ|˗kRejS㩩)5Q%͛N ^nn:A8740 _(X-ɊwVևdųv,_ PtaVʨhaR͉>eUyPk\JID|UʯDXeV5AbKwٌklVAkYIg=BP2 >0Ҕ:/}.ޞ6fZ3!b21U!nH v_v~p\GMmgZbbvմ ) hb S_n5G9`ŒQyC3x}wN.Xws_UbV5&܆mfp6|;X`_Z'奫z.uSӇ@'z.鵢^$MJ*MD8wizm O2[q/c˞SsիG"]Ru hGڃLyZ0'!9\D&?%Soƀufeu-MS#;iu v ~haچI9Py/v7Ei]qJblסPV\[yL}r1h^uJ/i^cV$Jy tBmUz+JH ϚݤI9qlC Wmsq;YnEec3*yE[qs_ |})H.߿J $I1V*Df_$YUn"Ӟr%N!VE6̩LZUh$LQ޶߉N ?#g(5endstream endobj 543 0 obj << /Filter /FlateDecode /Length 4635 >> stream x[Is7$./4 U9P؎ k6ʯ[@K^e~W2ǿn_>^rn/T^W*Q,\_d.nFJfܮ/~ʮ"_jKxնeMxt-l-J`uKk<\yE N)G i|?:^`9j\!۟~`Xl(mV? ,5aHYjN<⎥8̪,*v\闸aZ<e5{q e[|)o渇syآY2_(X$uZ 9/(Fx hXJծ?n> *Z,2V2 dU:ZW9 %qd6 q~CL 0Uvj6`Ǿnw t:Ӕg+ b]e&8ުu3R@c@h_@_@2abnih'PZЬ݆wK'Kz%$U<>Hآ/ٟKĖ%V u@V%FӪLb9FE/x~ 7VN> d`L/YC5Hc=>Pڢwس 2hϐ>l?oO@Vt0 Y1>I*85ɡZ-w.9XV,+~7 tSnx X_,]LB'QHP‘@t|@_ / }S1"1|5zPqYYӠ[7x5n |>Lǫ8vßյx2I:u-dgy3u<~f7?YPIĵOaX)x͋vAE 8SOd=d:luO">lF;{^ˡLq\y,A ŹXhU$JY9"9aγU+61)tlaH39jW"p+:XiR JaR%j5%8d@jp >-V([Rsf~ 9lF^'BwF%kr(هs;zOCƖorx+gFٟĄdB5<< ڤwz; QQ-* ͫ9mS*0Bw"0~rpRFdhyv~@/X@Ԍ8r]- ?xC](o҃,k*{lЙ&qKCic& tm=a 4UM2ez Z rv$8yX d<{war,"d\I]FIau}4N#ߎKox) \A 9Rƒ $/CYh !a:3c{Aۂ?KAKѹ|58n KAcCpoeݼ] xKJnJ£;E^RҕwƓ][E^7!h~ZD!z owZg#DdRvCUUh`3p]jS+M`&W(r뱜ԔuCpW‚ЛF'b>,Cw3bj!(wLA#+LЃN"/F+m1Lxp}|# #?=  M԰u}wW'0eQT&wUʂ^1riVY^ewYʁzqݟB\ղHfGJQEb.VʕRq& ) a]PUH"9:>,Z( oNy!8d < рI Ҳ+rف%?ŷJ\0>_Z w6igfGgBۋ]pliFB]b;g~&eqWG1!܇rFnx/>рDR  )OCuOeUjMÛ}*`j_Q|m&|c8]|MV.D: ڃ8f`'r"COV_6(rT GήhIQr(C CT"W̅AP̃Sb7JE=rw#:0FQ2lzf^.b144Yy^MЅ*#O99.Q:>Ő T 2Or4x*)w 8BaNbS@t0뚇p0lOF!92؄:$&Xl52ʫc`nS4EYvJ:x ˩L -RA@wT4%u=AXVKTvm<|RYo M\{4u̞(@j6u<-O1j}!3֡ʏ,xBHYNFo`LcmP8$< (IM Yo^kLsLtgT$$!^mpLI+)aRcTu>d'|DikU c/8/tED e+g:P!+:?t m szC/.\呵,,0َT0hn 5{ = `XU{4xPڿK)q_!0q])i:RlCݥM?!WSm+{_>vԩpEWb?P.q?"MpQu驰PTAvMւUe6 3yH V,wR}㹻BK΄|NnA(ڃxj˄! ه{7\e:;!!]ÓɊ{C#cwjK SoѴw Μ0R(0Lћ,0} !;HM!J8dnogڧs4#'&Jo^W$ >9Tz+Bmem? }iOZ0 g*^UqbL";$]0.ySm*u:d$+H{*endstream endobj 544 0 obj << /Filter /FlateDecode /Length 5016 >> stream x\KFe:6N4B`;7,XOHf͇Z_^τ"zdefe~@~].u7W+E^o*|eP7wWD$bn65*U}q<^P,u}͟r91Ϋ2xLD=Q'I%%,VRXTUfۗh_ Fwj`>g>!k[D]z|oe4pԠ@!^8GOŋi NUp[N' V f)C} e|KF PU=`jC;PėgE !+8fnq+ 0bw``upF WSLيa8 nOQ/6~*'QZj1B^["v:~(וJc>M }8k0ckV7I‹ L Ëh"/SZ%GfKK$R m> r₯PY^c , ĦAnƉ6/u6r1,nɎp>T᠑oz;CNt募 UdR)u &1I`&_[Fa(^0d 5ߌPؕ.UL2: }~àw0CG.'fnWcD<4%@Jg7C@?ЧR[ig׎:p#$iֹѢaN%>񺻨QyRi;vp AI]@Q k0g$#'Dln yx$48X\RcbTWlne{bXU|hj2jȣk3H6 P(Az dW!Nq.Am -Ba/*GO:;[@8`wXa?%-$ƪ ݉mކM )ъ^t~Ӎ*EqE봱wdl!OCv+4Jj{{4Z6Wg]@ZXx WXhJkHnWH8E-yo(W&x2 xi TI&!/a.&fJ a~K^J LP%PYt>f 8 rZ# Nˈ7G4 !i~/.bH$IWݥ8@&Fƃh6&3<_y(DCac4 tqx9HqnԂ{"Gc0š6&χW̽eI|*{K+K׺w-V C$ <|_;)~ l↯JT)h||=fO'ca-0؈%@™8#όH-)d{t'%%yο &Ni=_.M{ +jJdc`L`ds+z]|E\N[4u; a+-r `Pl jsζHhYk9xu̞DQS* 0 ܀?^x :HawN] tYO4Srq?ϒ3M2VIFl]&ց40qz9HLNp=M^.a0Ͷ2hT(,RfU?<"Af qng!TY젌j,/(7hf؁-n`(FOb 7W?^q]]׮^hU_[S.L]aBs"`V&/ϳ븀/Vg7;Ql Ā^d!&= /L6^*[k`ei+%r0&[Z$x ΂]'%sUqZj K?g{c6ȑJf,"8u>F^cُe7k͐:Rp&x-6` re#wnOt< OyMdYᔼu)|yz*{,$;!x@Fwn'ԭdgUOFBWC<lh}] •aݼ<ݘvTXԲ 1md'Ʌ kEas_y`ܚ=i959Tʪ}?ڣ>w@.oJhD$ ]zmh҉vJ8ART@`%cFBL8\_LeQS`hk6dL)T6h>ty !MW A*K\r\$Df{?R/9R8X [wdBw_d&.gx3 s:heOu+ e5mZ^ߑ WSf* EbGnqDe)N,J[2)8?>SĞN##Hp6Ou140_Q_\Lv1 p8oɮU݈>Zn-XnZwِy1+vt\?[~Nk!9m$̒D 撏)lQIȩ;>]U]sWC~&;5S8ѩ;"(O>^~q֋ѶXcon7ۅuVv+& >";qZF=3lod!mVSz*;N*i)Y"R.z*x~&u4n\롇kGky+cB]I/ƶWטXXaYO9qq mٺh\-Hpx;*LDWf\M/y#^0zo99˸Qp&Q%S87r=WSm*ԢpDdښ.DRz0(]K ~p`I٢!v*/2"6b,m +.#M/!}V5r7# cLDUcmz439xֽ-^|{ͱ!I~[Wbp#h9;` :-\#hbx) X(IT\AfݺArL#M+ޤJd3RJm㙸K9E|fDobq5v-Sw"ltݧy%BXm,er k,Pdk+b8Z&/tU+pX=>byܣa *K\ޭ69+Vn2֭px )f-(d8ч '9޷0[$we z70Saײ@ n<]2-~!tDdV% wKt2MU'̥ylwigO6mhxbc?;@L!\Ӹ`0Vt!9G d}[ X|;{& ZkAYY%rlRnMy#{Ywf)2]?, 9MUa)T,E*`D Г P!Dg##Ks&H.l:çN]s[OεE/WiOD xk=ťc6a>m-vY@bOzЕaru{KqEaLo]gqR=e4iMlzk<肑l);ocTqؔqPOhzGK!~ 5՘]5ZxOq6`&wB*ecUMT2njqxn:1e+ mvg~  JAO.}s39À%hn9<.\bO+!k? ʨ+ ݷ;da%;Y/Fb FSdv~?yendstream endobj 545 0 obj << /Filter /FlateDecode /Length 5436 >> stream x\KwF/ZsL6z蝓8g4;֜,Y@D h~GPRb&zܪ>J]:۫zsUFo^LUjUUv}p}뼰*ׅ)V2׷۫_tUdiu<ߕYiˤ{w4ڬҢoW*_Zg4KeVפ{X,uRe֦,,wLS6sk\;OeJ nkGZ&4%[ -N"/ة,{ 7Mwpdɺ-Gћ[#yn\i4OPe|"9AykZ=xʙZ]׷uu&(UAk3يG.V(d!~ay9=m/lZߵ~|S%7?R8v>dQK`~$&7:dy7OVZ.m&i~܈ݝZGbr*Gٚ97"\Ö_Tl=,=7wZ,m擢n~zH<ߥ\.)KtL1݆e~548zB^$QᘸpV zž6~OK9ZF\׏RòAQe&/ $͵ ;{Fxr[Xx:ؼo r4a_o]O?4& |9Κ83N*co}*W-^U&׺x1rP8DCSϩ.Lx4b9;v?i1!*I1k<6HH Mse魅?,KRՊO:kcݶ/RPr9BGDVve7Ǫ{+9#85syp8>@x/EӉ;o@v}p?ejdajo̚]T|_oֵo::졭Q#InDp,UJ{q$D˥x894(B%\؅nf;cso9Ļ@4"?Hu]A=ӆy?py4}B!I[Qdǧx󈉕|yB 9rڛԟ,&y8tD.g>};M(rf6_ 8azML`* %5jMB^¸Q4"Hvؔ#v+Bi\wQdžk$ D}Jhv{+7z*Pצ3д_L3VRcs]"Ӹ¬lH4ja%_P24VtG#E3F9HfYгxI<$$yE]@D٤=FOouRw@@K06yawʌ7u kwkB-\b3[Y‡F qZnɆV@(vy$MK;ޥLtƠm2i@PB:ta^ 󇆜[eM|("+lrf -8fthd8cHk_|d#Ti ٱQ :{5ZǑ%RyY&\ /%ƛ 4B<΃օMtdOpiV%<UQv&2pNkZhS>}9ncĴRDmbAԎφž9샄X.>'"i}T"!Ns kYXҲl|- b^!YáRXrlj8D\oU1s$@2?7,_Y7ŜK *#ۂ xq/qeGTa⿖ 9Pi9#ufO Ѭ&GN oYa9ʸru-c8F#En} lڼT*YPi 7;o>ՄCCr΍Kgh KDniҐL='F`e{5ɟ7Exb>`CWa^/{f9gr"H3zx:|Y &)V1XߞzgյUCBZ)[gs_&ۨͲ`6' ҹN`hJB9zsPi'3ιP%ί1'gL-J%h2vhoIQق) ֓ Go(泘*OU냧 يDLrTI;o ,9 nWHd[iʉ. ޵JaD:x5Knj:l48u.rq|5aT.EOoR?`@yYZ*)@%gYg.JY9*bQ'FQrΔͥ(b1Mv'!**ۼ Y2(1!=~³MF`&웩FEv xSt )ha?Ŵ*kK8/$IznbKk f W-*T( :ʢX%R"6E&UQKJk0ט8O c7:~:s秎 L~nBy~>L§pNeBRRJc=X g2OХ6ǝ84^ f(O) .S239O4689 fyD-Vr':Rr[5b'?2q(6((#K3"(/6i0c8љ.1p uY(}al{]Nҩ4gY'+Wku91 8%FXsPg:8pdĜFrܞS(ҹe[} '5w52kz)Ys!܀?}'Y<ޜ2b!0 sr!RjD>7g7=O(!݉M?Ɉi9>b2JA|;pkXvn-߿Ӽ&vmp{fo3shε՘-&END/>#ֿ6;|.?'QP;;q?Y*B_~,-H/]&*<ȸoj+k ja,=n~M7!-tl,"), {^x6n22{ULcQ{*c_.{ Y^FAEQTOcG~.SgIʩUIQph0){dcdqBKpص!p>,>f\;.I#N~6Ń(St9+pWELJ'?vu&ss*PV9Hђn'm5ͅI"LyZ,4kzzq,D%OQ]bh(Ńa9ì_@d\p %Nvh2d'v͒\Fya (r* ]̇S,9:M? ֆ rJBV>5rZ20p:~TgT߄ahGP\hNM8+T%L0vZA=K6k⚞AH_@ r&Pip, S?13r^ͅf;3~3,9X$y iy;X"BSF{/bܟxeD GAuښp~*/aI8>8 ~L5RǏ$~pm⿕^8@endstream endobj 546 0 obj << /Filter /FlateDecode /Length 5177 >> stream x+t9?ѵ^ٯŏì\FUj579]UyZi-`nmB- <_xvd)si+V=TLDRbDDv㗅12?M_L0sٺ@aR 3flRgoIZݯv_!ulR~X\.,M":@iLڀzlL'?AHf $d lt!a%N^,WD1RbBhJ +="=Dgd,Sz\G2</ tȻUL TY8JYoJ\$WljNk %!2%<䴎e dd瀸4a1]?GtPUF牐WHV]V'0FJgj"Z=c]9W0xHIy^?6H2.ض̈$ .|NE*<O 4YoKuf綉K2BM"/\^ii8`+Q\vA#79)5?2 l]E*!Sf"2};H?"!߸O)\j0fm#H%-c \qۡfК!艟_F8 c-iy%ױs'\\s{u4 S۲\H0f6nlo"L\oV{Π=eEbڳQLԟ1!-{qvQADv3%Ej;z69I DNA-%uؘޯ>4UPf*V'!sƲHlwP ǵjIpatj%s@P'm^9 8 $${p^h=a `62]eI:9Hax?h>70t(GFź!KTr6hVfKdI=v3ƻaЭCUt2`)6O}ܾ&7??!UJPɽ0 ZMn{$rC*V O-/8X554\ӆWk!)USa秖EOw~iKg/(qpH}hLṬgW]-3+V^?tI{TpNؠA4:Š)UAA.H_{%U&sĢ P "gu$ ywD;D#@ALkl0 |1Qh3񆇩L0zm:_m)s- pAnܢX'!r +`mϛw!(TQ3 B? &1@u-l$C&7 '5*;uH(ֽp2&UGW_IvBUmCi EXOZ"J`~i<go<@$I<>Lc @Pn8\C9%wV%J6Edl3Fz )Jr f5WI]};#`Nc)&7ze䦦RĸTLO${bzᄑЧ *>khHdJ%R e+ܬW?c`2  d$.O|BxJ{#Uġ{Gܝ"خc>Usşfh qQew^I–u@?M44 E=h<rLd; UWD8L.uZ;7%%ZhE]g-t_Ɍ4`+e\ڑg|`*[o4xMy~%2ڂJ/5AƏS녵?\D$5]s@L֊ۺN 業rQ'dEdsH?ƏT'?_~n;Κ y"Ίl;s?o,>thѻl0m$B2lW sW7dwz:xK̆.u/4nr$?X@'q}d#S0Hgx^XW|2!uM_f56YbgkWkf,C(P˗B [$L_"?{-/ luYJ LwXQBRn ,W(iMZԆC\5)6n;͗YVuȧs8543N(ǁv $?qDop!lq}ah}=s}zBUiQr:6ƹq|1brA^QUr8ͭmS*eH]nDa5bYY'ؔj砊~H 90M6̩qwK<1[7ie s)7G-prB,\`!gD2@6v1=QĨX{Bes55i˜{$Yrh_f}}CO[CQ5APxӠd{$*_COӲ)i~cx]+*m!>&@ަQvZ,TTwtj@czv8B+7%)T:J|D@EV oz;vAneӗg0<,ò˳ȦR˃TMNKƄۜEkРM2&]L">t-|CzxIDG+('Rd<9+^xA\tpXXHt"+Dp:tHpq3 Pҷuf|p C(UXfuSX2xNueFS""IRMo$20YZTGbGS^oF* K`?v*Ri{ m]sGrbk*M 8q4BLƒl #:%,~8t]jYO1Yk6Ț|BUg{p:wFiB\ؐ9fKS$3mȸ2iDĉMy2@ *e]0\0,X݂i1wD0c:r Y8B. /j"U>׏19i 3hւzn!}T~"9]ő2oo"A=X&=BZD1TJu㴝- ^ac*z9=:ے jH8M[n`U\,28!}v\6E>̽ס'ЖDמX Lue$,)pۮS̗k壋z+~6 0J#(/2 92x*?ۆ EL>0}O  悴8=8Χ-Q#i|^΀ t_by{V9ZYşhNRa^~+A7~yU2 On4f^[]j|MQas&.ėwN3&D=ꓵPFL6t5loӎǍ fx?&#.($AGNC3 0^h5\) $kn8Vfʚg;j['ZQe!_\\l%]%4dAmgn>O'(N:eLD6{Uendstream endobj 547 0 obj << /Filter /FlateDecode /Length 4273 >> stream x[rph[Anë>d  lglRF49P( Ԛ˗YU]TO.?׻ˋwWGeS5jqy{}B_6. ecrwCeUVU5ű=vzg}]/VbPm]Y(Z^xVUe+{|3t{1z MVSE[WZa{8]71N ;ޖMHs9k诊V?hZi6&[t{Z4l?Ǎ4q+4)wIL^):-nסAzu_*{{^am,Tkn)mjU:e{~ [5mrVh3uwaQcr+4L_16q%)RqckdPw>XHU}hI'Ȏ}  DJ@XSkaD R $&~Mrw<[*Ut7j,F 9Z 8Űy=8`/0 M@q4OR5+\+E{KC݀JOt3VfR.ZԡC0cDQ:/Q}w8~7q>)tҡ<4 ` pqãAn }wbJ~7IB 8zMoɈKrY\[)-36$֦&jW"͡ޡhj0 4A'NK(fr<H1|s^2cb`*N ݾo?&LDl]~(nVUF/VC4N񰻠^!݈BJ GS,F2wM ZS9z_&2[:m[3A YDbJ40N21F:Hu\|ߣefeM*GD5{2xDy)i32pyFp5M1߄Sp>Ŋ8`ZARmP c՞$)qƤNK{AJђxo j!;/u'X*B2sf F4`6  #Hut,ix:F`ۏ;a!r 'c}(pD&F,i*CvAz@iBih!+hz뙴*w\>D8?=ΕQ yg]1FBLts1YEp Kqn?NW1M[8H)>ݢNZNQj"!yKB1~v@aǧܗ6^~T3^FX瑯5pЯ3vV _K#I=4v m#2`/p ւF/'?> 4u8.'Lc35)2@(%nq1uM⑬?m;.14F~bpt؎U/CpA@iN|sapN2mz: kǠ Xk,5 #Wp+i"$0`."n!6hSg "R}β%42nX ZZO.gn_ȀW^lC< h*Y-#Kd>.&y¢bsYZ6*ǴBܗ7!*OGYI s#wٵRMh\B,.V cOhkXAԤn1nq@B;]#zZ71n%fziF]c7 J|1 ke#a#AjFʚ|YB +UҏYsZOs4_L9 n:1Bp*~IF?xmX`ԯ1&)6Eݤ˄yZEHk-0qb"_eLs9P8DrM\De4=l0x6q|iQVp.&T( ߝ͛ڞ jQUg  0Z-l3%'ϥݚXw@8ER(9#w>$Uzħi@X1#ҿldbsNaQ(s-&`[Bդ ~`WX`#F{0)HwQdv(ʜd|E ~'< Cg0V3):̟0 =F* e*ݩ>|59(ٜzԫ'lv>sC9mA0TwM|ܹE' "7LBSœR}y"f錋r^j۹rjN:DۑHND=?^}^G9FsM>Aj.Ju ﹧ xG?Ztc'SJf.Mg+D:pqĦpP=0P%D;aߥ\R!ZW{s2&X_K< N-y~Jdǔ@\"ωYHf'R9)b#![))<ˁA0dsvj" Lj@Mhr.ÎWZKùxN"ü; jKӃ;RnjeX۪}N.Is)\'3E/?vܸݧY0d?>=ܧ@6N8A%MhijJwbN: ,35kRn{'aH.cѣ>`)RSAVYR2%@z<[n⺍ ΁RUV x>\Ah|̝Qy|sþk/sBXGe=K; 7 S0\ľH8; %F5B sh,ʱHOř(.Mhw9ۡ/HBePգ ,yhܢ;g;ꅲ%h Z'ه}`d4td]JJv<~XS[i;zuy}߲\ j<} "&4>+3XSYs7h@v-*` 򤃞ߊCRyF>/Q<3)y|9}+;Zӡt$uwًz}l5ڋp$*^okk-M@f^wߘN};$yബ5Ul^0IjVO{65M2Zvcd9ݠN FDbd %Pk0*6/qWi4X7 "~Oئ5,wQL,C S]r ߂VlMiaYf;KL^>AښGqx?W@f޾ 3/!fDMWll^?n;HCyt|JBj8sr Ah8?|9Pm:C|o)t3 [Y*LHR󭘯AB J 1cs_l1r|BB:HaK1NV'  *??S `LHM3K!p(KŠ8 S]=b'MxN5ZJ7"p_F-ϰ;Jot}Bg\) D5H%r WcpC J8\^20 K7dd?(od|f<w>JSqHH>KEY%2 yĻ&L^814l)\+M]Kv?h>endstream endobj 548 0 obj << /Filter /FlateDecode /Length 5413 >> stream x\Ksȑ/-zCl @m3#1pEV?8 Zv>IsQG,z^.yܜg)<Wg?-Cεwˠ͹~*{~9\V^蛾}ۏ V_O8i)&.K`YQ?`V~jY:W|\he~ >Ɛ[O|xՍNaB ]O ;v=s!biK/ ]lEZ%-9R:1xnWdQ{2owb~Hz9K^z]r>~@;PanF7ҷwo7?ORI#4͏Q+AЕTZ?]ś//Q$hַRY..u$W O_zwe5ux";di@Ph+ @̌2>J y}4[5-ȢQ0t\w6~_Li?YϜ%k n)Kԁ$qP'o\U#Zi{bJx7$>+%`)P* .ci?!?[i,Q /@<}Ӳ_wîHh+DM :T_}m\P, +#Q!HҚ( N[Ń(FPo+=J*;RUqGO8cl %HD\jj^ݷ>3L I.Y5.Dھ?STC|fMeU0[ B"`4y4t:=(/4<sBh㝆g3}jFFǰm9KìIzՌn6_}y!P|n.DHOUwussILq],TZl3FGDVQ#A7@±fQ!A D3qPdlO>l*]RmQSB&Đ*4+M&Q 4ІA:SSߘJ3b@v~XФ-I!(HdPRBaHu6EQME# Ju?OiF* E@)ONE+쪐 $T.max\-ȪNb{6xw3 \S1 Kc6z-ҥ2rѾԱvڣroFFNGN=K4w"k? bTY&,]ˈ۠Ar"00AOO4ǻO|CїY&q~` N`#CmX')jk"}O}& V+lgWK}e l1=0pNH`w{R,i]fIYP%"f c<闪i!!ut (Ydc48Tb _#؄ڤ4n,JL[<`?Oz|췻ݹ+7d\"̨- .W0M*eR8*;S5 T\?!24'3'( ou7LehQRŝ|ʕɢaH>?т2S$} շ C'._34o1J &-lJFQNYx@Ҁ@V#6<;_[LAK7Eے9oKb- r w_MV_}uH8M6j'P/]3NJTOᡔX2hi FbRӠȚc;/U Hʓ+CFFb߽q#1C/25ۂD8ԙɉi)?Nn /$:,@`HLo>O}(.~*ɲ\ %5IuD]miChpȪz%u'K;6'^^z8baI7+7%oUԻ`]2SHLccx ,#Xn33$걃;>e+"db; h7GNbS6~$OomDt>0XAI482UfWOv9>wQU>~LR\!Ut~8;Nst>p3j68!n# 6(Chg- A0 GED zDs }*HøDͧ" ̙ nGiJ1C܋CU6шL7cE^mꖷ_ kmzѤxѦܓT s ߔ\n?N=1ye]QAVLSKB@.}=\B&|$ On"U=d#z21_[)9nr,%.Co} YV;U3H v#\#R6(6\a(/”qR$)U2\ҰA>" u \j|Y86m6r 5ZS({܋'Dj{؏]:lg"m]XŜQw bE+V)XMg Onk/;_M|`@0@s3ȄKp1H'"E90ĒwǶ5"acnŨ ְrH_Eьڔm-En5ޱsFг5"L:dM=k|KK9H jX+7# T3ZAݯ& Y 4 D 2F+JtЖk~v UU]B VXϹ3Y؊Hy$6d1$|Ȏ%L_$pFvd*IVgGLl L˔^ߋ\T }|bO Ny6YdO=wN[ ~; /4}gCo Jq~UOi"`=#"#DʿH{${]1L/̄ $Wg9*;qK j?V"%->tFS]3v Thi!Gw7bS1`ft^ #)/>m,@oLmE2b[Y1M9k/Y9K=17=F|B+n ˺l/f:uf%mTX6u}>vH1=k o; C[֪< $e* t^(E@g tؚ$;O*:ے&SY'4G `:p3^Duvq'by=EgAs@@Uu^Iit?FFŌZ)M\3Q&c@N5hoCBΉE*fAQRuC²m;PA|`bκc '柟H1gèFYC6;@Ow|YR{Q-5 oZ +!C WQ}6x`vR("fԫ^(#,`c0ѱqHE$, 46syFP sBQ q gBqGcёzevjw`)g9(hL2[,+SeQt8tjh^e-A)Ms<ĩwc F`Lxy"=v~ѾpÁԜw~:0E?h8bbh.u{mj?,>whj9<PS=>>8M.}lG&XH[.}n?_𬁋J35χ|g9==Vj8Fg-ʺ*l9a*OeWqGCgɿF%` ۴$ w3⼳"ua~^UzNhbo)3BEYA&W!1 abd/YϕJ69p ~g1LOum~\ g% |^ 1i.v18:JL:12S}:F 71 >6t9 ժq|h'YLHۮ۞:A+U#UÖ@Қ@cUZaN!#ucq3Xjm&=ƣδ &++t$wR=^wwQm2*b.L 3schI{ls_QPJ9ڝ6)Lx;׻jyA%6y(;tQAN!,Hix%ڭ'ǦʂA>LQ%Fⵡj;G#_QI()΂7oN[)邊94wۉA,|C-#p.jCIf|.XkSz{Eҫ拒Li/ &UvC,7x b3ӼoF%;%qI*}>mv[,XÀ{H}.Cq1a1ffZ?!튨`!S3{9%i$̮7Yiؘs3X.ٿhPa?#endstream endobj 549 0 obj << /Type /XRef /Length 392 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 550 /ID [] >> stream x+DQ=c3)dVFlDQJTRJRH򑐽I^,X`s( gNy{st 7E tvlG%!&!~6&وl6L6 6'850FbE4FI0PZB{C)Cѯ5YZia*S-,͍}/҃ 񤨳*׌U(z1=3Ivl# aqad#3?ߚzpoG-pU/9x$- U*% :#&3*t`#6 ̠s΄?@_'ut ධt:#ÉYϻGON endstream endobj startxref 398143 %%EOF LaplacesDemon/inst/doc/Examples.pdf0000644000176200001440000167235115145054161016775 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 5787 /Filter /FlateDecode /N 96 /First 817 >> stream x 4H`#@`߅y)`a5 2vVO Da8eaЄ*` a=4͇"2H)xgeaS[otE, _^gm>@ݴ뷃f$rśy9h7if0yeG0Hx=J>v1j*, | z~R}#yӺkWOk섒VO^q9c]lqs ?6_> S4&o3< xaq=jp-|.{wmKf<Xoᤛ$9u+v,XiYXG#A`+Z؆ `q.{FfOMti1vSIeOeEez11m %-izDOeCe?{}iGDonvtJzO^޳^Q ԗ+i4uw2J?*I' nI1kGJpL&TTCh=g]累Z;4XGzN^pW'մwpWCeM{5#\vÚIki]Y Z+{ 2wr 2Cq]@&s(d⡘nw p|F: I7Gw_P,݋ga6`;wBltREHBI%iݗ@P=#]Ǘp=y /Ew[@oLG`๡:,kJ:Y齾@@d؃aݴT@@zx f#ب)gSR&߃ ;zcc+Øi>KJVTύ SŸ?}k3}ߴW]29"W1SƟ  ?o;35?=sS 5䗗-O7/_F̀#>v!!m.ߍSgf/ok1I;4i?wݧ!'?kUq`?W2=)$p>gmрnNf+ټ~{<7N&@D niE_$~F{c;}.)y5鋷3*5 &\kwW;zbNPb~@>` r/ '[7 I.Y H% b_RM7;q1T6P970ME^O,zv+ E;Έ :QQ&ߦ % X)ӂVk 2 bİ%1u\F=i}@VtHq0 WP zEA0 pU'|jU>AƆ.Ey[9XZ4N;FlW 'D*סi 3%WBx7FZ)JwSSlc~`+G5 r8n*( pZ lm5y`jQ~soFrJIm{7{$G/͌yt.}@9IL7Kfvd2=9^ †ܴ{sgʋYa5SpVZe4[}_>| 1jgfLRA=ٯaWC`cDt dHVh22XeBeLr;8q;X@N~uM6@RU.z@8G8^RfQQQЕpa 5SxQ\ҕ; YE‹H?b\KvQʉ/a~Z PEmaON^<-r_; Eׅ]bP1ʡdJԲmiSt'&ikQK?Ea_>ob1xwLpǎ^dueF; YLn^aukN[rongxa Owbtr&`zu׍&Ss^5j82Qasl-?}/ͤߴHT 8uV3Ph4&TUUUPGb?7k|0֊ .\0es^<|\L67rMD0Y_a›0 žoH*۹P[i*`[䱖'e<`~:{ZC/:fGF{佻zUbKo-\Gόa%flG  @kD+g% }9J\q ,ǓD$AWYT3*!mSU ,C;Bm.i@#ǀsZf)rry[ml} 0Ylp٘lC.EtPyi_n·F5dRZdc;h+7?~-ė =}%ihȢFѬɾ|.+OSYlxuzM^No7rh옂b%$s T vp iL];Pٔ-I{vgDNFv u-@tJmEng{5}MF^~֭+/D~*v-y`&gs7௖; cɽxWK2 V[2Vd0f0ەda& l!,aھH-n'_|11ۮb&?"weG>oPV9<C0o~GPӫi'7,`_q ֡ )M9ƉiXA݁ОE=ڔd:@m `"_seWYuR;(BUrjycˇ'%ӡk1F),P $s!Z6؄ld|e5/-7Y8H A x2!@3ǡ5ڵ1с~- CWƳc+N.?K%!2ѲV9les [PvArqendstream endobj 98 0 obj << /Subtype /XML /Type /Metadata /Length 1724 >> stream GPL Ghostscript 10.05.1 bayesian, laplacesdemon, laplacesdemoncpp, r 2026-02-17T12:00:49Z 2026-02-17T12:00:49Z 2026-02-17T12:00:49Z LaTeX with hyperref LaplacesDemon ExamplesStatisticat LLC endstream endobj 99 0 obj << /Type /ObjStm /Length 2612 /Filter /FlateDecode /N 96 /First 879 >> stream x[n9}߯P$"0L,̃#gu$C﷪-uWX̃&*.R-PB+-#Fa Ew"X.{Z?Ew pFKk:hniD/pWm(b@ёk0> j: ]Пn-L\Cꀌ,D4`dxDQX^%fP‚C@p;@ak@=Gݢ!zh )&_PM[N8 \sJ# rhyJjy FxʼnJ<:@][N\EP1]5F -6#B?deQy@sND@9/"=.8dAg=H1Ҟ#"hvOYv^d9f3=ݘG)8΁cs FϤ ȘbAQ|f L*B`#Sr6Hf7Dk PX|[mxsO3Ja_M'^_[AoXD*iuw}-~C^}~ۯ|d/.K,v+H>iKΧ{o 1i طz ۘ8ԣ1}M{ZYXf26W̱ HYX@%u:h}DMёO +7}8TDY~8@F[m! *&5.NS [FEs EZEu&SQ3mLP-NS4VBPYxQãFJ9.dUzc$^*وĝ968Y524Jf"=9)5dJ J&IE![Hu[}(T( RQm! 0GE )3U>ZũԔ-Nm`QU2ImєMk ,J*(ŶH5@zb)EcN^o(NĝEN$ C$j[F@b8mV~5Xn֫ꏿm7^,>wfէN7rya=^xV[XpSnp:_}s84\?.nח?Q>]95lEz(->#=,XihFW%_,)>) >Vzi_77u\{}\?xs0ZS/f֮8G Qi, 2TӮ/ITïd6kbHgpWb|wFݦp +H1Qv@=,jMX0|57g|6Ì5' gـ?H@m/=Z)_Kendstream endobj 196 0 obj << /Type /ObjStm /Length 2474 /Filter /FlateDecode /N 96 /First 883 >> stream xZko_-p|A˱vM&w p}r-HR@f8}_^ڒQde=KQ.EQbOBpx:ӫe 8uD %)+E o$,V9?;tf,ޢ3W ;Gbb|DhƳOQ>(_WwVsձO8QpB.*'$%ASV tEI F 6w*xla }DȭBG e4"a:_T kQ1bL#rƂPb#*Y 2D#B!J 8QِmL94@c'9pTBT9~.+vQѨa~ʖHơQ(ΐ c:B8%cxvxIX&B>L=7b$=F&hdBM?kyZ߰$#2LKX"Z wUdnA6 XpkRa oHL! T~k?B1` =z]COl9?ZR? +ACXyߨF(>Yl/N1]dbf/=V,>m17_/H7$q" I$vC'"Iݐ; yZj8&`ts! }_A+M7g!(oNGa.\/2%;I7D$wH\7&:|(IqLzIyS5)5w3.});9|ȱfMwyCZGs#X'5oFbʾW<4-Bg[iIO| m |ۯoooymUۻت ]]L^PF 6lF/GBk%|GQxzNU|z|g q`Gfh~ Øۮ/Ԟ0EF9)5ۅ#)EKjx>k)hk00lT; Q}qagqUk&xKkHb#Drx\[G`Z`oY#FtCM3׀EYkX>0,eeZ`F `5 C"H:θP1PIՏ<^{q*JK`ky#b˝q #ܨ|9[lѦ|`EIMlJ2*_j3BX5R`j*5V8$s U!א^X5K[c&!K\6X>p;|HFY&aJS'IfRp 8.Jߠ'1yį>dM,egk+0q1#*hYWU`Lk+n'b,<ZeaQNGaB` x #j 'H^`C3a~5c+Plg ,3`t}q %uGua {څ+G5ύ1EwwLv@Iae#X85,;I18~tsFB!H;}n01yFqVZS'YĊ$1S,*S-v WG?wY=_`r3*꽚٫_ծ cfێ$c+^rYMy}8ذ 8LɬȹZ ´=ܰ(WPeV3c`Zc m6zclyJ {V*|1EtuN\' 6SW^ +'0u7pendstream endobj 293 0 obj << /Type /ObjStm /Length 2969 /Filter /FlateDecode /N 96 /First 890 >> stream x[mo_[W `[QRDjUD"8-)ţ)(ggfuiUZq+🂲N>E<`bUWRQDV0VFB  II&ń312:@U&y;k L-&%d, !)b1ƈQ*qʑb[s"exF0kX'(o2+oUyLN ~ *Pwe`SkXU<<^E@w"[*Fw Ԥ-xH0EWRU) $Ifufai|qd%X1$q !(rgrdu csxapcC89`#Ø8xDKx B j(aD|98HX D dXpmM/g/x VA #/T}6e۷G|vw{̕;,YP}vt6C#<>@bCt:_ZpQڲ袋B́|!H~|1^4X teӇmXn, O}k,tX7uOk6tY߳dk.ش.ب7t  @?lSҽGMs )xӗ99nӣfBQsuw=Ow镪L/Ǔ{5ɇ6rɸ$@w.2AD^O' Lтm[&:t2 U9QB[LXH]iㄐk "gAVvҁ#Y_?L/֟>Gy~S˺'u}SOY׋gQpX(~K>_͑zԢ%93]O2DoO)_ud>\qͿ9Zܚ&o˲-,Rfۢ: <EM*ZQ^*x=~<m!aW!ad*JbMN&.}X`[Q=(JKM%zd$0F4(0]9 cbz VWF<aL}BBhb%5$ aP`ԕ$C">IZ_M 6KrR*C%ep\)I„4(ObZW.jՕ/P\K%B =. hB =.г^pp/pܹ\V.9#K%[Ll%W<bIuOK#ft}gozJ8XW$ݩ&al.M, bƆiٺBԁ>^6נW 6S+\pua굷eGa8a!amX[zr}H, xl`2o#.窈|{* E``@FH]Rp,_Rau͗ٔ9<|A$$sXNF@Cᤈ11ʉ}> O5,0? ,bgH*V^:^$u0I_1h\0UG)"xHkq``^ FZAp3h7!LlS~1MV S1>A4dO_d ,%jKfQ6w@nd(! Pp;;M%7[^i p#0KӁfń?"@Y"+&tla㌘db I6> 0C:[.?n`!@|& G:P_F ͦKB%r ܸ-lP\r\+Hl7`Ox`fC0 FI T%> c'ȁYVáTso?%ʚo$6[ `&nɍ'[e "jaX̊Qk P c$ܑE>ǃbk ɁmQyjgNkG'ߜ5-%8lMӭo:'u)"?J~_iwG We}i&k_>v fB&O֪HC'n1ۈl|uBwA}}*p>y(1w TׯʵIcGhom3#sĶ Kl״z)Hzs'km+zДvendstream endobj 390 0 obj << /Type /ObjStm /Length 2632 /Filter /FlateDecode /N 96 /First 884 >> stream x[mo_ p93|FԐm|U p};YJZrCvK>>3I!6$W1"xM,.ِ)H[;qC|rAe܈#nq0XGÔ nam m9Y.@ ('b0f("em(E0OOx!03"u^?-YxH! 9E$@)&dƋ3t/d"6Qވ4ƠJ930܉-&UtH {2)=yMfspϸ}19뀛y|n"nt!F`TBѩx3v\)K*|;U@ *.ULGAcD5@QG҃1(\`cl FbCQ #a N*1`$+EM!_f!1 y]O0167fx^mS\92G %X7{7fxq|7[-6'XBb=6O[vu'HJ7$2IrݐH0 wCg"HxT4pVk@ҙl6^]]Go'{65U!6{&4I.涏{2I7n܍#DҍLߚ;ŽL} =N:9ǻΥkioaҡ {D.Q6OͣFWPwc4OF}#1( n+hb`"w.ze|VE,.۠b[l#)8eK iٙ{bD[yEo-R"Jj:/?c[<[Uv;\[)\9ڢwu5 2rt#gX0)6%[ws`ǘtW`r` qc0Ch4ƱB7udrceL9[qN'ƂgH5:q΃%8D rF o @է5K|lY9ID{2jx a˅xUnSq.П'sX7G].rdUY-Lo"ӜOCg%3([1 5O{uFx/?>~=^m}p} ߯NoS3Z6/7G V˘v}^ϑQFRN*!e.paZݾӺrҪzPp⺿\T7'ZPZGËz8U5`BgǧCBr=Uknߌ_>^-x~iU=-ONxexl*A;ןMJ"SMNO;[@z>{[9چzIVxVf>8e.q YW- 2VKUz$i9[$n|#ϐ6oYfnNKBB &A"zny2_ً-Z}XL+x'~CC5φD &1q+vVH55Z͢|ʚ\=:O=> stream xZn7 +c) 4Mhm,]k >N=nMKۃ E=GrqDeTZ"nLELZ!7~ y =gsa2;,5\Cj)Q6tԔ)bbʭ&BC(\BYCوC-@*iN$ 4g IS,$ZB84m0pYBS eLT0(:3n)a=tГkuɡ:_AyXQK+c'!%% LV Nk P* jGPj2p/S90 K*U^CQ [ZՆqTy*!dS& !r<3#(7bCAז*ZR̶q(CIt6Ԑt%ČFXfZ\yҷpxE֥I)i~Y q!'' g#:$z 聴NFCt$vp c@,_^]_].)}fͳz5'Ϭ#4^>[a'tF> ~pHJ'D;0$։CR;0$މ CҺP.66\Hx>CGvY!#n#;Ð]Nh]Tʣ0ԇ$k$qvrlƱɱylesSNhW;.]$/`Mm.a흕 #lͪ{t~ruq=hCF^WaH_'|C':z:ihT-ʄ˜M'3 ) Wg/|T\`߁+{ ę N |Lu-;/k/OxmbT3Yd -c\،ĵ׸]F :I/z8BN\H`G`U2ٕ`X-~^OLuj~CX>h4Z"t4]W#磸O{kmiSZg{7aii%bL}pZOF@Cnc= <6OtށO.r#paͿ{ z!LٶD? pN]|`*M$I4vq{$Y=6wTKlNx!jeOaW|K74ox \-@'mTS -eX&FUĥ߃O-F/A}endstream endobj 584 0 obj << /Type /ObjStm /Length 2925 /Filter /FlateDecode /N 96 /First 888 >> stream x[ksG?~VR86@$!a[[r$y{NdK8LgɃr5=ݧ==W!EQ-YxYDHVE2Wτ1F xͮұo&&vdEg.0Zpau6x /lA<."@J[Y8tE(" o0NxNŗM>~D}yId$Z r:tb:xH$rѢ:SM"ieHkE$E}"e@ΉT%pDjt*%B99XDcoD1Pbd(rFP (}.(hm8TM=t4#0DWyAu' I@Q!2a1ɔVpucqFc-#iЛ36@1FR3U6S]UsD臹`t2qEx>a>aW""Y_sx9$t<+(}$lZx.|fTOɽi%Hp'{#!#kB>{}>?0q?m !L(ko&&qPt?ȺOߨ^H|fГybgkDJV'[D@Os$wr 8:osM,v- z0h!#GgyX{#\!/aޭS}T=VOgY WDR`~W%\6\[e8-s:;>V[J:6^_rjsuq3,[4>b >f!%7DrNj2!1X7|q^ %Py<X3߆+`* WE?,Rec2gIj=$-40EW>&Hh ,]VdaF:=䩺Y&H9&!~!W|HԷ]EDdi ɪwnWLAC7C MydnH`Vɝ7Vݖv\QS`ĴZd\& 4T ؤ7fw%4,,#Ș`0_ $[0-6 rH ,).+/zދi54Ae֋`da^ Wgg[V(Ium ,^^z aaS].D-KL.T|LxLB،M_2 KykT Ͳ D{Z 0ܔbL4"Wxʹ(&M0 H 3T`g=CpM}EԻ. |!0b]&,ڱH$2AC\O qؐb1ȨKӬY;i8+5ЊzՁ]pvM7< 89\;,]eƛ!y%r$믣wo+vQh070V46%@hZ9׷ zӰt;nXx 0v7\1i8pKʹ!.׉ahh;7Xi!7Xi,lK#xSi~@7 {@30_%=+w}&k.{ڭxw=P6d&_VE/8Iec<6lW56p?2={qߴK6p1ox#aR6A ujYc63> GwW e(q>s#e ow {vƗ& &S|0rx6t? ])naw>{u7ZօqʷZ:]ypk=?*R~f@ڒ*XvSܪSzΉ:PT-Y]fTB!WةU3m8;Pk]Cݬy[ys0U/_6VpK0Л~'o`͛nX]_Q|;c[62endstream endobj 681 0 obj << /Type /ObjStm /Length 1067 /Filter /FlateDecode /N 96 /First 863 >> stream xnG } >A4!C ȡSCHU}~Zh"hcҕR$|v\XbT.4~Ϲ}{w,tLpu_SY#Y8/bnC&Yk9:d G41z8 p^4t0so4քs$ Y X- a3.2 6`Lc$k"m-:i$F(q' U &È9И=NrW,?HꮑЩahFXgc1nhI4tÍ aM/^W7w;)hO?r=1o{iwu}?n(ҽFEkW7oH5?+zT?0+SI%JhI%^X+SI%LH*2%T2ʔhR)I%ZĒJ;2Ǝ$cd1V]e$cWc%UXI2v1V]e$OVc%ɓUXMd1V<)cfyRXMIxc5/c&l^XMټd1V2$c}s>6Ã$ 3 _&yTuxí3Gne$9p+#Q[-Gne$Ɏ[-;ne].R;q+;Zdl/c=8C$vAv`oD~L޻%޹e頊 mp*9K)G:qiGQT7׳liߝ>_k;=3]ϑDžauAI|q+|Ge/:yy"O͟V ??cJendstream endobj 778 0 obj << /Filter /FlateDecode /Length 2409 >> stream xZmoPߺט}PR4v$ԑgI!y4EI?ys"8$) C<3<s^G||7<qs=_zL_|=bWepŒ28.nF/1A{~n >ygſ/ErKn"|(2{l*`-lN>Ե pR ղP]wy[tɝeM1BIvݑ 6Yy>†U&.4;IBFiU yNEZ (<ʰYFX4J`ƫNʒ4*!~"UgK1dc|鄋zFR>)@+ش[,R{VKTh1fVY.gy.bY (D}ΔʚU_ P-dܳ)}Ws>@"zRD]"|7A?!)A5k"@PP>tVca,T*hPpFh䖈 @/b&QDX-#Ad`fQM56*vTĀh uCݭz{C,2q.l  ]{ ~ 2QC6h(-wDAƀs{2t"wzn뜄] `")xA:|}ǘI)YHAɋU} 5*֫AK"C$$aTձ4dcW h&J}o9dtG c 8|nfbI|1G 'G9"|()Et( pQB .J<hTIzy>qR+C\Գӣ+]I[9 2y!҃]qKG[z\H*P`kr:LNwa)(d]8{W#QJt1IzmU$ޯf5@. B >ȄAi0σJįU_>Y/̝-O˃TyϔgO*T_<%&ay<źP7MԿA:[ۿ"H YM#B5)@iQl`'ڐ ̼t , tToZlW[ Y& 1 cL8DFtz1qT0z-SVb?}?I=$ M(8+eiXr('D>0Q9J*Nj s v (8$ iZ/*4gGF߰םI%yiPbຉ: sZg} >)hSd2Ag("̍r[`^FHJWЙa#Lq$:@X|(b*$f|hzf^mEְ-cn,U5OVŽUwy\v*ݵ@ΦQqFcq2ˇt-0oV5r՟z odmcfvi/e9w|Q/3F;:i>|Ty(03տMk0ic'~6rW6~cU F ![ cRsڿJh/6#ZR--SIg5߾HXeCGِkjʹ(3`uf|;km9=NGoE{ zq~=NpwG ztK1=}U`L&*,RIaoEKb{h'1{ZEx̳Y{oa9h ;jgdO;.IxlGh<T4;L^aŮ_o64NF̈oU[$BI!FTF߻o4߭t#$zCx 1_/已AaDoV#.|"LTd2$D)*:-.KYkNKzÆ64νЎ } 4?bAjӓԗT/~ENQh5 ^h"Wy')F&ctGΜre'֟3y(GJa>B[#=ˢYHBr>e!F7br]t,3SY5_EidZtqJ:UddLwO-"x\q}E~Ig2RLKh2i8_{%LGߋܾ9DвݦlIq9̈́"ks<J{sN}~4|sgkcA 4k ԁY֖@~ endstream endobj 779 0 obj << /Filter /FlateDecode /Length 1611 >> stream xXoErأ~oBVHUEjߙsf7Lp}ލ> >͚lw"@6;{ Vs}Al?rQD`UY-74/o=+PJ쀴jfoG '!kRB eD٧^/WsvXlu3'ya!8~mV1$]׫)ѿB!ȬōunsMf>?716`n2Bےkb$$y!`Yyq:h#wV)raq6k]Ѯ;3psvPXtI](y [n)fUD0س27ѐhLۤ_UcOc<۾$eUQWW4 !\p8$̓׃@-H& q[itMMn]*jS!Qcg'wR"m*؜5 @s/ciZj3O<}FM(MNs#ъ$# ǥ`680l&RyIn5hR7aK#/-7 ,]\cnj'AOZC[]вM{|rVqs *~ͤD,8t(`({"OԼ',y2خv:KGOi|kp{O50Kdإ՝W;16p~=B5B2\V"d?Q;[_0E;p2K$O߹Gt6'(R6_wpwFK YtƄčGh>h,}܉AhA"`t 8qq'IN$툟 EaTD 3i!2\9(zg QԮ :h?#ރ p^NiN;h s ݝ'H9dfۈ&=J $W pZd{S^Нak=OnMxAc KL.QߗU 0f48j/7 PaU%קe5gGS<:lQ4WekY/h(`_܎/;pr"=iڿ"z8^lnVn&} V<`TOG1\&.|]\uz|j<*7xr0't> stream xVmFί@w}%U,.rRY2bls|gwyU'2ٙyy/*XE3ԃE:{#HjW3X5]ZzQl_ȱ<.o< Ǿ냤 ˲@=D+!wzsmB#D;Eud#ö Trv 6Dچķ@tM_ A_-TPlnF{Q+qmŽ_7[a\)&MU7e >͹,aV{ʽc-־Xd]"St"[FɩHҌ%X$ 3b,ҦnSSbG͇!]ħp&<E}OIQ-`cR/1sf:"OޯYzwMly^Wyp7RvY`: }NێH]]%`s25[yr]r2rb4@ڛr|xsWpk-0߄Euwu &te./ EVcL)Y Rh.,Ұ]1£TUfxFڒF򄪜1|ֈMA6H3} j1~bXl={sg.AcCDaAߴL1 ( ¤*OlЍh> stream xWKoF =z]fܵK-nEXYJCi R0 y|`:$dx;x?tX}W_#m!2%0z.`#J *"<홦ZiA9GɋzzlK[g`M 7dx0BJBkf!o ={,%hΓܵծ'ߋeze7d:\uKҨ-խ#m[Hs]>:)ŢRP>7C!gh'w fQƨ\ l3~A< Bb*S`I$qa V9"8aBrBbCF1p )PժE;ŒV^ m˩ʄZaXGK HR4IW\BQF!VdBVhOFd\T2'LAQlQP%m߃cm"^+۠h@4:]í8.GQD1awʷ/>i;)io`ʍd4&Lhf05Dmb^Ӱ>6ioݱ{2NGgEfk_qTt97T'C~#)GԭЫgendstream endobj 782 0 obj << /Filter /FlateDecode /Length 1953 >> stream xXo\Q"n%AI Xy%YD"ܕgܝofv)tJOt;mB۩O^L^e^aC .&:t2 ϦQ/v&rF9Zz%,3Bk)ܟ\Qbn/MdKXQ9My$X e诩}hVE^":_&N`Ʉa|xamYx+|?d%z42⬌|\_uYm~gJDj{xûHͫWjUfSUuf!P,ˤF|?zmMcEְ՛T:X FNp !beQJz -PI*}.I()11isi g󹗆lzkE%qX"2{%<@fiטQA!Bnb^ {Jh6ۺ55 hfY(Sb8<)O]7Diq,EZ5VVS +6g[á4!iL2qy{0( k:}L2iB.ǝ.$*4tt$Lhtwg/CG#m>TM z'?:w`NX[r[(%+Eba8 )W,zsa3c@go0)ApEp(R4I@bKzK)̇nC15}Mux06"#+ mBRUHȲ/Pi/u>"ې@Yn5mZ9uC$G}&q(1wׁ3Vѐ.#ldCtZl3sP4ٍʠ*T1C}\+(V̞ `as-QmYe8PK;MyH ΁G4x zjF_B[`k}"YʘuQng&c z wjypb;>iC)BF`v"=h#PĊ̶ʪaz>aPChqOF3eP+b. )CIb(@?CuEʗ`vgM'Tx]* H=nh((i:m?X"FM`&XJwc QJWtQ3*, Alj c냕q!hZ8 z\ iyH  SoWg5Xh;Ja4D+8uMJ ֲHYP %\%_F@AI2ʃۋq'}=r6ot>q D !RG;s,jw BssSc9>&%;n;a̰ .{PtAo.3p t ߡX <`|.zwv| K%Opo<ݾlx;Y&o;Ì<!ԓjs~v73&3Gi8:ykGg4%8c# :<(כܬA ϛI~|e!u%K?;\M0@|ϯIﷳ֡: gsxe\@ +)Ջr+-/d}Pө\aB;,~W?3P}au0x v-w-+&CuUـ:7-z~iendstream endobj 783 0 obj << /Filter /FlateDecode /Length 1929 >> stream xX[o~@Q/@9;g!&rE\V5{Br(6[(Ιs93g~L~ﲞ uogYOOm& †:?N:t .y=A4SI$gcL& &!HiDz޹<Ġ*I?MWVj3)X+I*Fs>m{lʯ/Ą0T/ZI0W\툑h̿")$a|>lz^6CKƳUӬik5o}slՏE+,3.N᳠@HAVMH`Z!z>YuR{cm#'>qZtS"4hj8Q[^oV]8eQ+ T%Z EVh pX!!5m M/Uk !$"`HR2h2a;C!F69?)afUb-k2,M'3M@K7A5svNFN]a\Y82nI)OQhnU|~lb sh!xSս%[1L!.fI]7ͮ>p:vb|<.kMf=pB@ER!d!6Cܧs&\<)u0A!7Y<!jJ*B*7Oq*-e=pq<fA ð] 4o]#L7?V)P#~d fRX1bNJL[#T_aHr~g9ݞ.e~`??n:(:3nοMZ]KPP[ |[#x=$CeFo}:2ODaV=dJ<ÌPEaܰ0`MQ:'$zwz.cpك@ C u 2Q£߾0H)Ħ0$c5lg_ѥJTyO1}oZU8׻Ь 4مvsv;V,r^J ;%,)H}I-]K;l19wsfqݮDvGꜽqPF'1Uݗx,hd'M>|F8lendstream endobj 784 0 obj << /Filter /FlateDecode /Length 1817 >> stream xX[D~Xċճeh{]W; $`%8h"眪:4/~s)  szϳw3jg]g9QMifyhȂT2ْUY2im;= \+r9)'\Mޞg 1j}snzs.]"7iysK_770YCBQBJD( !DLj8ȝAJN8 X )w8n .eHyS}2!3,B|HUի1\E 98@W<4|ح^H1C.2Bˈ&5OR=FeH!=bݷվ^ק`\uxR`ſ ]`F)xtx? ϔPMwc HF6>eTSKx;:3*ˠf:zi-r[i=WPLޫa^T/wv 4_E󒾶!i1/^}.8ŋ`N %]Ky#Wl-&mFm=8, 1V/zI|MW?6e0>*e #q:/k`CD"麿iq.*I/Ou-v~-o}XLfݾ};/8cD 3ή֕0{',̤ 3Dp战̑IS_B- v0ݩ<.$tB)ſX+}#j>{3-9L)941|DgP&%bT\i1MjdEa0c}#z&)Kgi)B$Jz!Ġ n2+\Y[tVFH2КQgfYP5 !&Ei7Xa%Dm]vc8qjT8t4kzYTGǐr8v7È? oWl&2208E1gpa>wr(!3 yf0?6+O3.Iy)CS3{Γ>i@BiRLg\*KHRYO;Ȟ(EhK Grr_x1Rp? P_/X2l`yZ(Tl 3.(ڃ=MN`:pUυ"G6t2G^ dכ6E;3o0M?R`NAoO3{A'^^JX0P824p셹 %,o2}sl~cPԇ)!&J- F-jTBmU4>,)z,R*6L#:o4M$zz!:\\?OdٴLh.+0#bEg~gBMXf`B$ L&;+dS/l~fa_Mg LԾ;\w`B$_Po}یn@f; ,I k(20T~.OWiʠ|L|  I"ť5}4Jendstream endobj 785 0 obj << /Filter /FlateDecode /Length 1623 >> stream xXKoF@ t۝}oR]/(m3H>b,GY>28A 27m(Uggո7[gѷ/K1q&*@̵B(CPq&8a)a9wr~͂Ֆ$Bqr+jMKӈqI*JcT8Z서o)Y_MR89JRe '.:;97-J!Ek6ksbj>xߍR`<|lG{ >ip8 N#(ȷ.:﮶&toI:x~mTJCW&tg b׉L|u5\:U`܂J}]mR"/K p$PE]D T,wq=#hv_+RYq0i-dZI + '˷ }ضg`Q" 4)dAhq'^d۝2 7CA4PddͣQd:'uTavS!Vu*ZsSrRJ]ercВ#Vfc8hnjG5R(IA+ WCuXRńWyk_R#~i11vb?R@:Iy5p.b6Ԯn~[ЖJc^tE*.jD`'N)0kcfễņ⒂ ݤW&cB~JRoUL1⭤۔pUvʱ>5Nn"? wOݳ>jojsnAua+? endstream endobj 786 0 obj << /Filter /FlateDecode /Length 1657 >> stream xXk7-PMFߊsikqk^pSwy -[G3H 0S=YXr>x=kR9Y&ߌ_?79Hgj$\K*M2 5e)a9RfjK"̈́d4z+jMKƧ+/U( ǨI&ZE~M/7ȸO2TI\Ȅ>-BqIQ֭wJF(c<fhtXK:zVbxF/s>MKb Vn.bY77S΋)y7~cmfi!P[2,4-m:L6z~0K`FgzLLSM2))*NQIL:50My:&I]yHNs@K)1~0i0;rבj(վzWQQRs=T(@fKr^zy i0;|j"ȔX1eui  24;[YU jv<7GRYb\knmNڰrcA'ȪܪtR4UV9r7͸)N~q98qUU?%nZ\rekk"o;x!Xe|'9!GiZc, -5IFDR++ZXp-*og b/ùh6 C! pCT2Z-:qj@U`Ԇ#L#v3@jo]@E3?+,s?$ֵ+:.H.w; `2n7ߗB7[f|O[>&ks1OGDa< wΏ~Y9eGJ]OK}[JŽ 7,A5n J@z l r?IwA+'1(5%zujDrLx4ɯIٔ,SuVr rV?%$xܯLe7qіA)&?v9A'2p"` oãWu7? FomJa+ӌ/Wyi8& ipTȻ =J`FO^x^x2&{utMw6Rwv:)U5ĭ]61g6aivH5ę3 r,ݞ!L]Wyun{t(6[_Xp8 7)ԗfN|RW^z.VNΗoǃ_/?mHendstream endobj 787 0 obj << /Filter /FlateDecode /Length 1375 >> stream xW[F~o胕T,aiCۤU*Mi^?56'۷j2̜wsttşݔ w[/<]M1^zRGw9^w Ń /C:e\.f)șk{8o:.g }J˃|%!v9g-fCGk*glBJuڦM=nųpFо8 4 &(+M)*ʩ2;FS|tHR_W!H[SxI<'S"ҿ qY"3W,vOStJ}_bpJ=> 'NXC9]8!.Aep?>fxCϓ8uզ-*4i3Dzd{~nfJp+~==*Qa$&WE2}2+n$l|5{lnFIO"D ^F"Ȭ:% |zW#,I۽sSO&aIrlF}.Roizg4EݜGX&s3Dб+mA>|fO#Ju!f*r!P!x@e۾E?$v=0t5fqt32ў8kQ;9 ]U%HP\) dT;j&6)AIygŶ*E^ہFe2mSbk\&-1WvWx=ŔW-^l|9j tk+kN>\wYwIߣT.OBnf0 uj6ȏyɡU.jpL3,[!p}Q1Vyұ~OPd$ kG-nA8yhi`l|d(GkaxunT{=Db2u]mHV7SQbϪ] YRucφ kJ {ojk`b="8o4a-XY0P}.;e0'Z^؛ ?b 4;Mu|r؅z$2@C{{!J}pc֮ɫg!`L~}Ǣg,4Do"Q:bX|gl# ]>ge%LyaL($B"/r;Z&~ &I(̠hc֕Iv4wbwJHTCEL9*d%>L;jBk^ E4 z Ynj{H)!aN!61 4J,JA؝\R[x Rendstream endobj 788 0 obj << /Filter /FlateDecode /Length 1857 >> stream xXKo#0| l6@z֜Nnb،@aLD$RuwcPXΣ cb3"/#꟎b3~7;--<–X:ݎ:6tƖl3BԈb7$gcc݌Ї`"Ơ_rME(ݝF/g_;uJJj TK.Q*h}uQJ&U[mC`_ Ƴh UݲrqPiݙCEsǜ~uڂkz~r؋_OLA.)!Wyc!59ѣ>(t*M]5mć0lv0``}Q棕o)'<9ʽRbˇYHj}yNR$Ynv^Ms3ruO9,fߵT_^w6!%C?IU.tGHp썷ٽNL#Dg>2;*t8\GEm>dQ{ZqBZuaOR"M;T] :inuscC2$뇋NٮM{pǖ j^LI:\Da903=۟F=x9nևv;( 1~1Jq&j,pQ k -zuXUH zƝR:8JDmpv2nXF\(2%0B4"1.FU~tk`jEpM{6ܝY1 VgDC\7 ᆂVQ[Pg:oS- m+2  <4js\$FvK"q; &J Rѫ涻Ϙ|Hʢ[.NF8@_zWL;^X0B^nS QM˸፶U)ifX2@2$ i~BBgO] bqӳ32W52XzsLr֮?Ww@CB*U `@X2N:qŠpv~q(3" $YqNBȰoyfBrdACO!paϔ֓:xמZWI%sa{ҝ?-G"30xhaDHAۿ`_2%'0md{Gbؾ8K#0"$XP1u9(6~g4& XtPD\LNo JB{$p-ǎ[h$D`090j8T SZ4~ B):]ڶXMJR&NYxzW{h'Rc83D2t853(=홌dӹth I>zw|į}- q"bWo5ӛ9gbӸq㘜JIe97B=zp~bÝ6Es~@\DЉV̳鑇  H+W'YS4o,JR$Ϣ+NW>$+#X=5O Rix`G}7c 3 85T c ]h qlPenF`ŠBK'ɠIf-0K< vj4fDb\'saN%\h=0v7oT5`^ mƚ#T?foZ endstream endobj 789 0 obj << /Filter /FlateDecode /Length 1427 >> stream xWo6n@6)|Yۡ !k"@ԃbZJehHIeA1  ${4 _\M>Oe|% |†?L=44PRae0/'8r- &R57+J *0oTiOX"5V4".FUZ)#$&_",eꋓL 'ݺ@ˬ4vo6[5t毗I$a|6?@͢뛺Z&EI{`6 CfqE .[E'ֳjhr<⡟&zv6Gs '{wuvAuj } D sʹYm7V3;<_d_{rOb#%sju n_h,p cH~#,LޅF "PZl-{Jhc%I k6J;ԅ:IVLj~'|ܭs;#)ahUVxeZ#Mg"x, S(Vo~fEfЫvVK ^@$\#D=s$JӣK+j2wbL5MRĦa?S)сbـtFCT`&ԝ\L6cK. tPD [mp k"XqF6_ @D~}X5Di;qN|h I0zYg#|lRF 'I;Ɂ'V1pt/oI^hx;f~4f$Cth# J;j0YaBc&aFߏ2j6m@RD\Qx}{/zC:5NFnô'u'P@OYbH03zGyqWnx' 3ͻؠGq.9 Ѱ,~ \(523#n0{ިkm=j2K{h;8Lvx#8aC-y-N7;%ֳZWy4_?Usq;FӢlM[jiGSe' 7q=P.<ةW3{ ]?>_||0yx(z>vpt2AҲ!7:;:v]^$i/V3HVT_jn3)dn{/?4endstream endobj 790 0 obj << /Filter /FlateDecode /Length 1311 >> stream xWoDx!՞~ܝ\M*%qzIB̮֮ Um6of~Lj`S~#ݍ>mlݯZZx-4ݎ i2mG3;!!Q`2ѻ1DJ+A5%mqjAr6EDB1.DbeYsRWJboc˱LtN_%2dzOgq$\ ty! L l05愲&2c3~l,$G[H`m-=S YPq̴@\Ʊgh @Ey,mUS`&4/jjS*0T\2  ,$Gae6ȓ3£8.ƽb!1.JûTA"EjR6bGv%-EW-F @a1ͧxCa A(V\qBjV@*JPAS隘 ed(p_PL [n<- _ 5T]MoW0FQY< }^1h'UU>4 t, r຿?`#UT=U)'β>x`;&3safdvCzL+kh0XxF@ tmw!OW@oFpH8EbHĒI=cv-Qm.Sfw2}6,0^7 D'ͣqr?0Ÿ\o\f^Nj%OSY~t- Lv7Bw>ЉL:h> stream xX[o~7\>HRHE"gl t6.Ac+x%9b{! c;v sΕyt]p<7O /ffGy'b|Yn^1KhHvykoJ!Iy>c,oK) @r3#T*oT"RƁg+ߒ"-?mRϏ8CA3d$yL٥My.?60{>]4&4i[yZ[ʂh\̖/ns"D:5C_dQoM^7KdŎ-\MU7Jҏ}F0X2F˛}ε4LeAqSm[[ƾlhmw~j(2J<.x")+ )ݺvԛѮ0'Ig#8Tr4|]\-&4U/=44Pq!FQH ~<-%&%?z iIZW!Ԗ)EA܂^k.w_ r4tҧ.ƚuWhSip(2%tTa@M~*2&䇬]^W7EntNL@E¯bvr%A'NCA̐»$B;uBIw?ݒ2o.\IV&2{" 1UQDA>%MjJqJ˽&gL1$0AM먗K"jx4bٴE+u־ʺL" -WH0}+ɝ =5"y*LaKlmJ)[)=oT繱"p8Xv,7e7p}Dex5avnʴVL[&~L GjmWVbqjꦮaIG$n`$`Mb"ƺ;|< ly.G1`>I%|2%64F&AC(;wTrDhR4r;}]VgzG/qpK]Rbϛ}ߡd30~=g4,KuYS0A+9g6Vㇲn.m2[׋Rüeendstream endobj 792 0 obj << /Filter /FlateDecode /Length 3501 >> stream xZo=E[|rf{h6Ic&.`@[Z[Jt(9E7áf("ę7<3:=g볟Ϩvξ<Ư2:|{S"B Yd\$yK^ܐCy&I;MҤ<$)眼~*KRg@M '\.54|gWU)g*ㅙ\fZ)\|Ehβ$9kcbxf +HVu rW7w\\x1RJdE,e<.7>IEN\q g&)|-Ȓ*ȝUДC f*ɶIRBeHlZv[`ۦݺOҼo(9lVwAr)c liDSdޓdAI 3R.[wa\Zhv•j0 p ̀MTR`سr~Byʶ n ʘsPh6J(pEd:t~pY PE/P^f5LY:l[V6۸pycnAwLcVQ__]}$8|Y1SZ]/ߔm1%=˳* [IG3# ocBB" lxgZHm3Q.MU* `vC rgѧx H9Q6[" ,9{i~ZwrH; >;׸mKGC Mƥ.d֡OUb7+/]'4Bk:^`6Hn&fVɁd8ne>׆À_fc oC}B^($0O|>A.e L"˧fgC] %%Sf:x?eĩl}OfMބcqedo֛(PNmT;p`+ZF[^Zݫ˞y[}m+Q:04J\rйAqJڐݚ+ iy;C]Frmp 5e"-ZF&t]ZA90U%d>Pq~dtt\A{#\vʨe+ߍjȄT͂W,"!Ox-Bֽ1rD,0FDVvA2ve^&wU1WA@0e|  YVS&T '!% s.~=DɈO6 <}*@n¢% g{m1pA«c i3apU9)s҂(ѐMY򊼄 N>=gbG`8AqN>Qqؔjk,o:0Ch:9oqfFOJu&sP~NJtTf :,6!y>Jc ެt4e&$nפ`B x0r惁qr_KjÌf"IҝU9(Pk< Prn?HQm8sy= MNysN ~ٖ 60#l![0$?| +-% NT{6 ]u44^nnu81\eXQYc%:xVՇse=tm"V"`Ppa{d?TАŌʭCݦ.Շ* ]zsШu9Qgm$qas9 ]@! }yyK o[7Py++Da$ {`FeQ(xB1f l;uӷد-M{؎#'twh*ƠE v/l<(")U_tE}!6tg\)|>^V]?q}>`A ~OGE'xʃ Ptt!զ/ +螸z$3P},_#z%Lc Arm߶wp_ 9Pe*)> ;%4p/?ﭛuWeݴ*j8j*ٶ<կ .)@ǟl)Hn jw$s̞c~s5)Wa^ܔj3ٮܮ~eYg{6rl[աz[> hݖ6"fdD p\ u?,zٮnV.㛔;< ]@^g<`Ҳ2Ufo%9rrG?%;RvEIZ(\Gqe5q/WΌqݿ>:dH^{acwG-&uCtnQ:wCsszlendstream endobj 793 0 obj << /Filter /FlateDecode /Length 3155 >> stream xYs6S!M ""fKn]NSDיv R/7)Xo?i){f=Nl$7UbSg>J2\牕zpMijԲhU[^ G&3h#)%EچX˔ήHwpHqa#  m8B%jϑ6\^WeS__-o $Mk/-.i?.xLbp6;_7[[~g4CUgyUxK aVw v}9k*/1֋_KXG9Љ˺\yֻ[;wIEF37߬]9oF5eݬOy V̗E$f a nz6ip~<~I]m^4hʪ;ӑ^ ~ }k 9&@(\kp۶ՋϏ&?&( K ﳫ6p6<>4Zp.Œ޸wGg̎f^v߫4mLÎ${6'Nx 2 2z*0) SQniO%45 ||rp>*B@U\C*ށqr]6@la!o9Y"\t9̣bpm"o=. A'a!ˑπ(,Eۭgb?;*Mo.6Z.*hGѨ(G+7*t uJD 2{rJV ܲ{r÷d}jhW)8m˻y8t26I1N4YD4[T۶sX wjKy$P/RXhj\NPj31P+?Ia"^B?%ŝqANiݮʞf_K띃!I{0o ^qMD 9B &SxxZ Bn FNv5! TǺ<~hESF>w@*r9d[y8ͧYz" JCLzQHN`BاBoS ͣXV%@UBordx¹κ=tࠨ^`%ZU7Ƶ| }*^?[{qn&ѩ 204?<0W GnyWퟦQIx幌As8H QfEꥍ28akO9a5p{ dt*f. ߹B$9k߅A(%\aUl )5.@nφZOr$n[,'!0Pk:8ДX'U*)õ! լ5 +87@<5|y>7}޺O7J癛"X[$SyD.=sH/A%zf/N5@Žie]eUT,^KqaVk}l>6w_4=kjTUք\%uѠs(ʪr>@dtqwCtqpLm-`;~zrs\f%7 WBnInܨH +SyۀLC^4 p E(W׵!Mµg\}]O 6UX;T14ݗhx+ag *w5n&ۈ"AV%"캖2)~Eh1z%ԮA H9aY7 EY뛇<h/KZp.u5.>poyFT kܯĐڹQκ[u-E-٭k> stream xZKwkլw<ΉnN:]@$%& ,>f=>8wŬrw~V rf(r%ϥWOfr7:ə(s)]^b&\B̬rд-{SE^ez9_k%ٚ^FU)ny$v895{[U}ښN&u^8ۻ^fH3igQY;lקyC4ȝC kJf2F9闶n74؀Ͳn/ UU6{9N5gӅ#EB5eargg #eٗ3П6,]n*93ʅCg/oN^0 [csePuJ>=Kڔt"VArKóuPh٫5tNEޜ6,(˰eٻ 4f5>*-2`a5v= e{Zcߍ Qs̾𧹴PBGmY"MuM: a*vYwv=n~gE[U^2dr~k\SٯcPoOحdeOܱ7 ~pUhtN eJN@0.]7kIx47/ݯVd>83n 64|= vqjܒA^KYz/`g T~YB>U9+%%C=v%[;V3 i0YB*basnD~>i4%K\[Eh7\*) M{.F S.aaEVJi~zj,xd`X9C)]:/0^S2xSi`G9S9;?IM*,s#efo3D<:"3;>GjԎp2/ D;*-"bCV:$Ky59p\L/ Ft:nc8/V8\@#4߼>3P #}؊h(^}`R!7p< {':P.݁|Cz]0.KryXJ6Hq!}:- 7*G/׹?xiܶ5wO#=HA ʼJ8$y`CC#wp7Lb$' ҁ!>w_a:WJi Kd-RAH;H"TY؀s kV>T}嗓^#Q ̓$e؆P\oyLL;iMp[Ɉ OzXXgі HC4Q Hg#Aۃ@Wh61H<sr`"~Oed=~Q6\"aw#dPvSLWr=/{ΐ?Y:K&Y|7Ga 'FKA:4r a2Lp>ȴCZ+O?#8Q],cIe ֻ]\i3>-5P,G;p63$q-@# LQUx 4Sh_VZ!Z*GۡTS>Mi*`^"v7 ZPk>mK,O7aRf;&mt7&H٠|iwG^溜d[endstream endobj 795 0 obj << /Filter /FlateDecode /Length 573 >> stream x]?nPwB7d}jxKdhQ,=" 3%C eQ;>=}^{s_:֗e=tfZu|۰_^g>OmXa}Kۖ> stream xYX֞uagƕ]Yw1KĊ "  t ,Âi"l-A\c%EјXn4 ~7^S{?wyy[cӎd]|s԰5ҩLN%&):ʡMCOE n]L6tZ?No64uAaAN>k w^X$=40,wO:uN z;-iy<< ^0̌)Sæ_:}Ìp׈gm37-z5ﭝoυAx 9װ.#51cǍ{@az3>ӗL`1 '3Y d1`Ƌx3Sf3YLg3˘ƕqaf2#Y̛lf3ͼŸ1cwf,3cBNL(ә¼3<ӍQ2FŨ#1eWZƆgl]HYSCwP4uN,6lu8IZ-`K OMMEkL@5T5(7pVvt3L]O0C- \d%٦xȶs-}t5brJ9faw+?~@Ms LJղg`\qղ妫kpsJ#H/j>ЂV.-7mBw%82dƾUo1؛dyCg!k5H{ rxZ:if7t xqq paVj:O7LR"ۃ1;* Sd$;N Ñ8cH8 QoKꄲG1ԭ`P=kŠHaUvŴzySF)w$mQ'Ck$́QŞ: (kN$8SC͐\9*4ʖC&a4*$YG|q ܀bg"Vg9kX3ZLw% GȠ H`s_Tp![p'a_ұ;7{V[v,X,v|_cg>fqpB+~!K]:9]'q ~vwĞb!LK4+SĈ)\"/r+QGb!4ox.āR3M V/+f,>p%`WoR JZv9SdL.~K+uq Kkg}"I'cP! $SgGL psAG3_y{!Xdp|=;/c9͙ Z7Lu3r|cbrEa`SH_8_hM4[sz!Ϟ=E΁wYee\}V+d[nAh-Y8 !l8$PN R-d-G'eMZפ6zTVO٫55aa!Vcʩx#d5ث|l%rI.BoD \37w^.߃Rg7 i1RBz[& ~OLN +Z\ {oiO*ْ ݊ I;iAF a(H,2ANaW'XSb` bb*mc&E <=m1cĨFP@d3iYg `4Ԙ\Y?mf."3bIG, c!_&i1}΋AMXC$6"tVh.*`Ѹ!%inVQnE|բ74(ēi,V6]; 3g{.4SIIWT^z<* 1T7.&ObkD9L.( T(fXvW=l>?QiAFm:΁#~&DBTڕwQĉy<'XhX~6|{>1~+ =d!8mYŽVQ&l (V`"lX)ghD)iF5a{qƴH [X14c>+ \#b,-mWFigZq$ͣ̏^> qZVHbLI6̙Dz?#:G *82&Ɗczӏ.8yC3J0J;PZWR~N23m%RV~`b7ukqDsYT?(џ؟ҋ ~36?8(a~I1Ykow]:|jQ?V7?Hѫm*bE!'SBk 'N^} +}vȒk22qAǭUVWxXETVǤqJd~C C[caq<a,! 6F#`6JVnڰ{n/xSgv9F*+k}h3kގDXΌh.u[8>"}g}ͯU̅Q 9MdvZan P'Z.aJMNMNWkWAI@V͌Gwu*.JD%DwjOP ŵ+1^V<|."nZ'*-]Ǟy}Su [c0! 6Q%{ :{ q~c=y,g-=pOkY ?+&^Z[ 8U7'5)p?Pw|U8 7 3GArB 7[ w=^Hh6)^j6R?n!zi>;'adkYqZ#ѹ (w$DcB`]̅ċ Ƃu.4j+x6uv`BmlنZYme?/АZqrq4 X86}-l\6|})_ݭ#k2T0Iȫ(YwoCRz׊^}__.J}"$^rûˉCcI%DOjKKLowG٬4'v'=dSLSޜV7،" !=/hii!7ל_Yyzi;;:0.i$RD7e$uǿ PD~Q VwdV!& 1Z,}#{{%|gKS+).>WJm D>m[zJL`k,I HXؼԄ* VԲ'iY*lQ^a~Y1v".*~rVB^IEy; P-Po,mQyq㤿7Xҧ|bG`ӂ8/HPWd^ZHYO[}xf/?Zm59Qtei@<5ev듷O? l* C`-W Y9l,\]KXEs]ZQ,mjq/:F9Al/E¹0u˸n%:龲MbsA6LH_NH 2j0Bd0m)2y)(%b8MD0 q;!^ qoݪ5 -ybo\t!R7YSENkrgd`*ؔy27^loI 36 XMCI4%(bc%Az-YJbk4B &(%P p:_X'a~֛N*Ԥ8zd[-}Rsds0"kธ]UEKO<ݟ(I_"52le_Cn.ƾ;" 幐S W\Ww0#C0%?#1`d.>/.3!-a"jD'cWJc*q1{} %kI5>OJDkQcCj^ ꄍ;R?at8mږ01P5k}}-Xl=Rk[d&mUOIDO$$Oí1O Du[HHd-Epe(x|5 jւfoxZD'HE6ݭ%r雘(m}h<5&۶ϡ*;jnrфA=%$N^}~RgDElغ|O] ƌR%b3%~hyYBK =p IYk4R!L+,[ ΄N߻Lc5Ph'N dv_}D2T|K{I8vȋD'Xt\rH4RrSZNWPwZ&6q!]ֹ|᝘eP.$0zbwîGbvK t\WNsajz."|mʖ0XUmeqM &Y@ rUD' ӔaBe,pviyJM*%S$RM=a5p>@T5g~ ETV8l \HXjʂ,!0ƙ*se{uc7rypש}%ta"#^T5.r/O<x&RLJ_*7Z 8} +WS7Wʚ;*'L6гkGPhF*R nmeOaE4?MƎ~V+3`"PYZ \ W8~1W )g;n= \}䄘{jܟ"i!)+vzI*^Q^<gdg I+ZP⌂Z=2IPB hq:H%Aۼ4h$@A } ;sLfbod:۞yWuװKWBNxv$Z^ƴT;-&x|Ֆ ,ٯQU!ˎ*s#(n콹]%t≠jgNj°LiY7:v8dJ73:vbendstream endobj 797 0 obj << /Filter /FlateDecode /Length 428 >> stream x]MN@>o'y? E F 8vycSUY̢Z{ie 뵝esj{o8o:k{x?_km@n}2֏/o9u]9MSi2ooGtV(ъ4, 0SQ>v5lٰigv, HDXd(1, ":M^+ x_=\88kQ88rv:;|]Ngu9;.gtv_{`C'<ɀQ*h0 Y`o$T,(CO?9~$U,JES'O 09`3՛M 09`bԀXyM#o,/]omU_y>ilendstream endobj 798 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4638 >> stream xX Xז"e-EKHbwZdU ݧٷ&"(YcbI^bLb&y&&b}Ɯ"en8q̛>?nߺq( -Kx="ɩ Eo yOJ 1%*oq]ЙQ*boݼ)vnԩ糺t]d݂Ԥͺh݂ɋ&BRͺ Ș؈66VĬ֭\l.xKN~|Ucfku~R^Nx%-razKb-_2UON1 ,fe11^Ryf<,g|f%1f dQ8toFXFpNwz.]V|"Ύ1;€ޒǑ>U ؛N̶4d>EPQ8o4ӠB_~ UX^$ުIz#@'|m\5IcCvg=I7Ñue*rWlu '\#sUzRDkɥz]bPѡ1*nw6eH ˑn:w箒/G >efsU#8[ G :CZalznL1/h $Н5c#'A$ f@,{í" #28F0SSLzVc!(\v/q efKAŊb;\3c~G6܎vnx=}f~H(Ap~ƗdhGv0z9WYd*V޾kȗ Hq eGGraoA7AwOPK0#7ڡ&8Ǹ(Xd19N6)79H?;ToFPYl I+ڭwOAq! L0彩9%Pgzڃfɔ_%e ʾ"LU1oߝMbMCExaջ-8gE۲Ӏ 84f-q5Pe4d//Yt}!O|I@\*v sIcSty,(Y<G <#$5j@愾M=XpB@flϱ=]-j(W26hՂ]z8&fVjx儱Pc6WVvv.s!ž.0R$eTlEHDt2Mc&26&wQ<6/`LMb)ԉA"xϞ7o>ʾ xK[Z(Y\~WǬ [<}G]|zZoP`Ll?oTroęPp݄_6a $ ":$l;T>W+=;7+O\8p&"ľU]sQ(~9h.tr&!ͫ,&Iq:2FǍwHٚZ)(>O_/a]?N8E?ѭxZ~Em_PiǠPiJMZuciH C)L ULnk\q3 itԩ'-`ts\_ 5uį(;y7@A\kh1"0 d nQ߮Ƚ=ݰ3&^*`IMK\d+`8P}"4M N4QJI6S?Vt*TdXIe9Hm;r`&l^{)+W@z T#mj.8.)a)\VDg ~͍&VmϏ*:N77S{\%Tg$. { )'b?\zD?=atORz*eNH:zzB}f. ]eiu<^riĝd.]W_ĹnBP y,ݴmMI0JzMCɠ$%êsK@DXv5w5T9@V /ybJa +%pmÊiM#U? E/|.̭(/~I>Khg˧ab inܜ>]FNЖZ}(`ˁ-bv37@̉їRWw(y Cv,-_N@հ4 %n9 kaxrcn>o/PC=rJZ?#(#T;#]eJ34ga)h9\lm]yFs$I ӢWK]tI8y}Q2h(CJҁGV'qp[ފCՕ`Oɸ;OL\.m5-Z@]QVm0Th;)Y B- Kp2>u"SvhWJ9(RY;B;3Y<Y,PMImC [ KZmLV&!K\5F7臛wo@ 1 CpU2 Ai`6A2olrJX]i2xt]d!dJ0P౵4wBN7vs%j2C/!j6]AJeOݽ *{3rIC>/i,(c33; Zk2>q)@e_!!ω1C-P-wD^`fj{+YIx{ujҘdфYw_eڃhiǖ~6pҾIbڳ$_Őu%X`+Z«h ,mt{+q݂CHͭ4˰ǒ/[UZ"ɾ yV$<?Z'ˋ!$GzGwܠT>2=dx9x_LԋI`MJ6daXPBEL dm#9H7v6&z~]qɤ-AAZJ,T5'>X{; 4%T:uѝBRtKxb6U.<_bw3ٔ~^ү k/=cE%C/uK kzӝ.i梨^!'_=NEGL DAvN3%[_{5#jt˾!#Afo/+R<$Łʾ!*C]FV%c'YwtD|'̏ G-؝AO&rl54UG]%?Tܑg&cABɴ3C$?^V鱋fgԅlAETt̞wR{BTh}=݄4j^M&ć"sʌGUEƲ fj%lI,ɢe.ܡ%ǹt]Wa/.8SJ5&L>|#…vKsCHڹ*+/nj[$啦M8G*}jnS+?%Tb,l,)QyEE+K|MONKIOH |9( >OppzH*./ZG@Ok sK;FHWpR*Yj26Ⅿ{sGckK]^a4jO9Z!{GjvтY! &~n&x'm{=mᱱm==mm=SfjKXiOV$ zj5-梢# + ˬ4ZpGևendstream endobj 799 0 obj << /Filter /FlateDecode /Length 641 >> stream x]=n@D{7~,n\$\" S,}fFvCxDzOe;ݺynzږk{?\i cgu~.ӷϥux}zkCA /ܮv}_׵ڶw G:Tuaԑ"}+jT5Xև*{ u *1ƥ*[UPZTH>3}+*ԁu ZJbUA5V    1 "B"B2UubMQi4 @h4BMFH i4A! &H#i4 ALG1 b8ߤ`R Q1b1k(Wu:\]N_pu:}._uȹ9S!t :l\FNo[xCAo9 1! s7ds9Oh?T BP!OhFQ6 n'QpkjF הo7M&\SI߄k7pM&})ߤo5M| הo7ŕGYӌ9kn:=u:L> stream xyXT2 jΠ^cFw.RHE20̚zC{]CbI4X1Œ}͗3~<<gΜ׻w#zPbZ;_gS&ڹy8 a=XRa7>Bcvrظmځ?0 =D 6e9.֋&Yrvczդ{Yy:[[otb`zzw&i_/PeomK- ^"teتp.k"]ݽ}O=^|6n~ga9Q2iӔӦϘ9Y5zc5ަSs=jeG1Fj,@CmQj5J-&Rۨ%$j;L-P˩ jNfP]j-5ZGͦzQ>/՗ާQTjeC ,(15PpʒRVj(%hjSKЛH΍2"= /11a. :C;e~Qzѧ~lA~b A%Z<(/޶RY5zVC4L>L7谏={k[o=ceKe{ ~{ηg;Q3GŎ;XyC[9~g'dv 2"3V 58wj߸˸y6jӡ&хNjYdh s\1&>[HDd{JVo,T:M1 o=wKl3E;R2dfO['r=?E'nGۅ7Ac^x8,'$fggJBw: N,ha g+W=V PhSl7t'@w ak GZR.W$+dx.+l@U>E`ro11d ;A7BԠAoРd}ev 9}xbj-Xo̦B9DNp9_h%ِ#EMo[`-)tm>p :ѥ2M4()m E!ONv{Ö x:v®]<C bd]LÛ84A[qzQax_|$H<)6+4mŏH#nd(v:=_L<:Nju'H"=]:խ%.52(:UsЛcsN\Qp yT* %`YD$l/_f䐯gX* (Ps(& NuZuD9 jo<Cu2{3Lh،:$ES񂿦pX4 Xa-r4V{WjF3⛺;Qlt?VJ&#eXJĜ4h@S\r}O /QA?ʤ+v (S»ࡵj46xUx[I`]۩xL)7]pv,:.3#_U^< mv& 2 dhݔ!9CA7\ G ZnurC D Ezo ֌ j;L(-]lÍخ*}C4 749 N䩴7z£5P: .q|Z_U4! !Z|#M3/_4+iVݣ-]4Gχ)h¹Wjة4AuϰW7Cy9_摸v*%~".Ӵ>?uH 6KmI؍xU+_hq>_Sq` ?D׎VB3^Fܴ1i(!weyhFͥ#eP8ǜdWoê9Rt՟JӨaGs_*u}Q TJ "Β{V* YjU0Q"OUp9`ehofX&)>Ez q\46h`PHI1GC~G~GDYIp(sWxnY~Vf6qs = 'L/ <'ύ Q?SOmf7UouDԜ QA-WEM-`~VcTcP@CZ1mK9@hU$92{b K2YSPy J wf<+Rek`L -qXN9z񰖽(`f7OM+:FoqirgQ:K\ndC<^bξN_cmux6ӳj؂ #/Y G?K`~,>|~9N9b2(YSѰ8SG6ɞPrт: 95nyeö́m첍`T'ѫ9HW1-3=a7r9tFNw[K H!'F%A NE4ڶ%+n_̏XtaGopZWNG4]Ha+`1S-(]tZCesXT\CNR`"d<'\JlV$xaqﷹDx+ӚdF>R}ֽSҍOJ=AVٮ!=R-.shnܵ5ׄ|2Z'g+*Ń8ڂgI˷{:<1U+@fF5QMd=|k\ZΚ>|Ed9ɧb?[?ڽ,0 %[[vbAWSdԺ3ܞk !:J}x[YFXӎ3W'@^ [ZULeddxs?r[V<0 " ] (e~$8@\,,C*!;,E3%?ϡĕv~qjX$|pǺs:sv/%hg41 ;p/=cK䩈~RȂfݤVK  ,K״w/c=0ī .۰]h{=,2Ӫ@^&Fok΃4^F?4Z74#"MEIKG=i~cU>[hOLxpop[7^7|n8b  pA\gQ2R„oْ?RzA( q.R}4!܈T? r=tKXigr0_|sHMuG;: Rm6.AiR43UUF<wn2 P82p DH+rw#2Eg~"9YHٓtdp1Ē*EjrzÏ"{ EBtqk_Nh^Bq/'zEki$mJ.BuNԎ2ۅ)ls L^4ރS[{3/P{=6|Ε_._o#\kЖy="Xkth!IRWUNF6&:;q񚵲خ`ԯ/P/m|̈́$?fECdpI~[4i!4hUѱ\ѧbpVӥ]gAx(@\% #lZa^_۝Kc3k=,< k96c2V-BHTE%0A"/B|0j^nFm#Ux(8p}ư%%&*حW,VtDQXQKfីs?yñӲO&5pKOU35tfƊIdyABU{'A^`?=J0yyh.zü3lFm7>`IaC P΢4zt4ìQ}DQmiSLi!څ賗>hT6;/N30fYCuuۋQIWk+r|3Ct@%rX9wFp`W 1wk/p`+:s%&3;ٯ4=-(=Ŀas;jF Y?Q dÛgE^yEGQ74]lAΌOtD+'iJ<](!}fo,@-:h`^s˱x=B8}?pIOf= HK3 ]nI_}Z00SdI*ǏI*D)ÍBTOzxe0 sOTGFďtQ&BÑ7n刄.oe2k۹dCK3$=|0T;%>!4786~bE}/T/.B~9:zoF>=ujr>m&]զKQyendstream endobj 801 0 obj << /Filter /FlateDecode /Length 654 >> stream x]Kna=H/EI.0 ? En"`FO-e>߇e<oqpy tlzNou|6^/ӣ:w֏˱_ǩ/U۟Nmmfݔ OMSP7Tc:k45X)ɺm uԑԉ#ko jg=5ϬVxg hp&hFg hZ5Xa5y^5z V5XM^`5y^5z Vuh\"ȡq"%r)rh\"ȡq"%r)rh\"ȡq"%r)rh\"ȡq\"lϵA m05 z֐7 XCޠ7` yހ5 z֐7 XCޠ7` yހ5 z֐7 XCޠ7 . IBb!IH"$ S$!1~$$O)B?EHIBb!IH"$ uV\YB%E MJa]%WVXWieŕ%o[EoZk[%o[EoZk[%o[EoZ\ 'oQ:q33{K~\Հ,׌iendstream endobj 802 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7710 >> stream xy\SW 溕Z@A*KQAQ+0愽ވXQ*AmVmmkXsO EL8g|D@P`m`@ {'gS4UT5Dc.NkM k"e(8yn x{zZ,]x…u[EGFz[ 8favŮ2m170눟E> m{,}aݬ1EQmܿ%yk6eaVGvJl"Fn=^{|}^w`C ]8zRٲ+Vڪg֬׭KQө j7IޢfQ{ٔ5R#5rSj?ZH9S[EjeI-SKRʊZFYS˩ ʆZIRoRUhj KS j"5:HP,BBɔ)eFP!52R4^GQKJW \ n4lda$5mI?{-̙Q(QF;|Xfl<]> &.9I&&/XW&"M~,ujfg)c8LɚrkOSͧ7-ӊ^5y['sZ8e^di3|f g֬Y}Ax)UEmC>UJR rP j3Ih$wkd(%'''XƿUp?ӕ-y~5t c_*?U>6߇5+C^i U|AM9WwfocU(5RU7et)ybWF-/t4mGjkR߷PsX2/S4- N`lM|!p4~ *Bk2ɬx#A~uN^P[D{)\jDe:0l+h&:X@ٴ_P*~l L^aCYLk$+Ei bT4 DHu[g/~ؐLx*7 ʂA`|cx t|q3&_k;"csph.RpM *CD0i lœ002OvMsoY/憽,)x&9r`-OKk`UBy}Ήd54}xD82cI3̩-WJ)%V( Kz}Mb_>pCkJYQѭD5b QdJBR c%>͇!ȶ`k;L櫁D o(6ϪDɌQ;k_;ͱ/ZKnt3vĀ[Nz:'B֤o^s  =VZo/mBxG\Th~< I95퓘#,=sWHF&Ġd`]8+hcT"y؜n旉keaL Q{y4`@:^UZ(w.ŭq/qѬwuՈ^RM,z&OU}VZ7A\5@czWuO>[4%00㨶{>t-ڍæJݐH8-ЛAf t~",T }i.1ӫ팴 ُ5O эTCP]3qV7 -id|,,6xĎA^j |`F.e9b(>TBҐwI"+l/6 ^a۾?8SDeF JSo!tεII ]oQdOc#]# RZuHZP*z<7rY- 2%U N> DjHctQ\ބPĬG UU鑬\\K_jbxw]ޠbkL2㤮.aJo|rb+JA= 4~օxn4X7JVyw5AUu5k4X%txpru4j ssP9S/ڼgWa'~r8-0sYa!Q(Uz?dA6ƞ뎼VHŇ%\jA;%t ERk7@vhV)d~ eT*(JjԅGe'GUbԅʳkoYkpړ4hRd!# 9Y 9|g6Dח5t)8PTg*JPb>U |isW^yW{!fEDdhH-tASmݎU@/8C> \zvjnF&^'` f!x:Z=q1T ˆyy6VjốKz00(Y#r졾WNglWț 8(Σ4~V=ƧҦL5ěfoɸqX+Q:O0 4029_<8pXikU$GM`. U7pE\ k Ap¿ɼWJ]u C:B|Gd(l'е1tG#&>oi)V~0`>Qb6 O|:M-NqC4"eozui{n|^g iq1YA|EIxd lJ3ykqI1 % xEidž,21MąshDT.w'1 b i6n+L*~{w1%3WM$j^p]Û- g &8Y-o-Cq=ԏ+k+~Ny}Ab.f8-`A_VUэP[-Oh6xj~jR uVו7&%i.l%(z)r8b'PS)8%Wʑy]Vr#N׊K"',,*c,"#da16e("O"4E">ؗ^"/;*E^(y@QEv0`wYΞXMoN_Λ&mCfBꈪO .1#*r븸Y~W{WiuGhE gm8 ;2Y#* ㈹YI*/"g=-!<;4?xi/7+ JO+=c܏a|9600,,06VS}$1|Zu^bmS֏5"tt\۩uk*͎w̥ `tB\.+(z+3Ӷ)Q[C lÍkW8gyAlYs˧8޽69(w)tFeFEFP4mdmni{w_}'C y6U[j$4B^A~D̘LBb(i XQ7:coq+ uA>P=# }ߜʜNC6)2k1d^;M0c?0Ɲz"=%Fx15ZGU=2gP,30=xk(ֶFUOvZ1K[X999Z_?mUkVe'|˗_? uJzP'p5=4"N$~K&`g'`YҚQ:q_tCaLwÝ5C6gOD(t/G-ȼ U.0+N [=6 cԿl_w Rc\Je!a YkzKCD[1l=J9,J_n/h4)rXM|ZVhWU$@[9#W^-@ -=er2:|iFb`1WN=*Z@d_auVU>El8R'iDyEG9fECݎ~>1z]t71Ę41‚2,S$$&17k "7U+$;K3++CUL6j9[2| `S7e( GFHK ؍qI(<`V(\|::PGAK鍜ۣL2V)A]B=q(1)"+'I+N_nqFR !E< uzy!/2 ȟ^XLZtD̀b&kalCx R{h{#7OKMHLALLYTEW/#y菝C0k+ 5/63=lєDO()+x9̿ ;c/{U0}%~~'ԶUTD%&sY&Eg hYU]WVX+7GUOZ|gl `5gY$sua4̅٪}: .@I"Q9<- @m n e%j@+O>DLnun=ImX,J@fyhϘIH(7f -Ӂk\8^T֏x%@ e.+h5CKR8Nt2;YnpbNdL.L uzDi 4;Ϝb7{t ǣ׮^_QSW\R"Νo{1?>l+{1ƻ)Hf>xFpkIZC \d25wZ4d{!&apU* .χG|τD -gk\JĊ\t53O$fe'O]Pkc3ty &g(Ѫ|(l{Z{O4_CW?B|8''t#KCĀϞ)JɿJtp@u/@:dF`)LI$q)[=CH@=fsKhZ)aRD$~Wh/פ07Bޡyp0WfsMݕIlַ ܙ^ b~bKhyxت/Lz  VҽHĉ< " `'(7^t礐dɄTF46TWx^G*z ]pm~OA04+n>֣3Q)G]ٱI~a8])8KNtry$JD7 if*h x 鬨(jr fe_uef&YA|3Cen\@Yar{ 3Xl2p$^|hݷӦw{5Gx 5{$cm ߹{yϗ$0ynu̱m{G8K;"K+UwUJy7Ϯgp^[H\K"&+ ]NCEbG[HA26T-WOr x⺹\Tg >:X[f`&3cUk?x4FaڏHN!+ׄÛwa]X! "YZVt%6+؝.aNWHa 2Cq1x̿]cH#@ [ "jb#|Xq(!RSM}qх\Ch] bwn@PH.`c.n1r QR!L=z`9uo֊ʹB_u+t[.\8_ASrpg<cϸ}}vw@ .]&KBmSU0Pv?L~/$C&ztޱsC/4"$IJ7k[jBz J2GWUesg~yw=voԵŮE8i֒J 2tlUSqqUFx}#BUyXy)+GUuhyZ\<96I0 f B3UuCu_ &ͪvu/kgcVp⠭>+cknF\7G h+ǚQ\γ'&ٙ! Bo[>~+G0;: NNJcr?'/>Wp R"=\θ4ux9:8N"CKͦ E/|JCր=#Q8}Lgo"@?/h).PN!׺M kH**I,J_ M!GL4.TJfI?p [a?>IЪ,EA)hA&BjS6rbR늲hhn}Q'sꟜܱc;k2U«cQendstream endobj 803 0 obj << /Filter /FlateDecode /Length 1096 >> stream xU;sFY%[,2uģv )$(d8yLp{oD7O_o]'byLO, |ċǂ2I^/@r濓Ss)^zV)gܘoE} `W!-:z6˔a뇮zWۢK3Bm$ L\/) ܬZᙴbLe\̂xVB%x৲7N(AfF59M3$bm_&۲RAUPT Z6uPAa6v ˡ*O fSCf*x[x6 L`s5ؼha^Im6I"ВbukxH%.0'(3,T؀U "'=|Ug&BXsR;1c=32ncz(پ~I+TbI&0Im'tȾOcfoō:-*z_/MX夠Nm5'PD,%4:3b`ߧqw&n ! e z8!V[Lͪ&àtt#יEwO< pMF<aBh + F5!.rv|(ܟl\Ǧ?Q[UJkmB'gPbgYvkW]W)5 [yQGswtd,l~q~}Q߶o 8W ,~Q5C:nR6=LyZrn$Qn xu]8A0Q0fxBga몯h"^OFA˴f01h 9QDŽ3e(F' 3$V(Aw(txd,r$/j Ѓ(4#41C394-h m7' XjjEa50Jzn#qplS.iq8LLyK"Aj$gs&`zUs]~r/aP4endstream endobj 804 0 obj << /Filter /FlateDecode /Length 1895 >> stream xYr6)x:?zN;i<@KVJ7cw$V+A& !9d9kgQ-GFFgΦK=q{Ȧףf d2-Rgd y\kcmxrV8v{O:y3ZײD8̓<\E"3kn?<,xQn%tFaTŶ,6tF{9zQ/6N$dU듽gxP[a3+!s81>Hp&xJ\FUUEHL!~>MMv}.زả!UT0z]$8G(׋V b ^AhUnIUi:.R P4l}gZ!|UnC <;B1"=(nUF6U+F:ݔ9@:.Ȯe*Xb/%rL\dFؐ]y-s]qvU۟jsb-"ע) %mCQ) LĤ?C/vѧ9I,MIcm:dCNPMፚr:AR Tzh]ojwʉ;˃9='TL\*#BDEf-QmМ,:: DD1jnʨ \Zr;^'3:!cYq,Mi9^jYF _ ;B Egg̀GwoLWeVH!A?[Co$V /+8<쥘.Zpr{YP~??@3MF$)>F6W7ēN4k&=v#'ǶdJLǎ !!TqR&IJ0!*gvfazچ}x4X"_t=! ;8`{:Mu-Z[Fْ-!yxRpعi %12$1Pz{&'C"s=JMb-b>odu0s) ^rcB̆W&Dfu_KlK$t|ىx式<$&˛ xk][$+oS"RF)cn'?j Iks<ӼU|~|qiU#6Ͳc IOlE%  S ޫDIb* $at1-xyL ;Poq"`<+> stream x]1n0 EwB7Z Z%C4DgI':|Ov<sZUYMSn˽Rgto*>IjҴ_~~ )h~uvۦV|󅚝n7Ϯ~8OkDZ cp"` mDZѱҵE(Qvr"ĈT+ɖmt"`X5*$> stream xmUiTWJKWȘvcLe\(([dYPٺ]E7K@i-QAd&'1qƩVL:ǫw}] CH$brRr4) *Ҥz%K>o&qIK$ D$O$ɦҨݪys愅BU^UdjMJμ];ժt՚uqSJNd2UU q+cTbcǽr vY b1'Hb B $oh"@%ْ̒}}"=) qA@|n- ^d\6Xk+@ ۉcXрzΣJHL8h\ܔcH:Z-&0rmRӗr5105ޮi(Eр[IIx#^w 4_ ;3tN5Q4 }a lI]RRLa:%c$-ڨA16~XF)@g? )KH֒:X~KydR| `7N](ƍŃzJ6Z,SqpO^J_ZZ\y$-vx.xJNFDEC@U|eDfF&Ы7 htxP)[j)R~%߆;q7}@߂chxtYw /GCUq PsjF;&|D[6Wmma8eHC&f%*^Vo'vQ ocgHjyӚr&7a JzuRV;_;hKk"S F:fA^?YZ=Psm}'Xm@lb+FRR`XDZ4oTYYQ!7j鏡?Ê0ұb@RQwƛbθmqv(چRRUYoy$\;tiQXII0OtjHGel< rSa]J[w@vóTE9>l_Ks^u yEI6Uhh]:` cH ]] a{mh~ 9qCKgIHe9 cASI!Nѥx`L/g!Ћp 3tK!Sj50gl!{r~q{= X2Oڍ_-* r-d2X'կ==*q> DHc!OAH R5j>:CV: 9sO 5{r@ yBc~KA􀧣ԍxG5Z`:+JjwYF%bġ M~2 N˨aqvxPJsVؐ?F$> stream x]An0D>n`RtE$ ,(΢̨1Lkfhu޻V{\yoϽnjon_g}o{;ⱫN!e)-˱cZN00Ĺʡa2R KFªc DH^&( 3R0@dpQ+#D X!"MT{d"T0 oDLTDFau!%V ҕ!duT$ ],l2X00ve`aa`a`dh#!+Bbu Y) K0d2d$&$P۱ϵ׹q?$((((QS@#+3#+3) ф g&\m8p4jن W6Mp-S@YF1Yd.+`f4Y2eJ(#MVD=euO^ e~{[GЍ=ߟv۸Nendstream endobj 808 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7536 >> stream xyt[U%(JuLx L{ow[tOr{c4 $30fx̹xf޹vh3Z;Ək׭Ȏ.;"9!j⅛cr#2)g$aa$IO̚[zw+/NOMwf+ 5w=zi qaZx…uYXdA؊Ea#"RV/Z(l}Z6/-5,2&>"96,-6lkΰm[޼%l 6n_W##"c#c#"RR"I i䞈Ԝx򟜬 rw!!$.DL*#kU9#DZ>fcܦ-[<2i[]FϘ9ۦM66mmmmm= Z!Z Z)Z(zJHA3%gE='Z-h!Z:#ɢi.#AlĜ.vb-b/Kerq(hxb\o%_^􋛒n2L4,;n/MI:ei[gznw|.d雦[f,aqM̜͝vk1-ۘۘ>>ams޽M"u_KW2X J#*qn zO'T q0Hrgk iȖ}5E Di^5+^> T$1U`6"ViT[tWhYt򲖁?n7 Ͷ@M?z 릧]ёK?|_ Ag3?E t'ѽC2Λ:~ք}@O/=(F{lrO.-kӏkK%Y8g`%^nb7{ 0c(R -hh×%| ]|]{iͩ5k J6ϰWbYG6P!_0CM42mζ@OŻG\L 1nE<ޓ s%:윟9vB2EGKM1KɣeXLWx|??U֊9nChu SSY9%OM2 X ĝ'OK*~X˜&I00URXa>;I1~('8F1yxctYȤ}?UCLb fYo9 Ϻ۽E'9H9ڛ[ӽU }o.~YϠ|y>a43l Wl*mܾ:Ql`WRtAWjh?x߻U>ĸ#:e;`V*l,JjWNGz[f0 `ogԠ#%e~+p&A͡F+ѝ7sn ur2YȢ JO;X =FbAJ82AWo_=f%Y/?ʘ'I?]$EAVk^z b7=BCHM~)*:5WBgΠuHYq1^&sem.S+ nFS*G=;}q@%$VAU9&36OqBYP5?X&@F j-"=,ſjZnrQ@5ʯ#XAU'Uᣤu`g(Yn /o)jG{~_dN3@bP6_fZ_{ڡ4𠸸Hi.=Uj +x3ߠ/{n݄%.H#,p PzF+4,"?֚I*].>k RuJfjeup>4[UdSY~PsyÓe|ȥ1(?RuwàpqmkVƼÿ1J=P`GyfL vd2a5,$ %e73hBfgUJ5n4O;FC926@aP[$xV5ɦ B r /wrf8a)rRȥAhP|2h>}om); HDͥfKPJ=s,܏W})1Ank#Ђ? |4LNGw:Gz7z*A7a)XJxqR41ߠ̢:az(:n dgK_Ec[GXሠ9A4 IVTp81()Sgٍ_:zeD,7iE>$Z<_TPȮ?[/_*=x!#;3'_[\Jx mzh68<\{CiQ* {r /vءwsy%^k@sD+~ P_]y de (-)C'MS}==UY~rޏ~6+'=|y_?Pz\'y_,} FCbEvS^/uUo06+lNwyZN-Ud%mbH]G!  ..NOH/-mm=#?`m7*q֞e lސ]K9-t},sMFSE5%Km?F5#d%F1Zu )/IH%ڕٵJj{`;ݳ$Shk*)6:-bgsݎ'^P2IҾe%_%A4QG*؞Wo%$}JL[p> a}^-> 4ؽM˼(%s~6"+;%;%6j9Qnjrg}JS‘OټPBEtz2Sszr]tzgqx>MB+H9^a#'Y`7ip]^I`{# W&UYXA[: qQB61kifs#(4e0r2ڍrW<6BM)MѦ b2T9gsلSej?J}T8{OI.Ya3 .mzRZ[wlHqp c$'l{Xm4"_~)x9m>ݣ+鄘7revx:g};"x`b5fY8.u9T #H}2R?#h-:U?OO-;f6²j?V_YAWvF?hܪm"KČdqTDHȦحX\L\!-TfF #u%fW ќ/Zi6c+ggd@#%k\oV n4M¤aJk1hq"nEA~%yk8 s-=bWV۩&WErCgMV&J_h'p-jM7U%8_ߕ?&H&#<s$r.B% TmA3<Ɇy<>#:1*jZTAl!zpr6phsTp2. Aϲz2Z] L?s\& [oI?{7R/߄,:| SҢ'tr7~Z^,gC?&ʱ!WNUu%&[P5A`9jo^.9=|5Z/s9!ihZTe>{ۿ6& {O< /rDP;gBMG^A8[uXg sj_ĽDWFz:C؊ndh(ڡ<ã !̅BmLALrNkylGA-fTa訯{[*n7מ9Ҍ)Tj)J (`s6>V(/n*k^V<hrKL{4'ڷ$d99V(nሥy\is %\'ZZtbVi*֖*}1UB[4oFƧ:x!לyIJ E8 꾠VWąHHU*M5Yd@Oo]CKu3ʫ*c"k!BO$k2|PHdPjp}t{A{-` _G{vA @ B3<-("YeJ.Q߱#>Vci\lM#"D-&G{ї?Ig*W(< \Ǵk5=rl$O7R*WvKkcj[qWzզ,e?  hI:7NC~ Va4kLE5FCFkCe{5]{_ D4oXlқx/*] 1ha :Zm73%FiҲByI/mXpZ ogvP3{"y~^pH2DQX*/nP9lEyB@dߝɍh^N,<11^.F2O}x:^ZS4xtO]{`͎eqKZ6:cnu&:T~.nӥG8qei"=ϒ0ݝ=@ j' Le0:;I!4 F^qY[PW?><%?r?1 !QuTkQD˳|fe IwjRrPm2~}6ߨMog/?`]@|)~K2|җxt8U4nx+!yvFoܖ u6TJ=sBWh+AqE~QY ^;p&,lz>Kcy=t4 kǝk6̚hd}Ǭ_qbnӧ3 _¥5o/{HyD5:waUsc"GVMD7IVUDSʯOU +p+9Z8rVMbKGf+sib56d ?"ӱ%6v*Ij(tw]`-[ Ԧ]v9?I+T%?,3"('Kx)gއqo{B9|J J7B<~kڤA> stream x]An0E:n`K$`&dѢh{-" WR]|"o<^~G;/׷^j{/t};-AzqkNO_ﭶXP烿KoݱܧRyb,U0\?2܈я͏Q{/~$F]點 s>  0 2عd=  0+D/UȮ3FAVVFAVAV+ qfԹF7WX] kR&TMX9A!I#Q#A!I#QðдظЫ_cL 4$_kr6:|MF ,L+Ϻkϸ{μ/\~ G9my>sЗlZMendstream endobj 810 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4717 >> stream xWiT׶p@ljr&΂q@qED@E@]̈`(^fR&&ј]ri47x֪}}[X[1 ~Qn'Z޾);+aVp%;;)aGy@@B2$F%-+ ދN w1nOu Hr3e`X6.,?rˢKƻ|/C]FFEot"h˽]/Y=j  _*;48ŸaёQE/Lܼ8 a֌us1w&O6ccXYƋYʸ2f4Y͌c2y,`13d1 fƁqd2U0*L Q(`PkFV|c5h/뷬6M'ƚ۷lllЧ}߷Y+{>`ʁ}~:yib/1"l#j]r!bConޖZź~QK_YyCg^.XCju:X h#"Lb .fWN?W\ +;Y3nƛRMj ҟ MdQ?#)j G?X_}86':|f? ~ ~ 8z+S{8LޭR(ڪtIFL% >$`'Ǖ{΢yZcJvvXtt)mձ1Dă@|8jӼD|$ZIJ5ۿ;n:F~cb=}V+E5=!8NgK؂>}?Bfɳ;0B5q,?hSg= D34-fJXkR{do"Cq{7HmGEb >2m5r,RW5y($o^2qӌR0ATTT9Fa1e0x=&jǵ^veK` ޑ?+A* M-g[źdȆhiu0.g؝dmCO%{;F{AeX7UŻ+jȻ=gER#nf樞*KyB\SE}4RB-͊=7q=}ե頧"/JGm|sVM>;r1; Օ7 @2 ~<9ڌJ?kQڨv'zb+xk5=,y!f0n73IUՆ Ch\O k]-c+q\.\ ؞%iFCpۡJ#ewgE^2ʸꀙѸY 4]Xj1XCӟCKGb_;NNG+Ӛ7hg <ѵ ͛6Ȝٚ B T\??,fAImJS L>(@/tssWy4s$FZw4=[Xȟ:j*;e`D _DT؇?Rؗ$/NjZlz3 [TۡJAOT\] Ulfv{Tk}tSҾNvU컉Ԗjs=+Sw̉ 6/gLYR{N75~nTpqSa}2vy:pd -p1jd7xbL]:OqJ)O"v|Se5]xSADf!۰^{]ۇ_J~}+ܥG9Ts"֧de.ɑ U׉=a1+[u4$5dA/]8~ߝ/W,!+&G7Y+T\ӿ8=3L_TÍWGu2Eǩ1ozzyn$U6[ )tbyp%-YX5d ӐetNW!ՍȰyfU ѴHk K]v!*_^Tq$'PXO\j-y 09Coq'&&Yaz l6fJjW^=+Z=sWעE5&֊Zcw)j; a% 幚ꖬfgpny K2@'GX2Ekk2\wd:d&kQ6 2|lGq0'h@:6l[pYQ49T뷘7djǷ/Fk~y@޳yw8Ǩ5?'> W ,١BJ Oݱd_OęI Fn} * 5F5[#|sa1DteW$밓a$cK[6lͥ&*byU\j 1%ʷ^Ζ@&݉&:úÇRϊOmuoKQwZwup{-s?9A~Cb⊏ aG0 v8]'de[|L{CMR\EBrDƆ'G5apO=%t4udsIp ,lq}ױpZB+qPT%㥴5GyD_W 6, ɍz?xr࿗kQ`ӳ׭yu*s]zCw^cL#f' ?jO=;ڔۄqT|Ǣ!1q9eMS>+(85Af'"çw;2W8yM7vs*2rr̴[;6|NRe'_s8 {mVgT!?q" z5RoTes=7I,EOٍ 56t%=J͈UZtIܩŁ.0k7]zSU KީD7LF!6JWUeT 3tb)M~S!*!&35[W`df;D*&lsXYX2܉wWv \>*LMM*R(p,L̪:: $ԧ[^JBj*1V%Wc"md4E&x_?sXh*E0_Ov-=endstream endobj 811 0 obj << /Filter /FlateDecode /Length 321 >> stream x]An0E7$R4dE"1Eo?CSU]> stream xuW TS>1Jv=AD>'PV PdPP&9$d <2YPT,իEkŶN^Zھ[:\o{O]/g嬕??߷"Ə#X,/>!!"?Y\-,*^ )'(,7;0>.[͏Z&@(Bǟ>ЃgJ,nhk ,WDxq̂}ED8bˆBQyaAD@D„ۄ"f bPU!̍x='%bg-Iw&&]/˂())776UMGSF+ps=vkZDS'tz@b6ex3ke*z3&'Q8vg,2C@JJ3A \ϑ$޺HיSɰƍ0>:7xMekׂVO/F5sh?Aky? u> bAAb.I,U˳ P\Ǔuw7A[jX=F>m:-7&qmnY(&#gzm:Л(-v@t='77v6EjR{mk|r80+pឃ`ώ 7yyϩxYӌxo`Vbގ,^-/=_Q7RlOG>uy >30"_A K%,X{+FZ dyjXw"h= "Á߆YQ(;F\֤SR;ӄ;ކn>䟽q@T+rEF= btC=x?z28<11f55rK9B!h) G;(jM{`7f{[ a9liҗIm=ns =xF-UԘ"8}֣}\XN%s@hZ'*!;9B1)xu)W0kg>O,cjZ ڵ7FsQ&n2 OlG,ΰ]UhTASd*}ۗ834&OyX%SOPBQe)S?y*(}FůS=7Wogn\+>}~!zߣbK4}+A ̉  'Uײ [ԡo۽߀fvHF]h۩w6YhTRZ!5 :FbB>dtMDϣi&րZQzՁHܴ7+iρB((wKRYee"Ȩ2l[Xotv{;]Xe(loo+sId&KPG,9G?syzg8?DJ<M'^/_Y*;A{KL6[밷e=APƑ{ę#xdz{Ճf4MY;Эpˆ(ӥM*.`"fAO-_!\(j6v`9ϷvvxOy5dHwUhu`'ܻBW1)K=V4~5 6~x6 M-FpLdPG]Ѥ@,5&?3<fۇ~5=RbYԐ'.jʴ5``\B  fַT[m4s7CT LLniDq?^ J+`!3dSY5D~8>&uLX\HJc6pRg%\R4vS(=xtҦAt[Iv C+ nhh:SKo/%8Ux%S2>' A` ^Ei}g>PrޫZqU:jNBMΣzeOWJ_$U{X[>ke?ڀ 8%[ Abzkendstream endobj 813 0 obj << /Filter /FlateDecode /Length 267 >> stream x]Mn@ Fbnd"oMȀYlJ]> stream xe PSW_yyBQ/RQ ʏ[-jZ+J $1Q"A Z(+AvlZu=kklߝy3ܙ{yrtx<5ۣOKJ NO٧8 .]S\11yTueJF"^pųbꝉ iT6kfK*\P!LFʣ8ih&醐Ca]_~\*UE(GQ6wd~s?`hrR."ʕrD@SKWB8#MQW!^*a|t, !-LB븗CH"DAz :~L6 YI d&޽P+N(g\p{yRDg{.pD'M._3^xۆ߮b9bW͡@@Q/.anz۟N>\d bX~Y!Si@˪ӟe~Kʳ8 -piw!a9*9X֯8Y7 V[khػ E%)ltLNo` piYyݦڹuڴ}?=lg8᡻h:os֮O`0dq\餵8s :{]'hqYyt\"J Y+<|  M[DX q#l(JK4 ? C>qx%kS$[+{6߰n2"~I? ;HShk1=y0"#yK4{$ۓTEk w^Fs]􍮏JDg(~\XhpMpU":ܬKLQ~i'v9[v-[߲ k<_MK.$E*FOzjVpUrKl2w?{4 ;-(Ӭvjk]}k12[(bY *lXUv/NjG* ^"N yL$IV Njˉ[N]ƧD RC&ψ0Hhʹڋ̣3Ww5Alt88?+,n8?JRK7+>fh4ѥKJ50qx'a/Mw9 v)GSqO

1,nI1+i)JEC`a^ 0;?q_vqNdCg|U&ɰ+mDu3W:S͝ՏM??Tlbݮɱz]X>`<&9#ĵa^} 6@W@ 4s1 ỏ^cW<vXx.4 #\(#8ďG8z ù xi}8uS3I6R1z%)$Ԃt폭<H'4ZI8ihfȘ'}$;&F_UՐ NF]:-T&=)*O&iߥǥڗPYQ^K[zY'PKȣחsqL eR~X +endstream endobj 815 0 obj << /Filter /FlateDecode /Length 424 >> stream x]1n@E{7Вܝaq#Hrr4X"hW"_;e[oq-]m>(ۺ5]k%}ܛqr~vv>^UsRq{%|YmQ:{ͥ<cV#1e8-+!LYәvzs5+ayy&㐕"/G|F ۈl#9+@MX aB ~B Im$BRm../{"LZCT1@x cP7 &}Aݤo7uQߖ$\pN!t :\NAK)s :Z@ȹ9 Ncr8v_B+E___wVH2uendstream endobj 816 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5514 >> stream xXteSt ( (^QE@z %^f&I&}& m$"H BqYqY?&uϹINd<8`X-_f.rRfOO(ˊ<9 TRA0, <؆Q#G1b[*ULo^Aa)?+#SŒ/N\%ANV/?5nV7)ȏKNǭMn͂5q W[fL^KNff 2G҄< /W8/𖊓,O]*cuf֚9ysF}C; VjbO!9b1H#yMb&xXL,!fKerb1,`Xfeeوp XV>3pǠձ'zJv 36䇡9/D∿?z1Q#o||_=sF'i6pGsEܫ(<; ESnbEv1&A8nE-3zJ /5 H][qӁ]x(aW6S[6@\A"T:tN࠼ow`jŪlZj:\WRAYv?Z]jCrvQZo٠)뫽(GY{w_CDh;M`3~M8[4=E)SVǯd୽!D;vҥ*e\Op% Lo/ dC(P [1R[!ҥ +@.GB Lp|'x4~qymޚBe}& }U9UáMI1#foވA&B1eJA\ᅪp3HtF^J3kWTs+1VFw($$g6fW0/bn]RfҬp4j7Yph8 a]IE1p-gq `(46npvS)KN-P}1C1 <3ὕBg0Wq+yhl*lGW!w-(=A_&NXU%rȁjӇ:^jAmF."<"t7<9pKR*כ/ٶj>kCMfGƵ6Է5ۂ/ۦԤ,*ilكr X-4]M,yܜJwlv: V{gnyQD'KҚ@gߙ%˙nQwPU# H"qv8](,{K:ddUgn7:У(dJX/aX*r{::M~CcW z5.>(MjH5 4`JF`TczNλv][ق% F1YCBu/Tg6haWÆ2(hYo7JOt%DƢa R 0`}*L7WTwM.${[>0p-hb}~y,_lAMgc=?kpm+ W*ӲSTфP2n,k3 7еN<PAFl*bXK@.lyjKŅ´-zvi R5 :F6EEm]}C#{|Ͷ q1j5-~Q6K]AaRnA(R4Bj* ʡ;OOf'sFFӥFk ]x7m`pu0ʦXQ3oc2 qAp>مs &7_.3E<D j?v=LΐZnLQֹBVk+}q)^RMgB)붅?݀iglOJsoPl=ӧׯ{M1eK&39x>R ]z {?i]ќػl6/2p52cit[k-p.Zr0aiu3ľӇ,܏+|/;ddFZ&?6EmwK`v .mv(%?Ci߀>fD$V򰜧Ou#Vcv@xJZ_1cm^ |s jZY=cޅJW荔hdWqx @hf3l4T0F#^klxP 3LG>ā%1D%@oذAiVZTk_F_Cݸss v}.3f}s9"e ؽcwwwU"Sos]o׬B}~`b.bePsFw6[O{$k>cPO@NRX/+64׵P_$k!59VZ5WSvlxIM_ol(<`(\ՖkC!78zmvFt\@ 1+w6关5y5p|7$2@'%s^J-w/ LNɥE9rYe 4`5˦Ùͪe;fhV7ߑlrK/aV,^G܃rNj T22^yZdy(kN|$4Aâ,l0Y˿@Bơ H׵445P<5;ߺ{1Y僞@nVdW7|Ŧ%x Hj0d~!?;4 kV5z#Fj_ngl>~j fnAWT94NVeNY^4{/vɨJ:Q^*heh~3zw!B EtEgXMVq#ͱ&^ ?flûAnc&u=dF;Q13JH'BiJu4h6VEFkHě5^c:⃽zb6[ vn\5>ZϗKLK>%_oύBB/5Hv5:*O=j^b rE !U5@R|@][PW@MVU>5|=9jk]Ea|s?aWNj@h&gҗxKHjޣun/TߊBjDbbZ>X]xe WwׅNlp1ziQ/onkU/])=Z%W S% A=o(({8gkFG+`1AcT$'WvNihS; ǭj`Yd~[b#ǪCTCmj}P"(vdf7+2TI~E! jqySʭWCNF=EI%,͑6#MTxiFDG333 Ox 8YgD1P͝7ߗ}N2 cfXWShV vQd\7+r(2L^s2u->/LQ(A%Uȓ|?9 oР_Ac=pQt|.kW9M|(# a^`O963M9&nh4Ķx#˙8 ٸ5| ;;0WՀ[?׎aj\B]x$ "2303/h2P5yOр3@8Wehe' Śφy:ynng7 82pm f5U>a6wlY&۰Gendstream endobj 817 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1357 >> stream xu{LSW Nt3BVdNbRhﯷ ǒ95tl , ӽQ!F69Y$Ӟ>?N$_I(n޲`Pf5,]8Ŕ]oLDgiHp݌<[AR2r#gg0= {Q错\Tu꡾.QCMM/4[rs%K/^, ǰ ; KrYCA&)fK TX*~Qєcb mlZꆔTvcִ]?b*\=MYV#1PFaQx.Ul[d7[ ; FGb5=Vtx@ԡ켨h4O;iD7nCM(h5}PIrI:S'͓&KFx A1c%̴Ji<,GRčJOִڡT5ud$ Œ?A4@]@zWxnBkZ4GqՌҰ3PL)RԀzH"t$ ]HGzk?j_wDNe?TUnlNZC$DO\-"u$HsBZAn@"w{\Т{jq[fBV[EPDԽ}Q  MQ]%/ #H=k$\{#e hkU8$Ht,=b=(PD36 8G#CvŌǀ*G H!D# ֊:)a|Ӿ_-#@1L'rn3F|P^e N)3t#+J\tSS<)"NuhҠ{rHb*kE^}ٓL)SvaU_"@xHRbʂʆWB_v{E89^2S1@ @/"XG>~Ya| ZS OyeK؏py3T@"H,:G5N(^ACC==NуUu]H!"X&}3٭5> stream x]O10 $CY ]Z2D! }Ipw'y_{g!z|Rc5"HuLHYƻ w dv~W3uى=^RTn"TU2rO:qfH)dJQ5FrT-UrM!`kSZendstream endobj 819 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 283 >> stream xcd`ab`ddM,M) JM/I,If!Cg<<,{O"={3#cxns~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+kaw(#/c`bdd?U@'.*sdaLf.^$8uB7-dɵ[9\sy_={&LY3gɽ=< llendstream endobj 820 0 obj << /Type /ObjStm /Length 2325 /Filter /FlateDecode /N 86 /First 785 >> stream xZɎ#+fs4O10| *` 1HQRrQ#17`ċ$3K.P?; ;D/yvQb@z)Gh_Y䜵] "&mKA.e%sqY\{ ^9˹9]&{e6@Y6e) v&j8lStdmj`vm8HX:lb rQ;DV'B`q(Q)p(:J֏((;"8b}9qCPb851ؐFQPYUԏl g j\j=m8löm0(p'%QpvI4$;5R YL :azM^5f13HC:Pv(h!ʏ@Us%֝1S7H[9UňvN1"m=+FdbDSAIPe^ QC b$݇NC=\_~ur~|v&>P·ד|z~>:O5:QiP"^p?}-UK|-vׁqdc·:|;_Q2TITS}ưRIϝtm귗ު!HeCTpw5-[CRҀK0"cQ҃Ҥ3 JF!K>KrgINY2Òv޼Bo DhwBJrUS!H1nة -tM2ẍ́δD>F2!7"7"Ջ9AR[خ+t H8GZ#N\:] IR1:4O$Ә'MŀbaŘRyrŸJxy繼߫MRY:L2WB5h`YWmBI]²4L ́jl6z$yH#&-4j!5 ŐFДh )CL֍F O<UŎpV#wcװpѕtt@52R@ W-}q|tX8Z(c=C GgZ>8p`S8pL ˿&;&Iؿ1Wc-zyRdyǻs̸8U[W+Ot=.<|#a#U7x CNb<],UeVZ0|H9Nij!9)ؔ<,S:TKĽl"E:'z[bxjVDpTCZ.5RqEz $]"i~F}:)EޝF9~ꄯDz6t: (%-4)9Pኌc9e C5cf/"7hc|Fǩq:)Eޝ$R~h׎D%gCNia !a(s)| 2.Zaռ j4Q!jޚ(Ԩ97j·j>%{ۦsFρwM =0~ZQ0lr<]U;xC}dO+uLWyux*2{2Df2un߼P_9R ܹa!w_5nm9隙G*7j,ˡOI"w92Smp<^nC)FȾ ѥS0n/qEzlEB H<]n%`6Gl}tFQj9T)IBWfo@YYV"ɰ#`(rWs=*r Neȝmh|"{EϧoO(;% ruor~;~@8]N}~tңKs՗BĤ>~pWV 8A7rk݂ÛOe:$ToEs^C"jOP+;"<0ldboз:}Mлt[n"0J9R Nw'WAqt>dʼ2?.endstream endobj 907 0 obj << /Type /ObjStm /Length 2530 /Filter /FlateDecode /N 96 /First 885 >> stream x[M WDI×{ !am  CVK5*E=>QRM WBqP+op]VO]G3d$Vd,`p ?BNV@Ek"VZ Z`)ZAXSvjRkAM+(Y9Jj# jZ@L%vd+$.dME(VS\\LV@%YDBQ{A BMVuKXMq)sRpɬ+, Ě -DǬCQY,Ď3YAt ؚVSPVgjDD'l#DȚIVf'Ѻr+)ZSvmpl&~Ч1 d+ׂ5j=Kj8bF`mJ!IZ#$HVj`ӎ`Ql`%ŀDy%gS ~V%1 +1U10>G: fA ZPN1(Y7r/o"[[P^eu{޽/>w|7/eh$ս?<۽᧯zv۟~+v}tˏ_ Y>W/Wۗ'9!pRfZW?kmO܇[n1 ƶ ` _,<"I|Q`y-n *|pq\=/0nE<1-/cM|TyA/M(FMGY #el^PI Y\?UQfjsZZGdv ^,Kܳ?8767_/K՟;}.M)rR)>"%צ/0G=v@涂+rN{lnZcP/Irt;9E_Bc%&G 0SrH12- Ks:g~rhG#,q*|v>ɮLl; ϕ,=Iܳ]vR u_? a2^koymamyrB;Ͳq7BUߞQ_Z_x |u$_f8pyx @;M.@{.iprx/JʹgTCr,tegX#eendstream endobj 1004 0 obj << /Filter /FlateDecode /Length 1134 >> stream xWmo6_] [_uWZܱUnBRjm>E9/9 iC9b~/cP׵D{hx%61SDhcf%Ze[}ױ(,?h]z(AO1/YZJxr5ɯ!g/jWWWDiH >:/Mca[*y>Jm>iqNo.>>\4ۃ N X]r|vE jClȷN>(+L%DkrLNh~Iendstream endobj 1005 0 obj << /Filter /FlateDecode /Length 1556 >> stream xVݏ8=/h$\hMlǎ ~RꝄ}m6%鲬NqBUmg7͌?z>&rMcS,wpy6 fםBxx!bܛ:(ѝ}w)aXTf\R`,$BuwH!Q޽MЅ3}AgK!4*=p( ,4V6(9ۧ>uFQ҈b?aZ bFzneH2%D|ѵ< KS"9y3Y~62!A#<@PA  6ӇջF esRkV[?aY7]ȤϘb(λ}&3'(K(M?DpJblz 4%ikPgT R>Ð,^'u4$hv)8g53?fIMͭY3CwE8Jq&6J1p1JCO"xě(od * UsrDʄA])jWG *iZv_(fjI/ 3 <ŌK{ph@=^{`"힔C"i3 wco䃒kTٴ \LXsz Ob&$Fxo-;Mئ'X"Vgo5J(1ΩhBzn>AݧhCڂfZw3tGSTR꯳sYXV?zjs|=]6lԭ&L$Ws\_/m<UWxk=#/qPCU8OeNigG,3F3=?={_/oL*SWO,mV"=ޣz0C~ly|Zxpo7 t-iZg1I:eY|O˓]qLz޴qNB ȹի'Wу p,ڃ.fpak`̷:à@#ڜUkCBxW^5^gxyRT^CMeNf1<V1k]牐vF\BԸ?nWdmU߆~84@SCGlsޞȅĜ;WLe$ռM-.:}\Co]jsIW/K @/I_YsFw^Nӗlfw+T3-{gDVEWk&hxO=h׆i9Hg'5BpZ> stream xW[oH~@J+[3;j[9l>TmZc wf``8v}:A daR=?>mv`_JhuV: wC1r@A8/Peg6-bp`MGQkP5L2e)&5GQu,&CCw1?kPC:qsT[x0BjQH7k;H)qVNm04QI2^O= :X?ECp Y2/ T?Cp8?Eض6%I"rn'ÖS`{ą\7qʾQNHŽ.8cͫ"/X*;~ndŢҋڰ Vq2Y\܆ÊZNs!n,إ_ R̤̮b{Pe@qpm2UjԸa##*CV 2uXIIMOHq}uۢEx7}>m:Ⱦ pn8lхS,ҌZ }={y\I{W2sœ]y>yl yQo8sYO Lh,y KQ#LL/WTt>K/F.$=|QG5^#|O&w;ܯ{̡QVkF hֶL?dc|0Ge_ dl VT;yx(~jJJg{橸y*uVL/&2^ >w1{ qqKi cåo]L6 Y"X` ,m}?qkU;"c-28Йy]Z45(Ƌޖ:˻C.)ՈUHZwZ{@LR嚡6]םӁH~ڲQ LI:M>O 7LQ$Ov-T9: sg=XԆ棆+qD{EDv!ÔC~}ɢ^;Z磆hS[?~mendstream endobj 1007 0 obj << /Filter /FlateDecode /Length 1279 >> stream xWQF~*~@]#ذ6MZ>MhȾbcKNU{g]lT։efۙٹGtn 1ƣAĮ?6kb|F| 331Ǟ! 1 }9ء^Hڴ͛6l(Plbzv9:e: hB5almؾ,4m(|tZ밙Ktl`{a=G@GDX$eu)JKO0"hL::n]d@QG<@m/CP:Rۼ7rѾSbGm.fQ`1HȝMCu^XoBPRgG{ hI]<~K?da-H6+re=d< }UCԥm!N .ҶοHE^y ^#mۭѱگ{+82n61k<Mu+Nֶ_`Ee]}^l}z8y #XLRCc~~Eg0.C]L nֈXr7Vuɟ!NtL\NrhTZ!r\dQ]kXzz1?RpXir?1.W& U\"yT]p42B/T LegYv{{2x@iʹRNJd5շα2HA^U:6HW-/!xnYKTpfaGM6 u 4="F/v,MՔGC ٖ7'?t&*"]? i} &2k`Τ+8>bw!M[|ڦanT>?I#*^E3"D>QT[1^O#|1n6HFvTț~i endstream endobj 1008 0 obj << /Filter /FlateDecode /Length 2318 >> stream xY[ocB 2k۹_i\kT(ic,IFsfg/Cvy( X{9s;߹MوzGGw{?1t\/FN(RGMn5ld(:F&PҮ8g"V’%yД*夵mX[aud>KxgՖ Ӫn̬M ӣPպdL=-Ƨ!.,)UqV72c.55ʐtU4q2Qо k/ټnaf O =Ӄ6^|S^p}9.+ϮܜbDixt^C ge}9l1M}#RUi;KR 7*)3w06X4WJpv*eVSNSuA[Z '<Ӈ5<%,[brzpYęN THMgRCPPⱽW-|h痾mi wb!tXGxr:osqO7"BB{)1ȳ$ G0o'lǀnXZ ބ< YYiSSaP!Q6uwl^Lnz#+ Ү:GƤe[ '!V<9PDI}cZcm; rfs4j51o}? kP}UQS0[D62ґ \")("|}ыKDR;C,JML8b£ۮ(K|UlsQnI1õ`l uK@uGJ] kIMMDD #R_%^7 }hol8q!IdEwYMVz(*rZ멇<"r_cה"X^Bl;~ٍaӺyJP؝5C2V1]2B˽&?Ͼy@!@=rX ƧFA8~ȋmjزeB=@j Mev !|y#D5FnCғڼfX$'HpF'x nj)wMm: ?Ñ}(0?‘lA] ZKn~RGZyjuD/0Vm,h@"MuzTLɕxO*#:UFX1:R31#z,F-mg pD2UTj}3S*k,10qS5!ɇ+Pnh6~axDpiuy L~Z S[!Ts5jȥjh[vԿBݲLr 5 sXՕ]ܘ1lN- G/Ο]ȓ>e3"Ka?@hr$ L憀K>3VL*0EZħÁIvgyob8H™3+OZd5Pq8~0 O>R_t a, T2,Ё&B/ e ӥBBS*PXLV P5FJ~^V[ϱC6 -\:?6?W\H?]䰗e@/4E,t17 #18: 2& T,(-8jQ YC}۪8I&h4n 8r A0vzE&7v"Dѽ;0L U^Ezb}Fs9mpLS_`` ZG4eKԯFJ8NMJ_*;hp C\%ţ_83ЏK'q_" J&kL~cw_SXwbeCa HMlQ,o†_~H2+{GNA;Wwʛv_aKvUd?endstream endobj 1009 0 obj << /Filter /FlateDecode /Length 1176 >> stream xW[6~ϯ@3]-0*mwwԈ.i]}she[C֢褃5ñi̞Aϴ(-16gy!MZ7z= H3MAxEs,Z6#` <`RJE_6t /k%X z ~~uN:x؄Z a:6D+2'M VAQq3ݞk?LoZѰSίvDv_0SQv?JvURS2e\5o.MReUM0*Lj(EbQzƀd=4tp$ωOA^Y@r ϳ{(kŎp86(aX<ěhRj~8ȸ3O\Ezt?wnn{,MZ1H"i8 Eǎb<#gVUU~nY<3MVr˜PQpcnAu1R+"uСVIsh m#MexJ`se:rFr<<37VxTշ>W5#_(obb55\ lU_|w>#64g?!;ZlًMH]fgfz%=٩K:uuz(kdg(qvhmnooeqCR<7IU_2Jg2!]ivQJvU;O] n3z}Ix&KDnZɵ@!~} JDpBWPZТ?..@t%:FHK1C@jN>u92(wzXpeCذI'Ay2)+w%Qa־%lFˁ|p~f.i*9OF$xYy_pO{Һgb [9xQ 3}YnE8+eGzL (k|׻aQjmجϏKzxaZVgUIp[,]h ZwwjDK!Mn5?E_˱endstream endobj 1010 0 obj << /Filter /FlateDecode /Length 1476 >> stream xX[o67m?`B:`r'qL6+`Fy@jn-˕.CBʖnCsH住i^o1~{?L-"ƫ_? R ('\bלڻ N0œX./6#KVj1'Ivj>w])pޏB'kePe8' !%yҘr ĥ`q6bT"8mV(:ҙg E낤ΤнnCyO[9,]v[GIۅ3E{9^.s]>7o~0YPN""qpX=p&HFVzF#00=zduWnQm{CH ZVv|~W٠Iu#C}wk/Qz1h<Qh2c𝕷y,=S ژdXCG_6om)Y%_7_u6Ed|y}2QgwMY^uGJ\bؘ9vܾ~d3endstream endobj 1011 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceGray /DecodeParms << /Columns 156 /Predictor 15 >> /Filter /FlateDecode /Height 156 /Subtype /Image /Width 156 /Length 165 >> stream x10 տW)ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*ʩr*Naendstream endobj 1012 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 156 /SMask 1011 0 R /Subtype /Image /Width 156 /Length 3976 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?Z( ( ( (MVQiqOHq)g=@ZL4Tk4m+ĮH.ʤZjMm,PH߭oQQB ( ( ( ( (C)hWO"9pۊɎa <@ *MwpHUZ*F  }TuniHbA[ui/7}8ɤEFemn!f/$[ڮ+m?ST5MOm Pc IJ +n5 :י\Hm.}'#Zz>p-zoԹPte:`IQ4sx]d9kF=m%Sz\&݈uvHؓp#H8'$Ri:mty-+uDP0)Yu724 ŠekTi66K_ɟr# }Ep~-{ "pT@C Rp_ AfD T(af$  %_◇MF8ʸ;\@?qtmkqòA'Y6M8KzπXS?@w;Fk0 9euղVV8mOj.Hm#G#%~^O2NbHE2YY*"f=jjiĔzUczh;GGz1SlLPu?5#)n{Mn*L93Riba75V~Ŀ5|CyI(&$08s֛v1Qnw(#-1W1c6:hm$W(]񆒺΁wj)ÑZ")G\:{_: ԯmz xɬt:pIj:Wcϖ2:IE|է\-*J .զV*+3^ډ\Hw_3*YяJZ~g2vo-qjF?5N+X`+t҈m**y7hǬ|H"JcypA!&rŝUgf9rA,ѶAؠTpz| 5pYHR=ГAu8/Ҽl /Ҽ#;xʨNVxI9 :hkx'[rdBdʞ ^4kGuu\ǦECx%kIS>?Zj+[CK:ޏ6P9l$hj( >)Z GHWoOEuOW]CLq4lp,>l0.A]_Gwx$z-nV*s$qZ>黂*o>^[L0Ҽx]I&;^&q\泠u\11NIҚ7s@s[+9Ӱ< reoκ(Dc2}=>qn[uq _s@zqÏk⋻RтHsJږxKjpbstBB 2M|Ikq3IQJz"$k_c.q ۂWn=>@|W.o>`;}s^iHZg4RV`DaR"uW/xlm?kdTPF4d`A]do>{:#m(XTƬuFբ9& O>:^om׮Y>?ZddErAkhLs2:v5Zsܽ`\taPΈ;=yGk6w_*cڽ7c%f:(HSJ+3N$I8{ڪpY%O&?qknC0-+ֵAkg!6<;wo+G{8ڡݳ#;^cxylHny+#˙ZyY^ܱ"s>_^ o֚49gRVe2]߄![ c|P),js\~G)fR9;8:TӺ6S,CԬDw1O(^/g,Ü*9C49\TDF*OWcڵ-cOҡ2]7':@^ H-[!OaY8EE yb$[8DW+,!ݎQYQp1ҷ4!a޶@`S EPE%1 HTPj>((~{mTk9,Vcd Ԥatf{ͳ AztpPQwN-!zijvS.vFN:('@|P>؜򩡚9I"pV Ԕ vGQGRAKTF`a[k匜2FzgK@ fhy Fl29)˩ݥOT,۰e+cON5s@6.*J((((+mBsEn)  *Aʞ[h>Gi9ҡ5V=vVqInAs _By-޺jd 0EV5^ S ( ( (?endstream endobj 1013 0 obj << /Filter /FlateDecode /Length 1259 >> stream xV]o6}7&qr~#BGaY0'Tsdl2kgG$ΆQJ W*4ZĘ10GAEvAơS[$=ڷT}n`ܦXǼΞD]eOpQ)$1$ Y]Ž`(l4=SF(4-Vc2I./oi [Ը t=rBF,EY.ʻsŒbE8/i#̱Xal&q!as,:ϝnQ,6rY jɷd =rMNhi3>jY.f'~y1]Oa{] p_$*塀bOc\ jyU] l jwa~q6uZ}'>ulwݱ!4=u(="`8iIxtQ`$EMv[K陔X<\jP̶Xi@5ڲ$fU6=,&*/쪫Aa3G7y̪roǿJ\渧7OȵOW"t]aHXm :`sg0Z6߸~{lcOꋭW;O 3P~0%\Z9?À &i6fyF,˼_UaSZm/>-ʴpZfz],X] XuU3K?7DsoHo@_+Lm3)2*b}aE{8qhSێ ? r]9UEICb 'jڬ! ǹܱIhRWA!*%KZD V\ҽ)ud0)zsv+W 1]SK:Q#-lŘQ.`mz|P.mk ۜ%Xpu;q PCT̊ؔYA֘5 /Hz*P3}U^A@{ \$endstream endobj 1014 0 obj << /Filter /FlateDecode /Length 1371 >> stream xVo6߳aO JEú :/qXIٖ+]aeQe0S~A~ ?ni@ݬ7ci` bh0:44e t5@ &4# f@c\!DJ#Fզz1%-ad4Jj:8C;#RZX+U~ea2&vJJ+"E\`Jډ|D T S%"*I$cL*%_?ƜȮY渖&pKPRaGv$p|`\6~vp8&ZRdŁZd(y^d\qz"J &\SXSA;,Kr\cX叽qXPt寇5&w"d 5!z^̆`5Qd{@GyAv l^٥ꥷ[/_#~0h ksC8VȟAQoNrhmNiZh8Dvq-4*+BXSJ/F+V맥|]ٙbaS΋|@Zd;Or+t.k?L ̘t܌z11J41aLM#% Kـo"aLEټ7V \C%:I&@Ki͗@9$Չ|.8!j8@YpHu 2r J*$$4G84%d!E(Cơ ({&Qd:-ڸm5ry1_eZɆUkmMxr3@:z1\^]x!M~~׼ݭol Ϫ E@g ߎŠh`x7gl[(mLOZ'6=U~V& UPGZׅ2=Z[aǤ.5qC5f'E}}h(cF6kz[A9x4=ANNiץWbh:qI_g=IÛju[ՖRO1mFZwzcKx[/]%|Wփf> stream xWoEl8zY,|PN*SہD7;3뵛 YQ{ffӂ_l1"݈ElQ0}RK %QcC C -5\ VN:mCRmF ̂=) &RZa ^fIeЦ|=y惋Rld8sRWưXXQ|;1[Kѫ L(m\Pa d[! jlǒS#wlֳ)"Ϧ{.1! i!0A)TL6  =E/Jh5_)6(hҗO b g,)TZdje=G|Ii\!9&J]C˚^:YHO}39&}IB[2_e &)"\BM,r^ΆP`PVmrQ9m}l(WTJn\E5D6# ޸.`mXh ]QBȾA(,=}>/8 {]6yGIc@>?^M=Scro5ЃA@pa6АDʝfH6D`̺};cϽТ pqn蕌UC~t\Oڛ1Lyz{f[S4wêpѦpņ^'"f7~y"[$ V\Թ\ *wC*T p6"4.y{bȘDں3b ;34E.'a/TOWch7E Ohm(V𮏼Qe%r_Og>)%Tuֹ5έA^Yi4vZNN^ SEN qJAe(4omVX$]϶7kqW`7+()3n:!9NП 9[Ukr-qJ3QELtj`s\*[w,>~߿B endstream endobj 1016 0 obj << /Filter /FlateDecode /Length 2251 >> stream xY[o~WPpmt>G\9Ё) Qk,jiK({Ɲ!W0;gw\T^#ź+maSR̮RP1PBaD1[&S2m&ZjT1[]T;m0` Ys_ܴ _u5]r%"zj>|O?w,\UEI*> }  lIç!t)’`J$;0,|׭^,|wR7.7m8 `d?y0x|g rO2w˺NCS?}Y]ͽN x∝XNW?-ղm/S,I龌Q3rn0r;/nXα$9gUCn g:?ܵ/$Ly xZG{  !y7$E8ZF{L'}rui(&5gVٷh撝^1,S7;Ձ_Y QA>/6izu(6PwW*%U B]36= bW\BcasC)eЎr-,%GR>䓶 ɢ|Wm]+xk`Jeм628wl&1,y˩7"X%-!Av7_)ѧsP[m"R9qzwQ?=,~h"*Ȩŀ8U!d'Vz*0I%+*-0~;5Rf+ˈKba ˷۾Շ e66)\MMI6!a [vP7б73@ۆ!`Ɣ=4HgcS̜^d5b&A-Dv.J̖"}^$vjH_f+Vp,*ft Cz{^b зm(|L X('<^8vQG?Ze'?Cjx4X̹CDNm2 B VYBdT]`HA?NI*z6 g4PHD+Z_ Ds:/{ 06Tk$C6wΘ!JSG)$mYy S?gbߌ{J9LRm$H \ )Fg ,ûڳJ^< eH׳ÿ|bendstream endobj 1017 0 obj << /Filter /FlateDecode /Length 2555 >> stream xYIFs'a`  k%+>8rb('$InM-aS^罪"U X\b4H:H/O<zo%:t0y}aS""d2K4bJ$<&MєM9b|\hsNQjKKg M & "d4ył$gzsU NɣGX2<'u.QCy"fbxJղ)y ;d5nwsr_b^43v^i+%rf,2zPzlݕzIɥd]4u~F6N$ϊa=EYUzA֍ڭ!My鶼^?)f_Ͳ*W[3?eoԂge/2{~ }˿h`1hctK^S w9 .v{XK/ϖo/cx<*lw%)Ӧêh.k]]@KSmV1Wx0ۭ6dWKD^6z3b !P?9U (M%W qmDBk"Eݔ|iK)]Rx;dyǰNZO6bX/w3B Gat8zҜ ]">؈h@%)7bTto0@ju@EdQ0QGU_Cu!&H&B"S*H*LHq4;ZқZ%,(,9Mޭ6!C2ӗ7zٯ#duf]9c5 $@ vPs7VM2MaESHN]3kdlAa,6 NHS=Ñl႒U@(i mˆKKE# w`BeFޖhaPB(h7B rpJ䢸)6֘([33IVJYf뮡LG|wa0ϕDf8UQT,>ݾ[C#|i81㼭s_^݈Aɠ⭅gy Â0>9&qarb҄ .9S!6CwWrtQ7D[zbnèa◉`fmC (&3oXf3M:ȱr`(=JۋWvg@@YfF28k5+oissɝ#=0KAGsOVA{ ;A1])xbXfs380.% ehzW-[_Ila|L N.;J@VKT[A8 ͸$-В ˾A-/~0?.y uȕ)yѲK`gb`wC*`0yKZ8*B #u"9KA}풲O Kj-yuBZ%]BUyfO;6|vӐHd*SHgk AAx`(I.)AF•py"oWu@ B%6?}rxN|L|oT̐=&z|a"> stream xXKoF?Ѓ2Yd['h(+) V%6"P.E[5RO!ڦuq2mo.#kk!G_> 1uL2MGWɓ'P~f5LꝒBl^K'Ey RfsC_O#ap., )h 1'K oXE/O!ǭ%WQog?BlQ<.J޵<ظ m7QTgE`nڮE5_1mlܴ1z\0{"vf#}{ z{e@]$`@0uެӄPfΘz8D,l#_|BĎbRhJ,b=g@{H֐/ңK UfgȶUA]i9Pw*s@gO T1)T@{)\+B8ȁOAH@YcȐ +lz#Wn9pA 1@A*"u@2 H5(ik9d Sf!4ӽβ h4Ü4OL Dyy젇;=K/y+}-U诼dczwԤX}hcl88 7[[3Yskj~.E$g(?eyĂGo坪Jq:$1o ~4ԡ!UnHIySsy2 12F&)K,QF;H+`a_i`J@G8_a?jZp^&x@L۫o=.Rt&ٸ >Bo؀e~ap\m`1QTF`}zc17#$Ib9ogdtݶkت3s뺪{s+08, ZGeƉ+^M endstream endobj 1019 0 obj << /Filter /FlateDecode /Length 2642 >> stream xYoF{ؽ,؋訕X'gR7E(hIPK7DIS7f~]ngԾ?׿䆎7gn i:*d.GxuS\gX1_]<˥4Bk۟!z<_jnv)R3her\w۪iSd|7gꮬoi'P&'R=狱L F+ٳtNgu]5ʒ#M]nWe`9łPq͐ z_^ѷovi+QQUuJTY/E,a y&=Gʤ߽Ndy:n^lu]KKکĬ⽋d28AjIփBfպnrn-g~X?Oٗ٤UMk 7RvA?ݕy^oow Ÿzu_s;en]vhN+ H;Q)7dh*x)Le"O1"/@S^”66 R0K:,ϔY[)~m p/wxz y=Eƅzi 4jAIpE]dͶST]zsGpAQږu[Ba;33oǚV DrI dӴ],/Yli8dL@&şB }ܯ=I2mS1$Y=ʘ"pvy5?>lHr&^X! i+цcd[@:NX7sHD-l rq>1NU(+ҍ%@h}mSފ9vpnW(3@N}Prl8O9)]@Un&2_p=5Es101CFݺn, - v^ iQo$mHpƸQYR 'I˫J>[ y8#M^g*+xXB!%Y?ġ y݊=xW[,P.`%Dȓ#-|jJ{,عL / {de)Rk1,.^]L26C5~wS^cÏbcԄx^Ʊإ ikAe=REq8aJ:,3#D qedf~|2hҮC! Bт< ar̰.ya7i+=(ȍ[[ {Չ$i| Rd/)3Ftzyty;cu̵Ju/яIGB1I#UThmeѦ`2_tN$yu1a(?:S`4Cɰg !m)M+~S NUSZ["7mnx'2QWw/]pN-㓈ݻIzA\]םdЩ]/LC[Ee2xnԐ.P0۵jzuS}jP<;xaGSPS2bkiq=v&MkeU%?}h09i$TWc=:~܄@#XG{ g۲v1( h`v> stream xX[o~WA(ΕzȵXW lDKܥHk=gfHȴaJǯeNJf1c~̌GGRh6]&/S?ZV#ѫZui\mۢ6们{#/0(*.z0\/T-uMU7G/W^X ܹ*n6HP\nQc_'eT.GKʆ\-C!aKL^A&y?OPkKz,&eyuw#ŔHK T;W K"Bk8+"*:椆AtSAvyi ő}e^(0\]G(/^g ͛S(vi}l@ͅ#+4{Y݌xLѐ8u>u XuSMtk þ `È)rO`Jvf~CT19?ɃWŇ,uK<λOۦ9Fz9dVv{>heeu/2_)r/i[J=Arpl s_ya2R/C7ixu\]{p.[.WuUuܢ $SB?dM2a%3=?{=V.ыА6aGkfJ[d-<~ -O]J~iłd9?$tL)}EW-ɞa"׬jHC1e ) Ḛ%ővQhE>hMH1"{WڢxXF| E<'XhM2ޞ}Qs x4捐iL}UqmwVL!1_6ŧ>$X~u[O01:੕yc5CR ,U`) Nt4%I$.w Oj.xBk u|J]qS N'X-z͸$4m2¶)E)q|/%GX?5ZFLrd5uc)A 1_4E5̯D$ۊ?2.G~ Oc';Uʖ=3xTUﶋf& I>k3cȵI"u= <܇S!ʎE Od]|Pf;3BKpdw&֑!b%0FqD1^IC!hwa| jyuJB9G딖Ob+I\驑|?~4eԓ|Cnp3(d0`ca&vIqT()?5=XlH&U & IF#33~١C j7i 7[!: 0l!= +w7Ӫcc"mVmYxY$0qPIZpo@80pA"XbMT;|yb|err>91H}'?R?Rwx1km`#M:j[xK=fanP`uNI:nO@]0'a2cHQIa=xNc&XJb6arYa|e硩O] oݛ~a 2b  RX9.z AkN:e6e'mջ>Cq;>P&5D?̴P8[y^Ŋ^i4g> stream xXKoG3 t!IØˣp82Iڇ艹gj26iS] 0#܌ގ^M?2v2.Q$ףf$ uB%rDOne4gJpd>"Onj2ʻ_a9ǩςՖדsNP] VP!IVF"+_ͳqi?K )won͒ZQU^8ʲW7|ɦATIǓh\\ C'b=%OM/G9鸵U?zhࢺI_TM*U/r"n=7лZE,N@uqS8&&Q5L6w7ھ 5|9J\B~mQ7SE'OShjYlU- p,7tՔ"_lLOǝ2+:lU_X ԘU_-}4(}Hue@R_$;J3Jǩt=?M-Ʃ0>> ?DܙĊ׾ecPΨ5Dl M}OIg/{t1ܾc!C)8u5qTH],fTZ-NC h 4ar/P gobu U9Q-{\M\l:IEęEy:+HZP ͺk\knmNܰz#')ITH+8 sOڐo&Ci\@V rɕmZ_vvsr!iq\ZVv #']A9p{"'@k_EΑ:Pgt Mh6`ɱT`y<cd]~]ij_: \"umP4^x*6Yky{zb v ,,z6Xʓ2yS52%Y`#_ůt\Y~F˘Sj-41E|>4.:+>IߢzlF0GTSEITcAu\CĶN="GyoבeДZƦjCo H2_- WGpo*s6ݎ:~,.//]ZXx9Sߚ:nn@&_8 n[UY~c=}Ǯ{ߛ> stream xWmo6%'ü#,)J’ {,MmBb3?bX1~rf*ٷ J? SFhXY=5X<ǰ@]mWY;t>6CԦmoL\/@im8 exvXguse#q`nFy-Tݵ\Q'6zDmtzՕy#&GnQQbݥ[6mb.lۭj#&ۧ{ {7Ykao, -eVgwhoxooTY?|,L(bOѓ5OueTi9 xy2Ҧ8$A[J6$.t-Uh7iYQygA\7t 18c)]A ;OϼR--I-{y쪬-*Ais] N(_ MU7ezoD= Zj>bۮY7M`Ga<f(rHd'J/y4х&^D it]I# ;? Mt#}nѠhxӎS/WI\AEÛ5ze(Zq(g#B6T CXKZu=M(PtIZ[t\S- <5<' Wz(P/7TeuP.˚W {?p?H^?30ހOQ(qїMQ7HgA[<>K`g1¦iжD/}Nج> stream xWےF}WPʠaM*zH늽K*T0B+6d@+{\X\J =ӧnZ_ džC?wVNqeٮerc-;턟x6"#C#Xx0Q +ڮLE0 "vq|c>owmf\>Q׍,vbB; ueWisz6R0;KDXe]QW R Mڥ=\NFDj6"J"m]޴(*f"m!WBhS,a^ !Oa$kfVb28#k-^[w=b8gYQ[v~Qs :&LꌉVCk~w2Xc0zݱ!#ۂom#9y,QdB! O&1oaB(<o?ju YXOM?(ՏHֽ<3)G:-穧1EkC?d  0?\Em+`ԟ]N~"[IUendstream endobj 1024 0 obj << /Filter /FlateDecode /Length 2067 >> stream xXYo#3W -v>(R'`D=pIJ-2E9ZaSM6 LOuU}u|]3C|=`Wg~1V{,Q<Nn>t|h^d= &iǺ҂9ǎbpE1ʴ9<[?[i9~9;ǝqqt=s4\QNQñSi{!_VǸ!~UxN.gFS,INߛh=cN:˵GY8\Hjp< +K`GY#neƓY$[Sm @B'oJrA<']&:EC#{xo>mH6b6%,tK*jwe  Hr15))@Qd7QC  Im@!XɲvFDΘ[O8M=۾[:!f``_t.Ht%ɩ).ǎ&M2q_w$E<8q:(BA0Q(#C 5 ^OD8ÁZBi)Fa\5s jCymjBTL2N}ad KCܫP"pN9FN$圉LbӖoK亠2z>m #a",[9g(y(SVsֱ JÛYxq;]Nc@}?MG>ǃ?`VjD c?wmrbq~ؕ||w9 c4iheA|đ*+=BG?w%݈ L.f6aNy4x:gߖ4'ؐ1ʕFfOd96QV<,TNft@,"L 68VQ́?ѢAѠ>xEK?70/QpvS8F; G4$v3i T0dB_ZXHL-M&:/l_[5:rK\RSXg ~yq.<|v^ߎõ =vͫ)NjڨgS~=UѥxZYn~ vOy"ɯ2[,O _گ:}f I‘?3OoIّvwϽ\_w9~[~y^_s²H\U*/f'VEGM0ZcU%|YSzM27.}s.M1W}\K\W: \& P}h{:jWZgg*q[K]ʡWяi톦FjzFoNJe0ۭ}Yb"2T8nv'~~ wV]C"ouf_m7H+M_f4m4O8 d(YQ[q|q* rC)C Oۢ< &ĐYѥ#mb|XrÔDZ߃N*tJ@Wvendstream endobj 1025 0 obj << /Filter /FlateDecode /Length 1161 >> stream xW[oF~@:$E*/m6VDr7t)k/TV}\l"ù~;3ٟ|663w XUAȶGHgBٮ ȥFZ͞ЃmL݀y[reZl/$5-uQb.ߘu{xH33 T<~Da}>C}wyiu<'KCm␡7BͼCT>cfkS/r4a[2jcNY$H`doXn>0%-6ityJd>8ZzÿuQU{1V9w ވCJUxTu;lXtaSъl1%3{,Z X4$d BRϋl#2t۵M؋@G~FE5qxh]zc:ziIIʍWmY3/+ X C#z- qڼ߷fKUV1AkK–{%egREXB[kJRE8z,hh'b) U_ʌpHa~5?=0DO덨kєu^.=n m+?igQbpwIޝ8W7Fqc/3. j39Ύ>qJ]߬6=n=eh8:H0a$Iw+uV2U78tnLah7ٶ$>=Y.! EuEX>rDm>f~d:cWe2H,Սp_G8.M*~ct7HNteMU_uN)'E,-^b˹Nʿe[7\2mƍomLm:Yx09gH2hn>;9|5rx+s܀EIG3 AɻȦn/„fk>3-jO]2Aq"edOa ܞ7v0ܟ0@7Q_*6/ĝU) w33 A?I:2ww ҞXcendstream endobj 1026 0 obj << /Filter /FlateDecode /Length 1371 >> stream xWMo6ٽ"$Je-HJܭ/fpړر[Krc!%Q#g/Dfͼy3?ySOw?4[Ƚ"+^>ԋPxI>B2uL\kFb̙n4G>D=e #J.@41{K1' Bc)!~JItdpHJ!d@e,bB@&£H[W^ <"JX~CBM)X"D. Rq&uɤdQtKK~J`G1av@)h3DFFwPTcU c0XAb~&PgHi&dh,#xtV N"(ԄR,C _ fp-'y@mxA_772 Ö ɰt`XuZ#Lds5F ?(4XIXvg;}V~,Bir [\Xs.bb *kNȄhvP荾f9|$&x(fQ؛۠~ǴPi?Fsa $ TW 7bN9m? ` ֯k1V@-CP( #&b^®uwYRO9LGRtbE}?!pɕ #}!x=~\.rΛ*E>Y<ِsI:_LFC`,_誇t1]X''l-Rtmbϳ\;~yZ=աXTH }W3$JJN~j;.7~/CK {Pp7l8+7[K֤C+,P ;v:Lg4[>Nv5:{,6pv/z4GqU]MvYWL}&[G͉ጭlLslCO[Yendstream endobj 1027 0 obj << /Filter /FlateDecode /Length 2465 >> stream xYێ 7}@`@8 {w0Ibv0f@.t$6{BvK$ӧNUwoEjTw#t֖ȏSZrYLWkq]ՒkZ[rhގKgQ4q9'/^<^"):4%,0ohdjT *+lQrO0R2gdE)J!Z M ƥFC,[0 |N [SJ1MhK? @ ?RWr7dU׊ЛqpCJU<,(4𗑽rՒ4.zźY~t*$H $bvیy|H0<bݬ Ճ9-Cn>Lj`V?4P65.ɇPSKC*a1x7Cˉ >} qҐrR8\@#j3.HEf`}&f=l> npOF1vy1~vy|7ky tmj'}И+ OTl /Y^` ,A(BH2KDŽ-`.&MJgrw4F^$Puȵc"S`"cDBph!."2^8h;`{N]0d">Z(HZtzHؑH]"@}H K(`BA%0TAg$ovǢuX"r&AN*IZB'nB(w&QЪE2 eK{M6mv!@Tfa%)?g`sFYx XΘfo8p|LzOĬ|޴kX B(uPڴnᷮ yk`콃Q砛N`y(#UDxmy~k>Y:QYW9kiBpf,wɻ@j6r?p AXv3mRkKڴ>E8ٙ(PFh۾v kKxj3A!yO94M޴0M'KPk tZ` Ni(+sdz0"BUr ֹj ɨR<-ud1Po跤]ؠ6D[*ϚyEf,0$ac}AK[.]>wC/] kLV8qi ?rZt~12piv!Je\m"M Sru"kv)^]ؠo!kv$Is3uE VO7Px|mh6д PQpmn;xp-?>ZN+Ǒ"ws8p@P}`aas6}n&z[a^lvFݶ8iq~a۸` Q&i:e_b_P8Z -( i=9+FeX ),hh R irNC:#fqFT+?u5kgh+a5teťoV U"1&Ċ#?.uBW$7$@,TbI㍮Q2#*HȶҖs!8CP7D iQɚ<6@Ń0 ӁظѰ{PX {G˒‚+,TS$nmuEenSi 8 aq;SuZ3!:&:%EPT,Ň&N8'|R͐dٵN6=O ;t+& : 3f]5'všW4:Ðn ’-3@rbUٵwWC`k?* cfbqC}MӺVUm77,_6= f dѧ8$ wnIf { LOID$:?nfo;oO2/];3ؑۗ`{C_ CUܻ-$WO/PM|lKO壬?fs|zB_VdߣCzn*3aEoZo ͬyUO&dDoV͓|/Qȉt}syG"9n,M`-ޭoxZ'o?vf;{vvk8Tyos.#we_Q%endstream endobj 1028 0 obj << /Filter /FlateDecode /Length 1865 >> stream xWKYw Fǎ֐mba"cJZ Od,dZؿ'nㄸi?&N KLWL5*ab'Hv.ݴИS'V zpDz~pL .&Zjtޭ9)bs9 SI9XKrAcn?96|n:s Â:]-&7ݝa6k(r魮p+bSӼ7cݿy.\25_uAލ@2~jnVUnPֻ91NQ>m6-#̇Nj%)Pc%§`#uYs1K7.R1S0d9,v=-,̽i'9=6 #mޑ$Z;/^k,[ k2婭>z7NfŹ{VyF@}(Fd\}}o9 :B]l ?K%mM['SU$z7ww{_՞qu_o7ysG"S1y$I͓?vicGimkԾcȽLY=nrHG]d:pDǶ)P2dx1XWgMNf"s2sE\?]s;I/b90F.J:*Y9l`FR47rX%aaӗET4ԴncW {e x_歧٫h[c}tEҩϑz%:,Am0)3-2)l T%R)r`=$R2(3ɨ`^!Dm(tS\`vԼ0w.\"sF]7}N^ sZ;{xy7JDYv1tq&VnkXY@bE,R_ IC%hċ,"Tx|fB^ׂDʕBpdZي1 zSlD1l;1Pv Xo/WP{L.T0PȰ:˩ҮC~ L,4 5 SsL9?:2B1͞CZeR*RЯH Y7hm2xlpŦo ˠfXu$%B͔•x:OQ,Nw`>dH鳒0ţp?W7(+8zt 7' rq*!J7 GNY !x'yW$ӶE :Zii-mĚ 嘞@Y2-EFBMzI @ͱƽ3 dϙ۷~=j,9wcP*=1iե2\1T=B~rLvxJ,ȥLq.P;ar׾W81>&IR jDG8TP>ckn I 'z0<"MBIUbKL|G8U~5 [7.endstream endobj 1029 0 obj << /Filter /FlateDecode /Length 1888 >> stream xX[4F?!Rip.eG:m;3)i;I8Bhi9߱8dؿsގE>v6^a2ݎ9dX Y>BFhi1f̖,Jp"Zwi2E֫(4R]j5'o.&a*8fk)k.O̊28I(:>].r֌0 Quqw>{-9zqH}O?:T/ݪ՚v-T;la PQrV-0GcdɩvGu4LxZgElЁ]k߾r 2{7G4L=ta.ߗ[*0Z;D6 bt[Ю2)J,<1?x vxX,nE2 #~鼡 B.$|~sEq&r.0uc՛>Lκ,6پ(vJ e&Ղ-%D$`m#+~fh$f`9JͼuzI$ FZ5&8'T9(&~otLY %20$jgTJ XÿsۚC2Hi'&Uz5G^Y2 ؋UmX5o O3.+8g';cHth@bo3fKo6}Q8("QE n8/gvmгw(S0ژQpo1+hJaY "46%C5Hƪ-f@Ey9OKElc!+hDεMz=QtӅYCv,(tԦSki\+mL8ڹj2.Yn,60Ij`Вf ȫ7F(֊A"%+D"^]Texy4K @4~YiD2Jꑘk!Hx,wӼeML7(JW}fRH虣61ThO"dB1͆P-C)S*F1Eh *HDRGCA1CˠTNUc>*7tDld wλ7FȓGQ)i WAe_x+˺1D8Ai 3e}DpfձWk},=31,Zslmk&]I &W?y2'{4 =6V }ϲuD>A FA&`a@L@O8> stream xZKs7ުܸR x?!*HfVDƔ0&EfD9a6f0Ptٛ_76&6[_F_!lCdžr9GHb6$f`,̘].Г`"Ơ7z|VWE>jA?1\I Lq%6J9ToY1JQ&1Uf\ [w7ݲZ%[KυP"Pu K(YkFXh"۹dj{9ZQ}#rrh:/N740<}tVN9t^|:!:ן7(μ^ʱ6iټB5^@@( n2IV‚Z6upF_TM*KR@ÉV`ѓ7jSW H՗KOW'eJMkPWr>y"YdBo>i(R焉D2XğjPEL# SʹsK1=yvZF?G_A`17ETC$V~:zS *~݊D}%w]e[3O6 6UL2.'r[.vt(EOdjBSϾ'Y vt Cid0_13>mjo%4 JhrB%5Oa&uMo Cݓy,1+Nj !p dcbL0i4gzvvKT{ 70/sx K82OHjpO2K .Ф()Uhy0Պ0qp*C4LH5@,f:(0ޣGNshbΛzf=3Q@˵c_j/3,>ry ,!ob 3jݎX?Q -\8 ]C'zv'̠.@5VpaZ++_ "Db?DŽ`0CTB@6};J_/@`k|  :qlOj⫁(g ; W MM`n{y@=c{̓Dv[nuoC*Jb& C|g=LK "O\ a, |Z\--Q(A+0ovG+ي{ TV7Y diI0Iz6!n?D1]1R \L\{z.%RS>ͯrvq;/rU(98H6* hIXyM_c$lJvm 5g}CxrqP'YSc^$tk:a;ZG k5y]7[;֗w\mۡ pNb]BhEDpFx }+(K'yiqC6¦7E–:JU@PoWºVJ}lsm"p3Whwx.mM5"@7nGiʝ)$H%(so=GzɅoCa +_,]|[%j,A䦒owWuwY|]Kw^o[<8;Zl=n vQ_p9 ÿnH;Oên7z=GOݍznZ=J0ծ^q׼a̢3\6_ȼxH}kMnWc>[_xY^|䋽#Oׯost~S+nд>^usc  z;o7EJt4Ρt>d@<^vv[o.4= Pop)lbendstream endobj 1031 0 obj << /Filter /FlateDecode /Length 2404 >> stream xYop)Хc߻I@ ZXy`,V` -%;weq.p"g732eA%^,GjaDqse2nt<3tlXK]X.ǓhMޣ)ciVB0 '&9yE)Ɛ䚖̳j! Td.LqeaZOYu]MipgrdQRI(=v&(/l<9MrJ'^NI4Y_WAwilgrP)-̍$T LB0,ւ/,Mf[ Hv~sPؒR;\*A۴mv^ 4bx{;y2?OsloY<0$aSrˣ04G4*(AQpB4emgZ Qnihy~x(%BzQvmR^(9ÿ"6^Rnb9'~qBY6nbCppx1k`kjn"%B/BN4z)l*19kCg&w$6į E>]GMj,DW3PB_B1r'rE.1-'}o_~/ BdK`\0pəJ B ش8$"I!Y͆Ȧ TE,wwd8 {|.jRؠz$5`bׇAb';qiZmvSʤ(ӤDNqh%l@ʙvg~\kgu<ڕw|vtC&n*affE AY`x %#ډpMuRD(EĩB[^1/sH-ǻ<ܣqU(Fw<nM"KcOvjQCuLF1ۦBp)O0\u}L !%:`*#hr;lH >{Pׁs@;d$G jȐ۹r 5}`enQc[$ڒUusw=$t|3q)X<\`d۽q8=qC^z[k@Kg ھ]vK큨ۻn7F/9FФ ?HR8OaBJP |ab5\^h!w{["CA?Jp1T$%`c J}REb%%9,-Mc*M0*MJc/l幣<{_**H TqJWXzx#GKPji \9;>60}g%|_` z+$b?'!~Eֿ_őؿ2BsD#̘rb# j8B !|y:ݏq)M5RtG_Bt!`[U!,ˁl1fX4[Qlj֋]lxzendstream endobj 1032 0 obj << /Filter /FlateDecode /Length 1408 >> stream xWo6ء!0*8=lknu^ A]ǝe&{(n1e}c@0 ? 惏jO.~ ~x#ҡAB%ֱ&$|0 qI0g4&5zL[˶wOiҦî{NLESų'{gy ӄa5b}$l0.{szm?(Lp#:k,3t=٦\<0PU߹spTw#\+,)]Ϝ(`xFx8:j2໦/|niH0߭AkI'ꫛ`e垿tbYW8Skޟez3km 7^8) xg{3 $L}{6ā&)e3[.h|Bei)b/iJ_aNbNWlTT9i֖@'LUZKWKc)lԷaĔOI@lP*^iq8Icsh2K0RB޵b Ky*)rn뇞ղ},6aLb=vG[Tqܕ76Y 2o1Ib%#%rqϞ eEjsԄ CXjH|%QF!N@U ?+D1H]Nԛ:lj`q_Cz$`뛁ܿbqM lývA< ;^Vy5\D"=h߽$Jnboa?*̜;DSȽ xF9Ƭ#qsѱw3c~W~ӕ}`#6d0/T?:޼_jVWYl Ý=~qKNk vzκ^9*w&o^*˻%whxd);CC7zVvjq'ɤ8_m툴d'3uendstream endobj 1033 0 obj << /Filter /FlateDecode /Length 1393 >> stream xWMoFY")e"nMKĐ 7USDl$ѡBYrI.% 5PԆ593;͛g/ ͯG}g?kHGXxQC<*9f\yf›G?ġ` 5*2ۖ3ET()1&陉.B450]PH (ё0[1-?czte#chl 'ouUFa5ILvց Ƅ]HzĹ|Sͼ J<!( ڼ Tp&/uHd'R6 "-w$9U4!̷NoQKل0)MN+ gmX.q*rޯMMyܮƧ*w6Z*)nmuU#~:^xoi0!X A+6ip1~DW"#Crq"]5Qm@ $jzK VoG,Aǝx.x+b{5I\WlȽ껓26d5;7N1H0w}nsoWn7Rl: &\M|\Y^ h|_=h^F6 ]r0t*_n{{B{.<3Z *n)q|}JW]/Zdqqb<-Eα+e͈s25dNlIbͷ ʦ='Ù?mTJqWw\ƓKK'U?qKtqai3[ef'Y ewΦ4j 1 y}' }5C.ݚk !!!FjvvC8>@gc Ga wT p#HyZ 0/(׬Bf;+(C&Uȴ$\rjւ%#8UNw] P6Y"!umw J#q?VoIIQE54 +/% vH$pV^| 3Y;[?:&)UC4I21T}S(a '-".2HY#Ò ױF/H UZ ^ fXW;}հ9)ɘEII/ Šu߃J iH7jgPv$CCՐ4$B=z3tS4Oѧ2m[y=u0`0Xӓ.J #Jt(mq"0e> stream xY[S}CQ p;W'zĕM,?+$n(jEsBp$. cywsfÄlB{>?7ɟV(7԰}&D+&T ͨ!]ՇɦdeQ˦B2%{xҕsVH Rl/\TxTJ1z2*/׾!W]MW9enJA`ɒ O$y={"f0. dDN}e/M搿[w,\\KKn[ޭ[w}8{\f}䄱(m(1Rʔ3F\T~MA4di9bhm >@sgϞKr]n |;e&uA_9EPb:zr }6$)SFi@ST2y0;Rɂ9g"1o6n$}4q$}[G/Om-2qFRh[Uۛxs$l]pUݬMb]7B"#a!Z Mv[PŁʈr XSh #eFBĩ$>`2~{aw87KO/_&bi]X76y P@unN7~3ީ.R]  Ukp\璑 v^R#9Bky!:tx)%:>/6-<N$/炗n<ĺʋ %7RmՕ*k? *L.K)z.* !VIogoDF~%s]KpIXjԕ"|쬼MֺC:)/@Ad U8 F-W'`9Ԑ2\%1Wl+Ɋ/YX=%fOw D/R E!/w PitaxLrQ,$N]EaBeL;tkDpxX4I1]o UnE0 bÇ$ Jn"WV#g'A8 X'lQ \ ('Q$2!p9o tl\΁TxYX^_m9Ax/AkdBj()*`)~6yY&lI'6H*.hBtNrhOx6>z*H*+a5mv^[d'XݓYX:=&*0bl^|bNj0^CMc#S=DJ3#kH{P&퐜!* tw´:{ .3fJ^=nlg IJB$_ŽMBۮ"C. K 0b*^k>a/endstream endobj 1035 0 obj << /Filter /FlateDecode /Length 1491 >> stream xWQo6~o؃Z(L/[xW2@[-wGe]a$>ORÏ^&|Pka1y6qΡ27`=yg{ǃz4YSbi;8INd6~X޹0-dVX&$şhra/,'0D{Rͱ.SLsdS>sECC \΄o-fƖ#]t5Y{G/- ȵ[%j<эn,&۪\AݚJ<&z5;ci,m߮*2凤kM;B8ұ')yȾ:}FDAG^ 0(t-#JԷTQR̢R-2 Z׵&8ɍi H *jC iBC u cl 4lqz\3\ԼC\ŋzvLY 7y}p01޷nWze3Y4(Jm3P %#3@.z~eB3& Ct#=BWƦF⹊7N{?\F_T${ǀQ :hsWhVy]T@D^vpܥdUV)kjkM{^yFVd5K,=Âu{F)ߦA*8/f{-7qS1g\|S~ cY"Q ϛLM5&|%2<BdyQGبd#_r yu95}S)/.ajS[m՘v>tfYWþV ڨMːTP,: FV+;qIă_e挂| euG1oD͟<֫c3lnw?%5*%OORßM$jlrlRHK_P͒a$oi*M.:V]JoT̸Q .EAx(yo <{dc~Wܯ3};uگ} Qq8m'=$>oB/f(t":Z7u.T 5|^nO6%YHp;~I`nyLѷq1mq,6X@'{,qWbtAzo T`Z5:sD)9@(Iy EFt"pᅰ4CSbaGbjM%ul V 4el>HU,9ҌfV&G_s3_Ǹ_|ҴFwG9$0ύX sQވ&1#?-&?;endstream endobj 1036 0 obj << /Filter /FlateDecode /Length 2293 >> stream xY[C 4-P>d}HlB X  Kjl2;Έ8݋a;wsˀ`: 9[_/Խ?ھ†:hSs,r0^_ܠDi],;MhZg9 gk]P;mJ0_ JM6~i rA% r?7]Un,L`c$K5Gw7jz/r$ưAN9r3 JqG$&ʷzM闣VuN'$ Wؾvش֍z> j6'l ]s7hWFաr;^B4MW4i$[;9;M8l-umdgZDd3X+ogsq] ϔ3d߻wp{WUnzھy_5(iG90;K9.>%Tؕ$'ۻzrHIڻXc:1dE1}-AGbWvIGW9?$1nz[9SZkj*Zln Y**u=ϴZ_#]բWIBп?;rJ9ڵB`bZ?g0P{ $E?e)h/PJT+ymlW0 pY-v_.G:.tuH}|v)>e s:3J >k7 ܰS+#P}0BMlb-'6WA.[)/ EzT?c4B[è4.H]h?DX#pPh]բ(e E 8X'$ի$x`B#Laa)m;n2k+c'4Tz5U֝^hӈN}pE^ޤ]] mHܫPҫVL)V,$z?3W&xiAljېjV%_E3Q6")\$ʉИ) Z s\]AUeS iPO;8E*;,^" WGe03ʯ1SйijAٮq~Haqh {?!$%T„A{f-y9Pcc50T yT[Ibz^ 8-Jlvm=P4S utqpn_v[2PY8Z!zBq7ķu@o8pQx??:Eo\Q*.:jG;x&zUF} ,:0aD\GW7-x`]ѽQ[>0=֒X]-Tx`%Lm֠aZ`4fȷ8LB`&ԭ?d>o [.6qؒp 0o$:3a] Dġr ٱ_IOXqNtEa W-CeXRW5Xh(/JbaPoR 82%EZ]ZUnerM`MJlW6eJ Z_yg=Z$5ҋ$wi B)hb4=i)hZ2}s(f}px/lW bQ(1iǤaz:¶6};N'AJVaH7˙ C6F>GQ(a h`pCLI!$aM=Q0Zh:R&$$Wp *3HG"Hz~<^g.ZYN},LQ$Pmj%I@4U|ag&o9J㺛Xǻg;!=$\M9yscе/(w,=6D5v ٥^;n%b=jL''@0I65ApE?z}ؿ (ٟ]IXע[@CD<#_ϞêGGSx+a?I+(pD2-$iVjU2A!:FBqtu(;xAA,j2^ѷiHIGmI YJLCԞfeB}=9e;>xt&Ѧ7Iq*}Rt1ӝ<ɸߠfUJE@y<7Xendstream endobj 1037 0 obj << /Filter /FlateDecode /Length 1932 >> stream xYogER e^֐ 'Q;H~ي#CdI.;r\+5w3p-qb#UGl],F?bW[.Ѳѵ7$gcc,]y`"Ơ~jAĩS2UWRc(FJզ_J&t]h~'~^cTq: %&f+a<BVA>RXV'6.6ajRhѴKZK%``IM2my7XσD߃!'c:Wx1Xq 1g(XF`A|8S -DGVbuFyŏd ֩0Caqmjbnכe8d=zʳv7́Ӧn8 YB1_+kJFR 9[O(>wng4k?E)hm ),fDFlk6Z<-* 7Iã4"G/ ^ ̅^ Jn0$eY3Pj7͜n^WJqeZkX0cI?!چFBqT=#Km=JI 4n4wK 0+T:Kop%:z͇uoҺkDt wYK q.$8K@q E3}]Ǭ77,yS~R*Kru=loX1O% wendstream endobj 1038 0 obj << /Filter /FlateDecode /Length 1648 >> stream x͙R7 9Q[eIS c@[0gxe |j`G(̬f4ꟺjBĿr"Der6"bפ{Gj8} . 8)[zUMwo^zY;<ܛ9-nBڻެtw;>>du{kGIuw.h㝗Lڡqػ)~@X]]`f]OM.6ou{cVz鍯6ߟMO0E 1j\Z(RgYcs1{vucE4Dv rqCa5yW_Țe[Ntp@7Hq(sܘwUwQ7-F8t'zЖEom{c Zj15UlT؉x v܁"f*Z=Ee!P r՘CkL~M3^zY 1y"jou5Q=4at+f|E~o=]M/2Y*^9b.,xCe%18iR@ˎeMHs+b:{^)T#2x0_&"@@ւ`X  :Z;\I6] zg]n&-+I{![OG'C'Grb)RئoϾ-"(cV\o̜n;q*@gYw}EėIuTJ2~ &oIAX=g}sRH梪a |Y<&yCTԈQr]66jjy0ANuvh`zMb:d(̞Q}j bbAͯKlJ)+gs, -h k%,%-8b$d)(LQ}].?ou$6R}}?}09Jl_,l_c;xkJgIPI1Z MyEJ.R.'E_/ںQlu>i%ğBYJ6;MEf:rl>w4!)|[QsgÚ '5@H#15~2zn[6}A i.CeI{ B^bv+vGp5٭٨\M ,115wjs8z9t<2~/`fendstream endobj 1039 0 obj << /Filter /FlateDecode /Length 198 >> stream x]M Mib؍6M HP}Q^fY];=_p뼉0Ok{gڛ On|W#dϼTto)=5BZr vy֒$:kB@G% F,KIHA0WQ=>-Rc/ԚZ.cR~dendstream endobj 1040 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 916 >> stream x}L[U׍`ov=}Blu=A_!ŤHyx\ Ys5S)sm]u;Ʉ-G \=ib0qmL  eP 8 o G㑸B<),睢7pG;/K0xe0=CJW:m~ 48nŪBxiuwJ}t >vC؅ۦe\P`󚔣㰰 <+oB&Z舘۹S,K͹Ei?X9܁k{p:vESNTh:ԳC C$Jwk: h +2Z/6]|kiCOWjBeJ^:/nږD Heh{f|'8 d@7~N1L l?<9tB²endstream endobj 1041 0 obj << /Filter /FlateDecode /Length 1925 >> stream xX[և@p#¹هvڅie0wDzs "lߤxWEF LCGwh$hJwX=&͒i+ab{dj_/0 kcg-g}4(yhPIn S .i30}UJ?AI[!rP0tnsss6EYX& L;KU˚֝l\]mQnvGGc&NT߼D\;NDʷHtH搄߳gHX8y{ ukqqw,tOxϺ/1z(`7 CVH7o): ?; = @I).UVWX O!7> /|6 :|n;WRoۃ?Ru\^l]qJE*b6AhMQO툏*ۚj*uCMڏ]Zn?mNDcPUr0L>zFnUID1Y;8ax$ \uqe0!loGlq::,IVYSaN)SJ- $ӛ˯=hO"mD(x"YĘDz2NU[JXGU\fێ)%() 9 Ǩ9Eo X,=|Rs8qPt:Lp+2A}ʁx9`(߆`ĺ@1Al,:â"Uh5+W.Txbۂ][7xSӂZ ;Zoff(gu慱N֥[uX:v?Cê> U4nUzmԠkZ}(gʺdR2~}c-AA!mrV ԫ$ 6 Kݬ7M,] eHޢPzܴ  T`Z>1f1aqBvkJR4rFE0ɩ3}ac3V< 4t@Zn(2fAy6̠,}Fjհo"sc\ AhZScOQWv +mGwC? D=?(070:NmK&]>dJgdj>omUR.n2ΦUɢ]ZOnͰo(|(3{@.j?vU_V^u鍽<l_> stream xW[o6޳{4:U$ek-pqTGqX+]}ԍr:1tLFd}Q:oыJX†:^܌*:t†"!-ŝėfDc h,GW, Hi>v+J $Ah4ՑFܚo.cq%QTY͂P2װ{%Ey^e~UyIa$ڧ,fGZM.} r,alx~NOOaf:eRy᤭b8H?_(9+MGJň:\&wup t_.!좭/CӐ=ͼ˷iNQjpӢ&ٮe2Zy"?užg<e.gĘRldBǡ*0FOH77Aȕ#DxsH@ mQV[Tm)^hЎMohޖe)PQ|+ՐZ[&44YnbgHvKD_'E3'ls"r3mа4oZclk5LCµDRJ%o6NVéZۦ w:Jhe-I|a ̓z {0֐ m Rp76X1UiZGRD1Rɠy(3@ %|,XRUL|O0RGUE 8A}kKTRӗI@p*2FWAHȵYsUXiXA(dS!AP?"jši7{gݽ B0Xj¼`-+AYlBtC8'@C&Gj&j[Jk!Lϛ$>SLqp+y 57eB$kUwA{f bTHhsśVղ |oB(}&>Ӷ8+ *u7VH8o4^5E3b# / 2HdwA;Jўp$?tKnt~>&Ew\7ܮHпGjsN* KJveE/Hz|rtD%lV5vUn˫݇'w)rI'L7 ,P9?Zi%T[9'֓OH"wE~D^Wt96ԻI$,muqG,iA}x;e}ͰqM $xJw4Kako[;ڙ<'ߞ.Yk6wm9,.޾p雹9lW%pڢ|yLM}dzEU݃=]&o1HSsYZU=o]]:R_endstream endobj 1043 0 obj << /Filter /FlateDecode /Length 2597 >> stream xYݏ?(P?prCZmlŸ\ rbN~u|8;QQߛY:=oGf+%5|T3r:RR%lsFt:yJ4OӰb8&iJEfg&xO9ͳfqLMhф$2ӧODaiu;wuنD F54'twuESs|)4I3'M1fO5}a$߼*rH"#__`vuy(:pݜLv%ȳnsr>]ٲ3YK:[޾s,I/p4ՉqoX?<0jӶ';?WǹygUIo(q1׫6aa9Ylz|"m|8yj,벪9*Զ3Mvf+jG#{kbP޶CYMuuh]{Ȭ2p凋 {6w|[m˦/nPa=梶Y/ja5nK5@B]Qo.0BesT.$aS(M0壉I*UD$T7`iYP Jk #k RJIGq[]&dpjI8m Ͳ"xά,;98rL \9d~i[7Kgȕ) J .j ڶpcO29V%xDgƭ9HH8W4D24u6~e,x@Y}xrxRDU&Z*!tHo=Tt[2=:⭛@uO D*2(#;M$u:.@[I9 LeF'MaLz^BiCtb>NV=AA&[~ ‡&W J5 7h7c2{P !{؊^EȞO)q;"_ULa4ꂋ+5T8ݙ*`<~t u.&9)ΊlqQx}ZHExE O nV|>fQF >DKiI12\&ډ}vUiaj,{H2'&ԯfgߝGϞydBpW)2|ɛ1UKwS2H, FTcȵwTqBb^P&aSW(}q[QDJB4g;19Ucc'Im՜&rTEO:T!R.2mєE#)!Z0QYlĵ xPИxY{Hv2ySl)rK4U^|Z+R@|໶)CV֛5JA^Aq -4kX?B.V;W"x+[ج-LHrj AcT]M4E"[-ЀQfJ}t٠q>x c֋R@SbÒ>ϛa%ܐ7m kO6*a쮍uZw!=a90M<O'ݮ;Ǩg7d8y1YTf\wn?nsj0P+MB Sv%sؽZap @R1 dceIRpmz@䚑Me4 "XDMMݔi][5vE u%Nu]؋jf6[4'Fl}>u0ʎOL\v6!llr(,떀? "$.;y[DoR{t0ĝR0*0r`H!z`4>-YP@%DM \ISnOФR{ l$30wH XCQ{|^! )S,ƏNRxlzwP.z,9! B}> stream xW[o6~0:I/V8WxE-ZuId1(V;9恏7,gO3,jj5}rxj7S:xy>|Ug!4 #z~% +#qQ;xJp%|Z sQh{ $Շ/$8AhCYyRWfg<[?(݉Q@őwq Qeg>eL'b{gdZu}pֽg@̒pynpkP!)!D$M0ڡXF]atuAAk$>8|YrBeWz4߫.dAxϤEk-駓X;a%16> Y9@epA氤ɚI<"d{۷χj=@{Y*CCՐP~hHJ;HADmkG%u-G?LɪchgUosϢ %$W`*=bQAbcUo 4ö7@8:Xv좧ӼrR<~Z(Pt nX`Jg_׺Nq"BQY:ۡqHdSb)۪;<2O/e.#12̭ۘ_pV |rĉDY[`^E#1dЃ 0 a]ԟ2( C20;PA!pkC> stream xV[oE~;5%(vOe.ϼs1[)37b.Q*,8~*}k]d&ﳝs*,> (ͿY6J7 3G]dD^bBI q(`L0IVҲa,zhpݔI?s-&Nͅ<+rq⨠|UQSE"0"D i /ciq"@TCXh[nZCWO: #R5bJ1]iYB-/i2K2*PjW0i_JQj@p<8U9 kP(=@ ~9:Vϻ3o< ehJ}u:<pɸe(!T;:ծ䴇G4rpqИ<ǚYg 4?*T==8K+m#K*DtSśiA zrTM٤S26l7mxؓh6 8Øo|hgN]UujQ`ڪhR~l?jK> stream xW]o6}7< ؋F)r_vXe2(AsGewIQe+]"ޏsν$?1&Al>{Y`54#mྖUbU+cMݬ!3D$X3,5-q,XBbڼ-m #N%0b41YB)D\C $\i"XIilCŷź燧0c]ݖ[OGm~E'h< k!Vc:[F" JtaY˄阡H#Շs1*&}X z 6˶7zț#6os L "°JY!6:^t)^x+h f^mlm cʫ*?a_/b`kp\n cΎXKJ8VaΑ<2hgHN*3d`e_x u19)i(:MMv`:ta WQ׏MY7V;nz:Cm|6"ྮWZl|}w}cQQMA$\??xjY/Gv8jcHX !=`v8;m2LnZU=-@eSoM}SGBÁ[.49bv^=ǜ_ruEd''>YׇJjpmEc Yik=2Pa^zR-}^]ԛkxHty;oͪϠlYUt˝`?$hw \=70?7GvaC cƐa`IЇPssw֌k\ÅD3hC;q3̀C HրCS;rf02юArSc畝@Q 0r?tf $ݺ-ch50i?ψO֐A%aZicq8T9&wX .ݔ| #(qy4%BR&nP7Vk2BQ!Ms #">NbLalX$c$' 3P$)#1sPDAX$%$9PzsN A'jg !T~˧~+)q&L&EvG)f>yvb"(hLLGMwSaJ2l΍ɻW j[*endstream endobj 1047 0 obj << /Filter /FlateDecode /Length 2331 >> stream xX[c[ }+sA/m p`e J+DC{ϙR3Zvy\QQ߻E1Z^rAQsmz 1%r.HK[.G-Ɋ\’l}[ec|fQm6朓ٛ5j6@,LloR2 *shR({K.2K&rk%8|6lʶȮl6ߖm]Qew߻2/(gs\ F-Y3J 878Wˡ3ն]4='0.ƴ("mw~tgEDipJv14ĿrU E.ݪ^_M_.՘΁yU.A?Ŏ,fG(2dR//nׯ>tگʦS!=b]84:Z{La!l;—G9ǖȅWnjMEɄI0#Edhj/ǣٝ]y[}yLF`(źZbM{}Ql.jILU1C" 7(4P=&oL^ {{XǏqAREw=u}h}\4AWqX<\ٓ$"z[uQ7R {4XU3^lje"=ح𿐘qjCYf;aJ}#Js+%s# U)3 [eIsgca-xWmUי)()ׇg4t"7RvsݦY@,.r@_av !vE((bFn\bsNpMA9\5fpqk0<:T j(t\7t FX6 Ia$\[<]ծ ?FKrX@4Z),?w܆hM >.1cX,%]2+ӽ3.$E!\4qdnE TƧɷy_CDA2A"~,"?2AyȤB^(G3^&_\٘aڒJJ'vH)$m*͘)t~%Α׸t۹2.F"'$ azJrQ&ԧsy¥bԳ92yh=<%v0Dp\$[gSdd s=v( (F3"^P<ďL0(4ԡ."]Sw.L2 ,#mNXr#lX.TIWL)]78r(pItӲ;]-y^& ['DR+I* KL"ծNܦE(OK }8 yӢîV|P<sxDь7 { >^ `8`PCj%^rT!J6^i'QЕ>b zp@ꊛ[)#skgIPɴe2mmL@p`GJjV$d4rj΋3 t:MПu /v %M~@/9qسm@ ./7(d{h ,1&R>/C]GQ7ܺ)H Kz&v i) [LůZWI3ʍdhK ^zs 20;iB̏2g,;eCfY%-yXNV/ݞOA¯Ǔ=X*,V (ހլ `\|n;Nts U{r b/=(܈([˳K .PҨ brc%),~M5|rMY\p~ϧy|m6 aM4O-GŦWR24W\@s W aYpT&+rYph@[R pkx= ߒ?Lk?;rC14tGn9L.ƨkY_v>VR$1vq,Q@"A6ZFG,Wwg`WlnL]q Z;_ea>o/Ǜ;I ފ>uf Aa#PSz0e({6!> stream xX[6~wXxn)[bkl4}oi~8MbpGN}'TWtK9 FL y5!1qEvMt[|*wc*{hr $CpLЫd{[C_E޶e^#) 95M[= | L~"n3*xz|_il'5dE֦6/k燇M~ֆ+͔yE9*š7:7׸غ#N_Rg\/75*Oqse/tL Ƅk OkZg9F>1|N5Ϋ=JMۜNǶz`h0K1"^ zqvRP}#RTiX "3'WQ|]{#fEGT^ a>]0yEd 0bゥ|U\uzwsiF8>/x90֌ݏv#R$߳n'^ys7ֹ5pxǻ(f"ˮi5-ywךzAg/#gB}~1j\R5z7X3Nq^Ro|.9,D(#0e&)&sqR0 kVZY7ڬڛW:.@ʒ;tƮ]h}ɱhj,1 7 s1ł+oF." QZ2 2vQv{%^p t7;' Pk+#@CjjDLQJbuzC"A|Ej{NS5RxjQj=f0Qatا$BPOJX>PXMB J3W$!ll-9L2*e2=qCƙjtĶ3SrquNSِ(_xe1[&b%K`H49Tagy7O_AICa6Ӯ|Tcc}QTꛔ<#B@˂q"OACB0 D顪HwqѦv[85M j\#9cS)a)]6ÙFU5  ꡿H{\Ofi^^]OTds"Vˠtg0=I^?[0wyp!28ePQ\ ՎƴrBxo{\ M2=`Q0DPtѝVOèA+f6vۍ1Q)7mgzH"Um*Nc mzŃ%[Z!EL-7%PWAA+?,'Phendstream endobj 1049 0 obj << /Filter /FlateDecode /Length 2214 >> stream xYKY%Ā/6@Z~ g`V=pg4Q%jvn>9 ءz|ՃүӔiڿ7$n&N;mTӗɗorI .& r%zg95".ɒ4Ki4ESf=ʹҤhf[3kMIR1[R*2&*KRbd<#OF r()zO ƙ4|O/uSSP)SrSEf}/va+i [',MLV^}tgEzYHWEŋNFyI^8įu'iu1ՊcurW ޣ]^^X`1)eɳey*MQU z]$Gw嶮o:}ͱ>vElѸpF{eu87N T[uöٮHy6ug\]ujx CVC3:U=n};.<CctWzWK;+pzڣ7>{LU˦>ZA4̀m\~@jj+#ط]8d$4A3>qalSƨ2n4jPzHI9i&D(teS;9ۙP*!? g4)c 0oѷhE r + mk1iCęl\QDh*ea蛗uqlUo$̥" LI)WfAWVRB`Y_BdDN`ݝޞ9 eM> _|ioW° Oz|8[ ԅ $f(d%#zƵ˪h#yY8:SSt0o(}{,c,ApR7\s,~IV%<0U*Yrٮ=MqjVY nnm=fওZCa7,;A +5ݺ@Sk1\d4cʵUr݇\*\x">@ p}q)@MZr!]tpl5|Si ܺMcY߭`Zo-MlȪcF~@<Y E@K2@~CPBj-`hP(!a4λN%Vƺ}OBA3CB$Z{-2;>>UvAHm[T-/ phaÂӌF?V(6 %U;$ u,<TvIEf1u@|*,鎳h66FFOQM,:lvܶa1u1e}بVo|V][ų{W㥼).U,owXNXXPCv o)f? >]=P߮HEUB7xχ4,{Q.¥R[~58l* )#8ҧ=a,`9:m[.&?Ztst=ksii5252M~#8G8(Q%s~`0\웑Ưe|q?N endstream endobj 1050 0 obj << /Filter /FlateDecode /Length 2571 >> stream xX[o~\ 0s*P9.j.G ~X1/riY{\3RQ ̜-؀O<룏G=W_ߚZ68ײe +|ytA~҂*azW>+YKRÑ/_teSiiA0?*U#TQr; 5. p,l)FjS|]fBګf4|W՟~:!Ty5⏳BIo.Ȭ2SQ>-5HXmV\̪\ J!>nU[/fTpsv^nN&ӂï_ 1KDMa㙒e6I0by EmLr7v/KI.L R/f$I\i xYFy Sw왂ZE~q@ @ݨc~$@ԦXUًy}\>Ilwd! 2@MlW Ȉ ifCo4n%eQF:wJtWt$Bu\z3֣,1fY}o|i qxպmxӦ^rO'\~$ӧ;!ligM zkq5q":׿Qx 0^{WΑ^~YOg7Gd|Ɉ3'нYj(]X`iWI㹈fM#~T<ifc': $e|ŵ9` "[qPPDԠ}y,d1Ik&M^ufbF~Z Q mg}RXhmy⬠0AZۥ^Jna=Lpv](0a$BS\S1`s\fU*-yZf׍wMA7z|-*נQRՋrEea(XǭXڥl.e)RWP|5:WS3a/$Fmzں{N|n{yX? 42_1zHNnBw$%Q{5}>4$p:>Ln85U_|]g"[F: (.sI} Zy{%IX$TG%nj 𰆳5plL $W[JA^(T]o(vbœq½Z,'R`R1lBQgH <:+?`EzMNRALጟNp$pafU3> t<2, ƣ;GsJ9 q#- he~?sԵv Q~:9\d W CNdr ]i@l?08aM9{(BSH|co2SОT l )`NacɉK#;?k2OzmS(W"#WDrS ©+Lvx<'5jzW\ Rendstream endobj 1051 0 obj << /Filter /FlateDecode /Length 2247 >> stream xY[oE0ks&6 ,?0,kCIuf1I || $l3rӈIgI~Z r I&7h(rD2ٌ:5Sr92XõF͝e`֋4wh>|v !ZsYc/c"RVVYfܘh^9CR1ڥ8p4_R Rd2MBvva&@_V9ngn;EwE9k~PLSg @ nEibfgϞ5oktYfqXMbqq(&cA\٭?so- ҳ@c‚ǫ-yW'f<"#5v{Sد4C}g>vw6n}s(ծeaW?E־Yb}w[\0/bb/=7NP\w2`z]S۪tdo^d#;˘\.78vЈΫ0^}^vX60+w]O{Ci7 폛)ow6tֹ9z^y`vw{ey*%.',~Stnw<1W{b|Ż~1{\ۮ-lDЀeuBz]niښQ?WؚC8ؖñn|Š_bVkB+oU) RP60n@pm-z7"Y ͦ@뇴%Y!-ΩvH5LR`Ћ׮O*fgEr,NnWIš_k ^Vo:a5_Rqp;hz4hw~ލrA/R GR#6P 7kN3uKL[G2-T]I ̀LF0fw4e^[+t( 2NC R/P; )97[f洲@rL jRW-,@X?b0u|0;A Q`:#.ѴGАA*> iU5V`p ܕgm3̆5p=fD.f+Qxzw)(\HTpnKeNAЪ~2]XE/'48+hHRMqɀN;l yLQqܕgk՚mM<N8\`.A"&߭ItND6r⵱?e-xNs>Y!z-K4\\G*N`ķ/d,V^_Cv_RtPjF)my9+_M! eH.tsh0:V^4t fXsqqD6s(fI/FhAT(P\t&Hnw)\wO'tF47u-<6/Lx^B, E4l AꨡKzR"}p[KIEc~T66;=Itc(操M|V`$g@(b\캕̊b @lHv]"ʨ1]UKPa>";$DJsDqoS6F%M?c49Ny-h"e0aSIl} ېTpZT90t9}!~dϡ#yD˜e*O6#qd=z3D FsmJsw+Q!_& -Ba>O4'@SzN*,`jwnTe:I4"Tv&L'-Wh7`{%QgӲO8 [u>S 7Z1n?kش .  hn1CnmVx_{>pGP=x!UDt7T+>?4~  _+zF௬k峁zDI_4nNO+Ot+]K t+ @'#TC3% ɕ6VfK{L3m/ΚQa?sR3' 911AVi (;6aTTv~o0endstream endobj 1052 0 obj << /Filter /FlateDecode /Length 2149 >> stream xYo=Ev()Хm2;q˥@/]RX~`mf y%).#@a |f7O !hr;inR\͓ƃg?hiVnd|3ށ@-x> 4݉31__.ȫTJ+!%io2d^q e`LA%QҺ*󋯋mroyqfA5@3²d<O.ӧO)CF\{\VwEPL攲@1'\/I%} ҳftgmuWk6bom1!'| ;kC`p}`͡  n UquiRI"1ɳP 1Ey3v& y4I=/<{U5I!PhF| >hYy\^tU#E) Զg夺_isՄduO/29|\UNΞ\uA4ڪĦG'{7Oc,@'z*[iza1o Ya4cM } Xv2-/gC[nvJj6YiW:t[҄O-0 7 X0 Xrv8W[iNFD\((X\L .Eֈ(ŕŷ/K98w@ݝ/vmwi3ܧ.W҄AFrS?Q@kd2P>|s-?J_.mcCrY>n;_s>(Zdy\ J! .z#ɋGFVĂW?r"$/nnsYƥ\+D)@n(]m=$6WjE_Y9c&W9sm\|.~QxAn}r/js[S9NbWE[xbr 0]/GuICM=8> %'*N+AIZ 0"WBBZT@T#0i:<8eiԨ9 *x A@uG!u3R]?_t3ʡcZ:$r&4˴IPMcPucy4h6km_T@@y(6AK ؝myaς-x*gn ex<; m8F'n,4U;`Z܏=E5K}}w˨}hsK@p7}] dp蝊 Kg6U{}\F9;MhK02v,"D#$ΒHJ,OsaMxTNkw|G NWc{ҟĬ0.ɮ(`3e`5_<**ֶ'wi 8Jx>Ԝ ~Ŝ8>0\cЂk`9k 'STֿ Ce?{'Nx@z e"yO&jo=){zWB?u .R#endstream endobj 1053 0 obj << /Filter /FlateDecode /Length 2315 >> stream xYK֙ [` =NoxPdUdRb,}vcD!=U3=3=dsw0@9]SUuW=2Fy_{jnYs2{lfP3aeV[9y3ʴyRN_>sGe^H)h8qkk(Ɨ¹B)cBqMY!1(|NvtU^hwhƒm ūv7!_O~hD5e\$䕇\Rƣ9~#U|+gz[Iyg3?u㇍-A)T*Lt󒼞4u<}5].ozr(,VkD_y5 ]+8[uFa11'C_ `4:y^vx'?;I$0X7Zըhji9.߯6jyREM?|t!Ɗd;+I'C.FeS5JAby| xΧ @r* Ι 0wg083!hw[ḧ́z`k ͝5sͦ H _o6--j1|z5Ch> g*9+\2 ސ茑+sA3(Mz7*nBHj^W=q4IPY|fT;6d #V{pW\/.\k p \geb'ȽM3iQ͢gbK])PHK}C2 HpAW{+ m뫐A!ۇfp&vkNJ265Txݠ:PaTn-UBf 1(䖠ZX9y)E0UdڼL)Oj{u^B(,{AX8#UW!WP8HgbV=Z+=䇺ee$dIX$AVTS!McUJ3R';`,Y<'_< kkWf| ƽ >ȨBs١6+uh%/4hEAd ,Z I*4rr͊#G6Os+xayo6+ll2W8Uji=<ȃ٧9B?Qk!LBphX:@<&r<G~#o XYڬPXa,m,QP! OQ4pF:6?+N@T{h6?O9"kD?&Y3٦C?CC& #R[ .eSA]<ȃBh3/A\Pwf߅15TTuׁ7'e@kJe-sBdI=5ީqؑry r J9r`7(M!}zʙP썜h34l {()2O_ezH|hMY:jn7FjaB: dZ[`qt'75Q\GMs #daEKd\n!H%^U'me{]ƹwhQ! <8)( uڨ8&{) ,\D^O)徢nm)#L &Sg&9.0W[A ~.RN:vC.63 BV;;&Xq{H 2B7:ʱP[<ݐY)I1njnKSa(oydu)ǡ碼tc+9(OBlc=(O~um&?<_ΎG7>u6;K@o%# r> ^ /S>@ːp^s1V>zdX5P.F4{Z ׿FFF];t,b| bErm[{Ǧ~BHVqew?A-nY1io3GogLk*VNGNQ4,g/J?SXyoyri@%\9&D oliOEtiÏjURx}kg׳,~fiL/vMNHMlUWiglun'r 0 6ۏl"bo qnendstream endobj 1054 0 obj << /Filter /FlateDecode /Length 1542 >> stream xX]o6}/ F'"%uZK`AGewIQ(i yx?>&:w|w|p^u:w]8? #/rR`DnC,wDėNꬪSkDz1||ZTֹS& 'JJp[ S%DS}BϞzJ*|HI]fbt95r>E%uëv0$O[_nx{" <]̝%dΞH2Ƅҫmh|6:PTX"DRş+v%<HozQ+yˬ({Lv5;oFڂI Wbk7-g'=b-ۚO:%YMGmfuRk l [czjןFK5D? aPkݤ(6wo?)n>^Y^u1k&O;N?m'V}&?.7AQ^X^qpyӄrJVܱjE M48:FPDjڤKLһ̒:]=/COueU_>XMXpOX5t]eS VE>%觇*{x=?ǻ7tnd'U]U:F,>jT{ 0 bjX?aRTpJ|-6¡IuI?&nPGa;YIwűrS HNbmgk%nuZ izoj<ccM0Qb9#A7$LUg)uL`45endstream endobj 1055 0 obj << /Filter /FlateDecode /Length 2551 >> stream xY[o~wԇnA@ t5;'`AQ XyZM(j)ʱ ᐜ)7%0rf;92Ib:IG#jNy1ub:_5k)sNԱr2/i'kRguiRd4✓ .;ݔ0a<""Ae238*gdUˬ-w?Vu"0$qB%S"6)%.Ye bj<°|v4zFe(պ㖭`읗ꗫ=ͼ@3FvI,ԀMQzd BUz_m,􏶕 &;t TI$4ƀNJȳ5t%Qf"Hޯvτ*]%Ru?4kZc|/H1 b_yv/-1wǞi0]BsC8Y) ˩"3gB'+J ǭ"sp5ףcyژ3w81@o mZKq %Iց&$K_hՌ!(Bv7קHĸ5t^4N8Sʿl$]]L0_zmAnwY;`. T>\.Pܴ)zWVNCBI}IAxc޸!,L)\j̙Boe5 )tl 7.==P<aBm]GƹGΩXT9@z#! p7;7M!<@s\D3f2Ys}(%,FQu‡ &+F2&imti}ablPUVPU79t}h=|d։1WK Ĺ,F3d`5%ca2 P2 ;?e?.AwƐ^4dtr\[k`jn p<hb YY-k6pJxe haHث:Ą/@=ZuZjJ1LI'dV5 Cv]P9KSUV ص@4{20|6Ӕ+񖜫Eneb٫/%9a ITA*~ zSk;'C>nSjPc3#<&P(mo:#-[F<1W0qn6Hb&FL ?FT5SV~t:!Mśeu0$DĚC<6{E4Qp؛ijv9Kb9F;)*OdIhah, ql0H[mVs'Jƌ >HqL&AtdZO}7ʞaY>u웚6cpnE> Xȉ|8F:0"]$73 ¡vI_b@gݺ;K&%<=}?}Rj|dl0RF]V `I^Av>8q`Ϡ*̅ x:ZX{ 0ʀ< aHH6B6Hz f8)ORDCo:[L!x9#<>0i50 2*$$e$@$y|3Qg"ʒbDcaA-yɞ, 8 xF4<0|=r&8uױM*ζe%IrsLxsḁXhK(w~簃_D,-IN4Mfi1A}3b@jncWGە6 ╄-84TO9D/߇/A=jTuj>yr;G^m<x9gqo J}7155? `ddZendstream endobj 1056 0 obj << /Filter /FlateDecode /Length 1840 >> stream xX[oGO *1F/~pH1ބ 7m {fnzCX~wͬ?Dӈ?ED׽=FE˨+--–Xz3424Rce4Ze?qᆴfKO0 cЧI?v 5ʠUg \)Vr\bT8ZlB/ I8/cːnz͉le({p1 J@lưVt3POng zu)>[wgajNH3 AY'9NJ} 2H!Zc^ y!-a89 w;Q_W=~ *#8̜=N1kJfIȽ1J``, ?ؑs3Mi)! G94a-9e_@k F /TpBd -_KXg:úZ4ҋ҂ AoԄ2' zmd^0\zA[&sko{c` Ftm /0v4 g}ulZ'ggttm߹P7\ՒCkNXPf ob7쾰< gۡ|Ox~914HۡPj Bov ;a0Nw.1] ̗Tnթݿ_g1fuNsV211o1qSM _F1Az*s¹3W ;WsuhZv8q[:{:ջX#?wYLH,$/].ZkܕZjX`A3;6Hj,M^A B2G/)c5JVKKwHӒ`߻C )8g]SxC03¬.d=W;AzAc4Kr.K 00G1zߎ%~? G^nIN;P\f#+0mtu~e8 WY^M.kh9ctaV͛<.'r䯧y2..YxIdy~7F[LJC7&?,&y,GUStN> stream xZ[o3Ep]d|h- <0"3HZC{Yfe٩c?,r9s||6nj1 5O.Fl|>yī賗օG3dzF>FQjKNeZZ<)\LqgYBJI|7{kߕ. (f#…~ * ?.$WI9"~9O3Zy1f+ӔqI}[ݼ> `+bNNO|(k~\ώ|:{'IGÇw:l΋ll[ :8xWv0?+2žoNV2/rq^# /B<:8 |Y/6]xjQNIְ&,9?[ ߹a`b{1 L`F. h{V^oFg׊pj9ZJAqB)ʭ5N =`,+p`M"U`sސ:`n-iU%6>XiGZj4B Zo .< 7yH^梃z-˽|AI )N'w;R4ol/ZA6*JPFM0Fzl|cYP#8^jN^*$%5<&º* 'c?f^&5Mn&5@Jh,zh NsZG]gB*kc:|gvFffI: XGr?Occ'y*nliV <}w;OwO0)?$ ~'j?#1.rPc?bLD{5*<K2ӧYN!f˰lM܌ϯF_k$4 -\RdOVߋXD@(P$Z[Ȑ d>Z eG$n/eY@4e"!\A<2ȏAUV%EI*9SS'Dy;pn:;MuW 欘˜kfD!y!k%%o "3W21Ās|m{+BZwF*vO!P%w25F GU䐫 #`??^[[Vpe5oa8J4p#B@CRQm!JÔ-I+OP%l˥?V-ɼmR4C%֣u r-\L6YU8_e Kסל|zv,4׆iX{|[[]S zA8G Y3*ޱjsV?4;Jx<Q`uJƤ8`%lTHD^b q'gzr8+9s:rrmgqc\i[ F]\{}q+j>6FOSØQjZpg*˦E>̓Bfʍ'FBF!k?yk޼k,¥[EoPAeꪭ9ǰ64>vq^ʻ|=ʑUqr=9ze,O5:s4T;IeErx݋N~K287VȡU᮫뷸{e )r6MGM|]&V5]k sn`AO=,EbLi-t7C^uT-1HJ5UUع|=Yoֵ:^HMYǨ$Q샨D0N2ٵ]//,)[bP8mqD4dz<({pȶu&j Y6 7J%AfCkGCN4Lɮ+ IlP*A h>BŹ.eY7rd\mHLGt5qxJD y#Q'|K#jYcw-*@-IR4O]Of ެ}X(WBendstream endobj 1058 0 obj << /Filter /FlateDecode /Length 1623 >> stream xXKoF =7z!]fߏ:4mBH$bˮ r(wAr)SA"K㛙og~L3dWf|==]C\ $(@6"V5Y RU_4|1Pr^I Mn I1Q lb<ˁW ԡfMH'F7mf,rObPڃ@/ BwDJXˌ/zswRpkyXhS!3g'דeVuϧbmU0}?j@ %r`qx\2~J.9;CӶŮqsakwx;w{}N@fpF4Œ(Q FRމ!yDI [&sITdK3ب5gge"z(<"%3m|x) fG12jDGӶ`NG}[Ȟ7NR b߀$I@p 1K^Ga53%gPu-\ax<{fmsD줞rI`#` xKl'Wc" cj*Lh0@2Gfxn[E Ţj볯]'oԘ Cd O σp(هep#pc[Qk!6ǒ6YMɁ#Xg*Ky) )Zkt|;]/`0G8.ft◛ru5{tJ~8 >GEVa >=|tOwKZg>fJ67)h! wjynazӢpVX˱ 7kp*vū.E^dS6B[hbEbJks$"uw9oah;3GIJڪvc U=+*yO:wܟӴpO|vu'3 \w~%@`Nmt5Mr_zj?B7 _uܛMgE_pH'NI0VD8EΚ;m]g[c30m~wӻ hM2 SQ7||:'y'=a]F.=">|?5Y9+?-;endstream endobj 1059 0 obj << /Filter /FlateDecode /Length 284 >> stream x]1n0 EwB7H2 \%Cc]ofsZ<9WMk'iTm,? .x ӳfw%񽌑1_ajLϫT֢VçStRT@'ؑ FR##k(Q^' "kАZT |AA Г mi#$R Ȃap"kQxwQe`eGXWΛ.R%3,E\~endstream endobj 1060 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2439 >> stream x}VyPwa`a 0(g"k4 rX(!3!2A9CT D i\FјR$(9+&ۃZlj_QH$ry)NRrϰ܌,BEĻZOD\>bbjlYc6%2 5Yi)9˗xz ) kq 隼4e:Qܤ)iԸd&Y5i2"<0,\.lsDh3^3<(QV.ncBRXZxDKQ+(j3NR-j+ZKyRTCSBMjd %B*JݷeqYbigiiʪ]^( u֋۰W% 8<Ɲ4QP"g;qAxL:o߬fuIR+ZJtZ &I:憏aIWp8`%jQA?6qr@,E9HM& {5,`T*~?1&ؗ%؄J sj~|$%r3chCT¼P =Ю2%V(xAڌb>52s%e+2t3T TUVɐVji/@pp+yUץhA 8gm@3<1OZ/m#<3`DF\k9DE'C|scSY#Fn@#4SWf$cѳ_Ԏָ%b>CŕEzDc;d."1iTU[y')Rdȣ^=>6roȯs֣С ( U@ t>z'7K ^ z~m8IvyB o\0 m^q?+,gr7A d)8 5+ْҢC?)=ˉ,\#|ε-Y!h7o|̏|9V޴eO>Wht'S/#2o ]r;If zIo@=@s̺Al=cwUrvB.VP^Wǖei{*\z]~P4N3?Nvuct?%eВAii?iHjMlPn=+@];Q 'Ų $Ok[w$8!M98[rM쐒3ąR2Yk6+v+&\jNUzRB\_yg`}dXkr^$VNrײ^XIcL-JkPqy =ZɼjְceGrsM[=PSl.`tgk*.6u*X]3T>yvwbo9hcָh9I.vOnx 9ʚb}3/[$OTR LF]tKOϖ%w>GX@,&wސ %c{Irg QL`ty jUo9<07FgpГ,x h tjրĨL6C:öxfڼ|vohGB2TÞ)N$lifvU$rV3+i ^Emz3r M`#?:YT.i9p}zMMaUIi?t9^i /{?'7b>ofm?pJA춒wwujkah]*¾᳻;SkخՂV0>> stream xZr7r[0U&4SͲeC&COcJ ,$MVUJjݯy]. ߳L٦8ZξzL[< o~,,q<(S,73e/җA)_ . {ڼ."rֳ7/ n.}VC1W{k2v'֫;Bd;\)$/8v{Yh[_\{cً/M9ΐc\qټ=1E;Y%  4Le)As6bիuER\8`O +ǰM*СzZTτQm 7frS2R#ANYDBL 7C3["μKWu)`y%6MXz 3,լj۩Sʱg<\vYԫ#&L}jGgc2X0}s+th_HZK^_ l\y )r66˽ArxI|[vxhETS?P*G_w6R](^$Eo#HZ6H8yܹ@c?̂ 15~[o_asj%.fǃB>4Ub]Z07tp dHԔ/3z6;#ry+xaM*Iҋ \b-BmTi,_x(]hGG92=z!6d5<3{zM-ׁft4 if28_VVNY`ft-4f ҨXKs [<ճ@jRLY3<^<3`U" %d)uMcsT~.%Q&KA lWG>&tz8nuAo*L(1hd3)&47?LQ#% e 6KCzǽ%'pgvأA7!|TLqPzKY 7-NWDdiV :vԗ)@ P!Ğ|}@+:smw_uD(I.tZ0ΰ/856w] MRK ',բaU[wlվ*{ˤZp)S6K `"&D7i3fDr;At0Of endstream endobj 1062 0 obj << /Filter /FlateDecode /Length 186 >> stream x]= {N E&6)t,CH $v G t/Q0Z kҮJU7ޟx默d^A_{`]endstream endobj 1063 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 854 >> stream xm_hSwm358ohe q:{薮]Nm\XӤIG,MZɤ鴮tLD! n2 0'{9p~RQ4M7|aqw[Cf2bq@2GcD`t'>a/8MmeYjҵ#2$@"2;= JiV,_B:͍L Yvfb FX$∎$|Qױc˗Y[ً5ln$&q9WWrKY.Eſ ߭/.ΙL~ \z|YN{gEҭ`KVZNk#8"$(g&c+B V- z {<9 q6XL)=]vN_Ʝ$5Nf ࡍ7ϼԚ/5,ׯn=NKT:%.S3jjb*MeRbNendstream endobj 1064 0 obj << /Filter /FlateDecode /Length 171 >> stream x]; D{N Dɢq$X^EnvҰ3->SH S&Xš &DHjɻk:t|"=ۛZ&XX64N@:U"o%I&,VbeS:YS̍U;.X[|Vbendstream endobj 1065 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 439 >> stream xcd`ab`dd M3 JM/I, f!CǺ<<,{( }G1<=9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C53000101g <} d)M?o:]}CbUg}e{wjwz7G ǗseSKHa;0>5lb?}Mcmihi]eONZ)r}ݗ8 f[귨nĶiKV]nuܢ}'6^r%[wƮl|e ~8?uM\XBy8WN|gCI=Sz20쳘endstream endobj 1066 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O1 y@@jDY%C1C2 $g|wݵs6GOJ`ӑfD$h bY8x{S{5TvbK4U4`~R Yqp\*UK\:~|)X>jdSXendstream endobj 1067 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 284 >> stream xcd`ab`ddM,M)6 JM/I,If!C+XyyX|*=E{"8fFjʢ#c]] iTध_^竧_TSHJHISOSIP v Vp 4TQF ^Ȣ} C_g:OtiQw_>ڢ%3\ҽTq ?oZȶk?s> ==3zz&L?guO}20 plendstream endobj 1068 0 obj << /Filter /FlateDecode /Length 1773 >> stream xXKFS^#Hk"vy-[LlMb@%QPC{eO@ӬW_U7m@0 W.7#\ގh?M|3m`zTSsa-5\h &kJ,*"-8tkeP\C9;?vڥkgM L7NJɾT(Ć ^ńIy~g&ϺǨZD>֓w׻hK7)RXgIiy Ev/T-Nw=o}7=9\㿟9>sYovj:.&;+El(ZgWoG5Ͳ"-<icمߗyûR[]yD4[%l_x1UVN; lCiM,.$͊8OJ+Z OzwӼDsgЅM ]op1%O}ڐ@E4,8P,%J Xz-8ւ}x ]bA[WJi]reZEZ)IG<ٹ%:F'-\;ReLk- İ:&DdzZv%E6-ȳWiì31ShA7DYiA/% je ڝ$I%ŰUì̺LjQׂ[QZ74B> kǵE\Z>K K8o,U\sBj y@L`k\_4beҿ$#`ϩQ;eIS[h_`[s!i a~k} qH)T Y`1hkT4ch[( (t5+n_!+A7U`\hu0똠/,.@m4͞K/Ȅ8#Aҙj0^ɔbG\+,cEaQ/9SbIJC7`C#@@>H,kp:#u|X2>lGԗAu-NbG?с@{D !Uez/qWDB50X+vxJh"󃺼_KwT| DD^$c`sDz&F&6L'O7wgt/endstream endobj 1069 0 obj << /Filter /FlateDecode /Length 1809 >> stream xW[oE3B<8x_ZDEP*G I6]i+ w19s%Ç\) ʚZ3-]sfCmiBiQ~z| Sα+<3i&|Tm (k*C~4vyEňCls25d Y2ͷ•4xPc|L)j(n PK똃=/9v Puà`Σ%CXVʞC#74  *$3m,hnx@9tS, 4t@ϡmMqޛ`x.x#UCZ`F `@b_@gGZ$qS2dU>6ʿ Cr!`Bi3j Zw3MªA b$- =:6|=ȤG%ijg3Da`pk4}~*9X,yd=Y앤7 P]?6˸:sņ#ot9s!O^o%MC>m(|S H@ps#xb_ i uu rpJ*ڍQw'[ wѴq>3> jQ^i84OTf+3 =癤\3_t2l0}9c܂Kïhf̻2[ϚS=@M_ @%%= Gpu#1$,̺oiѼu'wQ_@5^4Ju#b wiuCv68@<_uEHE=gy|st>[هY٤,%| :^UTpmNabxyTJ@?rB+A+{Ʒ,Mj. &ZS8t*|ubZ-t62o™(6yv4YI7%|m˴f 8YYkظq[L]bMƉ͢[h3nLo3vv-?d^ȷeS`*[g)^*lڸ~7ecY~ '{Z.y§a,_ 6|y]\u|뤪sﻚcȀc'5Luuࠤ EK,9?1aT)D~wl?=3yG"ls˃wx㟽'Չ#>~ a9+=Nu"@ cKFёG916So񨤎jf [nM.tNS^`^Uz)OD@Py Z뉠*/}nM~yR: Wt| e9endstream endobj 1070 0 obj << /Filter /FlateDecode /Length 1605 >> stream xWKo7)Dž]T"|?HRTr 7[RI7++9IQw}qUb( Cp曏3"iD_;]vHtСmTL/O [bi4zHK-hA37$4gcc,:cK0 cd\Sbb'C2h}="ssק |Fܫ2bk%z(ŕnK?vVJ,Mvk 4,!FZ-6o2A$r(q^PCPP5AhB/Vh-+G8Xfլs$&Ђ:Zʽezcni`;FwLL3pk\e,a0P+r Sڨ)K0i"+ Rs!e C.% D'p6xQѤa(-@}P%PZtVr^2FP ], l@Q+dI{kT6[ɂ*-<;0XZ*(EIyp%-o (жƤAAUef#) L5/`43G*$lU@Z@kva c>SɅvihg_l@C!Z~ƷǣYUg\V* CJ]ܢ?[ڝms}44 =i ƩBgbCBE7Q_k::i/DsqK`}'}:0OƆ~p7Qjp2T˂#BMJ`H+~U-:(!&B"DAw0-j?S0Swks:,%z%N;hVMl l] wnvFpK&}?9JxsvܛNI5qa7j̿DOyӳvlinf/oK{tͶbm=|ެ9Px%/ayxV=h>K L/+Jmid NϏ*M-W1-nwI\; {I* . {BnۥdGl mm 9ڬqf3AGWRBpn5gw`WnFe0F=޲|~>?e^fm'W׈ux滻 O-՘/Ǟ] Ne0v&|gU./L!*WW0jj 6!E|_Wu|><ɀ< VXvdI٢|-P NhviG=> stream xX[oy$2JӹG/&E,uڭfhWJnP̐C塛"AP  3L#b>h=aDӨY_^&y54ZshĔ\Q"J4:,a'YJS!p|ť.6%4XX܏<^3RJRA%N&~2w8)GOaUCUgؼ}YlKYwcXXd]5޴0v)zՎ)ږ/fL<{u?զZu ߻}l8j_kٽU΅+]ߔ<ƶ \ίX_v>;[ߔ͡1T n֙aZ_-ZFUU15_ ?`N.ka R|j'"JYbe*&c ZkwU'Bk@!r LNLx@1ߛPJN6B0UC|֠Q'WPm6ЍsMpWsL9@'.^5WZ+L -lL r59h(rcVqsJHD@ʇ&m`8? m#^澲MVQ[ހ#Z'G`Hb^$+HP$ Vrsc*ywx’uf+Vf9PL` )\19j& w;tO(U Cx n´ } %,-X) aY=ËN8[WR@ *S^):Szf s 9@RΞN"g;ɢ![}µxC۲5$TujX Π v$!O@ ḩx?^$ӈ7K'm,YBQ.@in> Hg0B%V*’v<,IrEc@tΨӋnJK'iuN%g?]yӼj0s* 가B8 W !>l q:۱20_ *]le ."%vPp6͊NiO/,|PFQ )BՔp}"]#]mX$$+C>>t`k]A-Ao&JtΓO3?Ôa9S2/! qYyN i?-9q]GۄpO3,Lj(סZJ$A8qqm(]wU28x5֫SϮwy]U˷*_>v '5]ׄݐ*psZfag~zߪ mۼ%}oo76@sc:>]%hl ͬ1Ela6<6ʃcj8 X]Ǣ ;~7w,ܪ{l#O g* A@,M5ڬomߥY89Eûeto zHL(S4Y҂pWcۆr>15^Mo\nQ$c2ͭ;wOZk;3gm*Z%cUV=K߾ꚑ)wuWEc\T0폫/'_endstream endobj 1072 0 obj << /Filter /FlateDecode /Length 1615 >> stream xXKoF \( t;WI[K6DNmX>0bӖLE{gwXJT@ \3|ZS`'W^=ҿ}Q_^ƽoi6c}ML?^"ZqMBqF9Zw^G)}NKwJ ϢiFr|h)8sR^uXQ,D?*yu 'S 0?{mƄ?MZJ%tѻRR:ݯ J:xX.g^,ߞDԍ~Ű*ݏ-t>b14jClaݠ`X/o`y7x?wnt1[ վCb{˴XͲ֖e–A#sPJl>H\Tƅ(+9ba Б9pC8ʣC qͻQ +]%Qn%2:!6^%n_6r~NZϊUu&!E cpZ1zY]&fZu"+$;ʬی p+t]T&O`ێ7۫|^VZM>P Oj%夑 B4ʯ"ˋV=6v9R'Ex0ϫV3XUe~ ݠXiƭeqiNOfjCZX6vw>f&ϧ<]|h."_E>-[Y6u.)/4.uk; 'i7.A;$0!8I Tr~$}8' B57vă2ІRVVGF}q m, N2,3טNy?RC ߺDT. ˄y]N5Ò˶n/3_l AS=d]mRsdK xʒЂ3+Fo-A g,> stream xXKoF =E]KGQWIZ%T 9205%E{gX.e*- 79"FD7Z>?<: #lzPHK-, U< *zLt7G)6GF?&wQ̙5F\bTeU,p<bkumm#px)ɱ# C{e`H/u9T538baoM/ kNJ(0ZL5=IVHb TTKvHcA93Q YR@1L"RW:M]`#oFsȟ)A$4!d#\)NдQr~tGKUiuKrw> .y6ӴFXggƕPI=SKOex/ӢqV׭ܺHvUl%0-lyӮ@ۏi![nbe@.Q5' yt= ,v:A Yc949lwW;:vc=nMbH?.h݃u`h;b٬UPI{>z<%l r~Ҋ&{U@|@}X^5iQ'tw|ynݺzse"iHnM ۲*1@K^m/Mi R U\kQ󖦡r?)'Kŧ`k =Pk9cO|"QiEآJЏ.]d.aT'kl yH͆c~,iOqsL1-u?FWJZ)w-/KĽ? tI>mK-ppʹXUT8>>n f^zp{T/(@endstream endobj 1074 0 obj << /Filter /FlateDecode /Length 2210 >> stream xXoFc}],{=?\^PC RG`h %]jR;;;pg)gXz|6\*S3dzۃD25\l=@,88Өrזdb~SX 6PJt"\ hL a*#%x(5a_!*9EN0S͛0C(PNI?<ꝟb7Ҹs]5>ͪ;&Uh`j8vN`}>U0@TM;mܕ1>}@T<㩴\U BkP0M&(*CEƘ^r fP+Y_̖QU$ȡ|0H3yqH>ܔv7\o3I+$x cK$V(t/(b+6nId0+zm`8W# \Oֲl*طo˺;$u(Q@z\ef&Q`h!WDUbK$`Y`w\pj.l'3O^ tP+Dw `<]v-h4JYJq+?@2 C AVE? (\j-vV[u*yO МoW˕imh[fՆ9t<s;TO'%61Q8j;RANk:@BmlJ(M:>*-%՝pbćI/tkU@F4}'̹m0l!2s $mBRtGÔk@}e2l~$fX-I> mq5s?I/Ld `TPjd6K2:$/0P `ug :`Y3Y"Bd'jLBqb &hZ(b<g3TGLnéId  ,|Dzm~ dsÀ)0Mgf! $JŖ~9XAFX0ˠ)qL:4~(`ej#2/ xֲA5xK0NʺP. 4d;%#LAV#)Ő2DuCZh M@RIP?g%vq{sUcAQSaw]Yh\H"4is{> stream xXKoFYz,z$]△uit0 Ȳ!GE{gL:nE^Q3|G (qE'.;;F"y7m#j ࢓݁)A0Z.3$o M$אXoflҍ3F2tc99: viC )aCK=ŜT ,F)'<$n,*kz>[hN j&G٦4Z)3u 5F:M9WFȋ4A*]t-6R, u#RLg׬L"N-EÀE1 ,,s PThCM7fҝ&? rA#A<#ہZeI 25¨(MTi2..פNQTy.sԡc`, -ڳSj/rI Q :$*P5[ocM@ DjhX!oF+S\)Hx+kf3hKp C~\"1i.^5+M #PX45 1rD|27c[;55lv)[m>((`M0(ѻ@)(ǣa_m=R&у ;˔ci他e6n.yҒ8e+ I S 6q oz^y%J󿺏nVe͝c ު<o%kQCQjDΧrOޭX8PbE,]Y'ta34_iZ- c '㹏`|=e_gUJlzw c%)dWypYGCv֓t>-^J`㻂ΰwX*B{μI fxQZvNvrz.j`%2"z3"oq?^l!"S79E'`hP׫5ujlV/'ӫ vfsU^b'b/\Z.nlT\?eT nEKn8tJ'ґzbKyp&w"I^#+H'˸׭W)U'AWث\>0}@:ߗ=ѭ2د:]R_J&4Q;J,˺z&I1ie}W+'y mBު݊'e7;5Hendstream endobj 1076 0 obj << /Filter /FlateDecode /Length 1713 >> stream xX[oGB}TRאΙ@* 5EHvĀ!CgfolHKR=;gmB $}M^M໧ZZE,L_ JH $ZjbLA 8N2=CJV_Wt97Ft;<>p e` ѠKb*-wa& 6<=[ٽnY%Nƨ,[dyZZj6enq:߳ԤI<0mVp-hĵG9wq?-f9Ɠ]-ߍ2vk<oV ~x؍ _ r8ZaR%F~?HG "rw^lMd[X)?t2I&0^Z~u=ZXӉS`W=aݽig땀V{q*0+eJ$Gc/ | :ؔ {uFkw.?@w{B!)+AY $'ITV!yERA4:ȌMBc8V;coGW\n;~/v%u%70|5T^hKh1KkVG&5nɾb} Zȸ'0"pۑxBcI_3BɪEEG#D_m5ƶ=ֹdVJf ZM@!^I;]ѵEjÞQpz?ea73Pk ZEM|}h:1L7B{SJ7Va qjVߨ7> stream xXݏDG[g+/xYy(PDEHL%5(ά?wsH(Yۿǎw.b"~Eףw#(Fu|կZZE-ͯF D"-5nRcߌ.ȳQ&Ɛc)/S ̒"Nܕ ŗNTV]MF~.,VaŎ hbD_Z)yK D3C-q"(f_8I@~ 9e˗REV&R#IN w_R8-ej[ SPf d5Qt Uz 0h(x.$/nnIi0vqb (^VbnNWZ,VGZӔ3xL!vAZ>;5ixYAڵBPN%hqµA9:RN\!$#JLM{M6ҬԠ tUƲᬆJAFinQP.7Ֆ )A2t@S-5gL;-zwoFSu͒﵊̄G'5&S.VfVQ-h[ͱ䪸R\fKQű4٪Rn&SL*Oc9(R#O7 '7prꪸ|00i+0HD-M g,0/ <g>9gܦ~`mK|{1FkX2Pv:!4]- 9sKKU-2/wxmR<^eoWWT`$X+ $>{I*-:dE~owQ蟠ux1)nDSΘQoI)*yw*[V'2'Pe:AS휏2 .2SC~J[A:h Fbnց璁l/g)GCwqђ|; ɦUa$䯫3v,DW!ng>pI y8e֞X_,Kwy;y"^P\ n4q ێ7vȝ=r=֣a&CE[nUz;\-ūFiڏIJM'5lY}]:5n@I/ =Tns l?Uh۠Go,6~PQǙ[zGoJTendstream endobj 1078 0 obj << /Filter /FlateDecode /Length 2018 >> stream xX[s3'ϝ䅣aa_* ^Ѹ6Htf Ra RL{X`\i\g9߹|{0&툌FF|;V篵 [bxq;бc-5\B$NܐPQ0eq3B/V|6d 5ʠCnҺS̩z}S.QҪ%8 k5 %ώYI\ l-E'V`B@a}pF%چ!`hkWsR#~j~bL{ ae(8|OIU`.T)`@***෱t-zd=/ex0^U$ ]8~x8Rʣ?2 SPE!Uݳ`9f`P}N)ʍc03v1%'S /_4~D*oj: e/ਫ਼^UH !? ȗ"]ۍT wEH^(FdWg] (<(D)w%T@b}4EѬH ?,ʥ)I9:s\AK ̄spI)NRk0VԢm9u&{AU6Pj֟`īcTR؍zTU KD3ȭ CT+M58 Cd* 5pW,>,1>N17C­^َ}"#K 8ےЮ6#[՘CH[N ( }~ЅhD U: &ۤV)C_zŒ!U0@TرBGK+ O5fhS~S 325u* ҠZXٸ‡g6Ų)-J^,S T\˜rC͛2\b5a ~zb)a^0+ȲU3:.p=,'IP N Z++KqȞ{l ]M7H󸈟$@5`@d;:"h +FhVj/}ČC?(A3IoX TW(mެeE KĐzaݟѰI%nf$e! >2K>ݦ=7ׁ}] B}"x}A%QY*S%!GO8oAс%ݫv0rS sV+_OKU)@qcKsUsAQᚗʁX/ɂqWbtE+BP4*m᠊ 䄪6xͭ=~@1]?nj.a[am`=Ki2|E}( Ѥ92VK?H׉|9d9>{2V qGD^xȳ%LijS9u^Zw4swp3W_5ʺ_%cs7.ެz^w}xHcVK| w=o^)5[]g2h10i 䧽ۚEzowE+t'_]j2 WS⍢7|~O}0mc`뿿w?Zv [I8ya;sֺtzY.ym/3m2W'V>=7W'&}%z̠ɻPޟDUOmdܩVd6Dcz^_Yp*]632wÇ쮕fuU=PRv[BGJ%'N|!hTZU)~@W⓺J՟msj}Wl֊62+Ī"[S+vm;7]v`tfV'\.endstream endobj 1079 0 obj << /Filter /FlateDecode /Length 1296 >> stream xW[o6~7:`R`TkqUb3li6N%^ʃ([re9X0QA`:|ߡ1q|W.,G_G:"s~~B3U>ġcC'VL8l4G}+T&jWB%1d{3 eGMrf#Dpglj!USJmD}=XoV ^搂uY1Ю}ZU,y9VsUùM` m3_BAܚAUSA\ŁhdOwÕOTGß*߁'w"~!oNj*iӎ ɘY/dIgp?R8y]dД$z|e.n|0 Ѕ@.ӿ?a X̿7DC } zPa4[ukRҠR\^ZpY_,'ףڇ{N(`H7UQEzU)1d 0wL{~#LI-%ҥ-we(4`5Al 󐳦@P# &1#F4j8X2Lϵe_sB `,ku+JKiЪ\xrCAo~@(JhNc#D 8\P0FChә4 DnA– [}[-;&OӃmendstream endobj 1080 0 obj << /Filter /FlateDecode /Length 1397 >> stream xWmo6߰F;`Tfi04j8xEXIْ+]a}GXn#0INO8XvGF؜vrõ` "+<^>;x,X0)aʃZ\ƮxI$%+]q39̖+ɂP$\}q93H1hua/$,7Z(RI봽Ι bB08JO^SO(c \mgjamZW U"XILU0y?v?Z%#Y >{yV}w8WU eϻrU%Lzꕱ O kAٖETlUWū!,wi%G mdZen moKOáXb es9;5qQVF׷3kUY}"/AWGT 54ΦI+D8If{ebڭ&ޣ;헓F7PV!DrU!qʔ3DAH hmWq^ZRs&k 3\C{0dHͿRqډy.vhPZkz}n68ړSqҫW&*u'Iw3; 7?p^i2[G7Q{il/)>_ ;:}$ C=b:_8>Ob>wrxUy]VFuy|JiɊieqEO#ES3L D.LJ ܕ9uĔPD(1( HtwhTE/EO-BpD#Bq'NJL$ȳ~+&$̿ B Z8`2}Lb\7d7mTD4QKIḨ荝axd d %ML`]Jx%{ؙ]0**oarA޶8@Th@Kjջah=k4ڢtlPZJ3gֹw3D_B/o* bGҦxB# zD&ݕ篙O0 G.OB5HQV v :Յopw>$Gn6?t%)EæIfja0"ݟTp|eDe\.G?VIendstream endobj 1081 0 obj << /Filter /FlateDecode /Length 2013 >> stream xXYS0 H@Ҵw:}^!@ J`FPMrwG"949S=G))$X<$k_ndx;y@ar;n6sm#l C r9m#E]r9*3C2hQ 9L]9hS‚jk'd,U7V .Q _?,ŨLbBp[}fѳJ4c׽e~[n]ՅQeX mNFZ׋q{q6b /U~|?uCJPɀD[qt(-ᨂl@RVM45sg+r$$7ݲ.{u)ifGM\>ҘVŭOP ǁvl+p|@܁a/*J]Щϝ[ \-:tniﲮO9ZuEo| mG/]&}zPlw%樯qqo֛Vۍ1Q 0Ny40uVǹlC:y;>'d}5D%ڕuum[p$E=>tݬw7u!3m^S<6-R['at^jr?G Q xZ. v(z1fRzXnSh/ cp;P$ fc FipÐ ňz-鹟 Z #ɐ.ZcMt:+ 6_S7i,Z4aLG̸ rbXPkS Lu,ojWJ%갎ܦ9t:5iapR|.c$PqBaN4XdC68SXfNbh fu똵݄ ZOl65rQ@uM 9tKY1-Ga`E[(w-|')+P$+= '\shM|י!AJ=ln{ o-2*ڸ,s|$Y/BV-%00rHUq+[; C(PQMA J4bJ1XT{# 擄_*- FgLbzv tA5p>U{n+i% n >A<ۡu#+Ta0Fwz~jz kS?@ad&[*,g6-֖) 3Æ娠TA[; kQh{ic(hLyp)t^Ogu-?Q]rr7ь$ؐEi[+:)`@1, ƧB@ (8ss˦G 庉UrcgF4}wPMFC9%e)15󱂫|XQ+ʫ,?h\ϐal,WH䮑T4t|jX/> w++- \G=ņ*јM5D<< Q,r,/5c~ٕXOk Gnv+(..LPm> stream xX͏6߳(@ȴ4M8IrPƮG[rdM#EIFN`/2:"FϛDuG.g_=O]†-5{hĔ\()6\Fl^SJ 8M5M(s.M6% XXgJ/c A%D O0/+Ypg_';H{[zrٕw4!x2_\%y3Obt塨 k+6UcUBM v$y`] JWjSUsAE_OD2QJ5LAp>К`DxY;8GS7EFÐ:ns'0RV| CpCGtWjCbeml-'CԳ+֞!;h(O48CGjk5we `rMZKώ#)Ôj1ˤ 2&K,pI5KH mO3IDb&#f73[^G!RZ殶Ca(FC>) 4uQG5ҫST+ ĥ)4MxByik-]f=[+a,>;S Jj(ƾ3lw%b6rLP3ŨFEHȥtJ~#Ȕ-oɺ' SE*fS#2P ~;ڋMk$$}@?Yπ7TRhS\)=ԡ&L5ƺcG};d¥c Rpv\_/{Xlq+bs!׊ :KXendstream endobj 1083 0 obj << /Filter /FlateDecode /Length 2341 >> stream xY[o3P/aLw3h8@ȋ+rIZQsffw"m5_sfݸƿѻ3:|T(0ʍzx{rT& 6uǒ0=km]ZVٳtwM:xtLMeA=IG9rnu6˃L<HAU t~)J^%4kۻnii7$}5Xq Ş?`b9{ |EMR_;7'}> rf*-un-q*l6́LʗG|"M2re/оe8u  l!+SPb+៰#]o .Uծ?/_ަ;s)%2xR m:& z`P< WKC vB?73&58+j^DJ:GrQYV6{[)s5Pd? T+#D BJBAm˞7Wb,b sUPM?S}[8 o2贔tR/Oty b6Dnw#0ˍߏ񫑰Wua0#'L'էo)5 ہ#š /NXLWNXO::^ c̉8琛c~/ xH Da i D?qTo O~|:}zݴm4&][pl٬oo`XvV~sKׂ͇o~"-s!k L=!h?C޳8~f~:SwԽ? %@Eendstream endobj 1084 0 obj << /Filter /FlateDecode /Length 1258 >> stream xWKo7 =rYr]-T&N@6TC .ڊDu$Qw}R@ v1ПF!aS,&m|?<#jd~Ṕ@6ɴ"~p9Sw+r2ʤǬx?s ̒(t=+Q;}mu7NR$JD!(H`zzE 9M3a-RܓT:,'e͂ wU1ǡIw^H4`q}[k S#Eq@$CIGtY䤙mț3"|Sy⧛lp?c)]v(Zx ]o] L aXPF&|dP^'tm_O7qrM6r'Ѓn]n*n{cKӺ*gu9D!}Yj3=q9!^)vv@VnѴdYQDܺ k{iWQ7ݛn؋ "G 6vY$XG7hYHcz;{ƃZ *wՉ<Ɠ^!>xT rܕѭ zaD׆l7T=Վgl O c~}}V8)^Si.gx.3J?ηK EEjnK*ʆ,laBy $; tǬ"ia4f[- x/6~ 鏱_[h4n߬=^{0A<:"erfX3,UR(\WJ3/z !О#U K$( ~Tj"@)g$xҬ&J&YU~-Dr $Ӕ3wPQb ʢDjE>aT_*]RaD|YJFyzmVTF ˚j EvQ/~j$[1|;feC_B@_c#?/#^g9V@Fӏ8U8E \p \1O !/Jb $vo(Y{ڋ}[5 `5xm?F `'Jzao̝xDGA?Ж<4XtP@q_vs4|A YWlgOg{ endstream endobj 1085 0 obj << /Filter /FlateDecode /Length 2199 >> stream xY[碏\Dp3K4F)6$]^q%ڒ(3یܵ ͥ|6;gȟ &kMz󄸧䳧JG$L7z R1z†b7BϢ')TU~(4RbX\Xta|t hаXM*ZRRR1'kj1WeVQ,(׸ ݦ|eZx47tO\C޹|_et!mqN-Ib$7e4Yխi$!F,{4k#Nm'6Jѓ'OZh:,죩u+i3oݯ8wK zdfuvb}xeWvVt{s7wZާC?nzx^(lobu?,۲X-K폞cU.T'χ1wiw\ (=8l7r&O]J7Y3]f[l[a# |~/71d>6w> Zl%&njnVEfuYBxQCX{YPhk^pǁFGreVsZѿ8SB:~ROcΰFk9bn X%%*O@Aڄt{p|B9&Xn?6`z52t'nuAmQҹ$%VЭXV4,zB2ۦUrSF5ٺ}:G}^={L z_H԰&\TlEDl{]Sp?OmthrL3!e5- PZ-Wιb)Ĵ|`F N0Sl yLzgm4F7u+UCle|OY ԃ~oLpO4PXm)6 ,eƞ[ muvS*%=Qk e-4CB㮉xJ*.Z@#tQ/64]bVKvi ?AX~hpv-ȯB!HB ^Ǽ4HQEX z,ncmE<[U/>tD~"= o`[*Pf] V@Bō5m:; S7SZns9$a>]r|y"j?eL헵_1$t;嗺@:OȈd N\s }i^7\A zWOvSGh U@p Rз >%>4aK, $2p (C+Ǩ  8s2D[ADg xs\!I< k%7ߵաZ2֞WG)F$xc9bB`,r= ]p' Nh*_S'nbm=јh& SXhrr {m:`; CpIFviNsK 6؟-:FNm>&XaaB tpLQaFLH`f%%0vJ5T5m{*|(UC(*băkGahT&Uf~Q#Q0C1gn~1-RM"#R˘ZE~Wj(6UN?^Tdv=q&ǩ%ZgCjzɄl` uRlDCœPRO#9|s d0w!J{6&W#62wE-$K*OE엱OVmNT2̌:io7;A#4Xژ^ n yиs4RB[ldpO4G0B:6PfKMS16 hdcb,,R&#_a‚۶~ 6߾̴oF~jU |0ݛE$vO.o7a]|^"bEڋm/.<b/^p{+?3O6W&[ nHX a:wXzk&3!V3αq `r3I g YzL/endstream endobj 1086 0 obj << /Filter /FlateDecode /Length 2970 >> stream xZ[s/;#"]=ĎVGmĦo;tH0-ubgt&䚦TY|8 5ʐ8RM5%,pOv8'R}j$L J3؜!{=I&k8먹eVeg=IJ9tfUǯFb\N FqZ#)t/OAQ1^~כńL qd~F^ւ_yqq4p2to=>?#ݫr\\Nu5+ܞ~!omH6_]fJ۱q^exmŦg G'-3};{w4bn˼*Jwp7ˬ:*e~6 t ܭrq u?)gզ\Nza Kb@ibdHAHD+F&"VW!4JHOC+lfk JaSJi8X ^'fmejBCV~|vB}E'ïA]L$ʩKT ZYir y-gfT[nd$RPtK yIі+ S!FǗ9e5If>Y|+FQ7Ã&I'śp )ʢȌ d%UħѷVc뾖Z3w &LMBZ"ْ<"/I`%j,FdxɄ8>pkR[bOԵ+(n hBL%AHg[ŁQZ؛3*a2f `Hcm\d4_^xK)ӤX!($^ݟ7QŬZAS<8EiR]v F^FoUi89V5#"FԲtD1FQb61Fb"pΜ#+ycHi <~"w+MZƥS 4_ ЅB@68>{שTx>Z^@BT $cKϢQv=h^OO]fVć 曩4"jYΈ jE.jq@˭ Y'" VV@cl$AL7ew)RrAY=_ODmo>"'$G5# XGDlۏ/ZC- gN=)Jc@Dڶq/]!!a{=儆hUnP(Еr}7ge2EO?4nձ%2D>Pqtkn3 gR/\bϜ(zD4^:"1 7o&,[4,(!%>9(]/@޿&p4|yIe&xEXe۴ID@NEY(䱃 wMzdӰtC[b&1l%Y7(+߹phoGq̢ڸ:gIrhd(1 gO3\~IB9YӚZel%m@ -:؉;?&Qޗ,qa=ɴ==%u {L3jh% ƧՎMȫ|Usk+SZ7r5 !ǝ,S: 0T6&iVe^dFSy u7+?>F%4Kr#.]ӸaeM96ll>βrlP|K\S Ld꾼*/`CHuZKZ?o-h.MM%xu/N}NjV{pŅ(n<=L2,;ESG߽8imf%)W0J0ٖFpwi~2F]l)Ǖ4m1 q^麍eCy*MYkU!o! @(\S&~ɽg ^s%9yڻ&~ / L<X/i'Tr`o({ ji~;|Y?ါnE{10rDqMiu'=, Ln?&}XKY}@#,QE[WUx"SniT[G[@ɨM~6l0UϮ v0} W#h۠mv}- eK%} '} [;-0/hʄvr7~(qw ZkcN@NQ'Nc'߱Պ+"CQ}*{qp#1yh{ҧtZȰE^ s L[Kg/#YqlbC/g:ˇQ:=3S}Ser uGTicٯ/w& _>y=|uQ٭q?_z -W{rO,zLI9Bj̍ONɷǺ F]n\,W`I>;%yg a7$T:4ʭJ<>v['eD+!o>avGnIiwqXfP-kd/endstream endobj 1087 0 obj << /Filter /FlateDecode /Length 3308 >> stream xZKr\CrJ QviEr+CƎ].yÑC{c+;CWv&|E:Yv;⏟Y$K3>[3mI=[n/7b7+.LSruq>Iuc۬ 3_/[p%l!uZuqi~<-:IS.R6H p0s3Ph rwפIE{Me@wyy?:9 /|hk ͉.Ory5{b^Z6P. l]]xްn_?_AvZұm^7XmvDz^'7bݳgt3e{77 5޵*@(C!EB2]d=bNxGڿ&'M{KWzd|dgC DTĴ"۴i3^p9i| ENERM66|?!RKrܹ}OXt7EU{j#ÛS3 `xu[uYF壶IiHT}CL.@g}M"ŋjٟql#峫|B|vMǥɎ9=Y됗g$f: a=DfCQԂh j0PI1$*/T1 ;7󅴸ξg *Ie)|* 8.x]䂶 n!5)TMn'v_JY{pX T|wY߰W"%[J2dSJT$!-߮bDzGSmq,Sd GZՂss d,?xmYGo(+j/o] oңLcXTpZ[01IvLϫb_E|BĨPnqO 6E{)F߷ ʭ4,/!{rs)s! Yep h x7G!ܒBqt(=S ŎWy)8Ġ/5%؇w;S Ե{M _bDԞXܝ3D H")J%-xAN-`_kҾILKVԡ}8)INS0!5_0w/]% )mJF[1^9ҥ~jm 3,0'1wza[0a3 opxQہ}us꾏[,/+UlQA:4'010\JUgao?P8;n[5 Tp"jnDžI= 7l]TV*6G(UؔA܀P'#E :~7auAz\ꨊ|0 $6y\oxz kgߎK\{8i]d~9G8. L3пP&1y:Huc*ܗDwdn }pg-N)Oaoh;γ7)ߤTvuCƖa(N? `!,A9@jb|`wA$wEu_+*=@Sxwl]9+(Hbm{O[ trGdØVD {`By/=0s}dȰiSVș2yh2Ipa圣I:`RRQ_s Ϋ~l 4(Bٿk$1mݫ7 6!h)b$'FrėG%R~y}QX`m KP1l^9-I*3bt#uZP1ӜD;~(F@^Vq"j46*4Xohg$]8%hljhbSH3 ,npPd'}5qc$C<"Wlq pLP< ueBpm~n)`hRuڏb~L ^ޟqwc:N$bCq@UV vWש1xih8@?]~,SHąnXJ8\,j6x!42b|*OL#0<*;ۛ1awD4ZJ6I ;W}Šs:;rv@JzXDKcVd-n}ΥϦ!͐$Fbǧ =H^#*ZnЈx3ݪ#d4vEzS/c` {xLR:|)to oNh˞TFdRTqcqW= u!֐ ľ241uCP}-m 0mh@RI_ȷw sL֊*9 CB`ՐQ9롔8W̶zWA&?p%D3Y6i})@ 26MBNQ6,?}bñ7vF:>i| VN@QIfտ*b}a`ݗJdo(Z\+^KtyQa+8Ej\GGˋO/Y?)}qhBݜRhɠ_# *E6/hB v*hꭏ {m}]RHhM-4 kIE P"M ~௃.M8w8!i03}R{3g8NjXFé/=z5R3\< ^bwoPGm?.±ǜ@Vb} sք.;d_~F7kC.Ԇȴ GvIK; {T,Z3ˆrSy? BL(- MWc((endstream endobj 1088 0 obj << /Filter /FlateDecode /Length 2827 >> stream xYߏ~!EqIn{ii΁S<'kI)ʵSܥb曙ד4l3No'/r|̭aT"U>tX'5IeS˚)My3Ờ&gE3I)?ڵ f3ƍRFR3iL$7eٲۛ{Uvr>i4mUo>o_pɊ~Z^^| ۬u2D++&˳lؗwZel]]7bJf[X6y ^"eU6v[[W\Gu,Ot1 N,M#>gqZkgc|FKc.)7nIgwƄn7š tolpS4uv~AdIUcUr?:@~\+wZFZP;@zúw"RCno[7b'V wqYXr\֋56.M=%|XYoV?-/1e q_LݗN`UDu#CwrΓg=sZաw*\{q,׫73eOmT5 y@E eYah@KvEs8W͡.30T}~WjԄj-OfJ%Jp,γD%әl1;8cY~Z&j]{$9-U7 iNQ4q_ ?^͵zѨӮ#9,kIBRT,%K3}Ck,c9:,wYFv߄AA[Ll٬$$~nOmojz$Sp ve_[*x FqrVuձZ/^2\ q G ^ ȘL) =-nbX}ٛɇxw2\RzV:]qjmWVf2~DRSv(Tj5Ps.@=a-cqRױ-Qё7QHsHqndKLhTAth; 5R%C?K^rYq3Q,+' ^5f4gIe_/4!6p$dz4!nT&>>'I,2@2|/t:0fOxBLVI3ʵ65rt#}P饙d }6R8zPfy(A+J2Z`)S6̈mԨ6`rvEw^t&l <AwBNΧ/cD,pR& Ɗ7AL9uHIQ٧ xi]m1ŰQF 1sumTߔ,p;R7F^ ~A[ ُg]OR D@T`&u:+5$BQaKcSŧ~[lv?Ѝ"M$3օղm4>xkjչCR:&F02 sL!=9 "40![B4(lz9@J7j {{X%h竳/dv{Y*tic4ʻ8:ZΕ`qh:*{!yj(/L hhl~6["?EF.m`i+%6(t4e殦ۀq]w+g *vܹ2aAS3bZ x&\A"A:c5/6j8-;8&vCCa=Z^<ѼHt&fTv| 쓞~<8endstream endobj 1089 0 obj << /Filter /FlateDecode /Length 3289 >> stream xZ͏/raCP$ABK=cחR8s%YfI8}{3CP,F?ə{_C8+6/^գՏW¿诓?c[M^\=ld(S9F۫i;m.LTJ2_=-VIk-] jW,/1Y 9+ҥPSҹ9]lE9inRU5/nnxDR%ZJ.*t'/=E*'(͸H;WInK/f^#'@tU3VLb@q`2v͓*Ιb:Kd&-`@Nb߲r֝!wh6 6*q6qϳ=f,88.<ݛHvczlܲfҸbsxI)hϫz1NaEbExL^O[@YZc .x6Ղ i/2m2-@pF Pa~)@*@/6pSC낢Ps`_]3XKܸ?NjSK,Z^<۲6R ( 9ӿƖ8/݈ ±,]XY1&OjG!ud])BAsRfVP*%繐$(_@6Xqa)S}fNhҭئIv!({ % (%Yt>ɋn4%Hب#ӄqVSr؂."$O0@ YK2(Mae0K7Q/<*,@sG 90]Q#i ZVh7rhWGڧXT'/q~ B6pM!4Vg鮡;崰vǀNW41BaN*!Y8迳ě'P̷/<]lȲMG2vO D}IbF6D2^UIz8X~@XT.a2Z? se4,8`ҠkPnK†ƒ WH=vDBf \AZY&e"=\}}o5ڽ ,=P [JjaV%|$0hӕ,O$wYyKI(kⴞ0^ECcwsVY{-̤֕2HN&˜ 4& %%+U s$@Pb*s/yFMUFG&ԟ_=|u:=Xs/̌7t!~t4pNzZD Jqu1jI\4(ڇ1db6N~⵮ցq Fȵ)>r9—Sde){$d#Og8IVv c]j٧PXwe@e+88`">-F}f2`pX=EHмqo񨺓A3e]{(Sx輮,W L%4cIT+=v^%D/0}| (2T02)4zyH,㞟 8"a! =VlCǒ` xD~oIN?S~ӫP HAs6In$xG)ZspcP曶wr"K,IΥՕӍJ`l>k͸uoL䚽9[. ;ȼ4fNz?Q$OC5Id%$4L4i`PiU }Q2P,?#C CoJRgjHE!}8i]>8À8FsŃ"Lmt 7sy v߭\pKn5F;@Vg8˶2}\:|yQorCj'EKW>O4cOY{rk nb!aYo%P[/cC(_:s `zӂ1[8O{M mdEI-@1sj3,K/Ep2Q>h5BS& Pd (6Ң (ON@|&Ha?+x=Cx|}ݸ@)7O*; P;]=osyג@FWxN>ϚwBɿoW2ǝ7:wug_>_7s_gj7>n5MAn 3۬F|Tnf3ߟz< ,]S=}yU_^Omݜ^ֿ`n9 fxA:bٸu7>)`JI؎zTMގ5 ?ζLq7Ҭendstream endobj 1090 0 obj << /Filter /FlateDecode /Length 1574 >> stream xZMoFW-{T8MҢ(!\2 ٝ%)#ˎi\ͼyˬ*+Ol9)DW2{2pb$tϨL{+YpAql9y', єMuTg4]*(&cO_k[o'峿Z x8oon 8c] QES}ΝډrUyk*Q WjB ^89v:ԞU#Blze[*˂ ~"1CeThP`}܃/z B2aIfi-T˪\|, T 1T& #EZ^`9P):Ewj>TPª]_T *x X<οZɝX톾 7uL6CL[,_`DCC`Q+<0#wQˮ˃ߜ՜d}.48@|. 3(HTxElys\c Bp}T6h ‥;O _o$*qt!Z{SKr$$:Hյ]D!Wt4ė hVkfU59,THlc돇0U¢z`Է Պ_J5Mg K\(Yhn`R&q5qD4~UZ'ON):YfR0iE0gUkq>HG{/q#M3.W9w@jdmD U Bs:26h wcȘ},ѰbѲķ"J_#*4GhIX@E!H\,jF©̸ aIދ5N%KE+_~Wm#ŭvX;ËS O3Ict8M74ղ#z{ UF]P8KYud Nf$/tY$)J%yy2_xlDY *0Sg>rH (M02i\Sђ䛫:fU'neP1HY`mz!AYcmuV ͫnK\})I^eQz<&_qt9<9>ܙ.&<響2($FMrc!#Nqۓuh1vWʦ7zx|lE I]ƅ[P @21Oy߫711bN%thc[SHFɰ ywq?$ħ\+šK!+Ne҆(c1f~(hŶuU39xi' Iendstream endobj 1091 0 obj << /Filter /FlateDecode /Length 225 >> stream x]An EZ$R&dѪj{E0"΢qE0w\򪻏/Zuent[-蒋/zq}x UuǷP*i\{Rirft!R B`?_˚mbJ t^t{/'/NϰA^a3V΋;(ݑ6NPyNyQY%2ȅRK) _oendstream endobj 1092 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1373 >> stream x]T{LSg-RsµۜQu3_STN1Iy]D;4ź|e^96&f]THgtjF6 0?ڬh4|R-\YbR8H<>o* Pƪ:*XgU0& oN)t.ppz&F5bB6~^6kz(cenI١! "eU}m}ڂZǬHʇ~ ' -PCσڱșwJb" cәYե$l7)#*uR9Rؤ03Ô"`n/7 ) &{?]9?8wL`q)\ kfDQ䥸Nݚ1}v\~Iz $,E^@7*,+ڵc^6چj\l~ZP9𪽿ju 1~xE7D[Drg^c^ퟹ^d}S,DpMSr8| {q|R ˊK+%hK#fڋvɩ@Kˎ3F $w9!zr6o{y[WWa`ZO9d#WCGT6Qs0rvobbuqʉtFALg2t,JxC թj)԰+1,Y*I0k۫=l#k:H !m kCm 5SH1p9in7u 5y8ŧ,-';$z_]ҥvy:)ˊW!Ú3]+5`F7'Uq $!Z8dcO6ssx `# nyNX͸uDQ#ȔAr +?妅%df=.ӓ[Â#:[1CᵨgEai*[u j63M7Ȳ!3 ?ٞvR2](܌lc&,I4&]`0qq&3M#Hjg;g mcNfðJFendstream endobj 1093 0 obj << /Filter /FlateDecode /Length 1693 >> stream xX[oG**$j!u /yiZL!qS_mI|ό2:"L6L~i$筏-&4om'lIוּ Ssa-5\&i޵ &kJ,Zer5SP Vs{]']P:iJX;m!]xPѤBI%6J9>v* (# h[|1-U!: "0\y) YP9>zN6P^z,5&ܤZdin`Rt~-VvJ{z\(pnV  , r%u$kOҐtЎJP ީpEM) SN/1`-`9Q1XPpZiM$ q)ŊK+Y_}`AzW%AZ( 2XQfl}twXmK*j4nOW =`mW!g B,x#[ecSGܞr ]_.yQͤԝafM^б\Y&Ǔl2_G!I5[iZ nHwD;b4@\p>, sf0*`sֳ`0{KA fӐ92(;6!204p9{iendstream endobj 1094 0 obj << /Filter /FlateDecode /Length 1145 >> stream xWn6}WK%]@R4mQw.D~m%VkI^]mdI`e8sfp8&cȘ}u&aI&*w?L9>}q,.i>J"Dv,G K3 J7v1ֱyE]+XÖ噮^lϧCvK\E LmAu*qŎvEtSڟ~lrq"DfVp,0T&uSZG(WURSKXGd61ݮҧ nS\D)%nە{%`Vuog; m{gEqT0q|e Ah#`Vx`attGpoèUwh#')ys2>F؀{M4C&0)头*ՠ\ɘ fN4[[d'i}lut,]Ƅ1]a5qqq1>)N:)V/B8& bbH}2] Ցs4Ȟ]$PE`g9"sb0< $ZgVgcu#f#d.ܨ!oB,p?[.W(QtEGl@Y 'c ØKXo̞iqF8qѮx/]L951E|,(g 9FSQTM ^| o7b;15> stream xV]oF}@7 lw`K{Ӫroi@m֗n%Ɖ++ʲ윙9s/Hߔ3g_fjM}Ͼp -͸|-W˙A}Zs; v s#{t!7,#H%=sŹ37l@Gdž9М6vzm%HGvDQg~(1ޞdpowC6k2Di*~'K!lnSbf[DYao/'l-fMcVI:)(;n}JJU.j򈫼jl0Hţ2}ޒ^`eA_;9)Ro^%[4ZᆨGjjLʗB)yͫ7'g ƩxFHkhF+iвoHѤG\- 57)QYԁL=g|#_%Gg?ћendstream endobj 1096 0 obj << /Filter /FlateDecode /Length 1531 >> stream xW[oE2Haw: /4*Hq\ nc;7Hsfvvw֞u@Qw.sO0" ?b=Z旅*m$AeC*9b\'J(dHe#,"ؤ\b=M匱j:ޅ S&7- r*$Ғ$9[:e'[9]r4„>CI'f'0Kq4QTy7đl2’((f8+[[@"Ʉ6zs8!&oo_Br"%2FjMބ 8M8W1PLr(۳"SP%/)G:̯J6Aaڠ7Ib`)`);vse@bjDhCҰ%! A|ҏba l1(n:4HX-:M o`ל" U}/ф)ߏNpJ f%H+UFCZ+R Q& nN6DC<йk\6b.VJI#]{nYL;3GXUWgd0Iڢ- HqxG$HJ^%V.(:e29\!Aj,t( ]P( 00ώw89[+srcShHdXVY|v@nvHU!}D$@vt(7"X/z#MR}1U5bԩe'kj ñOlFܣQs/Kx"ňQ.0py9ߥRt"XR`z6~y c5K~53s4q.ׯzwcygXM}FڳYZrܔ`]2\hE<,-,=v˻YJl4e8L@n3oV`$#]кr Lx 9ͨ7?m3wourc=swCAij6ˋˌ\]blwk,^v6r_gc4óWìuz7ߗKu q6f]1Zbaagu%ڰJ{M,+:4rfwv3W˻ ֝;bG-d_̳%nn8푪:QNþBM f^-Agvvƹ:DI}ZZ_,<⪭|E^Oz :HV$'}9ģ^c˙fQTОHjMJVIƃmm9cT):X-\vyZsIv15"˗;؅ U 줘=/΃A M(.fD*&c2k#Yk";f}Ѭ +i7x5> stream xWo67mأJ?DJl燭 gZ`AG-6HQe+`$ŻgcWv#:kw~~Q $vT0`aD< $|?Z.0gUIUr},&QR>c MoDsiS@ G~ Bm-}f.ےG`Cstp}QҶ]m_TyBhBG1A=ᥕKc@DIҬDkO:8 Zu$e/CI2t 0Fd*xw'Ph*^,AK x K(P`"퉖֬  5;ꀓuR%uUn7-@ǾR(U73R;Tφ*bmn=%ruejQ6UT]R-Q7r8~SvpO]Q m1@iRirHmN!fj2 ='Hs< 08]L{W*r8tpo G0H=ҩ$% mX|!$E;a`0 93/22"s Ћ /S;awt5 8d7ڝX$u[αa uZsto$Ca0;}UMW~sä*6a.~" !;F) ctP'lRz8%D6# bFaE|.J-|Nםd|*XEq. > stream xWIo6ٗ=EM Z,ILu2ݐvGvi\ +Nv嶺ߏ{#73endstream endobj 1099 0 obj << /Filter /FlateDecode /Length 1168 >> stream xVM6stTSv$mv !b„0qHBy?gbL-R}j?"f2rR?!laAV@-X8܊#$BD3` G qB0\AޒQu|Jڥ i:A;Î#e;W~#-]O_Y^G2zn#|8  q|ss"|@qmbx<=滘f:+ĂXDB9 \l=D(dW!XYR9`B_5V4U,'|+{8QCtlJ=B6[h!'ejSOgЕnt^S5ٜ JV:?.)]V6j*\ OGKsZhr#;}[R>=3g{L},uETBA$$SqEzB,Cˮ4};@Q/TE$dsL\tmy~O7A" UGm9V\Ga>#ݾI"H ].".ۻ\qpaUf!md}Tvk8>S}Tn%Cv6a\{TBnzWۋW}Fi ]^62P5uR8m ѝkG R_j# 79OцY% G0`gn?L_s'rOϵPzƈPͶpvvvzeR Tʬpzuoze<۱fP{E67Ǹ<ۧ;8(\ usaBkU jf_x> stream xW[o6_i^d@xo4`ېn=y[e'KP$ʖt+0E\s#`~OW={o{~ ܯ*n>!5 F^qKF^HiVطXj81}0:V*KW['p#"Jp׿4ib$,GJ5 NGbk)<33"(&DZ۽ďEBKZX&β'!UT~ܖG(a  5=YR*Vg1g VpA X`ta~ji?u?i*W1g P?0o L7r)$ %!g?q2(Rx;ҏG1%4]ZI#7mRADFI)4v:,c.Sk"s@9_h,ӫ:FJU_: R_)RƩ$/aDv yDRv˰!wN~k4VP揁hִtG9TĊ*7aHk>G6!̠l( z@[:@RGyg R5""Rb/7y8ĎEv$ Sc[+ť`6Ӥa]VgFJt^ h7O:x/iXWq@ ,?LV^.sjTaa['P#FiCO])xÙj^ezvԀhvG_{0|u tn~l6 |]|qWgTq> stream xV]o6Wv &0IMRbW!(! S@F ؆P*<9Z&V-wbG嫂٭ XˊpeVt:X"+3p ]-J,m[h{e4˴ \Giqa:+liǾF2㮊bS8c3bס= 7Яiyc+Q㵂 }VT5Ѵo lA7 61-l zvAicdA9?t -Ҷ_9`{XD># ؞tDaeWٱΚ&kzl8`l{g5G`2-F(!.FZ&Y@/4t>;҅) KM%*#|`}C=e}Š0p1;Ax^8R}}Z$a,HAwc9E11,Lݘ4Zڼ* ]}G Ef]Vu(5[g+ͽD 27^Sz>tc$!yɳL ں™-Pu^k殟J]B҅@s(28;GGR<sw1rXkɉ($!I<),;/GPÈOg69'/ hG`$a̬>B70`#gX4Á}`VzaګS+*ywb&i%}0@|||5jejx&jPu=V';/!L` %A 3""yAr߹++pf "BNrc?8Rb t&y]fIш꼪=j^_rtȌ9-~A(;o0tW}̈?m:[_ȃ%>ffnV] L^E#8x&ud^2׭C“w=_Lendstream endobj 1102 0 obj << /Filter /FlateDecode /Length 1075 >> stream xV]6}WJ5+ ЪUV/aPBZYBFU6`2b~mctR^wR9־pز=iD_ ;p\=.5D=#IXط4V[gu(񌂂FNls9'.PQ0@ )>  P1ȓK|Ov%"Vf%#H;RH;_`|Ԗ(xڣ΍auM3fТ$R\zg."?Tv^xS]-ċ;ϱ'pendstream endobj 1103 0 obj << /Filter /FlateDecode /Length 1240 >> stream xVKo6SB@Œ(bӢE m/#?rd9HPwHIevaəoy!SγqջN3ϜB.a K"/uuBbq'ag4L8=vR"&꟠"h?㮐Xr:DZ~,KN-1e$t\U_`B|^ ~qcNGǡB e{hGKMuKȐ]-k:^Gz(Ҁc)^~F!j /`!8Y*PN*:!~:BРC vHڽ;ƉCLWGU;j:eKEI6€wҗN0@ 5Eio֟Tq_2u~BC3s>{(t^()˩͒X'tDgaєpIr5E2xH|舏zS_@0]~~Khd7ؖxrU|ͺlCXƗOZ<*YχG BO@>뛫 c$O*^Fo̽ΆwQ ޶7N HH|' &QkBcb=[p-L@tXvq>j5ƽ3c1j)g'Q |-(! 6ρ>Zz\fS^苬!c7{Vj_.Au}k:}ǃ |sendstream endobj 1104 0 obj << /Filter /FlateDecode /Length 1233 >> stream xWKo6 (@bIJMuض Ia/Sȶ ";FCJ&)[vS!7of'`u5ɲGYG&K݇K’He^}z bcr/[PH/%WGL‰n} 2J/71)hQzJh"'iKy"dyAq"BE՚e$ZvXу/ &?،Le$j:@b!c7R7L)ID%N 8a B|rA|cE^@`RNcGH~֫O3HЛ3 7~@XJFH}L@jd[sk dީ%ꥳ[/o@1)3&Ȥż $a~Syn6%~ vn}Ѽ깠<6L"z_f!ghp8+gǢ2A9lai{WڸZWFvW˖\"r,6<%}f^UC4ְm9[jI792͋]~89lHE:F6-֪i+-qoij+Ձ ,vMZl%.bjd52}^Mvz5a>ɖI %j]-tgMh|jB*Z #U|1ϓn N㴖aWb\A& 6`z60B Mctq7_uo7%a3AVS;t,͜'R:O3,R4h-Ԭ2K{nR::Vr޾1]D:^q( N?a§8ŅpV'<יCA;:׶dyAU c+wY0u9c7 Gnn+4,Wd4m۬7_Tendstream endobj 1105 0 obj << /Filter /FlateDecode /Length 1605 >> stream xWKo7YG)Pne2.ic氖ZUV$B!/WI ;71{w#ꞎft>N#l1Ssp9oF菈`"Ġ2+Wrb,JPVF1,4]thJ0!.Q,=ĉR%JQDa$wΌN(,}0J](T՚jTv 6`"AeauZu窬ʶQAު&hWW7 GUWmX<䖫F(PQL6YdCm!piimnȾ0a[Pn hSx2kR*/VÉkr,a^26, %_D.Ruh\l_[PÙvO>?x mኛJI/ 4"-0*Ɣb#%r%efdpjb G=L,Mܷ5lf:-Uz]ZY%izZ⬣'ZosJvEph8.&uLvaozϧ}#_%Ja~uXxYNؐ"bᣟuЂGA_\sWl:ަ1}170mVl"6vithFW(썈wF %v N^Vެhĺa*cC.қl/ ̐drK E'g=|;|fdendstream endobj 1106 0 obj << /Filter /FlateDecode /Length 1623 >> stream xXo6޳uF3`t#q$şȰ)}NΖ]Yn w(t6 L#O}ir#ާ-Wrv bh|ի>'\P$?^&`"EAŬX kjѬI||jхInxCK#ާ!59FD`- 0Ńd`8& ƙ R P8D 殌W2)v.]K q~L)dKHX 1Ubc4snaʨtL9f 팶ei s6/т%d' (ę:b[SmnB@x$)vAU;AS+%XBciCf$5NoFuJb!9*QQ裠$ $=q&v$RȤ"I^ZNBh-G *!"t@ԵqtfFf41 pLuј{6<̉ g'5JλRIAz5v0?v0 !˥BiL({H@:j&usbq0 '!RbBf1V6)Zo8(ZnA’h}[_%x!*XX5001:8@?tgZԐ/7[ [l09 ?sS,D}K5=ХQiií?Eb- z+)5{.LƁ )9yϕɏQY YR.JgweOv4=Z ~6,um4ST/pb#*}lMm7EmҪM]X{ VfoϪV!7PScFlc mL*xnoQo+nAm1j3^nMńR5yѓj񘞷Q[}Luy"5.9 7(_no˥lv][cH&VtÛ}I9f&GmaVދxkZl6NYwcTU;^VI!~}CDq/V"=mG[V6Zlj[);lvvuUy[ j*6;`" Gaص~eV:6IQ:y-z9Ы&[4tNWl:gnfE;NW캸$Alc^Jc+ 4QZunJ{3 ?kmxendstream endobj 1107 0 obj << /Filter /FlateDecode /Length 1403 >> stream xW[o6~XEp,DIlyhlK`AqL%ݵwHJ$H Dussc;S+'ĹP봏]|%f0'::C:11*'( ՃN->w5zLaYyAL G[B(AGwZ= 'QP?0aybb"DaGqjq^=({y pcɮ &G.1X6}9ZWGsglX@ <"b}Bi\lE2omfm /P;p\)3R,,#vVIlcC"L)Ƨ ,YHp|DR8|1\H Jߘ^lc#K?1j8p@4i쳑Ԡ<`xDq\Υφhg8H_tqړ]̐Сs|ٰ|`^$ T` 9"w)G?Up476]^ձvDgL|_=_c>~u(ʎNMq};2@t0HUSA7!]tH#[TfM_.z ݬg[BhWu󍒱͇- \捡3rG͊<~. P6nػnS@"thOݦoiVc8ͩ@TqC=v4}s=YpXm z;t: "2`q]䣴1u%oli:g]̋+BY'PyY3cu!UyT` PJ`j qS/Z{Dz#hmE?Uw# j{TvqͻXg2o hLaQ[pC;M+h m07:HYГjC@n+gnqVendstream endobj 1108 0 obj << /Filter /FlateDecode /Length 1222 >> stream xW]s6}h3+FJKmgK8k xN{p$B[tY1A] 䧿CBbkHlE IGU1~`9:B&E],Vw5xg#~؋G/Ĉ]n;)QƾY-!o9QpVL  $^DQ`9s(Y4Qd5v0PF{Y.DB2H$vi(SQv0)䇽eLဥ MWۢK4gcH qE\A/~tB)4 oiv OՇ cEU6e}nXL0ק.Gޮky@"mSv7 ~،KqҲIuBH/cq"vC C{dzQmKƗ f.)pf8`m^]H|\WӶ8Cqhg0oMヶO]U;K<,"Wp:P%`tkO;oj)fj<5>N5ܧu1Kqhm&}4}lE:h;}1u848}1l0\XEbW5Hw4F3[I>-!PaT*W ^ İ*AFbHY.xWqI!*fOY,D5(g<:V,@*oF91[,-'DU%/z,C۪LWuxluYՅaV|, )Cf^ՙ 7 Ҩ= đg63_!Ũ.w8x_T5{0ub XcS #,m;S>'RЀC#FLwHBi>Zȱ X#ókīo2:\Kc xaLe4ٯ1ɯk{KFuuc4XjjexVc> stream xYKoYBf~w>($P\IeHW~pI ,=b}z} ?P|_׋?_8p7eOLEM- 8q|vpҽYAs|TDΗ+~ _~+eom⺾,%t -ж lR B~k=M$;Oi}KuV?gf&@J5r}ńjty/h]V5L`3Ins1!8teGv ky&'jktn7יC0 AY#[nI L$ݤ+c 5گx]6w5հ\Aǚ3 ?8IߔRoUpڪ6958%oMJ`j9)j*um.6w`DT'%{RvcVuGiT&6ߞFjEG9-wwvMi]TcoSpV >*T;y_⋌o62\J; !~Wy&wv lFQ̺XQauM//lr vkQLRyĚS >MbBjb (NGm=8>UҦzPV&Yecz,_e0ngOCsP}|Bk:ӃW6LhD3 d12b8**CA2뮧! 4 lVBVCk߾er1Q ER+I *-Aji o2MO $Uw$Q GA+fS|lMڠߐQ;jmҵMŤ澼;Luچw]Uz|= aSz"2q}dۛ#A|sb+ې%),7(>#ƪZog,\Fy-z;@C?-tZe D!&2eSvH58JE,c)J=VCH:x㜋+W6~H6Enpv];/`yڊ)h=Ig:C8c^x rRm> stream xV]oF}@Nj Z6Jt} yۍV{ga'ȉ~swX}|=ӄ軁g>dH,I0{>$)OσLdd"''X`r_ΣXIabXx}K0{ G-2'!_e (~,H4U=h^##N $2zbAy"sk5xM84C"&OL`L<$aAm$C XLo!׉M6Y3D%bq3$ 50b7.*?6~A N'$^W\E`6[j|l~is;v:HMz鹖$6eZk:5mHo4|aXZ]kJki҂ g@o,\k{͇5sD ,sLե5;#S9JiB+D 47;!^WuA.Тm_/{ ;BB}om3RW2&TZ^wӡa[5랟=j82\ Z/U,e<Yp-W>5Z?uwHq*8[wuU2*#u=XzY*i88Bh[tV flI^T\`jbA|f0#3ZT[ta! y/a3/MZ+e^+tlf {KݯQeP]MMO7 vf?4Py+r`{wru-^+}$V͋"#j벸DWŕ涸~A7 @ukΎ?gݸSmP]#Q.~]tW/Kb^y@H"ےc4i[r4MX\J7?͘,-1NxX٨zJfeqS+QЛ1:ZqG*p ~:m6^ø;S {p3I|V@(Of0Ο Mg֍#}<ʠgQ]ýxioH"&{K͓ x-דu5˺)%[`>#cZ_WݖlQTn.oۧm\n'r0BYخTWɟ,endstream endobj 1111 0 obj << /Filter /FlateDecode /Length 2392 >> stream xY[o#I9 i^,#D.~a$eEјq ͫiF5ʤewיeÉUb(V0j㳲O-J6>RD0a GAץ]4t hkrz ڌ&^k䥐XQz%XuhBh7ڝqXʇ("$IuyTh2"Eյ2`e a!Nz6s".<[b;|gE=+6tXu}>ƨp3>V9*XVL)}ru(˳4vVgP <] vަidjlFM`!-[.}z% rx WNze H^$=X$Mz-)֐t~~ 0amQlX⴪yfT3Uv_xAX1*xZ,!CFssw=瞢~s y6NgӰoq zd/|\A_ᦽER(jho;3c`da`AÔ7:0sg] d0ܚ@ 0smo"'!CjK1LF_t -f)a1ҦqaxoT^т$İp} 8kԃw`[ǒEƴɢKZ!^(@jI-Ұ+7ַg@%u:TMx/iFI@+ADԘ^M{gb=VG?у`E s8"0F\tV3wMEg]^Au',hF\˖  Kxi4:c=`Vc!¥;YR[GCgCW${aj cz"JbWz"0,k$ueu[k0cJ=@:ʻD%KYDР˻Wp _u!.:B:N:=ďDcvqن$( ʙ^=)bX '?,%z /hcCaBNd'Dڸ$ƕ=engh5eҕ_7Ue V 3Nq {C>Mk;v-Cve8l)JN/`埪m?X*.hyQ@>?Z_^-6G䧬U?m[e^mCt y#Tv@0;@…ڊoCj> kx"!y$AŬ7{\bݎ`j<'~_<ߏwns!g'_Uߍgѯs6_.l~#LM މ lQ5[V礩z;V |pQR*dI'񲩆I Td4%>^St2O}K4=Va tNOj`Qw&>'$e\rgegêAH|ю%m%MVfbwc;fdvuR''X?endstream endobj 1112 0 obj << /Filter /FlateDecode /Length 1007 >> stream xV[F~WlLn땶)}X-~ 6fibdg.\`:,\99𨚘&4B1LyTUU)~l f@hZmWg FrLl:?J3؞O|GImmYt7-s!Z+ȵ_fp'b=ڗƇ<+p-~3oJ1zؼЛ''UwIb"6vRGoߴQ|)[yџIP扃8||_LPUʪѷe"MhԻX54iGs9(3skɓct[?;5z>d.UZ+zU,JzO*?GFߴ_R "n ֍<מ6EHz]xNTح[0]on^[l(lzWUv#^حaŴ`= ֠26J\0!Mm,X3 i;d'2#T SꪗwO)uZd;) d|HjlOzۀﻬJ ֝w9B$,RDxO$*9b_u%> dh8yD\esq&NJ}+U4'#X6/U{g5"ODWn`{/L9Jt3' ɤ`1ʽ񜂳 sJs99FD6()2َ]0 kCK 6>>UgS#/endstream endobj 1113 0 obj << /Filter /FlateDecode /Length 2174 >> stream xYKo#Ι'#cptCB ::Aqy {wq`pT]juB0MW-{$^?f/?MK %&w M Mr\,{HŽ6$f`,]o)0.G)!FyqꍋRldN]ZKF\+Op?bko&7Jn8!64#PL)cV|ğRX1jL2Bo+Th@aN$FLL(C~*ݓFh)a@Tbƅօ6zW'⼐9-D!7z&BNI?Td 1,, @Сo֣G=ߞ )5PB28ۛe]XV>A BB$Fv sCw$.I)Vn4EGJO=-an88ɒesc0TuwIp8~n YtBNi$SNjZPR(Z~BC/vjccy}i4hrםZR+PV+_M*A`eX3܂>R1<:2qz?Zٜꪲ?ul :8S P (vRʆ& d /iIm*Õ7l,)" " -hy8]%*,:F l iЯ,x9ɕǼU<48Dg@ز*JccU~Gщ#Tk:cb2M$ф#0-N60he\:.;SqϬ`R"BqC Kc5 tIT2Mi[TY5_5hpSҰ>ZAFa^qPE pFa)EB6 {Lj8hZ|h~Eijo󏅹IYQmZ w[T|X}AB \pi g/-I4l&Zks/ipkwO*C$;[ILHIDC\B$EӕA*ImC԰}NbuŪ"E.J?=hI2FScx!āL_w^w`+e!rmf K^vw?roQ6imMqmvkRGps?F߳&ݏ*2c3uT}wl4gFcX`3eڽ„a-_5_h*cW6=/Z~Xg˛lSh}WCM|YdO'*4>rQkq.f&08j^ܾd,\g6V6}ȮFWgz3}n)4BA) WeƑ^UͲ! [YLi;A7v:n6ӷV<r8h7ru-Xo>].Mth/%)WYȸx\i1;b礡b'x\?a@c:rG:A 8;Mދx U^ԩp; B樌}:4z Q/.Pj]W?*)" Mgi3 eF7f9A?*?zQo5R¾VW&>ɠ]N{ō*ڭNPAU4?]:FlrnF>)s>)+jw~4/ "ow ^[CUFC3h8 tx:5Ogótσ_/OWë< {?"endstream endobj 1114 0 obj << /Filter /FlateDecode /Length 1907 >> stream xX[oFS`G8rnv Y!Ȱk14E;t,ɡngxJCWAa^|snH0' htXKN(GXMAJ.p F[#-͈Ӱb:s(Nj֗htaK[7,`\DaN./@௑&ӆz8^=SFiGXk2%AzA2 4pI[C@Cs oڹ,ڧwz,Tj=jC~de5(BLćI̤!v_@KG" ƌ)y !dAY`A8"Xс+P@tA5|vE -)C1U[IM-tΏ]S c=u]2'lGRF]T 0gNokoeo@.iHz2_- K P p,ed_ѩ3p):~v\B(w*$TVf2sá9sc,˩(#Ygn~R_ahe~4fb(|7oD)<N?&M{Cz'&obpL9ع;1z Xiؙ qcl|r-D3Ļ9!Ô[s|㝄Q4>.(J?1;w4 cVEwuJOV[fv&`JL0K/d{\R,li"dr"?=S|oaN jػ}(R[w-- /ytTo>x>'~ ;olnddsìC^*x ZYb yX-7,I!)([`|4(~"ͳ0׀bT^\Ql9w:oC-;D Hzkm -kvLVw((k.fוzb8]UߥQ)JirO[JOqK77,wXV=,Ҽ^u/*ּ҇ ©ۊ&G5M='3o rwDaFlF _=`z l+)\=0㖙VF">dUPDE] hCUYPPB/C[Y6f2*hxÊVb*_DD{ZPYqyjڹ?vųu2{||&+BױY|gzm1D{\k4=.d\m< ?ޛrMו3qqZu~N,JZ5@`:{Qlڛ&:%n}(y[7w9&v&er"lsjR0_VP!~Ua'OSnN;(,_uw^=t_o6endstream endobj 1115 0 obj << /Filter /FlateDecode /Length 1095 >> stream xVێ6}Wv%F.M$nVZ7ȊWe98k(R6m̙sfYii1UK p̧K[iIwiSρk3wja1Y;݂kϐA4yn5F7mAR.O7$B_se#A.X3myvrIMw@;TE->>CYY"ja0 WjEgƾd-b;[ueyluVi~GCbם |t=8KFІ`Lbyll٠$z0r&qch\DnKjHрM >}R{4Ic> Չ.<?ERURc8ETcfE!<goMdxl/ Lw3m/Τ1 w"ZKA#Mluo?.ZCVA| "Izt^  GC,l򭊵fQ>^!c7Km8+'RM>RaM&MYA9I^$›8+C>0S^IZ,WZ`'uLv173Du JZ M$\cnʆHuR"kCb0\TyY )lIMYeUcjiJ޶3I:PQ_Q3aD+JI.(ˍJ`F&ʺ>T妯?Ʀr3\N49t$;hziV}^cwߑ 4M? kAF{!PU~k:pR7Av)Yjܕ"ߨ䢬I9{BK{#SڍQeH9+MSÎ> stream x\[0z ,,q qz<;,Z׉~S}]EmT:;T>4ӟ7+޼[}X|{|qߝ x|#/g 475<-gZ|Uj7&h۟}sUNоzCyo\򫸸n`Im60om7RLFǼ?܌T,+vg'0^lSđwXm3HjWoj\~64e[1b;ƵRIWMiAnj-X o'Ebd`sx p1nڗp]j/aSO6yQTfH{=-+;mE*t*֔\~ysAHfgt$$ rCH(%V x >cxpx03^,}8]DQoNj퀯(ɠ iŽ/:.~hP,*YKŁ@}VY;u1 !EIRT$1"p GxItEXގTĖI r }vC*04#HN7ũ9:SYcR%rMl#QgEG⭳*b*WAFے\5zB1[Qa ?A(S:2De3K4rLzNABuR'OL';%%%).w^|b,L'0+BGZPC2TeTZޓgoƱȐAPRG1p%t ۡD2%{eLw5̦$ZNjvዂI낻(Y 7E=suH̭4ўd43u.h:J902$blw n ZӤ}T֍ BU7U PHM$4ȻbAdQmo4 )ھ{m.BAx,IUM#Il!K#N.szhf\:sdZۥ7ݹYON(kLSϝHz95O:,2fqJu(},L&4SU*W;yӝ`-6ˤ!n wJ i(|OWO=vewG¶NeJN`?(*Zu/Gv_>dɎendstream endobj 1117 0 obj << /Filter /FlateDecode /Length 1489 >> stream xXێ6}(PCbx%q~HҤb8Y@a탲7.,IP;.lJH`93gf$`W}>=> {%KXb&^,b,b0Cw>Dqu8@%4sno_BFg< FQ(L`! )ZorLhP*|I[4ă bM"1$Ąk!%e )T(d<ǔ3cX-)tF#e}]~P c/< `Wwjc0C/&hC $㘀w&,e8 =!E/ QKvE{VB^bW:d\SAڙV6ԉ#p(¨.+'T'aMIV.$#(RB8#e %IX}alRG;JCܔVhɡ[~Yrym nzb)ӂ9GjXB>Th' $21 Ŕ9Xeh('H*9"U4a JI|&$B?jP_^5\!A=d.~)g j09|sAy aM\u*{6G[o%!ڀwpT2U =y{ ` a@=ߗ|U> stream xVn@}+RKj,`z(҆<W"I\;qU?߽xoD~0,s9s ̳ Mks9b?<(!3 !% 1)ŶYLe8K3P6AHWW_I~ɣ'ԎhiLY|4 (Ml0 "ꇄ)^A&Q )Kqg#f `F~~cۺލO{+㶂mu9jCC4[nMۣ4rug*M:s]QPfY%XE}!MH48_aL)Y ECBk#Llc0/UT" ӈU[rc"#ڭb*SGY  3mj3埁rSfjYcago8kr=?Cul0Xr'R ypZ$fm`rl']!QԉX1f6vfEg5=irb #MpX!FHUuawThTNu.ĨG?]%vҍUeTOzQYejWZC*G W4y+f7 > stream xWmo8)Wlżs=m[m%!daemt~6`)R`gfb-@ݨ?{x )nA tmhپ9 ,G-V h84I|dG냤Qu˲fN xtv=DE\7m@ O%8e뼪U1m.E}Nm>kf .ɛ d7㸩æ1XVѧqHȂJYDˁpOQ. _Bymn0ScL*9xqq1T&;+}UfL,=)$'MӗcȐ%Df iqXRvC04#t~ϝh,]}jco`GyheCmMd yŠr7VOc'su= XAZ_?3 hwd%aLA $1r ke5@rDzp`[k<Z+ )'Rgt%!W$C\bRNrjzXW_tڥ:tkDA>D[_sJ=/U4Y:_5.t|aujI W.RHCܷ]]&e+Vp <9#VrۧlS|lEn?,$V3&b'tLsF14M7G陬&bV^G#=5f$$wv=G2Sa#;NCJj |=\mBn~}[rL}ySբ#nH+ҕvLrE Yh״[ 1 -q U`"yR G<"Y l6 &EUBMHt)v{0N,Yo]ͺ?h)^/º=s7Jr3u(PCc-Myx?uy2B gHxܹM'%'D 1 k=9+/ ac&vL8T9×Y|D=\UrDZK~Tcr?D?ÒLendstream endobj 1120 0 obj << /Filter /FlateDecode /Length 1415 >> stream xW[o6~/!)0z8Qԍuu!6XyPd9`I,-H9LHB~;W2 o,~qD]ƯOoaf1bv#q`QX Z-l'Cu\g:K& H(&]_߮.Sm@Vx7(12P2mF1aR~ߪ|M) `i4V~l 0 nl~>6,bl2cx-n4' SAWcŌ3=pGhw Hŵ}Ղ[,@R+0ӳ1֦M!’HM<}#Cu胄65 %R;o< ^ໆ! E:vl7hScv>}@WZc~g10`B= n^Wݠ->1-:K]:ǎg3 ǦÀO:sH0 ,Gh Z:~ʎG#B@l݌Mvk)Jb{}%}}In8 eT=%|>K& x_e ޗ"))K+Q:}*1Ń4*?*Mj+`9qKBO .+D IoȄNl6U\  @C* 7LAuN;G=㬐kz&H $mL+>&-Z&>N[}?9hw8θIGu]{/&1Ut8.&dbq Mum{(xzs OǺP?}ZL"Z>_-Xq1%)T ; pQ3r }U0Nثy[l, >A=)#T)lrhr>3כp0TNi^m4Adň^U2ЧtXթvsJx-H?U"*( aM}̾4'ճp<+mw~0.å" oop|Tد^C|a{"}}ʥ".WcCi 9v{Pa3k|,_W;<峒k>)٬k%m>FV7кaWAlT)Yo.j>:io&I,KpxK[D$ީS3ƆSpn}mt7ggc}>$gCL|Mު9N~yԠ.{sQe]ySO0b2qE&oKj'|\endstream endobj 1121 0 obj << /Filter /FlateDecode /Length 1200 >> stream xW[oF~@N, wvj#"/dsa!N%̙s3.: =rfHO3DW/٧O~3H2][l_O,GZR p,ܦmѴEhdGiheQhw\;ֻY/":PHmxf9D d?kߒwEqP;0u4[n:Ǵ. ΣxNSZ.DOEXm]HdCSjaQZ~ۥ!{\-o•Jb9;Ml2 DT.SIq^]CEA$6 sS '~"/ 6EgOSD 7)sGdM늿,I|ڢ:&oiOto/EO6c~kh;7bZL6x4 eީ0__!j|4oW.966ACʬ`NJ8I;d:B^閮hvH]yI :!c8DkeE$G]#IpF0lh8qۼn79iOi]A95gW@8c Æ;d /gzlhn;2%zP/>!GpP*r p#EsdTA_DՓEUOUld#p ?¹CY ?jxVeh=[kP~X0ɜi_v騢dhW7*žvS%690>h1C§[㊟rmj\pV p\Zς˳fu4 {&፱WM4yD@Fm ^qhy`3C|^? endstream endobj 1122 0 obj << /Filter /FlateDecode /Length 1196 >> stream xV[oF~@Nan<^6q"Y$tN;{[Y s9;3pȯnˑc< =5϶4~Z}FȎうG4ڱrc;7N ZM[lME0 #Z<,?o=et~%v#0 ՟( d"&Q5X֦G{ lPeSfRUg~huK=m&BZZp#HdhtBK\2ę3s֛}?(m҉:Lo,y `͉-X=N, $Fݦ(a9Q.@EmuƄ] y)67)j9չzʿF8bQxk+3Q vHx@g#glYwQIB w?CXVʼ::˱.dGT v-H2ǽ'D|7Yv#z2FI%"R% #퀴fy"9 _8MY^9D @ǪgTEg 1Hƈ~wK4RB@E =ۡ2dV誶⪶ }mꐁ_PD >T-O}'L_|8^m[ոccy7F(9U.UDJ%0Jfbsߒ|Cã:j\=.K=${=RU{.ȑ?J%Jg=ORI*7N-0KAL `Z SV ?tW2$/D, Yηd 8\:6 ɂZEgX^R:S/vG[q$ =Y#&?L#Mit%Նy)\22m &"L!ʝj\^\i8J끵> stream xWMo6z*w-V$Eܭ.Mv$M `u-ge'mPwHP #-y3C F8է viՠ?L u X`z3mp@xh"HRL7Yx9Qhcj_-&"ÈR Ӊbge' ׃0M;IE4iQeeqFrD920D#d]%XA,jT X 8%i<Kez`L ФuPEsR$dJAfAKRQѹZ ByLBM5Ap+>D"YhNBRRwPgvPt/HG̭N%2&u`\b]lWKocS?LvWDUϽ OeH7l/t.%zuJILĆ&Ӏ7: J`Đ%0HƈH'3NjPFpylCCxAx yx]l̗@o"3WU>RiXVۿ-;ez9jUez7whg,rQ2|x =MzXnl+s[@޵Uٞ _% f(Euż82Y/]roFe)v/;GG6tJB@Vx}U=vNd2{yy7/LU_ ]xm?ԃ1_5| ."θ}(on5u%@^Y+qj uwŘ r}ikg}P_:&Et|lCendstream endobj 1124 0 obj << /Filter /FlateDecode /Length 2086 >> stream xYM$KpcE3"=b@Bw9xwfװkȭl5ʏ/^D|7xG䇧N4>/a5hi^CCZHi|\fWg.rÊ뿟)X㓻No_/T::u kd|.9Jeiḙe^՜و}1˙P\ɋOMNSp?NjrXpw U'0,#ߞ8c$9n3@#X׊d9 >L 5Ct!Z|oqݍ/&.]hc <[xvE6cBfq%B̖Wu57 dt0&˜9'>>I}ƥ( vFW0\{zr `Br%C*F ݏahY;곉 ?"󅱿'!cUp2jtzM|Im}Qb6e^)" g7C~'?+6uIY)|g#?wZ.Ŏokr_HPk'AoID,JKOq{>fK5@+RgsDS>:##I]V@ MW-?E/K~cThXD>j9#~?)FQ6P@Gygq@tmZEF}| O?8Q#Y"i~BSnsB\3:2a5qqpșpU_~ϩKV=]xiE>#և.5[ڈZ1 j 8$G܇<.E $/={n,xj1zEפ =! M 4z킯o2U]=1D#NBAwmrx BڢArR= bˢvɬ&tQ!ՒE.gc#5. 4eVT\\5MG^_{5mO z'N|vڀ:_fsEӑpV&-(% J$g߾ydĨ.3tf(B.BV"QI$8#=póVˠ>Mx84% cGaEi~2.Ú\M&T;o$ 8l @O`ܔ"`|FeΖS)XjQ0HIJy¾ чU!j&p$=PLYS 7 Y6@}j}"#8![VH2JMA)u>{W/n+В8PUL(Qn$D~Cձv" O! jcPY$I($3Afm\zPಅΛ%ܟNfhdcfhn@>즨H dergg|mbBڈh{;iŴ ‚%k{:܅6Իx_~C&NlKW&~F~3* g zР<⾙_gcs71gTkE^:p_6CoZdc羷}? JBvFgۍug\.fɐRETŢdQ ;ٞKf>.6ԥ ti|嶫֛BhK`xgK)< CFda`$Y r]8`Yp#[p_gh!1-A hZRZ`t]n^*xWkJkaW0/#|v7$;߷]N~dIAH$ۀybOyAlg>Eendstream endobj 1125 0 obj << /Filter /FlateDecode /Length 1273 >> stream xW[oF~@N+eX֕?4Ff3D++b9߹f_K;LN6~]M>~ V~xf.t@y3:'knAsf A٥ζIHjtoV " e6!FX& @_B{2"v~>];gg{в|`FP~:w49sC!,[bd_Lrva8mi+>Be?Uwr/U˶uY]6Ȋeš @}LKViM5Uh"O**=X@DжSCv, DKc!u~R%apj`ħŠ(i nBS&hV2Tk )Q/XKJ\O\(,쮟/.ؗB aG3 s .z]gI,ϛ7nK^HQ=SN{NG)HbpMNcY+$u./6@M)TJt@D1K+D\F%)J|jmGF(T^qԯ:R$3?~ 7ŶW\R'@Y*_ ӣ:$y15ʰ!QZ$HZWiTL&TCs a} $+ ?+W' kh!)R6Ĉ!=HG׉٥cTFi/R9GWo;H釹hFчa$ Y\ !zM[u C;3'1WIo[6]:ޕr$})h\xûIW wH Krb*ie@mh! +X%CX%pQr;O7 ~#fgDt>/{ͅz]=.gE/nh &wav} G@PQفcKv`Ęec W]/P()W22Q*>ei"zPJryhWި(ô4x}4bt4T@RglM9qEӳ*ۘ]hF;p-Y90jzendstream endobj 1126 0 obj << /Filter /FlateDecode /Length 1120 >> stream xWے6}WP3[1͐ /Ivs)d<?$xOֵn =IfQQwY3!Lϴny[?B!=|X iv h;p0]-*f+Q7 dInT7;F7l:na4 h3G#ϕ _f.=خ) xL r 7طARCa&lUv9yk L kw"i `\h>]X#.0f5I;:P?.FwwK G/g݀D7!]* ͑lZ@(2.Eqo10jёz}WPc1?%MWtNO.+\o'ys oE*KIQ&+)^߲tj=>87/YڔU "}ê㹨A*JVU8KkBS+J[GRhl,qU֜+ QI_ol1e)GfB/x>O  t*0H%> #;la7& P*!bg\Q -$5 Űz76 /<ܤ9B0p]vov,hCpGJ6(q'%]9`ZPQZzںy,\Itz#^?'9p&Nj\~v/ɁQXZK}< QD%E4IQLh7%ɧf-#/L0MLTy*alZ" d:q;"͸ Fxh=LrrʪSXq C69zE 6Dz*^DӠ!揣Ѕ_.>N)ҰѐFUAkڞaP1jcRDuaqUYCzR)ebC{Imjh&JУ"*('6M9Y\lg^EVZ#eHi>M> stream xX[oE*V;}g)EDl*9\KmMsfvvwƞM!\>$Y'b&x42^!5Io;IIr#D2uR%{wFZa_b8ՠ18Oza!4W*͖OI/3)J׽oy,sؗ"jF_G $4 E_ !)HA{&sH  i>,-5&l+kXj}0J1!yN08>!׋8w"hrbt$Xk[;HiIV] `6$]3n01(9iY[6ԍԧP`kX&pݰ=DՐY YMF^F <(Y"Ov*z{Qc^*<O䴉1HɍUPf*xXx7i> stream xYKoɇ98J;~?HI`& @ÚZkiԒ竞g{(RV`:hv_}U|]p& N϶3^^D|[4m?3XAG/fQxQ8XP8JG?Ci=2`Il7&hwe|W o}y5?=URykkݼ%Q5jltЙlP)\ioT^/ 5n<԰dڧ EPaQ,88F蠑)L;X?DLd\b9o9*9\w++a-ѣp dRnyfs/2 TMD+;ie$Іvu]wPIV/ސ&VZl&Z7E D*eܔ{v4vV).S8ʇ `$6zpxOC@ !X2Z(Z)Δdb:aR "%rcr钭} Lsj=al0pY` - Jȸp31y䤻G=w`)˯ /Pώ7~@TB3/b8JIvtp'Wd6y9ƃ**(!MiqZJa{kK5 OEUvjL* \ =iFFF:"EXɔE%`]S~$K JQJm=BoFp |s<x4)i0E:>0KҾ@>$_H0(o-)d(D7qP-D@=/sC[t: 'Q#Q7yU slMsZfur؈ 86И' +8:)3-|wݛW'w{C' cko&@aI`HԠfbD3u>Rk5'TMŞD'l\)Cµ&{3\>VfVB2+囼04{8`S0@QWO(C GxWK7N|jL`T>Km H2Os@BIk(m!\1즣Di 9Y Ԣ0V19`c~tH|,rK5GCL{Z LC=͙ R|{qLx+ݍ(`Dμp ʅfpxW\Ɖ9Lobdm%=:1DFD^ނq`3o>@̺G!&AA1x{aWDDCd(oƽܩCAs|/9uR WmT-(ہ0P@ :?LI'; Jj9iIN jys0h4il?yVT¶%(ZqVFj QPRzsm+6K&Dh:`( -{UZj``ew"䍊a8MyNm:K8K?fq H~-ΧBO08"gy m\l-䢒|ѼǭU<>Y^hʆvܾI~>~wuu!y~…>{-]Їj:x|kJn[&$7tL+^x~BVSw//0WOC :&ԏTDz.&6EC!V]6ph#~3C"gjbʾi >}jCnA[!Vv/>endstream endobj 1129 0 obj << /Filter /FlateDecode /Length 1908 >> stream xXݏ6- {@S"Cu.rۦXAkkmJ&)p ?$Q68v)j8 gH>&݈ףGΎnSa kx0rkXq*Sw#DS5⊄r%&Rjhͣ<)ƨKd.J&Ki.Ç((LbB66c>hɶ|\%/Sdȶz:E,pB h6Eg,NaaD[vL Ҭ\dz|[lr71>cU|Xy=P^doo'Ǫ|ﱴݩj/e&UYׇ\-DMP:P4 crQؗe%}  ȫ>6٫a0!)feR#mt>x?-[@5$tfj5'"F\tvr[٫U@qg٤sr_@XK8&MvV..V w'6gp0wȪь/Z/A@eP)ZJf ѐq, AbQ,, ,mH Lʶ6Ohn:XR%׆rkۢ`/ D&o: ~rޱTIv9I'y<sX>( C ›Cw&Q:A21")qQe ;k6RŠqX0>(*$$ `T)7IQv _nucĀ(8jf={m #XEoWF1KldW{jP)e'm:6j@'%B5))q HʼG$zEPVωGŒA=^Q,|YE\V-UH8ǹt"UD&Y&2K{Բt4ӭMn4zD$}GXh15d < VKg+1ݳ7 @} dI ލ9=: WʃrnCTPb}#R1%$z_jQׂxZ7>||O: uH̸mR'\P~zo(vM̴MfB5AwmPUP@,c&p˴He'jTqhF{PQ^^ IhK:Il}j @Hb;bH)gC_ D]#KN4tqFA_Sk9bIqod>tFcqeWh )4j=.ZXH{PL^H)Q3D`0ѝ#L'mʛiV0F87 SYp(H] }cV^w7rsۋW1XrxaόJ&r_io/WڞA%]bf3D/$J%pR &KO= -=L6.N q#p1H˂"nnß*Nݭ/k95r*_C@\>r{Zu {E/qzvP ăK_ ^vt$wnKw*Zz(uGܢ?I>5_^ ;ոqebW6ɖޝwUdF@pȫ?C?/~8箾?U팰Gy<{do|HqSi7&1E?u5~/m?( endstream endobj 1130 0 obj << /Filter /FlateDecode /Length 3350 >> stream xZoP @.^.I~pcvtimH~XNҹ߭ #ȱz.9拜wA9m|𪰥ŁCԅr0p2(/0e<98% ˢ cO|% 5ʐ[] (P ɍ- ӃQVeiA-6UJIU] f'x^peF;.Aɂ Ô&ۍ]2Zls}',Eh=.H" ]^9+)ɛmtp<"g}X%Sdv5T\Y4BCRl*2[5Ye{N'C* ׀y ]ܤ(w6rˍ J׍% #3m5قOcCT%onѨaJB 7a0+nm?#jDQ0:bA0d)Tȁ(d)XYМA>FBژcgĄ-(/@0}̖ZN+ &ң7 G#3G90Ac2iܗa3F2`rcRKra0s},i,4m`mgVL<=a8+YPLK9 .KA7%$U*s*h<{ ʽC4(8`T^!D0YPU<.̹’E U_jvb%l6Ǽ^eiBFUޱYA4;*E6Pc9lkhlFte7={18?dutcފHԃO68qa 4GAe.l9!BؒX \1L=4Y/lxBP p.Ri<5 2/47j;C9);IQRwے?OAP#e1cG=eƠIiYx NqZ^ٗ)w*(S\NoO.`aM5ﰊ} '_U?4Xu^4majZVQ"u ,$#N}k%>D a ʥdeRȸBh^ xj(`Kk eژؿrD/Fg{D( iܾ 7&qP#UHpT[ @JU0 "'f+ƀhP{l?1UBy}JPA)#UɋCdd0݇XBޯ~Ab2 4SC~W*:;ğB(\帯4f2{)6=Km*׆FDXZeY iTȴ` 뉇fF_o vOh^{=h (%0K ^o4#H}ߣF?g&2zIկ%/$O]ރ,7>}e?*x7=ҽ==#L)jmJSum|7ڥDLBWp5F<8қzX eOƱL]"r{evа~IV˪ZW[icMڦ#O.Y7q+NMs"'ΦE =iX*4貳wWAgͽuCן*|V!+YD{teϵl'9:Sx.5xF &AȪ8>8WH+S)<q[ft]ύzEbCdJKJv32ΗzSn+Lƣ]Nj78զ ijrw^ _3_-q4\bGITXຮjpxð2 /b$n_MfGW=䎵mјv-}zK,^)}}r3}GP -kq4=Ed_$/zog77OfVO7KEr7o5[UӜ=|/Zh5]ϖM+'y3lxUO/6ۏ&rvњ뛉se \;d0COWu[{1NtSo?.˫7؞٬4Vh[˼xQ~ݶ lwwK̗AN^;vZ{~jsۈ$yq7Ilg)~"'<ۀW>3[Lζzٺa㉬Y?~׾f^. /撵endstream endobj 1131 0 obj << /Filter /FlateDecode /Length 1006 >> stream xWKo@WXSlw׉[b H&qifu(k|;;#/. G+΋맮Wܹ23(PݼtvSq c7/ L:EP:Bi82/(Qz?j[oc2ol4I[~/a$uE( 8Dh zf{-3zWYm]nj C0GY7N~aWG'Ы#gVDmi%F'@FM{QǪwLNւ;bWs7| ͎vMJ4.4%v^иAmq"ESE}nZtV)pV~zyDڽ[Iβi6᝝PwtxxԥNseTG!JV qP,M. 0^QUJv/]\+Fϵ\0mk]hu0T/*D$#g jڌ_tTp mxxdly]Q?^_vq˙y00@bAξV-׳ci ɤ.>'Rm-ڊ þv> zP.'>,YK'4i1[VAUۀ(R@W6s51T>0 ##|N\Fx<@ՃTqMڧ_Y45LYtp$ .'`W=o Jozd%z J,+aD/kZ cvbl@uHc*kl%j3OLR[6x-"?Zī;z!zp%1&b"XsīL?Òkendstream endobj 1132 0 obj << /Filter /FlateDecode /Length 1040 >> stream xXQ6~W ms!&FjZuzڇ{Z$ I*H$ڌ1v䲊73Cl~-l/7z?"| qH(،:qCQn D =ܱrhf=v11=ɷ?!8D|;FXn}T?!w؎O]pj[--Q c7d>Z$6)?}vsu˗%C0V NA]:=;z$|yBL_y␻jCOXm $.nvV#D>W{qJv*7I&f>SlH9PwE~1ϋBɕe ߫>]&Jղܤ[64ەٝMaBw|?xp)eGVz[q[adU86Hx̼ U I|]Hf!x9DgYW*iZ\\Tcz o& Wf$ΎV^ r"Q{*M}U`a^mC$bWz_jRZb&$F6gtKqŮLdTUM 1 m#k/y5ꎂ pVbD*ʕ~|\ȵ(k<,\zQD8_Na5rj<ݲ!v*>g?3_E[ߴ-ߴug5oj<'ߵ_szl u1"Kendstream endobj 1133 0 obj << /Filter /FlateDecode /Length 2172 >> stream xY[ogu}+ EP_qv~ئ- ;v[ X%{%f=ggdRzӢC(̙soƌ1W0j=l?[3dzQT*7R/x? F3O^UQ=ǝqRJI^|Q\ѻwތzD|1{lԘnFM)q)5uƠZV|w_2fȷj*BRajvA)E1/! Svqrl &EFvi ٦zc%W7iQ:wP}6_R(B8䮄kwKrz*~ ,$Vi(dt4Yό2dԫM,Rc2}?8|=m UV!j)=Æ Ƭ xw8\@ݱ^6_YrŔR֞\c˪Gv.< 2׼Ez(m˶_dSy w9cAz5 (mt#-Ԝ\pyV v a#a%STOOPCsAG7I<^&.5bݨ%Naƨ&}܊TZ O:,xgZjţZqSt4 @"-Fpډٟh7ߝ{z$A|هi-7sdϘ.]%\L̅8f#gȑ%\: #0B/ϣPX, 'x Dt0j9<oyϑt.oW01K'mix7 _&Ce=S80ΙfZz݌^퀧\Gf̉!s/13ޯ[8[ 9s y@s4w8«WE}}Zxi|힃ljNւ;OrH&a4w}8OuѰ4ycEoBsmR &1W(0=$k|Ee!ZLYn^B'EZXy:G? ZIsx(I_AzPq, tyibP\iBAKMQ$d=}qAXȃ/t_5 4qn>,ҟj'#^f_moKV",ofF~[7m{Cy YmgmlAM mn}}İ.ÒD cy՛zAWU oΧ"|k"3dqz |߹asOK>e]5Vw9,<ExD\>}nwz=EǑwx2nݬXh ?w5)SOeg]AB4h :`ۮl dnC7zkC$}p7w;v &"o>Ǯ+a,qaꁧrϤ vOAGKa˴endstream endobj 1134 0 obj << /Filter /FlateDecode /Length 1853 >> stream xX[oγ oApל}!E6Aڍi,jDQuTESGssM ?煮v넺I*'A4Lhqe2/'t+mH,͈pc~=Y)D\}䚒mif?jAjҪS2V2.Qk}uUi&Ą(̞ G͡Yӗn?]~~r}v $Xy.xkiwlg?%gd>̟.as[z1wt⹟/>)Jq.% c: C JpTs*z; #GJZ.<wfSyK]w ze>'O ,jYׇ6u`?zv1r;׬cnӓrL! =̚*纮d^UCS]s? Db<ԉ_:D} d[qfmvYo,Ax^w81]諸|D}xE׷t^DY{+9r8SYVl`E`W}pȚOAyswfUWwK4hLg_]U]?$2%zSz^ulgv9]Fh|~3,ۯݦʊ_$ZɁ,k]Lkvm%(tW>X XCoa珟4"4Bf ~LsDM."'s6+6;ү\/&QzozQwQq1D(0EH <ʸ6"ߥnx"yKNUӜYKT{LkQ:3XʲƱ bEy%he}3Xsؾ>OHnf2X4̦S>qp$ Bf>c.I4q" +apH} kRJ%aX]R@fm wV] dp m_(T m׃ћT* o*ҹS=~^Vϩ?d,@1>cN2 ט~G/v!*s;ͷEYUJOVf (9IAJmAf>1Q5BBo7i&>Ӹu; frUKtL0i.IB8pH=tP/|5$\iF&S0 Ld('Kz>LcFSøaEb+Wvѧ^fb`7I@bKXr:-i}8,B*̳q50Uh;RG lDA槱1iNPxfoLČ z5Θbʶ`rٙUGa'>0d0{dxn&} ;W˓[%YK J {pT=罀oAYY}=Xn*UiQp8%lԒ$N"Gx1|?/endstream endobj 1135 0 obj << /Filter /FlateDecode /Length 2737 >> stream xYKoH述{5cq/>!䐌dgD[Dx[UMvS=@ WU_wbc]m3NogvO:WQ|vu{fYgN\q5 ؗq)Ê5{7X\eVl(S. |xd0%n3RGY]_z5_hTŶleU.fWgW?\o  H}n]}sH膖/eWXe(gV̈b.pܚrnǂqe۸ [5Cծ=οb}?“e/,ʘLo}?g3:TwS@lz92o\r؋-⶟Z(O#u.ŧjHH=};5~i=3A58{n2BZ=X7烗Z/~N 7E}*,զL藔dMӬOS=}C&˫ qH>77SMrZqnb_yE[U9(|lͮu!Kkl֮yCKm9 !*nvN>?Ykb08l~ =U8Etxi^Ƨv gU,ج˺9vvա[d6 '|o#PSmMݺ' YKjL 2XU`ZкJԨ F_L vOub}NmA&t IBJO[Mk%c&RƎbϔ12!S,DtWP#*%bs ]uLp2D`PfG>,=txLZs$;h\H~ܤ9DV!D$"@$gguۓ+u(\O`|.-%"SXQ56 YQuH-ZCt䀄A&qDzVk:uԀ{0mP$99I4'xgnXIa(EOX>)XmO5s AR9_6M{OUg8A.H EFUHgoRfR*j^ԍb㛏o7Ǩp4$4vY (oK !T=7O20Fg4/ @A@t\8C@ՋtgT8 GCS@Ð^ q=Dƃn` ̩9w.H|S7v@( xI, A}n{TRD"$]tܕ&VD |b6P[DJH>O-Al?ݑ|+,m=MS-[ҙ<؛ripIH > stream xWKEl)-Hiw "h!sym_# ߩylf,qW_U}Uy0 sd9x=p7>f| ޢ9HŠ<(CPIOomYl͙;<_ .ɓ!L)'%o>|#0,Xmq*ᴊRr I*Z{Tr·<]׻i:T@P%O=| uJmTJ%CE%!ɯiU0:IʀIR/^(9__hey6UA$ߧ )Ƴ6z6b$.:Pks%u]EH HQZ(C%DYxBa* M93U2o ͵<KP4Sj4NRN58RGN_SeIdyI>X*ZCM)?C EK%Wgڹ;(+#jŜ(@<5jɒ5gi#XiD"bA:+nl@F?'Q@w%p.Yit=5ݭK:qzsqߺʺԥגHbˬ7mX Uȧ`J)Q7M180BgImG6HEA1p2?hAF i&*bq4W F Mwh@j@G7ZCSë>fa4/uKprsP*pv'ΑPܴB7sfQF\`1RO=t相#N1D/BW\5sKs>63ݽ#~MJNȋugppD˅0;bDu3M傇mH\axTljJv=,Hk /j*d:^ڊ#}3vT!o)Tۭ?5?$Ԉ{U7Ηz3~X[> bش{ _'8l:Nwk^Oب^e.=GuDW Z6.wG-E"=Ȣ5@j/`@gx/P䟟'meqN>Sik-_pp d[Pq˔pޮӯ&;/M]Ŭ8Ϯo;~XUyDZVoK#v0\ neq{&uM"yGߚɚ5h˜ iU5WJY9t=Ut&ӓ|;Iendstream endobj 1137 0 obj << /Filter /FlateDecode /Length 1502 >> stream xXoEIE&İI,nvt Y~FVg; أa<bTu-hj@mn5F}BFNrށ[⧒ /%I;fB^P<*($ uH:SM1:dX8 /Nk"K,䫼YrZH7UZ-IĜ+124^NY?*jM;_/:K,Y^؃|]쯏XiD&bRcڭg4ˏ!֨V1Q; 3h- JE#*E[ۛ!Qƃ QJ@oi)uEk>ߕbw >:-+~of=,I[w *j >^ϷPXK? B~;̵ؓ"@zF__} Fendstream endobj 1138 0 obj << /Filter /FlateDecode /Length 1749 >> stream xW[kGγ )eK Y霹OR=IJ["j(H)[J,K<^f䕬64E`WgmnJ S|[4jݴ _~3m+bg aJ.L&ˤ?o _ڔP5PGzz;Ftng}~i6P-/Z)v'd( 0drt4[NFd.VL2I(e鷙{^\/VwC/xROI))PJOUa;w8²mr26w+([Y,l:Cjh|9zJI̙툜dޫ^pLaAJ!72@N@DYBڷ*NϦFܘR| =\!޵~e͔I~^qg+.Av>,e7XV 'X tXm*Ʉ!)+u^&#+j1vz5Zu^O<ܔh:eA}Qd.服CVDtOP9Ҕ2˚k!.'䝲-n㼃w{ap$}\^k_d{׋lY7;!6h:^Ц_u2vzq=]/VnOFΪ}6ZOHho+~wD\<כ1E ,[),NL{54wGt:0.vHߴ@@"7[KgE5G m?[Ҁiz;,aE<9M[VTZg3et>?W-F8'칋KgmD3~%%_+ŕM6P:x*bTqhH\2bezyL)1+i+)E:Q`]oYVP"(Γ@r~Θ6y\eD2opô њ'L/4H?EYeLn"9NAR&}T#4OT\;+G~ d0LnyÀ58=x]/f:5'P-j8y(Qoo׀@JC#PΥ.4↴I(`K?iTfD!s*^%(c^)K,R>'6gKroo%P-eYqab(& _;31 /Bc [MD;HC盈-VՒM,Z;hX҃~]F,jk;n=Vyͧ솁YU>(vɸ?v0)g+"G Ǯ螯h4@){V,H[N7htendstream endobj 1139 0 obj << /Filter /FlateDecode /Length 1520 >> stream xX[kGзR(:9szhRT )a˖Zɒe)ٙrΜwso3F!cˮ;(NXf? ;߾4QdëNג i3 uBeegD~2ʔ0N3 V[2vs!v_ڕkjMK¡; i%(jrOLل7զ+(c|wIfY(R0uon.ٰz6.w[+([qY6b{Th ͛Y-MW8HW -2fۀS%lhp8W)04OT#=Y[ZQfuLjuY4LMM jBXowx\\ċ=8V^qszROquE9xi#( vTQeHM=)q )K1:ؼ{9]:M̂:ay-0ͯ^K^8oD2LD;菺p(}qlIATOBMv6OKox'~]G"Oq-;y^|n+羅ҿI U`u ztpc&Po[;y|zI/h v@8C?ḣg7{oWBpMMdbzs1nCr!{$zYvW1>Mۃe5VT ӖJ+O9W]'1ALbw;H n12Wnd3 ϱ)BJ@cΫ˘.a)ƇOS.G /Hk.Χq78ǁcӟ 5Հk2-h@c. Q1J)UBuNH'͵&\selVTsfS l(q'uSj!|͹EIr,rDI *)\ 4"pYYJP.9^g yAk$%_>2Fd*XCdhxèƆsQ^IBjP[^tX( "s0>6yy67%{aDȧR"wi[RGC'BuXKEuEBtXjDk3p!lFde5y<\Eg{4)2ኢ'_Ņ8p˾nR XI|HBLj>9feX@ O;ǯxJД3g+NThA[![㊣YG%;j,`amJ~NUjTiN 7I񧞂7(teFkaCܓb4>vA χsDendstream endobj 1140 0 obj << /Filter /FlateDecode /Length 1815 >> stream xWk#Gϳ 8 {߽{zlgO u+Y-u3 9 x>_ F`{jۢs*>eEsP_(TH[eϒQv]meYڒٶd4zQڕKsԦC  i UZ{ \/v-+%u֑Wͳ wՔ\ެoWNiȨG(pyb,\?P[OW,a*J*isSR#9즔j#0iuxNq:qZV3Z+ͨیts_иp`h bX(R"CY[YE("mx}oߗ)vŅ|6u#~l?tZfl;hޟ-;#.0}қ7Ӱs s:- C^MAKd\Qhũ?J/ltsd_ߧE"QOudޞ3M] r.n5kZW?.endstream endobj 1141 0 obj << /Filter /FlateDecode /Length 1892 >> stream xXo⣑t? $$H aޏ A2WiAHv$.q$R?sͬZP=s;eE0/V#R.G?NjUdsm#lQ8C+TZjl&&H)h;.ujAmpx>KjgM &/Gz ) 5JlJ9)zaH&5קx|y^(RXVMƣnZi>ov߯ovdV{Eo뫝//vc8dS 4+ʹy1keɬ>q:$&4%i1jqܜ-Az=g1&P7`  <\l닒O'ѩiar+KMzajvrE!;} \oQYE2q<.+Yˋꏘy\ j'Mz*z(;@O O&fVFM<^_oWK(q9I_xU*a6}o"g۳0`V'W7CP|U b຺(V"oN$D+ttFX f[a@h1E?V@Z,hPJȇ 5.^͞ 8ćXrOvxAn *&KarQ:I B_>P ԖK![1kf ThΪƚY z,a4#FHg]X#P- )t8e%`k)UðPah[R K8)n6fieq!f[L0i謁pYj(+.msו:x]%SnR0>l}v{PgWʆE&dјjeJD:ãQ opTa큣]RX{ @A[ ǽҳ>ydt XpC z:0| 5{pssQ6H5nQBn}mQ) !`GnKNгj?`7Ă*&#w^Sܯaee|'NUES.y 0T+"e{;B_(UzK=gr/¨Ү2K˥J俁:LYFR&@Gbl̸S_Qęh ^}f0 A8ePhӆCMԴN٬ih]P0B)ؚ4 Y\#hLJ]}6E"i.$2?!/}X9(pALOCy![& n@e YXkF2P[ ̍Y y1ud*[@@tWAtKc1d=(C-n1g-JDF{ d3yMY.}<ǚ{DxtL-@kQ.e{`/cncn1耍;[z2 B@o NwJ}ǚM1hԑ,or{%"6 "+ TKF}`,PUq>ݠJSU"`X pp I09D" *_NO@vWN{髺lWU? ypB p4edR F1[gH>E%}wI6=W o5&I73 bendstream endobj 1142 0 obj << /Filter /FlateDecode /Length 2006 >> stream xXo/b+\ wnHiAH lFb#E}qbc;H!@:73#R`^pq9^/'?TھBRL5#uBbMo+``Sn;M|WՌr<~^j&NAvTUX!)b45E௔VvZ~VYia{&O:U*15aHpxpVլzQH}a="K> un6jtF V gi㪑/P\+7U6TGW~Q߸,^0e W۪Kힼb]h&ۻ 5nw壮@k QW:(-A{>QJ !9E$snn{A{ l/G˾!&dCy1dyJJ^j \-V`8fi>R@7|n㩈e^Y+fe>,Hto`X*k mNz23Tendstream endobj 1143 0 obj << /Filter /FlateDecode /Length 1644 >> stream xW[#E +XI]]# JVfָLM&IKwWtv#H7էN9UMrLj˓Yo#n4 Uø;6!琄J׉ &7A9S$7h_wU1MԨܧc F?_wabIn`uQFRF'kjSJk;Ar*fXLP2α V]V42$y}Zgi ÂGq6E`/ B?iZ"˛p5(uR#*tO'w]޸F"f_"&QT>meb^_7k]MTq@r3C{]˯ЛF)@fy'/0`gu(6VIvUT#|>\ep_a( ֱIuY}7aB^TK56PSYF9-F3Q.k̀抳r_/E}ρ~'ۻlUf'b6I|yA1}0m.&J$h)z҄Y,5.#\Mrpүb'}nvD0UO?i 7 *G]~g{nĹipAkOZhX}TXcy\|BGh^Ig>_ngt@L$ϏH}Q  {?s|ZHtX .>\+h.ch@ 2H*e@)t(S0G>e2NR2i8Z[G%Ci. ͜_$lΔ r6T|WGŵ?=Rl8 (icA+8[k^&?9a4=,^1{AQ)ӌA͒X\%OF|K2/В$/Ҍ*̯!,CI+(DU`(&[ǔS}WNP\(-,!}1ھQ'\/^āK893= 8V L}Q G#NQʪ ÆiRMh@[t G^e<EG}1T]X..Rі.ml6Il9 $>tf0`slZY0 zrMĠ@\-2l@27?•ZCB_(OMUFqnAH*BCҍdPr f;,3@"N X2K ӵK[EM+2!#8"*H;YL g[bn̥25iY0[p$7mEGpbO|r̩uUK2دtn]̶ rbd|[[;3='8'ڛF $|-}UdBތ{!endstream endobj 1144 0 obj << /Filter /FlateDecode /Length 1479 >> stream xWIoF1z.r @v83Iuh6ةcS-4> gHQ˛|{ o$b1ȓOsH?U>&7$_ P1:QBaD2^ &4ǹ`mmVifiF6ch4zڅ S& b$BRB'kjVvnfYWu ʱ5 mv].Wŧ> ʛKMsw+pS4_]o|QEZ;Ld<O&hS]/Ϊ;Zrw1+t]#*Z:0Uڷ{1ҁΛ:UMllCM]EzzSr~3+[|z^n!Z7|iTU!gCԚŠpUC[4.I.TFeP\_D(Ca %* ƀV*=?7]l7wϮب܇,*R&"G'BRh.WA鞾rm`^DI{[=@gGbT;c'tFzt\2g4_wQ{ ;gM>Em@i{?4,.`4/D9 zbvӉBA%nitoқnO$6}~Kw@orb<8 endstream endobj 1145 0 obj << /Filter /FlateDecode /Length 1404 >> stream xWo6~oB:`Tjq)Р-닝Qov`DlDw`g?nG_Fyُ&~I &FQ{FF̰2mFx٭pbv=˘`"Jbs|%81UBj1J\K*M[q"Ą2SbkQ a-ܰE|7dּ_2QhSmؔ t651S,MF9/ tfӫqbfu:bca彵s6BN=GxGYАqav F!6D G7r DĎjxmUo.1%xͲ8,!;cirBxh<8~n0A?v|ʓ iO`[x8,;!<޷3E'"JN:ZT`Dh !}S?i5ᨊe@:\LbINY4Dx٤>A P?2-jt_ֻPB=Ջ bn\1}=xT_$8Y+ZS}2D˄kw8'm2WUݿ61QYk[}d삥B6}rP!=~ dIӝ,׫oo%:_ʵMIσm5:)VCͺ\'X dh[]йbvaܗ\TOLܶzj†G>{=] o'p~p/P-xv7M:^^?擩M5Od }]xiNJb!b]now&)^'=4W/yBEj%; e% KZyf"SpI*BBEzEYcS{GK331.of*o3D RL3jN\ƀ _1#B=:6aDUz;` s5f >ݏ2eiʲ$q7#ͩ (a8p6\# ł2J#o}',SM \D+aiFs:=$0L*ik:_gHP#N9`+@&nг8DdLpp 0}-X(0*cPl@=;iw`f@K<_=m܆6{ 2 F.ڳp>t+A>ze*hI`%1se]F?Hendstream endobj 1146 0 obj << /Filter /FlateDecode /Length 1167 >> stream xVoDģuEb}ˮ7/z'zT߃iӞ!sNr!wfsݸ=Pff'7ֻ~uϗwWJ-lkP?3}%6Lˍw%}7Ah4Rl1$??[ta\$7ay!Ƃ)F ׈  `%z·# H|~A(" ]s8PDӔai<)E~{‘ (!i5E;_4گ)6eluf,Ym5Q'n꺢j?T ~_8b c)M!yjC 1S_9O( {aٝ5 c۩:81a Ne=! =+j4xWZf) IdPh5 *Hv>7~78r:@}YWjBgC-;Ƒ(U^VCt9];lRt۴6P6ְ^ꗋOBH?V}Yޞ/I %/M+BQ86>OrT6Q]tXn7aOkwnFi4,d'q=O^Mp|_Vaף2:>\7dZ喭pQBw7uy)H>!szsG?A^yJeFA9%e\JE٢I۩~`Ѽ KJ֘>zn$:ϋ:ЁONm GNHQu0@j4h`ñ4}22R1å{`)lgkUFJ+ΛUK.P^t5oݛ8\Nh&51GBF_6c}6MD'@iQ=Ë 3+|e1H{]* uO"_y(Vڧb(1%TY{o5ԏ:ԂRƾzԤ@^a3ѓE%d$$s-e-' J,'"84@H-ikS,:j9l>@:endstream endobj 1147 0 obj << /Filter /FlateDecode /Length 1436 >> stream xW[F~wh%:f:3 ͥU-o&nz1UDCeY\88%Nm>! wgO_'?B $NWC1FaeN[*阸ҌĘ3 &a(y$ӗADDULcڻ\/`O ı*x!hI2;)8ԒV h9eN (Ƅ2g5I"C mƇ%zne8Cp+C !oES*B,%0XFA0IS{ƃ[2FQ5B>0d:{L8dx {>XWI"V(rv A4/Hj׏K$O/PWghJ8.]:2ٗUVJ_E4fpǽmgn謿8O*`m7(r9vʪU o"EfӁ<^j@^EVokH6l p]4b9`hz)9K|'ÁE6hOd^w^0_[ܵtu(MV]N2*DiXUUnl=YXJCU]c/baszsֺL̻ cg-BѲ\kX&8{緈ITz~+)U:J%&d*N(lnO`Ca>(ǏJ*{}Z_.>3p׹:dY^*mVw֨S%Tחf &fm)1/7t e!g7edClrgK-|g>p){ЙY f8ie[a< f!nfq.)$K<4vL/Wʡ*4!sVYSVZo e"UwIyebOftJ!\սoc AэYFXh R(zI!$%`lpI(2&5v`0;8Ш)@3dEV$QAqj`4/}܍>Qv8lT eځ- XvH F}j dWcz0`,;KEyv 0`\ 0F=57Tj%]a\뾄}(LDY1<\*پr0 Ӫ@eԖ`(y8Ԯ06NQ:Z[t?{wm/kl Ip 43o(0P=[LEsu[R:YQ# VNƑa{ZZ200PRC +ẏX`>H/֞endstream endobj 1148 0 obj << /Filter /FlateDecode /Length 1467 >> stream xWY6OZ,#^r56u}]>6(;(26Ô<8pӐ`:$.2|,WOﵴ [bpz;СC-5\*~tֆ֌,`F)0}I#הXʢ=jAz:vpJp153E1(Uf4%˸sgj{s>#Ąrc;#/:+c),N'LUw-ob3Go}8yS+'G~ d{_nwȷEc2_:taƪ$`~^kfy]fa߿*N2 H>'1{6T/|-38`׸ 1UF>)0~&niUUIXb{C *-–R ,(>GbNS1^ 3Z_eGPL)iVp ti KY  YP/o qtE_@'!%4衲9(Wp($abƅ@B:L c%_ EOtwe1P=4kEM!DΧr]bam65u\عp"}Y/HZ^8JsY͋^tq#Ōob 6&>TU=+8ii%:3[Δ͙&aUgҥlku 9SwLA M[xŔ* Mj^OHZRp(ꍻ ^Y,;Ek0na7y gOn}G!SvN@Qtr8h8z4P/B߼\sޖֻ}G˴X:C> stream xWKoFYQpd>8PC)\G >mӑHE{g\T5̷331XfiD˷X_F+m_aC ϮG:f @g&"PTDE-wjQTx~h:=.g]4̖#(ovgp|ŇRYQ` Ϧٳ9z ƱEy8ߖj# &sz:*'4$Vh[`) o!ZY‡i5EQ`BZe7 V)z_k4,[.;3\Em<[tUQQYPǟU-D>%X׫xQL޼;q4lՔfZa*Ư<{px87gn l׶_:ߜ`ifx8+ȫLg=NfiRdy)hAuj Ypf7m6͍ {<.-\Bze1t<*{>7J8D+(ʚDpp-<Ji]W%&hCvXMxZ{Ym,ͦ5 E@՘mD4ͰE*gWI";4 4uySA:@W50`c9]Z!LU 2.s3@Ab+tHF].l8T7mv4x`ή!u$cEV@e/k|Kx_$YZ$}N܉xhelA;gsmMoOP%J㟢%鎖1X0@iUMoœv`C<֯tF[ŧ^aO6}r> stream xWKoF葈t}? NC.D X9(6HE{g% @| o`ެ#G#<:~6~~GK]~CcCc-5\ƳuIf:kCBkF ')0}]7-הXʓjA)¥^%6Jr]J&1! k7s=V͢ZbηqD9²x6fO튛zYs|Q/cF* 1mxz1᪢- ߒimFby7Gt"'.*wDw3oN< ɺ7 Fࢾ|paOj"X .gˢMy_MNlP6\h)cu.R吵?A<كπ)VJ!ZP9NRa-|e#P%IA tQL ]q.Kg<)4KD@qp{=;;{ ku^m{a}Cy݇.,|`,VCe5b7ͣ;h[׃_vd2 TW}6{yPmˎ<5m۸>O~MtWZ~*f}bv7UnA-ш~ q(zc)<7r߭:{4j$働fZ{:=e[y ǛGzr CM;z::&ʧ!-r rWU6 >Ͽd){25,e]Va7],txM*/Oз o 9YQ kC Z&, ,0Uv1Q.IZv-2=~~O0p6+\xml РÇhl8,S F:Vgˢ\{M8-g]y+ңMplLJirL)ۯPW+)TLkdѳH4JWI;-;0\aNmaqL0iѦt*l$61qm 3hȱ28e`(1\,˜ jcg ^Ϣ׍3o#Wo_F0,:^G\Pxɽ}?$nVz$Ըv]Ud ƸY^B5ա\Gk)w\IU'*QW=Ti,ܘ0~4JNN~{aV UJPrXAo5RW`[wǭDݲלF_?Rendstream endobj 1151 0 obj << /Filter /FlateDecode /Length 1466 >> stream xWo6޳a^@[d7,[еFaj;:[Ne[6ߑ%Qb0;N"iDOw|Pۗ[C9C#BGL2Z'+*&HRb)?SV8ᜣbnѥ )ab3A⽵R2JX3%*鶮2,g)R-&("J9,&1U:JMVHJ,pc R2AP:6JwۣM[B)m˨u!loV n&į9ZgMtS/1! QH3yX H!Rj4OHtUVۼnstmICRPp]*{П!Eowj[?>[R"yQz\ć8iD4 :XzV*Ee:NNS0C/iLnp+1,AS6& qcӘ;%γQp 21+N|mqb )C*{#wץ@  c\B6. $mF" KlLWjUL)HFr 7ká࠸ 橻&PDV(m(,wA1#Tx`%ABW@wk0: jyV2aڣ~wT)C_{a60%{n k #}`.4mս!}Iq )|3v%mEQ -$)vu729P B2")VڐGBiD%P}Q!…7U?(m1 D/Gcٕc[7dFa5 )TO+sJ(֔+ӆϠ-\ S&)(_ɁCn2Y7Mv<xKy>*8o`xcҧ|ob0p%fkǣ.GlX?q8ꮝpfGPc;3Y1e[ÜQ Wӵ5O(7Y 2R -3н~ǯa[8:E괭_6klG}?wAdW/.:ۛ3Iv0gfW{dFIX|FuB Ƃtuhi.qZ g(֋gO{C;+sפqJWi\iTW0z5XcTd*ˎCҘdSbpj UۦεNAp8ͧB@ ~2Pn5Gl|Jeve;:uS}A14VdDdt7kOo%5endstream endobj 1152 0 obj << /Filter /FlateDecode /Length 2923 >> stream xZsY䖙|L]:"}ZաqlM*m߷%<&X {.^^ߋ^ڻy=b^iZ;ܫޡ=D…ietwF^$\Ԓ2+U_xP sNçN_ wipS‚LO"M21*gx2[Ad"(3"××xW&iȳ{<{J+"/#D%Zz)If<\,g#rq/#R/FdQ,?|=o¯pm y_3x:+ߨ$b8TI.@Lr=_Gibd4dLo DR+3LDkA3Ey6/iT7} l=YM)}c\2Qg[z/"=MiYVfˣoO_}qZ&RY ZT0 y@T̯gYm*rOO>OJ)»$y:]hlbodk 3Rq$zpCD^l"yRS qx] SL)It쵓_G}}^U e ƞ UPH(-zJXU|,c6t؀x̢B` e8.*m\r.uyj47MM\[IЄm"#5`Qp1fP@piof8!Yl2QQlM"sU4Tn3Y(1= ipQV+jFZM<{%"g\;kFX0b{V͔!7@x$lOJIFP/ ^!/U k:j`gd,^6!2bQ4SeG*@K9#XAHzyA | *3KW;rҁ< Σln #kT0@!,dT,THh\3ePJ5S7C2͚al ߳fE%7hLo=j5g*P;/Wׂo]5|rd=Iʩ==S (MU4J{3P:*LUѲ":Q.Y TjәN}Uz o{<d,pr(uG!:`p_TYZF_t'WL~VK?1AbS~ Cv8(,z!d yPS|oSݫ#L*0eqkh$z #,L R}ReE!qDuuG@s^ką s܃htqxAo!KnLT6yE<*~vWJ)qۥYF Ohd ?Quv]!P4{MzJ8ֿq 7_r*5nbwħ鸴#C]:[:o9)X)lDhLQ|87ӛ:auVUGyw}CJ&ZP:`ܐnw4ds&c<~|ƭ՚q/()mԝt,%"~?cݨl}?yZendstream endobj 1153 0 obj << /Filter /FlateDecode /Length 1462 >> stream xWmo6_!F*RDӇΐ5^Q Vbmzq$1"0PG'ȟ-x\`1zSE _5؉Y싐9r /iۜ’nq޻0&([Zc@"s=18jt1۝9c9^|E\ Ϟ5Uݔ7`YW7T?YtqlTݠK1EiYgA DظiI4LgpyzvņSmAU~M%9(ʯ2kaTP61֗i'`H9A2mIdY霒L*:14@C?N}XK%(EBАb^Y$2.kixc ygEȝ1x_ч!k#eM;';kZh87˞[K8p/p>VgcZPUG0]&o>Р񛍥& +=yI 蟫YVYz7PǸ6nm{h񋅡Ӆy5KZWyviOZG?=f |u5F9y}hVWI ]>D҇@^?v=.pu 27.{*Qh2c>D(gF{c Y$RQiwvѡ̢y P WW]b ZN>:M`EFC0\y'vHnKI3Y;jC.ߚpQDQ7޴cncXd$d(溯n/)z 4璀i Եf9^!>J%k =1+oQOEi)FUmUYC,v G98Id'Wr.WULw+;WJK +ۙ2'}CiSbp6RJ"A~^sYendstream endobj 1154 0 obj << /Filter /FlateDecode /Length 2853 >> stream xYoS9%O{\Lq@|&2A90 nXxqt!Bկ>nPtP?N1xnhϴW-,^4k)saZr9w 5-,˺a 5ʐfsrrr4|9:F҆hSBޢTm+>ȸ̍R(;&нe]$:~r2~_3Dn-[ N`dRXl:]]VbLNH2uz"~49 F';1G|^Ŵ. Qˍջף͒Ed2teP ^N:yY_&?<*Wgzdfp˫/0$cpe̩_LKbSCcC G Cf71crΝOCNoe=]W˵[P9MBH9[]ʩwy62i#w=Z!onC{ONC01ON7LflM+AϢk'x-?^!j<U80v4bFUn=YObҹ;Z!rF7<9[U9kJ^ ^bLʪk_4klBΖ'rq9!?yt{{ZT'}>ůmLTvjjCRϣH949PEMKQG'E=sI c d=r48@G$Gqk({$)4e&QHja($m|IrZ4I؛ǴiC$a\֥WAYk,t NK()AլI,S<zٮ@!%tH BihRZGB-Zl\=CqEfu~(jH1  So:`,cAxZ#-F>Q=HzAf™ɖa f]79ܜwX7XȢGn6QNs*OŮhw&; f;7QFMNoNLJf)oSɉ:>lj8A= ǩaZ|8=8 Q%&8$v=1zCe3Sߤ 1I`` J`]J9%݅V"STH&|<)2iO5\t3I1"II"o9H2wUf DcxKEu ̫$\*8@RL Ͽ(- \i[YҠ [3гnWo@3 µڣw] %L!02~4͟n9eRlQ:q }?彖Y&^&v¿WBendstream endobj 1155 0 obj << /Filter /FlateDecode /Length 2096 >> stream xXoSApɺ~DPe]6!*Rɣޙ/Αj (ǻٙs8dϫՀ o<ƏtnQ<N? 5|jKj@w4wi.)X2\ Lk#VUZz/kF*gϞfM:YyX]'O>[nn:B?MZ+9gXM*ʼj| 0ϊi.8{AאzwC\KǓx ߛ(Gqw|m !2ǧ%'̡T-gَϯrBcPg.IU(L,RP'4PAcB PQL_ sUZ3"T K<#W$QaXR8ʊIjʙZ!*v:rdzō%5pBYZ9ŨrʸL#0)D!x!e\ΐD8"%3M}x bAɗ]΂r*%nX)YYc֖@E0lz4R Ͱ$5Zްgy$&xx;8R?\?0Fp[w7 w@%c6{QGW(dP溶\7E j- g ztJY&y>uKx:ilp_P,J54Лc TqrԢ :UHEaGbppk(*9Rqp+[zkC'?B&~ @/Z c Ċ g4 58;Ύ|\h4K<V0 §,^L8G ǞEo!TBT֟"n`̃ा;cQ2l<(!Q{KHWY4I=v1BC-8øU肳o-endstream endobj 1156 0 obj << /Filter /FlateDecode /Length 1703 >> stream xXݏ7\Ueu GRORPrKl${^rETHkoLbCΗu.?FSi` bh2ةxhi.Ѳa'KIH(Z `:cK0ѷlv<ĠE/Mh=ZqJTkRZJ2%hٶ=sL(Gmvgql|.']gx!ahpj 5nv ~ r8v?g焃Rj@xi:h+ MŅ{֏ ۷oNi4,.gft<ܫe([/3v"Msf]ʮE؟(fmopb0< _}v<6Io1̶,fsX.w&$lZ\cYFe FowjҸĐ >~{]\P]+J/&x)QX`0spv-}Z)z5@O򍽰JɈ'^~[zEMŋ<[m&G"+5u,ܭ'GS&=si9*1X 5!/.Z mƚAkWRS#(+x$&P׳Ʊ[SkG_K|4$6a*b\FT+!$HQW4E!]DQE932x+ (^xp+c e} 2锠e7; 쩙_3 K R4  e* "$E+J0 U9ڋD:xyթ?ݕaaDHКm5ǂH"~%̑BNAQA})T0˦(jm,8%?0AV\F`%ƺfvoK0jiҊMP唡 3mR"ܪ@Ļ$Kxo7{(!i}gP_Hlj@Cu5vtĭ]Q ;mЂ4XV@aK` H(?y8)Qp?%7xLKhɸo! ! *"M٤ "d6<`R^3 Zhkc64:KKU`Z>h Nv* u` }FG)=mNL1 5| f0q`m`AѰ(h ̗jʦ7nڇeۑ= Ɲ}c п,ׇY` 8<E9CwY櫙ڭlY/9M-?M3hE j#ʾ_@ ƽOS&EFo"T4|M :WfѺHЀssڸqTcUk`o_ж 3^e˶7Qh"bdg68?m\ao@ 'sB3_^8"YQ<Ξ>i-q&sAmС vf 1  p qϫο/endstream endobj 1157 0 obj << /Filter /FlateDecode /Length 1377 >> stream xWKoF>{^ H,sGZ]$ 9PS5bJVJ]@0f}̮> c>sÈ،G?ƽ–X:_=t̔\[. L$הXTe+EwePZF1M?Gλwޔa!Fx4Y)ZłJlJ9+n6iK&O{ l G~]'&I9²|:?BŪ-ǪLϚ}rD6oh32u^ezA.&cf_mho6ݬvvus*]Zljn.aWפY5y/rҮ>M>UQaryĘRld&!1P^A#.p-WF}vB0t;ZE@+?G5=J&!.eDV@rDt_+,?Ui{jL,Vw Edu!|!@!PwWm:L[AVEoOҕ< 4ܩ`@y mSD zw>g٦zǒ4G<#EH:Fc&#gIj^yƔbf YP }L1:eᄎ$c [Md(6THVưJpim*I`4&WQ,\|M=;KW7^H@ owST+10,zV]E +^FPH7[?SWÏޏ,g%PQWke eJ\ l0‚2÷#A5LDA׀F0X eaǗz93-bpQѪbR`a+mPR wa1ԟ9Qc1ԏVo4P>"!iJ̸V+H p#~=tΑ!xں\K{Jvn;ND0'vt' x1 Aendstream endobj 1158 0 obj << /Filter /FlateDecode /Length 224 >> stream x]1n0 EwB70q\%C d 4DgCIۜy!}~vkL"i_.fbݸ]o<lB išڍiT27TI% QX(FT3V3"PX=d 2Y~/XOmQ E+Jj1_y5eE pmendstream endobj 1159 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1139 >> stream xuQ{PTU?w/(aVw Fٖ!P#,/Q2s!e]Ŗ]M|  %@t1BRBPuЦwi3ߜwE!7(jkiZPUHjn٠-r-y?_"⟢ٙMXBcۙ%n>`\'MQyXӖ"]^\J"Q\v Zɩ9ze^ioqjeK2Y 2|a3g̥2֤q`UB^ձ񩺴e%(pFyIrC1 ZDKDG"tgEpV~xf.cc֎~+*,9%w m}{|~Hb߯?A#œO7:2q',9Ʒ~9kx²00C@OMP XmIQM s})-dr}iVcMW7z͗0n]w;}%qYGZ}Z_8:GN\Wa%Vv~|W=3pW5ym$]9O 1=)z9 d$JmܳǎcVsPP}_#pL!SCP A]u"_c$KYR6ƀ [qjKpj)W O O^Ef՜F쫚K\/BKT(rH~isˆ35I{uO>ݹNNW ("6ٵZO]/w#!=AZ;nJj; \]Z=A4\ 6)}q.[Ld QQb x Ipޏ[j e,pŬZ˨ŭa`0.6pG̈́~KI4᥼{nEC ޜW1/ yseyr&J,g78-MBɊm,cǍ Ab[,خ16lmjv)7&4@fL-$쮯Ne0uUU.,@c#;yendstream endobj 1160 0 obj << /Filter /FlateDecode /Length 496 >> stream x]nP~ `X&dѨj.`DE>3㤋.il8s惻|~z^[]L2n yufۗuxG7_ũo:/uwnr_~?qn= Ej[\a"Hv*,WخHHZ+ў{ƘFGƘFGٱHGZL5M6N6/F`6Xq 5Lk\{'+#+'+#+#' ]*8+8wUpVpXUY!)** BBA@H(( !`P $ z(-8XY8XY8XYwBRmRmRmRmRmRmR*$+$|}Jxx$O`3|l[]n::> stream xyxTe Ep xMA)R  Iod̼kz2限@:"MPD uwƓ{$e{'yɜ9W#F x<޸fŤ?`˹1)qg)#ٜ{6 1|3i'ƣCQ#NjL\Y;u?M-j1q I8ejLz7͟J2uvF؄ĩS%윺="lkԵ[÷o3o [*cu暰r潜^!vcaܦI[S"H;oUuFHWH^6h:`D gqQѳ6SeKY}ߍ5Go=XGR}ݎ(S ? !| mz3x2ǣ &(b/)ZZ\?]PAOh:F}K/> (.Tp Y\pDMTz fp#(A*XvdB,z ֳ#͚O#H$vHy3vF2>D#ⷝ;/k=}玸l!y~z6?p2\h`%V*j跶Tˉ"v c/gFmW8pvuVa/.^r?/wϻW~`D`Х'1BE^ .wPTƔDxqH -X5lBrl4c(]FIi>^\{&n|h6p#J䙋go]DlCxzQl^8@v=akݍ'&tM&FV@axT.i| 娶ovqS 2!řҘӖTBt,O<pOۭWp|s~WQ=3%֤Tq {Zv`onڳ3㟡ʭ-ś^~40pD 1`|aD_ t0ULrMBEѼꫯa9MnTM@. n ..3zu 2o\躳|σ <&!x:b-CZcCt709]/Հd 8]vg@3)f/DqQ,wpahQA0(3 YޒyAV Uvn?vNݫ1fC# $bCM5D`s=Mx'#ԉǠ#94By!so dzpמh!qʭЁtF=f?w=pȴZjVN t4+0_'Q9 NN_KC'@ڧ}wnpnr A֨-yx7%pv&&h|nDjӗF7)c"u,2 P`Qꡆْ#ă\'J-N rBT+ Whh~L]un'~m›k@NG% &2"2_ x_hzQ$s%*/J>\;!H]Ac Bc[˱[E_NS%-8Fp#Qlnko %j) P猛=ph0*[J:V|Um5mG^= FSl!1iBe +`Ɍ:9CESLc-FRgZ8|xg~mx7oq(g2!9E؏&҇~WPE"OIW0ZW_䄞ůlIe߾=-}WZ g UVa9mP o` 6ƣG}u҄PzӸCSScN2Ō7"z5!q^ 7GQvhzPu9tM4qvI(>ԝ)+5aj,-ũ⼊65tR,h=W> B'-/m.t6!?yw4]e(cI?b)wO8FEĿ$40ߣ"};evƧ-/ =Ud* =%;P|]eB=>[u:p%m?[">epJp2T4B si K2bss4g"D}Ɏ|bYJ & ׀0>:0\}t . +ȢpIX`ⱮR2 %B0x9 dSiDxc9 '8t^L!kНlmHil(Y0q $P)l?TZ9^ *L_0t X6yطCtZ&(]3o`yJ>R7l׾}i(S~l8-'{ ~YI7\s6"yn9AW۵X:VCXE-J{R $1Ѓbe}ت-6&e#+X?Xklx$ո}1i7qA,G,tV=U KǬnnrGۿܣ%tqcQ/ڰ7N$c8!`$7>Cv>ֳ=B+9ȷ\$[e x* mTcJxoQB6C?mVUQc@4Kx5|v .\J)VQQ;HH*n)wQl`/] b62rfžB֡p {9A8{~4hwzW_ݵ3Hqt@:ӝ7ځ9aew0zpa }ZU2(2Ly k2YTqnZVk4˩gi]/H,.@ZV.zHw<`=g#t/3wvȳV4Ƈfgh]bWnd@SjMrƻRA`<;=*4 I4je\z=hLWCa @Viȕ+7f4hRgLEeD-Qrٌ=`+AП׍%|T?Z2?Hx*>^&i1WRAqуԋ^ 41ĤiT Y[)D/QCy67SCƬ_s. 3F\RR9^r9]Po|nh"7G<ҋ+uRODF'ƙJi.4w~;eב = =M&qn$uʚ/"?kO&ܗ 6L]R?n~QhZ ^r%h_uǚOP^ߑoybO4}wP6x2o҄[r>F5Ԅ) IsO=(\8 mcF,CV1]wdfk> stream x]O1 yai%]2~b!C@3@>`^y &057`uYGOD v~3gsS&X\64M:!TbHO:;m*ODK(5%\*'}C,)oSnendstream endobj 1163 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 279 >> stream xcd`ab`dd M34 JM/I,f!Cܬ<<,{7 }_1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C50\``````(a`bdd?3qG߷0~բxy؜u̙[r| 87mBU\XBy8L;ódKމ}}}&20fTendstream endobj 1164 0 obj << /Filter /FlateDecode /Length 276 >> stream x]An0E>o  &dѪj{bEo?CEo35Sϧs7[}Kͦ9O+ߗ^:gS4iZm,:N7>{]T\&1:+9R"y%=6RC5CVUmI)N4P׬oH61^rTIq\ll@.h6H6@{Q> stream xV{XTe?`ad/` nibЪ\B\~w p咄(nkҮelejt1sg=~Z۶9|;b$ɂ-A2ŦoLܗ+$.-yn2U"YYOOIlθ=-5w3IDZFfaVrj5^^"P[)6>5#?;5Yȧ όtE\ش==/+^Ea c'nK OaBL(Ylg<  `000AL0'cÔJVHj[YlmDi0gŵޜG)33F"ku$N.3Kt%b .5.!ӲwO#T&LVU:g;RM7͓mqt.2 de/H,k0fGtCTtDwaݙwRNaFdN띎ZomN73~-=W*z7nd7ز.Ekw!8p)#YҴ\aȕqB+Xޏahjخq5!E_@dXMf%GPً 2U*88!.' n H#uS-cPjHQTsAvqѨ(1;^@q.3o/ٲ>@4ĔƦ%$2Шq1|>3SKYBGF %| ؟=R6.8p·}GEHKOI>847g`pso !ʕxk&=覟z8/O/XBE[R=f'f8}}pkEai18,te,xK{J nۭZ@~j K0ʚ3G"N7\|O͚nBYye'A%G7-;\t˲o{Ռn4[o'8~'\o<ʻUb#C?5J,+@xvHSD( ~dA"CЅ8+XGW_֛Fh}~#R!^+:+J] 4 ]&oz[d>kJVU  27tpL;d<нtݭԫpGM*v|1Zҧr!_@+\ԯ»MM"?_֞n p@&+ɓ=-sY9NI^WBS!*YiZSq D&tVo)r(jmU2?u$AFhQDݩ.LTerUiqu7^ bK} _`mJ2Do-#M/Lp@}PUT]PC:Pbq_3{OFg0WCH[|_C6YLE^FqGb8z-G/gdKPU..ʀ(O2]cӽK?}{!>qp5*~{RjؚZ *ߢr֣<| _Q@HLP"y 8_M~¢+m%`95qL$rҙwD)S;_mh yx,}t7M,!*2pq0ؘq*% .(O濚z.~}W1ܐڜ3Vȹ@,$J  s637-S<}+Xؔt <}pFs2ȴȜm]MVlz`5 tO\< Ӊs-F#o9R[w=:o8Oy5|b(Ud7ScZu{yyjg<(3NpE?J꽫 ޕU0Kn, xwF?AzW=]`t}HQg-2OLJ$PUpX93y/XBჱhr}/FQ ?SbBk:/=4Tp9o,,)xm(a.SOaW_Ig|~bE7I ,^e=!o P.-Фo93BP .`kó76*Xf@̏EE2$J4K ºsgLhGd,k9>4dI+bwO־ח\;<8V7ʸ}W0)/+j_.6> stream xWmoFίHs7rP S-ĘiZU(}f晗5šM? 2Ao/q$~iyh`DMJғD$Ҹ\dD7Q6qS=4E ]ۉ 8Y e(4zpTo @Bzz e,!aLB"u+;n'?blʊBg X|;J+tPք P@ B, |pDkD]ܜ'b8szƴ_ro޷7('1Kfz:0L>endstream endobj 1167 0 obj << /Filter /FlateDecode /Length 1682 >> stream xXo6=`8;НŊLnmԵm$AQŋ%&)[jӵ#6E>{A*6DC[} ?V?A4i1x#BNAa 4\\=hѐ&E4/T6Crbp^mh"\mG̐-&[#N9 !(q:ga9VAǖ+WcB[I5z HRj0(5t@{(bv!(˱C A%B2:+Y g۱0mce&dnahXj^ }WɴQ(頨9fCT;AJroB p܉΅8ح,[;10l:yB@!@͞!zzb*=ui)35Th9<5dg2XwMq7FjC:0;*Wc`]"6$2֖L^$\T2B)8Q)|Ӆ@` \g[]U g]($*39tlL =9n1٫hE0oec W^KB$!rs=dCasӆݺ8Cg$ DV@yݝr@|h>y?G3i5қ:9;@D~FSdG{V,X~BH4oU< +FsL#˨U)ǢAݲZʜwe{:^~)٫afxr&dhlBGOwyvV`a˂\'uP^ Nmlm}$EXVOq1Anw]elm =>h4oS<\YmDVm,ς.M8 i8 j$tenwzs{uHn䑟H?_ٓ$ +.'x5M4aB[FCGa' $&=bD[o4l)AyEVcA& w> stream xVn6}7< ؋ IIM/[ad9ԒRY.f(RLˇs?8b->,z ou]G#߃R؉XyU؀\ "88o]N!ŀdфJ%)sR$ Io4q25n7O"LCAou)<xBh2$VBa4sg )Hȭ1uR F5Do*; Dz674|5L qhbu!tK@Fg6˵`#2ʉ/La%`=-^VbG͚$9x;$B^&/\Y gn~ 2MB6 ۗC8M<"$S[On6Se`ixdLb \558h$HӋ|;?@^ -2d7=]'Hhj$T;B.<]+NFR)Ex]ԙ:ZvUE/}FJݱlnx ceo^LN[yuRb<C×3J o\'k0+*$f9FF$z1z#66HƕU)9 *̌ѡAq> stream xW[o3P /\ C;>ˆ'Ph7В̒c=;K [? ivy;;g C~r@Z6w?ki~СC-5\gY3 1X0 ;fz="Hi1EĢ(sOea~68K{3M 3.Qʡ?zV!ģIm0Uւ!X( 9z<ۦNj44fژj`Ei1m0 ]=dF[|Fc|^sGsԘk&0L@ej@jVFm0"P`Iu0KE9D8bkry5(U [ &Sasmuؐw д(ic^_ &N2.Qehf ׺/%"+-"1:;j"MHSe: IA$_M2T5JU(g&OP,[RT^ɳD2V}nOJJuamKe#(9S>ä2pF1[:Z?iP# !c0Vt cX93M[o@ׂFET pv!GQ%x}Tʯ_aTuq6gϻ޵_D6LSlߤzN<-.u|c{{~|{զ_Te>gk2Gs̓fLۑәTYo4 vD|4`u^C"1 G28Mӕ3%`A= fmq)1 z{"lma?Ri<;h7w^u"eNn/(SqK鋸W7QLƔWGH)>݉6G>2i4O&mҳ4JZOTpu?jxƌƠ96g?߾޷G^Pu#9'NH|:jx_GO~hnw) ]%zVylt۫yXD> stream xWQo6޳7y^t@LHJezn]>lWrDQtСwwwӀfvDݠ(go^\-zdmh ir(! ć3c)0].ѳ1sH\)% H_I*DlbvO}w5(aEvkI@Ndd`Nbeh Z,PX & bNE@S>O1&^H B*LyQqmHR JYjq&8`Yw8ҡJz1QL.-!V"T(nyxšUS*=!ro8bĄhZf 9"+,<&nd>t&k$>G ҃,cQPaA&m ԛ& }z/a]<;Bn r0ނ& œiy-˖lzŞ$-::4B;QqX2H,F1;8&gÍIMCcXf0'QCzEpmJo\DnJ}r$TC~trb8u/Qxoχ:hTQ>)ZZN~7חãzz();[?#C K*n`*wF>y&>q8S7/!P`\M88Jt@O] -fGKh:"N<6_&qJ5^sjIPB=QƵa`b(8'_ iͫgrG2GQ> stream xX[o6~< 苐UXa Ft8NԒR_]C;I}@0 . nFG= ?އ3+ЍaPDRA2Ȑvˣtܖ5\eF75nPׄ#sL4WlhVuQ?Yq-|,\ LƥOUMq+ P W $981P@4T6:X%0TW3܌$^祰b @` Q2#T?J@} Y0!\2]:8 L͜}}FT> CpxP5g @>ZP 3$A>G&>lC!3XR(?E!HhҚ~׳+캛ammg@- bAa`k(TL6ElZ /Pȅ ^CءU )&]ojZ`rElDzDv H %[uLb)V\tRAXzf8ɑ*鬞X2^pҌA08l`6|(s,IWm&ƴ 1:KKUKi|L]pg0M8[Īn,ŁgvޭI- c w`&w}m/<0r["a7&`;GzzĘ:$*g^ӆzW,YY~*#N/PKUG̑ dZ|BH:Ofo~{x=&`6hyzދ^nwk7xi[Dvhmm%m){L4d:%;Zp{۱KՀ;Q:HeNwOڕq,u+qk޹5nm;aSSmwZ>@'tˆ 6΃Ǐw:]YVy1?(>endstream endobj 1172 0 obj << /Filter /FlateDecode /Length 1273 >> stream xVK6zJKR$nC>b-;X#iCEy0 73߼ D~U:"v~DSYѷ=.DPcU:q t(q&)]Q*h'΅c_ۣD]8A{-DŽyes컮E_T'%b{Jt\e}5(C+"cx }vE'#9̮9& '`%!ĢXlG _xvtAa~q#Ky=:<bVJdQYU(Rx8;Hrd4/`!F^ nlmbl,}0QI H{&:hEafN yM|z;Li l8+VlG5 Ah!; \TI<ĺ|t1[< li>79Z+H+S͸ƌgmgz,@~Tćc1;+m Xߖ ƤՋXʈg'5zf*i0̂م *>޷='iQ뇶ƒYnJ5hp9WӞ4Sp bÎ We0[a3uu=[ˆ%&#qjsi,J+dIn]tr?e|V>]E lf[ڗ}5)i=Q]xėmyp?!l5ۜ s7}cT<S7ֺ+S-{>=&=r|л$WP\ ?{3^{yX;*kKQ\dk"CԵQ ͎~DM.%o|8'!^ ВI;*Z]*Z7P:sendstream endobj 1173 0 obj << /Filter /FlateDecode /Length 1113 >> stream xVm6_v+ʗU#vi/N6`SUQ㌟yӀI>oRLtW~J=\akӀH{y*sm#{ ?Q|mJΌ_q:Sz\wI{y-ܷuVxڡ.$ HXT!}ΰ0GJu1Z41ci F1Bm'hW&gd߂JIx͈"'muI#,0~\2я<qýk^6:9i75 [┇M"P]?F)&6]qbdbyӟ3Y9GxC n4..=ϕ Qg\'(j0]Rݟ (N#z] ̈́ ^\(*ӪVuNy|d+^0O.WVBg- /LlM9#l0t6g6m\4+g=4B\!IWBbnoowq#cp]L3;uEtwm:FH&`I5-F2&;D@׭ (hPKbyӨ,&UxH8CΉp7|cendstream endobj 1174 0 obj << /Filter /FlateDecode /Length 1173 >> stream xVMo6S^@BbIJnu7 mS؎ ,,;"))E 0M=>y} p1 QrN!% D!J3,G2eA܇Ga˰Գ(i\U%i77򗖝I$P>NB?%Y$)Cs@3BʘBއF sAFdDeF4Ԥ%}U!r9 '% '9 I2E7G`7#*iTT/FQrD*"G"2&k-b * &!޺(TO&ab!8ƛgc2V/ӠL#4_(RՃ1g+TϽIDpyΟi TSY$cTV*M)VDZA(J2)k)\mvf]5Œagvԥz5,ijVPCj=?t09Xruswej%;C@h^X;r]MdY ޭs7<8 dp\:bzm'@mG 'ycpt{;U{\3lVGzGԇj%ܫgk`*-8e> stream xWMo6@/BZRV⒔Hкl݅QR7핔mCrl "g FivnGoGDu?v>z'$$fT! L 2gf XUZj-&1ݴ0 t- I$0̯G.!ě Q *"Ā<"C VX21sx,1_4 aMp/$c{6kJJr)’6{ܪHܜ#; )Q&#*A1msrQG")  (5V1 EsށDȡdRF6 E&^F0m GO'"\J5Iixj#GsC.Yq#){j)!"0Tl1„%hؚEΚ!g4ZK`O":r ʡ5`x%ˬ/NݳXa.fXVXe tZ֑0j׮hP/&5C3+aH6+GȠdc;9~{OԭgK/ơ="9}3yTo0gBF8$n6mùG5ÐPʴv8Ҙ<ջ9wn5-Ko :'/9iB(AZj !*B'R\,FyA$1wKLt4?]Q5~HM1dE!tw7}j.-i &-\q ~a7eUUm2>/^nlImo6污S26ٻlӞswmH~Ȉ)hYJ̮ZhҮ.=$ObwXU^m[d%ϧ4њЙ?C-,Ac%Mv}[O'>I[uܐY:i Cz! ? ɛJ{C< pŸ.{49(v]eӥ6sș=.gfag0yDX̖1|MC_<71qc^~_FM**θ-qQJ]3|xŝQFÇvwOKS$@"iR]YuR]71$˾IRlwEb_Ks4weO:Zw[M$L_RR 91ܨ?sCz۞X6n"$~&nYz`95M6XTK}u8FZ>_ũBeĝAYgi k &=3qW`p3Ef~7^Y&o]5DG1;Pa`6PCHH=jhSU< # jLU+(xo_C?#MZﶉ?ۄȵZO9ASXoajx@rڼ1wf_#wב 2{/ mY~?fendstream endobj 1176 0 obj << /Filter /FlateDecode /Length 1244 >> stream xV[oF~@J)CU^U;n*$1pfޙfdSYs999ߙyT4L6hqB~z%hQwF(6Q; "Deub`۞Sn⡳5t涍$ScA4f6-`}Y&4 b)ab۲PSMʾs*ҬH|{X.ϩ?̹+dC5 |}XT2$f5ȬQUxxᬳQv$s 7^Q"Fؙ]޻O3̸cA*BMP'?g9Q{"&.6,UW< NSڹ{]`t`rW`v^՟Bvžn0uoe"&x%Y0JW<,v[ʳb4)fK,n7IO+F-]ivŨ1wx\1Soyw-LH.sǡn,$(ClEDŽU$Tmgf ,V+-`.*ƪj'''‚_EE)zq"+aՒRSoEH54g̙S6YX3k^ d'Qu~+Ҡ!Fvb{!x/6U{~]{lC^CnV| Żx I/4ļt~6*FE}0C۝IeZ[= 1{8 z qt(D@8w1̒ ^^*3|M@_ޱ ޜ6n5uȺp oF3uW_^Ϝ%#hnAx-^ z¡oU߂8os<UN$ 4kPҙpq`p ߨ?BoP!:, *&vKhݝ(IGrL~6ufļx~=4'f$Fl(p) 9bRj[deٮ}4SQ*2SHM,!ǮZ.qo yJ~ ]Ro@9zOXa,ɳ4JP$?h/(N zUV4WL[+\re|8ԷЀ(ӮaRL7´I'&YECKҰǂ  `gGIendstream endobj 1177 0 obj << /Filter /FlateDecode /Length 1192 >> stream xWo6fzLæ&uTj@)e IoOS׏?l861e=rᣆ)kǩ!;r"b̗~ 1BbLM|c^!94wC.?؎G^E㯓)q"L$ BԚ>$50zĴ|׷⢟-Q8AǪ]*uwnŜF,nۨ uMUtu2SpE1OFJi1.3=8ɽޤ|\m2ԔEV\j!>Iff&VdΚ8e/}Uw `fY-3t- XGG|B,E׬fe-KSD]$Whj_nu ;+碮5g9N'=\t# 4yAbl k}!MZ%ͧ/G; 4,K~$w*_7qă&f4f7: ɎH*iA|uSfh܌AE[{kA ?vjc=բwES,2^[Ea`=:w:dtBlDxOjg}%jPsck<бJ:3XpU*Wc.v\᪍~l}h|!°۶e̷s ;*P# P9GT,{w׫XX7D,[m7ARh%J,37H_ X{tR> stream xY[oFgaT(P; ٹ_ivZCEE!9jӢxDwn 4!=_Hr=z?Ӥ5_&:--<–X^=414Rcer!Jƙ3ʱ1^cV>̖wG)6Ft?8=8K;SjVNF)<[FCS%gy8e`B1>9V1}r}8 enM5~FcL21|ZRỈLRW7)J$4͢T(Œ_k_ե_c޸$ZD>o&PFCK8=@5&X/,[婠pk:!Yi(wQLP׆`Σ`BRFф 0W܇wE*ht[ovXP. /W1,%YV3zP(-/S-˓q*!M#~>h٨eep8&cŒ6Iotfrt@iIO ef;:{2=QG8e˝+#Cn֏N9o՛L[L%eI3OC =iZd~ABJdФ Sg!h8֚‹/lusMt|26,h|-p3*dȄQhj+6)Ir:qRKrU8e;VKpRܭj%ZYe8Dw8q ``bS7j=/@:7$cK*[%-~Tb!E)!dNݲ],̕1W|/_pG ?o;x1#Uod|fqjAm)@|9=pə( ^VB7/zHw2 .KRroE0TXWWoW ,)̗z1!cw,L3uk82/^spG9.VSD'lS,>p ̣_ `nZŪ]vJ걕|rsQ#!=Wx3ʮCWכwS6}X-?喊Xm^Zj&^ Bټ&-NwE~oEp .up.op w o.):Jijl5냶1潛>dn)zof٬(fpai:Se6/N''V'3j䝻P!L&FlٶYi߲ n}60"gp8TA>z8ml nujz81]cߴ^=z5-v+ֶSr*俕\ʊFݷj򾕛^s6.A~A'_'Aӳ*[x=m A^桀JΫ)w4kLs~n`^='hKGK8ʎ*gǓ6'I 47ٛ,]֬vL;"Ylt_}'OMr >f۾4pƒk˫?sk8>c@TEیj,9p9 QPzA-gϞ zV@ሻ}M.JggQrT)!)[}e 42(_> stream xVm6 {R8׻&ڶRBHmFU{lmb3ϼ04l _L owɧ?|–E1%r7iu|:'@_06q pAe[-Ώ &{ H0 P3dp k8Lǃ甁ڋ5\p tLbMK杤M X*+p`#ҙ{lnm3ElZOH8%mKE)%n^ O]-&h RڦyYEUG\j3:g{ܤLv@PVY0Li\5d6BĐ[qmqSeoHkHYv/oҪpPry֜ žy6{TIYmkAlHCZ]cn)"9Y<%+Jc#ٕ<Ћ4(+B V˚ߪ@ć4jeRv,sI'Xee6&d9KWU. ϗ \5fVp$"tx7Ǹzt &b7qȽ">ڰ17f] nyAV{qa sGu1Gemq[}s;.qgȌSdXڨH,&)Nw eXxI.pw*&+^.vE. !BO|n33["Rl !"^#D wX2061VRI K3Smv7(Q|RhDCfƦmmA |!j~_n,)ùB"\(of!2'wАnbDRHIbe\U}/yAWaP/ 2+;G&7tQ9⦾C1|uӁA|z(Uɪf$)vE>J=T< |^c\G,XY_:QAJ5CT.qc/ 5>\@rk"AюiPޠmAx3޿ဍ*bfpV4{¬#e>nkƱNP@$Gsp♋ڼڹI̸E#Dܛ $,'_ٙendstream endobj 1180 0 obj << /Filter /FlateDecode /Length 1242 >> stream xWϏ6^zD3+lrtUF@a6@*Q!Lv`}~ﳟb@gVΠ}!kt4~[~; r$X=d`dDA/0V fn"اSVxgB1W/B]n #bp0Ws G"'B.1l/pp2TLp@{BLۍ"ROM B/w XG nJ#5lף|O~P`yv r!B \# >Q9$\j \:6Da0̖C3V e]4|.t>q8v|ڬS7wna0ll]T KuLۦ8%Vl} | %&Ii]hk5t|%8ympDNn[ 6yV7%X>iUVp/U}oկE펛vϹz)6o|JZ.FY&Eq+*v?X/rSDhJpT)!C5%Ki6DU싸 B(HS$ TL"ޝZ؈ 2_ aHb,vּoKiPl4i?{;۴dmQ 6-gs-kKx0bqoZk)ΊFUꨌ&p㍥* Oյqkvx[|+L21\3q]%-яNXemQW c tPdruͱ*қT5Q}SMO?-̥.薔le1}j'nϫ&/EK8Rg ֌ vu43ͥȒ ԘȳcӤꆞ ^!IL=-R&,m;FS[dmPFh8Xjpc ck&Sv*X\6GopYp%m5΋xt/7uc՚^5;y6ĪUSYb˖uQ3⾡CTX腟 gE,/v:Yf4ݹ> stream xW[F~W m2 R&R6KJfm.C{e0c+Eo9;<_T"դ/S=*_ĬjoˇOM00F ߃Ts]vըPA3+dInfP|Im0]Ew DvyN@N @Ң)sE V6yzoAOf ~5ӁolR18'ؾMsUCl4M@ ,cl:FnDp8|t_V5IIcZqfyiylN1)JR8c#_?.6-.!F&3S8*B0p](ʃi#gAjó&Krr=YQ7qtHڴ' ?PwoHlW/ ~[%o|51A9pJl]ab{lc ar.c`BWI9f:)7wqH~ot})Rendstream endobj 1182 0 obj << /Filter /FlateDecode /Length 1556 >> stream xVoF~>/'R",FMc5d#DžVˏ=pVVf4 4_\,vqe_\,Z/ jR\o^xϠ6Y–Zg)[6|uCg+0 ǨW&Eyٛ}G|]tv-5LA{$iZ[1*嗸FmF hRq~C+fĞ,ʙcP iÀA]]J=eE('=-Sep[`(~U+I󶡿pN2&N؄LdwH}=/c?@b1 VY#X-zQVo#~mU?@P&ldKYblPB,(r\XJA\k#RV19j%r QU,N(zZĂ6` gл`mY iPXh|;?de")xE[ziaSy(DHo|^qv)Aw>'S Wi٤MiAd`j<-.DO:2ئܻK-zҍA: ,=6v1|G6N,m, !dIVnG>0C2Fj]1s&m죺Bg"WM>DvST"EbGBF~JR1u<*c_ 0_Ֆz-ڤ,$c, 4 FPӝ2_^ ٍ kcAqgŰgϦTnAe,NǽL1A% KYK.QЛp?^̵N͚h  PWuoر$e΃s)Ep!y\IoЗiV}`|Ҟh} G4O4ȃڂAjS0l4rt$ґ;=l'kYN'ʕJv)3j~rO^Eq5QƗ(g4SՀ OabE'ͻ2/~]gU}FITZ蝘 }@y o8A b1@$ǫ{J;^&O&x͙|@aOd|cZͻ՟7mןy>{ZmCw9[/~^jendstream endobj 1183 0 obj << /Filter /FlateDecode /Length 1152 >> stream xV[oF~@NWgafKմRDY?LZc sǍzesfj&&ɮ?-F}VBq>ỳhQkC4hSw˛c}.}ߡ&h.&&6]7p|$Ş?SbhM Q=Y/;υ xJ<Ͱ]{^5 #}bEH*' 5rjIU]Rd64=S00&%jOV6C$ml1[0恹4=E# -ޣVQ D5.qW2Кn+9Knê݈[a)&'ewv'(xWҽdNW ;:l%LIl٦(Iڼ04[2+7m@XR>ЃɚO;;H5Жm)f9Αai)p2(Qܳl?ZuL,oVe]ru=1"%'}S$v f{548dgU~;42DntZΣ4w.N`-k⢭dvv~ѩE1Wz9endstream endobj 1184 0 obj << /Filter /FlateDecode /Length 1216 >> stream xW[o6~/D,˶h i"`lfY$ Brn9߹$?E [l`Wc?߿bb6aP c%[pݯv,*n|cR[Ų5DIf({aM(Z >.} 2S{)*V#'e9d%ڌ#\qj kHBl)-7Y1  -ͮwjyȠW!nQQBweispgw٣;Ͷ&?11ni3bT/2* 3P1~_=NͬO^01衅"Ժ~o=_. >,ayʣxF6JʨAɥ&Yf:Ug&FH%X}Bq>sک%Vke ` o; 59ڼmtZf9g^EHgOssHDMV%Ka燪?g[xĐYt'y(P]ZE-xX;O^͊?yfg%ۭ0Qߠfw"),`0[o |W; endstream endobj 1185 0 obj << /Filter /FlateDecode /Length 1178 >> stream xW[o6~R#uL5-(:qZ-Y1.$c%0i^;9%UiCw/F;,P"&WS>G:[б}S("}И-8!|Sm#MWtUF`ƛNYwT,ZTd1O:O뗍ӱEsow`#=}+܊ s0?Xj- 6-"*1% αI\CHfP4p^|e. e'vY^΃sIep){?ɲFڿ nF fIFrYRLS)R{RBKMƂxCI ڱ_gYckCqLos'Ђa>5<݉# P[4|lu넪IfZ2ξ `(U|滄 ]k@t,ɉȽY\P({B?]0x"tX/{ y1CHswx-"iCԕO47;E0s,Ǵv0uV[Biå)P]X,ƒ˿BE#zb>u>Sn*EKdJ=ڃe{a$YQmejUYS!"%R/ Țu$d)#o`G6ՙKP)3xi(jwQ+H¤#sKj\VZ,Ym΍Dl`h<6 )Zr9׆CIJ39lٲ"Z'v.aI] k:p3oC`a(q I ~6|JW b^'= MQ1U3XnNh> @3v^]GД M坎-u:iLkZm>Abc}#9 zІ/}Dqhendstream endobj 1186 0 obj << /Filter /FlateDecode /Length 1144 >> stream xVmF_*uE*_ڤimvk8a...,cvxfgf$!LO3ޕ~Y~!g3dfپ9X*g;kcy&i)RY%|w}4jY_՜;nb4U6ȫ-8ITƏZ.1OLMV o&؉f[( Šlձ,83,qf`c0*1Z+_'wJCbh3 >UF| Rlť=>-6-p}ז97`oe5_M!mYažtt)/f`5-aUI׃]0q-*xLP9z.pN5MbpҏC$PN]Y(Xfv>)$D#'b|:̊dQ2gxS+S:!#5\LbOc"W WA LCQ s5*o?{l)`Ӷ@Nle҄DO* Ow.K@`e=\&sReN£Ք5Cpd7-^X*4,C"pqN$?$_0e:ù… '.+ 76 XjKB~> stream xV[F~@JbpT٦Xɉh^>55jU 0-Y!\;߹!5Į =OK+HZ:X >$`;㿙xTq 07p#\8AM }8gɞxhxyj홶 VeZdnI@ofo7 7Gu]XZmpIbGܑ^@)s޴ h_6 du} ܝB4HCX3G R5/G ACHD]?Rm䂁*rl.w[2?HZ>yU&]ڦ4[cTŒj.Hz,Nks-g3bi`]r`3:2`Ž@kM9x*Ɛ\g<퍂U wG cN*>5O8ܩ֔ {+Zd> stream xW[F~@H 7Cݤ]+Y2~upoT``T\M5,}'Dvon+ɥ_?\zyXi̞iiK|B_d]msu5qM*s(nd4Mz1mZ75v_Lʒ0<6jYDśIikPYɪy:.nމc0E0A["mE]K/ljTbve6lMҳEʿu?2W11ߤUaY%q*KγQV1:qGqGqqSeWJ!kJI?FDxo:%H%uǵ/wXon=c wF4jWَ)?V U &$m6@ՈCE7wYTiH9pu{e%d#sN+eͼx1M&$ g2 Is^n7jS.{| 'D"'C B*=DHWڞdq/ULeQ]$jT`Gꁚd^cl2)Q0$?>\A"iDٷ?WRy,1[exHCP#+;V]fII.ID`S(<e0 ޿WD#E9Y넊ȭxד+*':.T4I"{{-Hgfz:d?ՆhJ*xwQu4\++D$ l ܈PGFI+zR+Vu=ˆRW>: =x6NO;'C5 x ʝV&FɪES_HtC<|.CϏfVYS2&~ߑ>6GK]rL+>Oׁz:P {Iײ܊u_ E>_ygs"ou"`24$UYׇvv=٨[4GU@,y>??-px=> YO\M*Gp[ dPWXHH܌y`&/ѝ IseM&  5;#Ջ^qN B?A{ޥj CYdMY O_ƯO?3aWm1`OW!l!2>.&Onendstream endobj 1189 0 obj << /Filter /FlateDecode /Length 1032 >> stream xV[8~W M)x1઼3JhMȄ)!V &vF(8s>nCRخ޿֥ky-mdu:Hw^/Į'v6lhY[bmXt/Da5,uAfub-0l4


B\A@;aYSnJRc( -BNg-v,OŒlL"ƨzk{,ʌж*B0i#[\)RJaCP_6녱L2ͮVzdi $!3;`q6>5zZy +r{҇)npHDg^HEwWYW9i5e/,#dG|%ETar..&Iጆ5dlݙL~6rC^]\>tay37lփmq"l0Av vSS J`<3d y\tՕh?yCl ys̏IFs&S.J 㙌PT$l*2ŕT=[ȶ9 gpކOxG#c~@X ׫X)e>[3S8+REm+rc:4m PIlC|%w f=J K4I}ɳV4l,.8o:qI/Q\ZQ.zd(҂OZc\dy q_/vu2qV~\UtMR㓟qw]yRs<0g5&,N̄ sG2{ۯ/VQ[cc5Awz`YWttzp#AKurx$G=ksT4Q<AM`ԪS\2rX"*ںa?6jJzCZv5]2*W! C}"w6m|endstream endobj 1190 0 obj << /Filter /FlateDecode /Length 1394 >> stream xWIoFYȹ(`/qyitc \bDS A{pe z-mz'Tgh_?{߿=–X/{3%0Ɩxݛ5%]ݥAjAnqŋW]0:hJX0z0}J9HpqRx"a-FW+0jP}6b0 Mig_TRLnVb%o܄2tY屌P1L4)*AYڂ.0L:׎Jb5:DT):c[M*` ,  Ī$J֜ޏB頳HHl9:=*pCuڴS,im06O:Dbf@ӊ'I@ -XR械LQ)12Au*BaEKF[ĭ+P40Z WI b(9BHYRJb}@N$1%'RwPfal5q3v8 LaAoViycȀy Kς[z\lqGk VS4_vm!nKa7Fɢ?D, G<%t.n<>-nŢ~/'.[7:MV>;*ip"Yeyy2ɐg4p&Y/m8:)l_f.-/+[^7&Sw)kK|q?UDmzNb媲;|;&Cz N|LudpPuӫӴ,7]mBF3]E<3[g.(wc:ߤ˩}U :p L]}1Ѱa26(^? ;HL4&n>ʉiSPC0l۪.NpQsL(Fg 0.1׭י|Fl@c܁a(UE?Q|Rf{g0Ep`,+LGVuD&,owţN0s73vdw/. sk:㥟8Z ornSȷa?z[,?&mNvyPn] {ʗL \} od8=_9Td|9n7endstream endobj 1191 0 obj << /Filter /FlateDecode /Length 1389 >> stream xWQ6~hs}-zwjU[j6)!w{;&k73gޏ 򧞫tD㈖zRp{ ‚jOj 585|c0#LG22?H8':ܦ܅%z@oƄ9zc9t|J'cK8G2Ng1aX$)ezGRز} _57#DSۜE'55א ;>x+]?)mC犐R:Ŷk3<,޽W*[Dej+E_۾FnN,O+SRM^p?f dĢD kB(*EEw=?Åޝq^jO_Q͛j.-OsT]& f[VM*xh(sCFhՀ4oS&_ʣhwU; &`7 f46Tm!xh9( Bm5ksEj]^5jՋU<3 F[Gl)_ܽhqNM57(36" {-;'}VE%hY!UxoџWendstream endobj 1192 0 obj << /Filter /FlateDecode /Length 1152 >> stream xV[F~@:x0eD0*|Y&4'dTeVljb .{C¯qPWQEߊ2YCª//A} sw4/l]gh0 0aAU1?M+)*aln3WoS\?&Z,U (-0G~-"IIU uzw] Oz¶)"4mqQkTNXxaQNBg 8) w}0w<0t??6=߶3<5>Ddǜ5#Ш=0C~ҩ `2N GAU:u3=ǃO?8-5IS ᷝIWN{HRvWVW:9:/ c6M BR  VtE ۦZ詚DUeӁocNЈb&)c 5cpTufiMv;v IXt{Yk77Js tS/0#X}J7Crn9b+0.<34?q e7^ӠWaG:l>S%ƠY>(=WKn 081l4SApx;j k]n-ǻ,[w&Gb(<+CYAG"m\b"ƭ74d ھ8n oit-"&4n*B67u]w_^ > stream xV]8}WJk:@1`iwՈm@ I6Z_ۀmFU4s=jPgNKRw껕G&0TW{|;H]|,B- .O5> ` 4qEv$baSDH[=3+Wp]}px5ހ1mS3\Mx}%cM8$R.+몭[k/ tLXހf =$0q}ug4ML]׼QҚe5_MnkC/CWi]`=NǾnFY88oĹXo-K%1&E6RFcN҄Y%e֎xR]c41& W f]6)N Š%}ީnM)ˉ̖'wop,x,ƚLjobRrJbo>($:S!5zhSMz({DuTCEm,CV̐+E}Oɲa/….p&(OJ׺s/'%*.&#sʄ3#$I^ol,٦|ddOLB=jTKOsyhR^hՖ .@Gԡx4ou˽^^NGRW|+Mf,i>Vm #UhfK&DX69Q[͢ОewKb~䆘66a vec2(E>&1%SpIOsz 5Ic#]3I;Bt`ˊX׻ۉyҦnSSQ[Kt. Q4S y Yt˺% -狑|/sz48f`P> stream xV[oF~WRav.T4"lHPyai]{*=K3+U/-޶duzj^OBGh[mW=XЮ3 ťP̹TֈpƵs[چGed9t gy<ќѱpYa]3X&H S;( x wgWj&kwN,:]-"tdL*T:3K\UJǀij6 ؍Cs,q/ p D ) I4(Eȥp"b0!i՟Lu4OoUWBfи|@PRO4S4s ՉH@`mфB8sOgKBaRBp @9cPexu Ϥ5ӆBj Y ^%cQbP͎ ?[tghxg6n2md%#x^'V5XJjy#!ARzJ\;X$Ne` TI@2<V9 !ر#BaK$t #)DMSQk %"d___}ljl;[Og#_|}ZΊ6x3"}]6{?wh Nk 4͚)|ETTfuC/{fȘ,ϻ1ɖY϶c l9>#rN|lJ .~t6 o@lj qAE:Uf28^),qR#/Z=דb߲]NB~*67jLT Ĺ1gPxq⩀-$睌nC N |W ;:cC+j:AS:j!C=]ҫ^ѫaz5ix{},?Lc{U*BZSZ/=~Zb;e1Eo<%m^kNQI$fu3C8<°^$0fpO?`AW[wrЗMqj:u_^^֭v,~ݓ'BaW|<ԴrX{wQMbh؏'7t}ԐŌ+Ka$>̻b%ۆ Hyfsk< A}t:՛߳f3dV_P G>QfǵBGnB4M&ؾꍺa1xth mUjGК?/kcendstream endobj 1195 0 obj << /Filter /FlateDecode /Length 2232 >> stream xZݓ5/.Ơѩ-r˥TkLTn|x4Yv\kfZ_%0i_lfb~6yy}9W|ă0_k􁹇3eͬ+˗DŐ\kqvR=^. foW-j< m@#| 5 6mp]m0/*[nMp;UeNpKPS7|#|n\=VYɯ,fl?vM:aZ՜׃=E_L4N)Q8_S,&SinsA ='8'ScMffcԢ96'^9.'F9I2m >gj]8MpNLL=6ň}$1ʻ!mI"ɤ$y7Xy`Ĭ>q\(xE{7Ru^ B¾\X}sޤmY)%>N[\H{D=aP6eT5wt2ƚQ A'Vg[BjlܡRkz@%aU݃ؤXB'.9,'E!?Zj#x4 lF 8F-&||MR"P!D6D@CS|6R C~Z&%4BP+D$e @hыlG  rSYЦ, @TtHB8FڋNSx"HjL@qh|מS42ĠkaEGUtp A(Q0z[>o ГQImX`#&{SK悷t xcsU4ɔoXJP6!4ɰY1e)K\)i T2%-MIq)rMNFK,zEǰ8_/ZXpLPɘ:(%EzCRJ+ERJ+M4m^_V$#=ۮY'iï?h7ɓd$+{[=1NR}A{oQyuÏUoWO#IxaO]_lח|G^_YUW.Nhfz'dpo7sTg&nϏ: 4k_6J> stream xWmsF_ĝqຉǵ1@e$ x!;{{v'бb_]&#CY>XU2Q~G|I +jTX:\ebOt؊N5t&lx xWKUk.vBtz.?vۃMͱ1eN Ϗy(,ZGMJCjBYdy0XCezAjW$> stream xZKo#|ȁ!; $N Z@]ar/S3͙Pqaz|UU?dӌŀdW?&/=–X T{hƔ\LK-p1`"Ģr\η|F4.s^";.m[:iJX8a8 x>|WRldnU!l:+F)x煰[_s+0mj؝#[Ė1P'}Si%2MJdŊK+IY*˰f#ۼ``B20L׶_Z6$0Lj9\(E-2Za}Zǒ-6L:U 8[b8*+CwU Gٴs96VѰ GQF!OOw6V=FecexI۲gT@)Kqєv[糂۬4wKZKGF*`KT}pFȔAEJa$ SOU@U;[83'=KL[#qE(A<(Tr :HU72 };LaBLѶ1Y}T}ؗ7D*8x0* @9S •U/<= b*zP1 gU=uJc]RJ 2p[ Ƃ^ mod:4͙ €3 90s?i`m/ր pn;o9 $/ES4gT Sը+{T] ,B5KXܜDZASevuJ5 ޭWIaRP~#qgximH F:&3s+ʫ[+ sZYյ.eЬ=~XG~\cnVP=%EQlF \WL  9S}r:!$eŠKs)iKηZo4GdGs 0c6ӴMn$!}Z+yaaF_]/=`hmyWw=]'iMDOXڄYLDF',44=jK3JQn%,|[*V҃08!0(*xVڰI90ji@#Pjk*jGBrG(F|E.w`2pKpYAGpŲ~]VHwY!:203e%Yj-5!ڂ.■]w۪o=Ʃ[ri{ T{ަ&!INrOk3CMZӈQtP]l nԒTG q.vd8#wenP8d \ AC3@U*ϹYMs{80*MT8te@yjVKp75<W{423Q(Ly{}s⩡xx50+OJ F5 ^ζŶZD-YbXL Ӎ{~VЫ.꿀zFAz)b  8ߠ+J@TZ?By9.a?T&0]:Uh:[x ҽa@}nB-^C{`x4a^p Ω cir {},d]sIxz3'j SaEy356W˫hݻ7;_:^ǵ"`t?;,0*7;Wr~ ˿/.W0vؽ\To3qPE[,^;~G-(7^IwI{+*`ð+endstream endobj 1198 0 obj << /Filter /FlateDecode /Length 1219 >> stream xWnH@IV;V鮺ilJ 8Gi}("w@%'ς/9C#YMhDИ3'#'KG~| ='||%)&st7b?S^ԛA7Ҵ,Q%0lg{!C5{LDž&c߉#r3fvy]S>q?ɧIr17! ]vUMe2a6ŋ"FpQv9?=v۴5zwuA?0E-RP9]jZ%sRwmW܆=L.B pW iJ"Ѵ,Fw;M7y(r ZfjT>adBA/S+Hc6m5R%]j6Eb锁p0V)u?&~.0|CQ[v]T8BLyWjRa 8$){&&?N"a8lMR+tQ_t'(f_mv&PH h灲ik~Tf#mWe% s(H >#{=l.Ŀ}@j9$G:PdFY1hb37 t \ΕS5 ̋]4RCf@LNqmݐ'18Q&2#x\zAy~~&o" 6!3)IuH"JW$>09RXGGaA?cJXu%>nW/1pz<|;̮ÈdIvGs,eI:N31n+ˆq7#Ps=Gzmoz䁢ђW;YHz[3i`)tӨ1U> stream xXoVôh MBB^ASŇsB@TtILkPis|;NOBWЦ>ر]~~0"6uZ pp20 iP_Ek2Rr ƚAuKb!;#+N CJp$ GC0:V*H$:<ˆ*,ɟNS⪋{q0Zo+:=G1b|-8T>kts@WbABi,ca9J0D(s&8V=Z kWA-7#) TD0"1 oRSjmP@h΂q)( 6IDa}wmtL6EB %+z_8pEbP3$oHH>I 7urJj`c,W##R,{iY W'A %ҠP1}r6o- CBAvjk2^圁J|A)D @F6D1*@\ R`ib0$ 4F~ `Lb= DKnjne]cBǚ^.o !]ԯ1gЃ>h|1M~ɘXpaF$_C_ǽJpDU7Y(Ll Dk UV7=8bܟ0MLB8ԝUF%W ܮ PxGPMk_hHׂGZ7nY>udX1b=L`†wO/ﶴHze 6 W"oaһ-,e*,mXIMmB,WʛgyO'eF)JHCX :lO5m@0s}ZBn}/d 5`8Wp3 g<tD9l{ޯ R!c㦷`u8=2k,ZЦ5IEbF0SE;G8MKs{`|GkWB) Xk>Lis^AA8I8ˊ|]%pwY@ ? _#8i<%21`aZ"] Oh Sg0Aq9뙾380QlՁZ :6X\e|^ooo8,,^lZǭDTŽŧI woU`'arT"\wE>_ݻ|[Ӭu&tqoYE-U't^Y7{F3dEZM=6=; קY Vl0Ѹۖy4)ʖ.EFd8ՙg.gyzr|hdN DMB6N#Qr wdӃq|]oP<-_I{O)LWEOX;y4Qؒ$ dFGƠmӼ JH7_e`o,%:̻u:ZQMJ5jViqIi B(wYd*ĞU"wYyw=Ob>Ӵ]MɘYD]Rv("Kk3w_7GdDJί[ؿFdW6AOK%Һrof:a=on:;d 1uzs4?"Zyl۳Fb_A7UHBjvVF~ߩʓ:źWKϽ5I=9?ٍ13 ܬan%qe탆U>_ϭ&iKƭi|`gyendstream endobj 1200 0 obj << /Filter /FlateDecode /Length 1212 >> stream xWmo6_! F+"6}u]Z-˕#* !w玧/f_S{|5mM|l S-3D<ێ9EdMמ:ζ|{>Jjݰm/&Iw,iCAC o2 ǙebAl:b5}ND7\~2Է5^5<ĆvY頛}.Z5D_K Vݛ` kKvZePb,ȋ#>&yZJN2oeg @<$lSZ'A襻l 0<;TC.3٧9Weu-6d.6}lcp(Q65mT98hZC@I3p5*a=ߞNi !uZV|2)F挩G1Ҳ*`t`ߚkNUCsr:%c7ȏR5&R "pefGp19HjӔ^tx:aW)J#p&JT"нh7%_ G RTmmmB>%W:{]wMYMգ ]dtuI5{"i/"-&GPkHd54*mh-:6.A2 voXYQ T6U@V&|Dv#{_'H{up\c'~ .&(?s*T}|#R]iR}WuEpfC/݋m?O2* Iiq&~LuQƨޖEUbJN-";/^rŽj=ew eKWaQAo+1\<;pxG&* B,ŒHlMRq:\B u4 % G iA)r#`Y;45B U}.>3LrKi.}.f LAG:`pN+P3<-a8Ilq9qJ&l7<7)7!楑P&rJendstream endobj 1201 0 obj << /Filter /FlateDecode /Length 1092 >> stream xV[F~@H"2 jyi+mc*eeYǭUU{g9WC#dy`faYi7v¿j&~'}hä!qmpxZOh[BTT7ɾ$ֺ87f uZݐzDPdRLץ/L3τ(/ \yvMvq[;h:rZNendstream endobj 1202 0 obj << /Filter /FlateDecode /Length 1174 >> stream xVnF}Wv.]@& "ЁDIlERŭ߳J+ ə333`(:ae7{2<ֹrWF,^(k+(|BUl`P4YdkUg|>JU, ErН͵ja!u7r(6'r u T1muU*71zF>F_&1*j/cTQ i7i/`mPYΤ|*¤rXcf[z3Ӆ߇Eg?ISeŨ*u>+{m =;qҸ8=QC_o(p,-VEJyYE7bYՎI z#%Eh()ʇUzC*:OsQ$AbY ۀv @ZEǼy*O݀I܀xg۶ź"F&M#A TeX?|rtJ6FDӉF@Bd8Rq YM[P=)4 5q;ĉSw|O,$Hy8xhC*;}Qee%8ve[:6l=#a3iC(L0u67X`["{"X':iSxk0` ]EFr#y+ߤ83,vq)I^HnWpsu[W^K>5%;T{=b1CY SPJul;ay>yEe5e /7i4ik1/~ytpcҐo]4oiQaqv[Fq  3KN<0Aa%A麱Le3>Ye{=6qY endstream endobj 1203 0 obj << /Filter /FlateDecode /Length 1266 >> stream xWk6_2UkFTJmgw3a硐4!<@_&0"lc{}拤kXٯ~.F_F:~Fg\Œ5Xئf4kXZ52XwQQQFkYecvlfw-O(mԂ!<5dO6˶,4iǝJaimKZKQY\@7A_}+bh%d4ѹ/+:yk˾\ 2݉Fb_+O>)sZ2m7XR? ¡l;YQT"WއO{`VB}L_fe`m )wA ".Va1LW/^Esx? nH pʭ3 hb_MLsThi^# `xtc+u ^(y j{V~**:\$,Enxh[/Vbݒla~[ =sW<,9ee͋+ (%qEy o.ȅ"BI.ޜAoAwE\k }лtEwع'{Zy؄i9(]iZ#mK4"i+itԁWۂoj:iJkeMdCikOqfhj.ųѼS ћ+tbm¸AK'X'$> stream xW[8~ϯ@JkfڀW2ҴeBu h* p9' ZH]jɧ jjeiE=$HvViZh>-`-& QĎ UR*]&{ @R8`>]_F3fٺMy. ?Lò5VyLxu؂޵H*71@x,k 6۬w_ Yz7!.h>n ŗ8&ehhԄH 1XcY<> V* 9Ј'@^ AfO}}öT<0cqV[ N T5p3HfLR!^喲вa90j}/²_k0:T*`㚁beW*-T ޸q%ƿ̋2k-Iޥ]{+Jm.Wg=[LJQ,΋ו`7@ K 嶪K ņgdF(ңQ[?3ìog,p7!J1Da$} _ ۋ!1.:l/*luWywlBnv,.'b[.!TͲ|@tW5\ܪ mdyv@8 &yѴ 8)ޮG4ݾDzHJZj[D:hhy~mwԅ*k'huUY\QPV,y[ &iN.`$`3ۈ/ $ښB SD@ʧ0c^͇2-!W:6Kpݰ]${h*PZbF~ۏ4N('utpb*PXqCv7Cgv7eZyrF<=ٞ{=-g Pɋ [˟_:]~1 eUG*1h8k[rhCyXXŠS Srحzt K.> stream xXK6هNR)!m/di,w`AA{D^I@aZfoHb_'ӄؿz9 IuL-_P#lIq3|hi†ˤXU:-^YsMBsF9ZKr0A)DJ#F̖+J 5ڥ34*tquWYj'IHMc8IFq!A*[#LuXXNiƔ ]5Y10QLUEq3n59%:'MU:rEU&6+Pʜɰp lJ6rXKߗ;G8Eܴ4yQӴR,D`I|fA[d 3Bj=Mbl΍U! V7}Raʐu4/È3̫eZόP }ڣnUFM'Ma3,?fH'զFeu9RE,BHO2 Lʇgj;v?ӜTuF!QQFgΨ`8 RhF}#&]3&Sd*LH)G]z1Iz;OifFJ$ $=LO XXmY70ܥR(yO 0"HpRld/ )$D-!8,F~VPBeR<_M@dMf9b9R ü1^6&:2™[Gv/wό So@ڣ:ݬm6 XYֹC4UfxjSr贁7߮e舌`6tmpUP9.K0_rxWZQնw6?h֮֓/訬VOX Ÿzjc«rkޚuM3/~A,AB_dJp3%>OE1h7ߌîofeTQg;ܚnۗЈq}OD6-nޒ۪m[/] pt@˃*RTtvtà`,WI,gq+j޻nb*ݞ=>TUH_!S&Y枈#jqS"XnʸrjxatGm)Oz~y{wt/;OЍb\!' ?c׫]z|Uy\}Q,~5o5A~܏k::]f0a|+nG4p*lgNgw4*r[ M6vW8Ǐx>vrq'NSѣM' ry3+ [#::hM} ӒUFz{͞op.{;> stream xW[6~W R,KRj} y IhC`&Z17mwn=eӠ~sI|>K.SoTRmW3PTÿgbsچ9$K򢚆麾y-Ίvh/slQoJ݆3O][,:C^k9M >}|n-'}4g-7}ך&IRT9Z@u|KWR!Y~1.qTmZ+ZWuUzbkhC)[E"PH Aq +`ƕM"rNpJ8(""k%)asHqJ1xi.Hְ!&“˽D> !:p|yeزRZ EEN %OX*A#iQ4(ʇlC6}л[ o vh.:/${^.PSPMEG3P|)"pl[KaGPgP=MtjJo`!_B-H5:Ul5|+aӮ7e]>B"DzϠcA;J#z?4mzwxԈD&C]ld8&Em|tnroqOXѯsz_{s?Oފ!PȺOeʗ-r["f mA]RwDPs %5ITr8 GYj=O~]& Xz[|d_B -Qendstream endobj 1207 0 obj << /Filter /FlateDecode /Length 2290 >> stream xX[۸(Z&ERL[/0\?/p^GMf/b<|gEzFSZX8 R飽Ul%͘6Z;n_% n+gQ%ɮlCO*qeT灟יU: `'~R)Ks?T1NUS&@HWI1~L>*{5=ef%3znBfpbp7io;K ݄m}}saũQ[qXdU{a?~C- Z 8qX=ɫ&=&S[[FiXy͂ ڿxNxC !.`s1UVY)q1@@BNӚMdGTXUҢ=V]X&aQEtLyNY$ NG- [>t yrE1CjgY =ErEߞێRzE"&XS#d/@\ N\:wo0P&IRnm(P)ylmNhN j W XKmNZ@la7_uIuť1%mJٗsG)|HfmР'Ec!l8v4 IgJd%z@r_ CͲBlq lD{ Ǒ bSBh38Lyr_W2&la%+ ^G7 xi78̫O}dzX:ppVa4n(hk#72Gt ^3hA6o>71wiR0!0!|0n  ?2 w/bX Uz[/d=Dӡ9Y8,:.TQCSl<Yႂ@Qc,NyI(3dAKමI"E~i^\Zv0sh@, m̠h ir:3@{ fA)]lWC7d3)\EKŧ }IiS^"3Lh nC W"8x W0KfxRj cNtC\C&Cz] Xl  " f*245L6"%\kw~ S2iSʔ9K/YwoUЗSv9q?k*V\tӿ{S~vOj 7 {t(yYߞ0->IGߊa#CYSdhoYnΐŴ{"\5$,7+tuw-(:`vȴhi~jkYI V%G%k79ܹ'3 ^~Ruo(x^K |Cuv1; Sendstream endobj 1208 0 obj << /Filter /FlateDecode /Length 1045 >> stream xV[F~W o 73Qy6MJۄJ+?l18G`.68R,|s.mf{wg zb>MoNY a㽶B ۲}wmڴ-m&}0Qh7EZo4C߈_clwyBVxHh9azX$ iA_ X 㥆6`McfIî{ġ+`[6vЯ&={EUV4u9NxsuSk6 s(=ZmO/jf$>U7̓F d*(̖O3fKiWxA$A%TW>m5!AhK{;v@9#p&0슩MO}c8i*^Vס>Z -'clf`&AKI\F@Y6b̂bvbb7ԋPK@t9L"~"|rđ-O7]#~(}V?I~yq1d&Jы<vD։Q5EOVdjhj~JfttDFX;SjJ_X3L6/iSrN.x.(ϻ=U(\P3{!OZ.o~vendstream endobj 1209 0 obj << /Filter /FlateDecode /Length 1069 >> stream xW[F}WlB>RyiVXMibce%+\`fmTY+sl@6gxKɔ/W UyxKX%Yglya;컾mWKYS5 ӵ}`BK^۶Dѯ!atB,'I]+}Y]#$*5mk;tH>HO] NA8=옿BcdfŅaL :tLyd "1ȯu}b{ʞ wǦn[S$h@'m#<B^2-cZ$P$"NξSZwK[oHȘǺʻ!~Mp5Yu "kKIŏLbכڊ|g0q?"nyfc'YrtVp j`{pf|gWZofkj;NIOFneڇX}Ыeendstream endobj 1210 0 obj << /Filter /FlateDecode /Length 1163 >> stream xV[oF~@I*/զXrS7ئ咍fH99߹|gj"fϰv}Kr'>6YgC4hKwim">7Vωmy& ®;^ĿK}Qd<-,7b^uuW@/ ;C 5`Pm4iYDsIJ(Yx)cT~X) ."GL索M[AIWCD)п0j |wf1Ɍλ!3 Oq<h@<o6x5 @[ l@<)QsO~^__˲Z6\8$ݧI cM$.~M6qmF塼Lw*9:m l9n3 ![h?&.$QW9ZRWeƙDi\ 5(v KUVtw1%V꣪5@ a#^vXqob;g.a!Xvs;<K6*uӆrLnw'n0JC2r9 !AS`^ Gq@xWl'.50f,wrӋS> stream xZKo6t2CnB>' Ãl9 a]+KY|zfv=JbdxlOuU_=zfzÿt.vvxUΦ;[C3{r Tg^`sB~eZZ83䫬/$Ϟ}48Dڷ f½/wJNpTiHj gaHd1YI|w*)u[*RUTky fK"j5Vqܨฆ_`KJ-k&eLj!׋Zaޱ'"jz^ k2̥ؐL--"\ݠEX 2-0 K7 lȀIS=i}F _NʛZ)4^n CbA+ BO{W eylUƄa5C pqT FbԪ4,QEltpCJ"huY/c NE^hPD;z K2jؚIʑj~y  l^AA$B|IsYjYT9]Lj*H_VDZuBZ'3d X?+,^(cX [%SRQVT(])tBTF V*:R>pR5V ՐyXA ΄^R8ABS=AG 6A%b4jA^OWm${x6FF` "J8!}!CLؚiLw1--| Ҽr-SUom72"]G~Ɂ}0GZP<!kUwI[a$(B_pjU4: ȍK.k,]G')e`n}1TF \a aBY \.\J{h)xBΉI:XC ̈́^{H-IB|Ȣ+,$D=ߎ GRe 93$5{5?m~^ RnZAT6A໰[ˡ$(cA Fh_[2ur]u Z{?SX/?6u*8/0x/KWv|JxRQş$եS@[>}(SDG>(IS0:5 gȌf_& +(},P)YG֚g@ 1J|J%DWߪ#׫BxUh\uABcEȝwmޒ=nu7S8ttp|nm Po-}"zfLk %A7~˦Cmُԍ{#U C7}Af- BA<<$pBx[&Y?|4bjyu3&s{}iztE7*; >*?p~΋~A! ^|U_5=_f3S2_V =.LmO˳|2Z6:WгǼXxnzEn5nV 1   ik+hʛSv̩_o=oH jAOxrb\_ꝒI~lY\hp$5GwLiNー(78ޤHww0@Z=J0NʅVUO,&o,5~NT_Lv1r`˥r< w7̟DT6r3-z-V> stream xVmoFίh.q_HC*9\aM.S{g1V(מygE aұmkF/LVOǃWg{Xt*jԘ8:*:p{kcZ;զDn{e;7r]$X'.ʥ%EjKбB'x~wek?,_|2SXqxrFX; @7\".D/>.n`摛z_:$Զ< vٗLI&-wz@5iδMH4H2| $RДLD!s,eEl_{83'SSgQn @ȜKDZ: J,Ve>7SspM>ve^}L[M i<QL|Vv飃xA(Do2Ӣ^<:6HXs3Y'B~-{:v:;J^7G!QetTTD* Ё\6LwCRqJmWɫv.Y6|VQ{|W3uD0&Z[B핬ݙ'ITcWy0Ng2,EYY942du;]8W* Ӎ·\cByh:x""Wvp8f]5ߚ-1f-eQ`,.G[K&Դ?MV0 .Ҭz㘴I.J![ EK`rTwb{O+Z0aq b{P - L_/ m q~AYQoq%P\SԜ kQG&Av.kq UsZFڲG!j]ۄl Aa~#΂5\_jYB7A%~x}3UR)gl"cwh` 3_%~Oٽq?`Z? "VRbӏfcUR3 /Ntd 3 /}RGԸ]u߿endstream endobj 1213 0 obj << /Type /ObjStm /Length 2524 /Filter /FlateDecode /N 96 /First 978 >> stream xˎ$~ ^ @X^YeyዼTKGKsX~|GE@fuH*~>) .H+E3EqT^T>J;)ZI^zj+0F-!ɇ=vK+ ).nTR QAt Ub{ .TQ5U‐:`֧$4XJ0#8L-y!A9Rjiv Uc(EhaRܞb!6DCqdʎ, "W16zO U N.Ǡepy]FX\Fnenm*Bh%..ֽZ Ԝ!= ƒ+)¤aJ4bcWi9 J)"R}b+jV# ur4kؼHCTPS+VɛAu9^UM; R*O:j%C랚w[ KևbR,)-Ҁz_Q Qk\~&juD@_[݇?\~%dl}?)'_+Woϗ}_~{_>"7H\n|W__/5_F!y>}:}M~GoAҠWE"?7ꆐBo3-1e~5:i.:>_/lR^mbv!MgU֦۪uS|Y6oյMkZ|2lSOErUw^3i\z4ޓ >(ɮt9e`y <<X c;ȗڼiĦ = L:4qx<7-ZckLlQAtGq %zip4{"{01qOa) FMBlM'U[7SBZl?)xuIyYe)atxzV  G-Kԣ-=NqjsyKq+}{CWJޣ,,=š8S|jfTݪyk6`ڳ;c1xGXZģ%?8ɏ!(moϒg琿NZs{cO~<&01S ym993mӲ4q8ͭ4mH>K^>a/LmCs 9${1ͧZCݪLu9Lxfk,W -GYҩsԶDTLR fR9{bSOl:&, eoƹV5(e5aU보6.DY;Ief(h3@jV&, ; X鳳@/2F'=g0ѥ'I-S&jp6`Rׄ"c9y6na!G,ͩy/r%c,ͭ5xb>澻zYa<1jOtDmZe_)`㖿tfkEd_aLdz,љ]-C[[{8'_9 <5fڶ%Xx5V{ͬf&R씘o}:]|fL}I3[J[鳔@3[PLa,u7=15]q28%3?N16-KfqglNxj-92[IS3Z;sOܓ9yj9̛aG m+äؚs~V $q\dK#+?Ng+e|ϖV,J'l mCg]_gs\<5uﲒzlUZy/7}{$eDs` P|c-uHFD>'h;J]O6 l=gn ,_'KӾ/Ǵ6~y۪kO^_f&n/Tu IX PN &M2bgcE 8;X3cRj4{ `:9/ PS\5u6HҜoooͬ1[hs.'F $8b]z3wZz[:N03{ Mt;yVK C" wfC$2!Y\je3Nuexk}n] SR/K9m2/ǙmdBښ ͗X7i1ՠ5Jqendstream endobj 1310 0 obj << /Type /ObjStm /Length 2564 /Filter /FlateDecode /N 96 /First 979 >> stream x[ˮ+b=H&AVA`Y,+St4ʞŕ8xT']p1Ep1HR tr6IWՆ:#kP tMYeЏ5rj8Tj+; nwZ rhg{AW\J0k]RvW\*FCWHh Ve/Du`5T[Z#jsQpXQpz(0Wk #kJ)8.NT ]@NڊN]5\Si6`t \3vW\VcVv'..sT4JJ(ASJ@[ Ŋ-CVYxٕRZ?(^@JM6W^,"Hl9~7fUgR,M*PGXT3F/r~l&j$(eizj4ѫhl[fBISm[]H:""}揯?vr:_7?ڌKuO~Go_^wzI/Ek珯>ʫ߹wΰc.#Vݧqe*h߀˪BX} oje*_ٖ[.KrY2'I9?(R!8?ߟ|, XrB:մ-e#O]mRrӶl^n$l7?x:ozkPeBXW^q4yf1?/3(o@ˢsY9x qt/?9iz躻s@w:s|s/o86FCF`U pmPPmD`mǣJ߀^Lxω4xMGtN@hPCw%,<$EFVXH#U%W#5ȱBڪ^US#{EO^ӹ'ȿ僚bmPlYldHG4?Ӱd#C͜V" Uix̤r-sn|߫7u+)zD=`£Ux\Q2G*< ԉCS o0d9{›٩)}j Oӹ {SF,>{䨞xP% F<=YDbUEhzQ틩OŤ,uxOQ{3;5bjO -M6%[j#V,3\OViBc4yR!q!k,c"z5gSFgi{Nnf*ʽs|seOU[&Q5*4?`xpV_2} `G mW>MZfv)H3 ͽB˹B sR!^]ݻ<#h6(eTM 9J*Bs/[Bs60syUh sGpR -srn[ѳO*+ - ='K<6RմTa7ӡߡrx0̔򜍎k ډXub&KcZK/nxN0:ntO1]gɲ4y>{ >'!ap=0/4*jWog YνYB&^LexV-jԞ=Y=Vb {Ͻs|xχ~=*/2yjWܾAz`Y5Ͻ5G3YyjnW|nxMQn'CW+z9W9a~M'ثtx> stream x[K# WD#Q`.ACal ??6)xL0cSOӧ#h&fw ]gЯ @iOlkx%ϴcvuۦz~ B߿d*"~7K|+ǯ?ۨ?]ֳ]ZM'#mScw޶RQ>,ͼsgi7)7_ gZK8M7yޯ7WĬ2` }HP ihv>1Ͼq:-Rҁѧ'd)2  $4w0h~ {Ys(P/qBz̔FSX\(uIJ]B`hh<'lk&+q0x0t=c`03 g<t eGu0N, Yd`K`,Z,~W"z5hxVr='hxQ&C,tIYd0,"nM-K?X66ol` 4pILetdBH;h*>6sP.c&Iy:fü581BKeҴ-jn A,&M/iozA`LjW4%ˍjäF:YU3)j&c&;̵81XGKMlj"8˦ISLZaS3`5SѲ^eSzl4sR65ȩfRfSll:w IM*nK{Ϥfq]q]uAMfV슚rp]MomeW ʮz u9jk9fWJ:w+U O.Kʴܾ%kS=rl:qե G/Čp54[2^cf]f#OAo= \'u.if&ts5~6w9U2%K3g-, $d4 '#SXier ce-sβ5gri7&ZܚiBiiX Y&Mg8s[hƸ͖-bM5ml =A&;k=w_WL~^ONg!7(uX7Xefvjq 57pȞh\ɖ-b-nx g+) n2Y3Κfrsy/ rnQ ^4x,X`I`eYz+F.c❖틦8ۗڭbBSf{ñq.پjl?wY`_U%+ϕX6 L1 J60g8)6MlPG"j^>"wuv=77lPu6`0+NF<3#gOF4inLne8[,+MѲՔX· #ղ^MY0 7eQ㺓uٿio?w@8TGqV1Bh=f쁜3q]mF&*Ys{cٌ`Wy |#Y dy!"tFha0+FIJْf=%ܩ+XRդ6.g6z7 2qtS8fÜޝ2zggV}(B²|[ays'ǵfYik+,o7qqϛЫ,7dp9eF:N ƥM A: :i0kR}vXWr 8m)FCNm};Wt\l{ϩAsendstream endobj 1504 0 obj << /Type /XRef /Length 882 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 1505 /ID [<2c7d7877334b26fb3238e6b90f5b0273><4fce56c8f707a9ee3033a733b7f66f00>] >> stream xYHTQ{玎`"IEVCюQF$E*fe۾PDDmTD6YcFEYQId4wKDLJ|?%f_ M?f>)VHy~w/e慣.z.>rQmvwe+U_.mEE]]\TѦ]EuEe40jBHSh=F$&R>ކ~(C-+iW+=P~N\a` 3ȩA{W=Ec+soLb%Ș'iH|oD2'fh*,:!vw䄣ZT*'Qm6qN@MK -^%?̦v*GS4+ >$g*Il3{i-vxꧼB&VOY'_Ծl沖ه3>ߏlw.j3 A"Vvk ڽ_2/8<1ɭaĭ ~4S ͎AZn(k I+{{ N "1د臮vNIfG ]a1鉮bwd[+q:tgiG!Ҏ"1&~kS6Kc܃r( JwDl"_Ỷu[@]݌'|v' =ة'mbdX_Q<~ۑc<'e~7yAZ>?~09ydcmoGHo'#n{ :dUVe~%&D&Vq{m R3#x8ȴh݉~F~8MׇO&[Sk'Ȉzzvw5+hizwѼ//jΝ endstream endobj startxref 487522 %%EOF LaplacesDemon/build/0000755000176200001440000000000015145054161014062 5ustar liggesusersLaplacesDemon/build/vignette.rds0000644000176200001440000000042315145054161016420 0ustar liggesusersRMO0 I  #P\֕*imǡ4.M?߳c!p;quWtM\5Ĝ#LA=5 ]> +$+",Crrl+lk_wXsq[ oNG/Ā[Y 8qK'5,//NȾV؂S6-w5,Up})uٲd_tu=(PD\PAhS b?fLaplacesDemon/build/partial.rdb0000644000176200001440000002431215145054146016214 0ustar liggesusers}{wֶ R}m`5%@bR $86NiϩٲlF)ws8?}הlYd+b4[BZ~sk_d2 ؽQ&s=+OfNsyuS2TI2ڔ!ɻRf2'N׶T{|RX L٤~/___UJBENhr?N͆ʍRMfBN۬N-[É*~}JWo,n"۾?ma8&i 5$BM+gr3?MӯgN`׍ʋFPvL?z2TG66suIE-(!C{JDjWC0iZ\BK <пBokI(w;mW}t ;+tq= qF\'r6`-(=T]O$IV~2PEi3%hVWi$_HHĉ/\6)p[Bʲ7RH>JN" ?ӧ$Z//j]ĥĪ$eNO0/NQN!`G{5ؘ)zо89|IϦTIJ1)A@Hfk-—ƮNIRď4dyb9_&&.'ZuNrr2YN9'r K3S쏑3hWژ(#&%gtH@L1JjgJ9`)942YJ n~HTV V 2nGeqk3rT{don1 -XHMI Bw`D'VN&#$#dZnzDm/" Sf"pq#ѤǤp)nu ih[к1ID\Τۺ$32/3Q%Ĥ p%e?4\\AKe~c\^;|yIw*p531XΗ%&FAkHõpmnr -—ɺK9OOSSR)d)4؎,L3 Y,3434_&,)sdL[Y訤 R@,++@)2`YezTʗH '_"_61ɗhLR1Y ,yLUR*C0FY  +ב _&ʈJܑ4;7p\/Nn`9_~ҫIԨrIQDlb b@&ۨIɖcB i?rZR8n9 qKUB&ʤ۪|L|h/mUeR摈2D(FV/  tG p/Z("!ϐgtӰgij@ӰghL6 CgQ7{T3Gœ򗑉唝eX,Q2Yg#^b%| r|$J@&;yyO*RI7"U _&F׹֐2uא/_C[esF5P4ALb֑L@u$dݓi%D!j#}b˟h#:ZRtyg߈2h5'=/qV/.ajRQmkT&-˼ٺZsss5k*'^|#RZ^Fh ~B$zjJDXɽ^7TjS5ku٤dIڧ4UIC3]ծTދuL6kmf#XD[ U5Uy$jimPο&|[οj&3lkI1@ΆK\~>HskH$"av ıViH&>+DaMx_ȴȄE)yVK54 @Re;KxkK(+)A"}leܿ"/1r(r_8/%niˏXž쉰vj,흍/||..y "4I:Q/Gh['.GPT5&M}6R.GtvVȪ+Z?M.' mQ85ݴ˻D0xK܆&غ\J<{ΤMޒLi W:SNJd3fdO| <*Fm(Jlՠ5TErjktmv z"S4?3^4 S L\sTLNlӱ9WlvL}O 8 p# g ^X&L*AA#v<ǂ"O:X4֦:w hS&i4:DÏFV".o%GP%rJSdLruc6\ g z9_1?LyU4@&L~ cuC7cS 8NL[ؕ;M\86S-!hgNJcFԊu]DS6K6Zvcqd9&58rdkcsb͍ʋqR*l[)IͶ k.2a,o G"%Zcq-9,cN٠GƜ]A`Ur#F.MB‹5\|D6j\%+0ȯ]@[ .0}(ӚW]Oֵ(%!j4J:\A xo5BAqkR ~J8<&dWmILF68;aO[ dE9`2*Y@֙CʺQ.*(IWxkSd~s-:?!{@{3f/;o)} -5 &[NT}NjKᎿVO&tݶlS2?(԰%M[Lju]t75*" ^ =ƻ!Zn,Da!%|V'gуWɤ2oZ@x'm'[I})\ڔ;ʹ._٪VT;: xB٤{⭡"X'^-4C0u`qqMq?Ul`"p[̳qtnTb:Y%L* SwjL@MrT-uUya:wݑ># zXb}Fdc3oC[;t!&s[Aj}Rސ̰ۦn|x潸NK#=uGdONQ6tO߱G3 -ވXB:(?N\3*O|PhŋibwL\(U щq쳩\Vf jMdN|l6}fTMm^;x1M-pp5[Cyl犫at&Ճnf%11CJg@rcЋ8S'JUnĭlg:?,wcxL)w>A ja<eh:VwxFdL+ѓRu5W{j To]e"ִ&[\W";~pas[l6|Mw1mױc*bJw^~k+zd )VdmG^3f q8fކ;0aRV"ppYWVv<'ߴ/iU(@ь%x$D=;A)1 >Z#֋bVV2 *Y9E<(i o>Ww /~``.9viNRuKI-q40y,'>rpiw_J7d9t%~g}a%{6Lݠuڂ>-5 RL~׹e5WY}ɲw\=f[`nef@Н0TnQ}6|?ω2rʳ)KfyҪil3 NUxO0&0>*HM+!E*^w;؁d|6BszA BgGkX.!~ kу#uQ܎rm1ԘoS4 w~e/&NOzE1\e?Q>ʀP[i?T3+Ú:*DlтB ҥ/ʝK84Aw\$©S"}k@]DG@'ĀߑE oMA>A#7nq"iD/ 0@neooPfG[ ʯy] ~=^ݽǵCWխξjƲǕWٝ eJOniw]xY!UA0 =Yzٓ^ٍfsǢf7 I=Nŀ뒹1=%E')~( |+nOY YQ V K}2ҦJ?QrQu_vQfkb-Ӓzk-f-w|Mῦ&*ҒE6' 7xgt_EW*"]6bQ2%-k.aZ#{̆d׏wQgrOoAI6$yWR4YujEj;E*M+V&}j }k2.m{rgɛt$i;!fs?7uޔT}YI>euܣ0I4yѝ]T\tij79DClOِTvGz'GbKI:>͙i$>25ڟ[h IMkMlW oV|l5-Z6q ˑkЄ,;fiS?KJ~/£Rlu*$'M$I\$& B9ޯ`jmXs\'N9A:=ko:%T /pEߌBp(q; TEe2ASm^ac!Hp^b&} z Sk}ےS.D oJp[0[T͔!Yiy`Yi9y}2ޚHŁQ]T`hP qoIX̥Ŏ#8?#qq rђByZw{g(qJ+Jɀĭu_8wĭG[³JE05;HּLr?Tw\Ay5ݜg{Jak1_x^ybg%>.!EWpr.ɥ}&r557ZEӽB1mƋ&hɞ$y$( W cg睏_e$0@S u $Q;eP5x{Ft,{nwAyd4E/ )0[B֩Y4ƳHos\U]5%lh`JȲ1piE$j$ ^PY屈78#O 'U3.)2 ä \]~<֖vLxɐ/ڟj͑tD;D[CIgyS?H6zF[D O-ܻצs~0ـ^4ߺ0-(1R0Nt< %n ogP~$Fhifj7X /-n) q۬{&IHXt]Ma?In]Ug%[*eN]YK;Pp4 $L%NE^j(x2ThO7h{ 8QaU*^ 9Qv QK6Y9xB%M# )֎$ْ-ꎩ_nFxc%OHI7Bw8_j5_U4cu Vk~xaN병ʺtV޵oh2B׳lWQWm+rѐڌ듈d]pe\BڐT'x 1;O2N5mc* <*KvB5cQ*9=ϗxxs5}XnKH#8URbAp8rs+~3(9A:CհtP}fQ G)IfՁ[_TTwvEF!v;qhY5})F3`;YR*AF4.l] B {L Tf>h m~O񶨣):[uGD̍(oE;T*`%x?N Ivʓ\;j&PRuǔ߇T.GD. &Q*UCJaik\Ien[Yo-(p>bK־ !ܡ@:Qjki0p[>(-OWRên]]`ߐϻt Svc1i iZeP_x1_2?Nz'OOf#pC2>Z⯷ǛMndeqݪslJ~nVz?+WV VޕOs%uQs־#K, _Z&k<8\'sF-7ОyP}G^?x;z> v~Xh .;ӏ>3yQx܁]ƾG"cθ]*p6fwpvab|:Үu|O[F{ԣK)_~ֻ_c;H޽v"tzxOGKeV$Paa?EPbzUHxmUލOI=Be"tcst'AvJG ș}- /ܞNpla[-p!ܰkg^BAnV"&]D/|p!QZ}iC[xKՅi0} pt u@a #"jG ᱄Qä!Y|?c FuQ?!LaplacesDemon/man/0000755000176200001440000000000015144337635013547 5ustar liggesusersLaplacesDemon/man/summary.laplace.ppc.Rd0000755000176200001440000004044015144316355017715 0ustar liggesusers\name{summary.laplace.ppc} \alias{summary.laplace.ppc} \title{Posterior Predictive Check Summary} \description{ This may be used to summarize either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}). Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is summarized, depending on \code{\link{predict.laplace}}. } \usage{\method{summary}{laplace.ppc}(object, Categorical, Rows, Discrep, d, Quiet, \dots)} \arguments{ \item{object}{An object of class \code{laplace.ppc} is required.} \item{Categorical}{Logical. If \code{TRUE}, then \code{y} and \code{yhat} are considered to be categorical (such as y=0 or y=1), rather than continuous.} \item{Rows}{An optional vector of row numbers, for example \code{c(1:10)}. All rows will be estimated, but only these rows will appear in the summary.} \item{Discrep}{A character string indicating a discrepancy test. \code{Discrep} defaults to \code{NULL}. Valid character strings when \code{y} is continuous are: \code{"Chi-Square"}, \code{"Chi-Square2"}, \code{"Kurtosis"}, \code{"L-criterion"}, \code{"MASE"}, \code{"MSE"}, \code{"PPL"}, \code{"Quadratic Loss"}, \code{"Quadratic Utility"}, \code{"RMSE"}, \code{"Skewness"}, \code{"max(yhat[i,]) > max(y)"}, \code{"mean(yhat[i,]) > mean(y)"}, \code{"mean(yhat[i,] > d)"}, \code{"mean(yhat[i,] > mean(y))"}, \code{"min(yhat[i,]) < min(y)"}, \code{"round(yhat[i,]) = d"}, and \code{"sd(yhat[i,]) > sd(y)"}. Valid character strings when \code{y} is categorical are: \code{"p(yhat[i,] != y[i])"}. Kurtosis and skewness are not discrepancies, but are included here for convenience.} \item{d}{This is an optional integer to be used with the \code{Discrep} argument above, and it defaults to \code{d=0}.} \item{Quiet}{This logical argument defaults to \code{FALSE} and will print results to the console. When \code{TRUE}, results are not printed.} \item{\dots}{Additional arguments are unused.} } \details{ This function summarizes an object of class \code{laplace.ppc}, which consists of posterior predictive checks on either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]}, depending respectively on whether unobserved instances of \eqn{\textbf{y}}{y} or the model sample of \eqn{\textbf{y}}{y} was used in the \code{\link{predict.laplace}} function. The deviance and monitored variables are also summarized. The purpose of a posterior predictive check is to assess how well (or poorly) the model fits the data, or to assess discrepancies between the model and the data. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. When \eqn{\textbf{y}}{y} is continuous and known, this function estimates the predictive concordance between \eqn{\textbf{y}}{y} and \eqn{\textbf{y}^{rep}}{y[rep]} as per Gelfand (1996), and the predictive quantile (PQ), which is for record-level outlier detection used to calculate Gelfand's predictive concordance. When \eqn{\textbf{y}}{y} is categorical and known, this function estimates the record-level lift, which is \code{p(yhat[i,] = y[i]) / [p(y = j) / n]}, or the number of correctly predicted samples over the rate of that category of \eqn{\textbf{y}}{y} in vector \eqn{\textbf{y}}{y}. A discrepancy measure is an approach to studying discrepancies between the model and data (Gelman et al., 1996). Below is a list of discrepancy measures, followed by a brief introduction to discrepancy analysis: \itemize{ \item The \code{"Chi-Square"} discrepancy measure is the chi-square goodness-of-fit test that is recommended by Gelman. For each record i=1:N, this returns (y[i] - E(y[i]))^2 / var(yhat[i,]). \item The \code{"Chi-Square2"} discrepancy measure returns the following for each record: Pr(chisq.rep[i,] > chisq.obs[i,]), where chisq.obs[i,] <- (y[i] - E(y[i]))^2 / E(y[i]), and chisq.rep[i,] <- (yhat[i,] - E(yhat[i,]))^2 / E(yhat[i,]), and the overall discrepancy is the percent of records that were outside of the 95\% quantile-based probability interval (see \code{\link{p.interval}}). \item The \code{"Kurtosis"} discrepancy measure returns the kurtosis of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding kurtotic replicate distributions. \item The \code{"L-criterion"} discrepancy measure of Laud and Ibrahim (1995) provides the record-level combination of two components (see below), and the discrepancy statistic is the sum, \code{L}, as well as a calibration number, \code{S.L}. For more information on the L-criterion, see the accompanying vignette entitled "Bayesian Inference". \item The \code{"MASE"} (Mean Absolute Scaled Error) is a discrepancy measure for the accuracy of time-series forecasts, estimated as \code{(|y - yhat|) / mean(abs(diff(y)))}. The discrepancy statistic is the mean of the record-level values. \item The \code{"MSE"} (Mean Squared Error) discrepancy measure provides the MSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level MSEs. MSE and quadratic loss are identical. \item The \code{"PPL"} (Posterior Predictive Loss) discrepancy measure of Gelfand and Ghosh (1998) provides the record-level combination of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The \code{d=0} argument applies the following weight to the accuracy component, which is then added to the variance component: \eqn{d/(d+1)}. For \eqn{\textbf{y}^{new}}{y[new]}, use \eqn{d=0}. For \eqn{\textbf{y}^{rep}}{y[rep]} and model comparison, \eqn{d} is commonly set to 1, 10, or 100000. Larger values of \eqn{d} put more stress on fit and downgrade the precision of the estimates. \item The \code{"Quadratic Loss"} discrepancy measure provides the mean quadratic loss for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic losses. Quadratic loss and MSE are identical, and quadratic loss is the negative of quadratic utility. \item The \code{"Quadratic Utility"} discrepancy measure provides the mean quadratic utility for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic utilities. Quadratic utility is the negative of quadratic loss. \item The \code{"RMSE"} (Root Mean Squared Error) discrepancy measure provides the RMSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level RMSEs. \item The \code{"Skewness"} discrepancy measure returns the skewness of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding skewed replicate distributions. \item The \code{"max(yhat[i,]) > max(y)"} discrepancy measure returns a record-level indicator when a record's maximum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} exceeds the maximum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications that exceed the maximum of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,]) > mean(y)"} discrepancy measure returns a record-level indicator when the mean of a record's \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is greater than the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with mean replications that exceed the mean of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,] > d)"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds a specified value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"mean(yhat[i,] > mean(y))"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"min(yhat[i,]) < min(y)"} discrepancy measure returns a record-level indicator when a record's minimum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is less than the minimum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications less than the minimum of \eqn{\textbf{y}}{y}. \item The \code{"round(yhat[i,]) = d"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that, when rounded, is equal to a specified discrete value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"sd(yhat[i,]) > sd(y)"} discrepancy measure returns a record-level indicator when the standard deviation of replicates is larger than the standard deviation of all of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with larger standard deviations than \eqn{\textbf{y}}{y}. \item The \code{"p(yhat[i,] != y[i])"} discrepancy measure returns the record-level probability that \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is not equal to \eqn{\textbf{y}}{y}. This is valid when \eqn{\textbf{y}}{y} is categorical and \code{yhat} is the predicted category. The probability is the proportion of replicates. } After observing a discrepancy statistic, the user attempts to improve the model by revising the model to account for discrepancies between data and the current model. This approach to model revision relies on an analysis of the discrepancy statistic. Given a discrepancy measure that is based on model fit, such as the L-criterion, the user may correlate the record-level discrepancy statistics with the dependent variable, independent variables, and interactions of independent variables. The discrepancy statistic should not correlate with the dependent and independent variables. Interaction variables may be useful for exploring new relationships that are not in the current model. Alternatively, a decision tree may be applied to the record-level discrepancy statistics, given the independent variables, in an effort to find relationships in the data that may be helpful in the model. Model revision may involve the addition of a finite mixture component to account for outliers in discrepancy, or specifying the model with a distribution that is more robust to outliers. There are too many suggestions to include here, and discrepancy analysis varies by model. } \value{ This function returns a list with the following components: \item{BPIC}{The Bayesian Predictive Information Criterion (BPIC) was introduced by Ando (2007). BPIC is a variation of the Deviance Information Criterion (DIC) that has been modified for predictive distributions. For more information on DIC (Spiegelhalter et al., 2002), see the accompanying vignette entitled "Bayesian Inference". \eqn{BPIC = Dbar + 2pD}. The goal is to minimize BPIC.} \item{Concordance}{This is the percentage of the records of y that are within the 95\% quantile-based probability interval (see \code{\link{p.interval}}) of \eqn{\textbf{y}^{rep}}{y[rep]}. Gelfand's suggested goal is to achieve 95\% predictive concordance. Lower percentages indicate too many outliers and a poor fit of the model to the data, and higher percentages may suggest overfitting. Concordance occurs only when \eqn{\textbf{y}}{y} is continuous.} \item{Mean Lift}{This is the mean of the record-level lifts, and occurs only when \eqn{\textbf{y}}{y} is specified as categorical with \code{Categorical=TRUE}.} \item{Discrepancy.Statistic}{This is only reported if the \code{Discrep} argument receives a valid discrepancy measure as listed above. The \code{Discrep} applies to each record of \eqn{\textbf{y}}{y}, and the \code{Discrepancy.Statistic} reports the results of the discrepancy measure on the entire data set. For example, if \code{Discrep="min(yhat[i,]) < min(y)"}, then the overall result is the proportion of records in which the minimum sample of yhat was less than the overall minimum \eqn{\textbf{y}}{y}. This is \code{Pr(min(yhat[i,]) < min(y) | y, Theta)}, where \code{Theta} is the parameter set.} \item{L-criterion}{The L-criterion (Laud and Ibrahim, 1995) was developed for model and variable selection. It is a sum of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The L-criterion measures model performance with a combination of how close its predictions are to the observed data and variability of the predictions. Better models have smaller values of \code{L}. \code{L} is measured in the same units as the response variable, and measures how close the data vector \eqn{\textbf{y}}{y} is to the predictive distribution. In addition to the value of \code{L}, there is a value for \code{S.L}, which is the calibration number of \code{L}, and is useful in determining how much of a decrease is necessary between models to be noteworthy.} \item{Monitor}{This is a \eqn{N \times 5}{N x 5} matrix, where \eqn{N} is the number of monitored variables and there are 5 columns, as follows: Mean, SD, LB (the 2.5\% quantile), Median, and UB (the 97.5\% quantile).} \item{Summary}{When \eqn{\textbf{y}}{y} is continuous, this is a \eqn{N \times 8}{N x 8} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and there are 8 columns, as follows: y, Mean, SD, LB (the 2.5\% quantile), Median, UB (the 97.5\% quantile), PQ (the predictive quantile, which is \eqn{Pr(\textbf{y}^{rep} \ge \textbf{y})}{Pr(y[rep] >= y)}), and Test, which shows the record-level result of a test, if specified. When \eqn{\textbf{y}}{y} is categorical, this matrix has a number of columns equal to the number of categories of \eqn{\textbf{y}}{y} plus 3, also including \code{y}, \code{Lift}, and \code{Discrep}.} } \references{ Ando, T. (2007). "Bayesian Predictive Information Criterion for the Evaluation of Hierarchical Bayesian and Empirical Bayes Models". \emph{Biometrika}, 94(2), p. 443--458. Gelfand, A. (1996). "Model Determination Using Sampling Based Methods". In Gilks, W., Richardson, S., Spiegehalter, D., Chapter 9 in Markov Chain Monte Carlo in Practice. Chapman and Hall: Boca Raton, FL. Gelfand, A. and Ghosh, S. (1998). "Model Choice: A Minimum Posterior Predictive Loss Approach". \emph{Biometrika}, 85, p. 1--11. Gelman, A., Meng, X.L., and Stern H. (1996). "Posterior Predictive Assessment of Model Fitness via Realized Discrepancies". \emph{Statistica Sinica}, 6, p. 733--807. Laud, P.W. and Ibrahim, J.G. (1995). "Predictive Model Selection". \emph{Journal of the Royal Statistical Society}, B 57, p. 247--262. Spiegelhalter, D.J., Best, N.G., Carlin, B.P., and van der Linde, A. (2002). "Bayesian Measures of Model Complexity and Fit (with Discussion)". \emph{Journal of the Royal Statistical Society}, B 64, p. 583--639. } \author{Statisticat, LLC.} \seealso{ \code{\link{LaplaceApproximation}}, \code{\link{predict.laplace}}, and \code{\link{p.interval}}. } \examples{### See the LaplaceApproximation function for an example.} \keyword{BPIC} \keyword{Chi-Square} \keyword{Kurtosis} \keyword{L-criterion} \keyword{MASE} \keyword{MSE} \keyword{Posterior Predictive Checks} \keyword{Posterior Predictive Loss} \keyword{Quadratic Loss} \keyword{Quadratic Utility} \keyword{RMSE} \keyword{Skewness} \keyword{summary} LaplacesDemon/man/data.demontexas.Rd0000755000176200001440000000660715144346364017130 0ustar liggesusers\name{data.demontexas} \alias{demontexas} \title{Demon Space-Time Data Set} \usage{data(demontexas)} \description{ This data set is for space-time models that require latitude and longitude, or coordinates. This data set consists of the minimum, mean, and maximum temperatures in Texas for 13 months. } \format{ This data frame contains 369 rows of sites in Texas and 43 columns. The following data dictionary describes each variable or column. \describe{ \item{\code{Elevation}}{This is the elevation of the site.} \item{\code{Latitude}}{This is the latitude of the site.} \item{\code{Longitude}}{This is the longitude of the site.} \item{\code{Gulf}}{This is a gulf indicator of the site.} \item{\code{Max1}}{This is the maximum temperature in month 1.} \item{\code{Max2}}{This is the maximum temperature in month 2.} \item{\code{Max3}}{This is the maximum temperature in month 3.} \item{\code{Max4}}{This is the maximum temperature in month 4.} \item{\code{Max5}}{This is the maximum temperature in month 5.} \item{\code{Max6}}{This is the maximum temperature in month 6.} \item{\code{Max7}}{This is the maximum temperature in month 7.} \item{\code{Max8}}{This is the maximum temperature in month 8.} \item{\code{Max9}}{This is the maximum temperature in month 9.} \item{\code{Max10}}{This is the maximum temperature in month 10.} \item{\code{Max11}}{This is the maximum temperature in month 11.} \item{\code{Max12}}{This is the maximum temperature in month 12.} \item{\code{Max13}}{This is the maximum temperature in month 13.} \item{\code{Mean1}}{This is the mean temperature in month 1.} \item{\code{Mean2}}{This is the mean temperature in month 2.} \item{\code{Mean3}}{This is the mean temperature in month 3.} \item{\code{Mean4}}{This is the mean temperature in month 4.} \item{\code{Mean5}}{This is the mean temperature in month 5.} \item{\code{Mean6}}{This is the mean temperature in month 6.} \item{\code{Mean7}}{This is the mean temperature in month 7.} \item{\code{Mean8}}{This is the mean temperature in month 8.} \item{\code{Mean9}}{This is the mean temperature in month 9.} \item{\code{Mean10}}{This is the mean temperature in month 10.} \item{\code{Mean11}}{This is the mean temperature in month 11.} \item{\code{Mean12}}{This is the mean temperature in month 12.} \item{\code{Mean13}}{This is the mean temperature in month 13.} \item{\code{Min1}}{This is the minimum temperature in month 1.} \item{\code{Min2}}{This is the minimum temperature in month 2.} \item{\code{Min3}}{This is the minimum temperature in month 3.} \item{\code{Min4}}{This is the minimum temperature in month 4.} \item{\code{Min5}}{This is the minimum temperature in month 5.} \item{\code{Min6}}{This is the minimum temperature in month 6.} \item{\code{Min7}}{This is the minimum temperature in month 7.} \item{\code{Min8}}{This is the minimum temperature in month 8.} \item{\code{Min9}}{This is the minimum temperature in month 9.} \item{\code{Min10}}{This is the minimum temperature in month 10.} \item{\code{Min11}}{This is the minimum temperature in month 11.} \item{\code{Min12}}{This is the minimum temperature in month 12.} \item{\code{Min13}}{This is the minimum temperature in month 13.} } } \source{\url{https://users.stat.ufl.edu/~winner/datasets.html}} \keyword{datasets} LaplacesDemon/man/data.demonfx.Rd0000755000176200001440000000647415144346337016423 0ustar liggesusers\name{data.demonfx} \alias{demonfx} \title{Demon FX Data Set} \usage{data(demonfx)} \description{ This data set consists of daily currency pair prices from 2010 through 2014. Each currency pair has a close, high, and low price. } \format{ This data frame contains 1,301 rows as time-periods (with row names) and 39 columns of currency pair prices. The following data dictionary describes each time-series or column. \describe{ \item{\code{EURUSD.Close}}{This is the currency pair closing price.} \item{\code{EURUSD.High}}{This is the currency pair high price.} \item{\code{EURUSD.Low}}{This is the currency pair low price.} \item{\code{USDJPY.Close}}{This is the currency pair closing price.} \item{\code{USDJPY.High}}{This is the currency pair high price.} \item{\code{USDJPY.Low}}{This is the currency pair low price.} \item{\code{USDCHF.Close}}{This is the currency pair closing price.} \item{\code{USDCHF.High}}{This is the currency pair high price.} \item{\code{USDCHF.Low}}{This is the currency pair low price.} \item{\code{GBPUSD.Close}}{This is the currency pair closing price.} \item{\code{GBPUSD.High}}{This is the currency pair high price.} \item{\code{GBPUSD.Low}}{This is the currency pair low price.} \item{\code{USDCAD.Close}}{This is the currency pair closing price.} \item{\code{USDCAD.High}}{This is the currency pair high price.} \item{\code{USDCAD.Low}}{This is the currency pair low price.} \item{\code{EURGBP.Close}}{This is the currency pair closing price.} \item{\code{EURGBP.High}}{This is the currency pair high price.} \item{\code{EURGBP.Low}}{This is the currency pair low price.} \item{\code{EURJPY.Close}}{This is the currency pair closing price.} \item{\code{EURJPY.High}}{This is the currency pair high price.} \item{\code{EURJPY.Low}}{This is the currency pair low price.} \item{\code{EURCHF.Close}}{This is the currency pair closing price.} \item{\code{EURCHF.High}}{This is the currency pair high price.} \item{\code{EURCHF.Low}}{This is the currency pair low price.} \item{\code{AUDUSD.Close}}{This is the currency pair closing price.} \item{\code{AUDUSD.High}}{This is the currency pair high price.} \item{\code{AUDUSD.Low}}{This is the currency pair low price.} \item{\code{GBPJPY.Close}}{This is the currency pair closing price.} \item{\code{GBPJPY.High}}{This is the currency pair high price.} \item{\code{GBPJPY.Low}}{This is the currency pair low price.} \item{\code{CHFJPY.Close}}{This is the currency pair closing price.} \item{\code{CHFJPY.High}}{This is the currency pair high price.} \item{\code{CHFJPY.Low}}{This is the currency pair low price.} \item{\code{GBPCHF.Close}}{This is the currency pair closing price.} \item{\code{GBPCHF.High}}{This is the currency pair high price.} \item{\code{GBPCHF.Low}}{This is the currency pair low price.} \item{\code{NZDUSD.Close}}{This is the currency pair closing price.} \item{\code{NZDUSD.High}}{This is the currency pair high price.} \item{\code{NZDUSD.Low}}{This is the currency pair low price.} } } \source{Originally downloaded from a database that is not available anymore. See: \url{https://web.archive.org/web/20150222115543/https://www.global-view.com/forex-trading-tools/forex-history/index.html}} \keyword{datasets} LaplacesDemon/man/Importance.Rd0000755000176200001440000002357415144316355016151 0ustar liggesusers\name{Importance} \alias{Importance} \title{Variable Importance} \description{ The \code{Importance} function considers variable importance (or predictor importance) to be the effect that the variable has on replicates \eqn{\textbf{y}^{rep}}{y^rep} (or \eqn{\textbf{Y}^{rep}}{Y^rep}) when the variable is removed from the model by setting it equal to zero. Here, variable importance is considered in terms of the comparison of posterior predictive checks. This may be considered to be a form of sensitivity analysis, and can be useful for model revision, variable selection, and model interpretation. Currently, this function only tests the variable importance of design matrix \eqn{\textbf{X}}{X}. } \usage{ Importance(object, Model, Data, Categorical=FALSE, Discrep, d=0, CPUs=1, Type="PSOCK") } \arguments{ \item{object}{An object of class \code{demonoid}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb} is required.} \item{Model}{The model specification function is required.} \item{Data}{A data set in a list is required. The dependent variable is required to be named either \code{y} or \code{Y}. The \code{Importance} function will sequentially remove each column vector in \code{X}, so \code{X} is required to be in data set \code{Data}.} \item{Categorical}{Logical. If \code{TRUE}, then \code{y} and \code{yhat} are considered to be categorical (such as y=0 or y=1), rather than continuous. This defaults to \code{FALSE}.} \item{Discrep}{This optional argument allows a discrepancy statistic to be included. For more information on discrepancy statistics, see \code{\link{summary.demonoid.ppc}}.} \item{d}{This is an optional integer to be used with the \code{Discrep} argument above, and it defaults to \code{d=0}. For more information on discrepancy, see \code{\link{summary.demonoid.ppc}}.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} } \details{Variable importance is defined here as the impact of each variable (predictor, or column vector) in design matrix \eqn{\textbf{X}}{X} on \eqn{\textbf{y}^{rep}}{y^rep} (or \eqn{\textbf{Y}^{rep}}{Y^rep}), when the variable is removed. First, the full model is predicted with the \code{\link{predict.demonoid}}, \code{\link{predict.iterquad}}, \code{\link{predict.laplace}}, \code{\link{predict.pmc}}, or \code{\link{predict.vb}} function, and summarized with the \code{\link{summary.demonoid.ppc}}, \code{\link{summary.iterquad.ppc}}, \code{\link{summary.laplace.ppc}}, \code{\link{summary.pmc.ppc}}, or \code{\link{summary.vb.ppc}} function, respectively. The results are stored in the first row of the output. Each successive row in the output corresponds to the application of \code{predict} and \code{summary} functions, but with each variable in design matrix \eqn{\textbf{X}}{X} being set to zero and effectively removed. The results show the impact of sequentially removing each predictor. The criterion for variable importance may differ from model to model. As a default, BPIC is recommended. The Bayesian Predictive Information Criterion (BPIC) was introduced by Ando (2007). BPIC is a variation of the Deviance Information Criterion (DIC) that has been modified for predictive distributions. For more information on DIC (Spiegelhalter et al., 2002), see the accompanying vignette entitled "Bayesian Inference". \eqn{BPIC = Dbar + 2pD}. With BPIC, variable importance has a positive relationship, such that larger values indicate a more important variable, because removing that variable resulted in a worse fit to the data. The best model has the lowest BPIC. In a model in which the dependent variable is not categorical, it is also recommended to consider the L-criterion (Laud and Ibrahim, 1995), provided that sample size is small enough that it does not result in \code{Inf}. For more information on the L-criterion, see the accompanying vignette entitled "Bayesian Inference". With the L-criterion, variable importance has a positive relationship, such that larger values indicate a more important variable, because removing that variable resulted in a worse fit to the data. Ibrahim (1995) recommended considering the model with the lowest L-criterion, say as \eqn{L_1}{L[1]}, and the model with the closest L-criterion, say as \eqn{L_2}{L[2]}, and creating a comparison score as \eqn{\phi = (L_2-L_1)/S_L}{phi = (L[2]-L[1])/S[L]}, where \code{S.L} is from the \eqn{L_1}{L[1]} model. If the comparison score, \eqn{\phi}{phi} is less than 2, then \eqn{L_2}{L[2]} is within 2 standard deviations of \eqn{L_1}{L[1]}, and is the recommended cut-off for model choice. The \code{Importance} function may suggest that a model fits the data better with a variable removed. In which case, the user may choose to leave the variable in the model (perhaps the model is misspecified without the variable), investigate and possibly re-specify the relationship between the independent and dependent variable(s), or remove the variable and update the model again. In contrast to variable importance, the \code{\link{PosteriorChecks}} function calculates parameter importance, which is the probability that each parameter's marginal posterior distribution is greater than zero, where an important parameter does not include zero in its probability interval (see \code{\link{p.interval}}). Parameter importance and variable importance may disagree, and both should be studied. The \code{Importance} function tends to indicate that a model fits the data better when variables are removed that have parameters with marginal posterior distributions that include 0 in the 95\% probability interval (variables associated with lower parameter importance). Often, in complicated models, it is difficult to assess variable importance by examining the marginal posterior distribution of the associated parameter(s). Consider polynomial regression, in which each variable may have multiple parameters. The information provided by the \code{Importance} function may be used for model revision, or reporting the relative importance of variables. The \code{\link{plot.importance}} function is available to plot the output of the \code{Importance} function according to BPIC, predictive concordance (Gelfand, 1996), the selected discrepancy statistic (Gelman et al., 1996), or the L-criterion. Parallel processing may be performed when the user specifies \code{CPUs} to be greater than one, implying that the specified number of CPUs exists and is available. Parallelization may be performed on a multicore computer or a computer cluster. Either a Simple Network of Workstations (SNOW) or Message Passing Interface is used (MPI). With small data sets and few samples, parallel processing may be slower, due to computer network communication. With larger data sets and more samples, the user should experience a faster run-time. } \value{ \code{Importance} returns an object of class \code{importance}, which is a matrix with a number of rows equal to the number of columns in design matrix \eqn{\textbf{X}}{X} + 1 (including the full model), and 4 columns, which are BPIC, Concordance (or Mean.Lift if categorical), Discrep, and L-criterion. Each row represents a model with a predictor in \eqn{\textbf{X}}{X} removed (except for the first row, which is the full model), and the resulting posterior predictive checks. For non-categorical dependent variables, an attribute is returned with the object, and the attribute is a vector of \code{S.L}, the calibration number of the L-criterion. } \references{ Ando, T. (2007). "Bayesian Predictive Information Criterion for the Evaluation of Hierarchical Bayesian and Empirical Bayes Models". \emph{Biometrika}, 94(2), p. 443--458. Gelfand, A. (1996). "Model Determination Using Sampling Based Methods". In Gilks, W., Richardson, S., Spiegehalter, D., Chapter 9 in Markov Chain Monte Carlo in Practice. Chapman and Hall: Boca Raton, FL. Laud, P.W. and Ibrahim, J.G. (1995). "Predictive Model Selection". \emph{Journal of the Royal Statistical Society}, B 57, p. 247--262. Spiegelhalter, D.J., Best, N.G., Carlin, B.P., and van der Linde, A. (2002). "Bayesian Measures of Model Complexity and Fit (with Discussion)". \emph{Journal of the Royal Statistical Society}, B 64, p. 583--639. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{is.importance}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, \code{\link{plot.importance}}, \code{\link{PosteriorChecks}}, \code{\link{p.interval}}, \code{\link{predict.demonoid}}, \code{\link{predict.iterquad}}, \code{\link{predict.laplace}}, \code{\link{predict.pmc}}, \code{\link{predict.vb}}, \code{\link{summary.demonoid.ppc}}, \code{\link{summary.iterquad.ppc}}, \code{\link{summary.laplace.ppc}}, \code{\link{summary.pmc.ppc}}, \code{\link{summary.vb.ppc}}, and \code{\link{VariationalBayes}}. } \examples{ #First, update the model with the LaplacesDemon function, such as #the example with linear regression, creating an object called Fit. #Then #Importance(Fit, Model, MyData, Discrep="Chi-Square", CPUs=1) } \keyword{BPIC} \keyword{High Performance Computing} \keyword{L-criterion} \keyword{Model Selection} \keyword{Posterior Predictive Checks}LaplacesDemon/man/dist.Skew.Laplace.Rd0000755000176200001440000001035115144316355017250 0ustar liggesusers\name{dist.Skew.Laplace} \alias{dslaplace} \alias{pslaplace} \alias{qslaplace} \alias{rslaplace} \title{Skew-Laplace Distribution: Univariate} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate, skew-Laplace distribution with location parameter \eqn{\mu}{mu}, and two mixture parameters: \eqn{\alpha}{alpha} and \eqn{\beta}{beta}. } \usage{ dslaplace(x, mu, alpha, beta, log=FALSE) pslaplace(q, mu, alpha, beta) qslaplace(p, mu, alpha, beta) rslaplace(n, mu, alpha, beta) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mu}{This is the location parameter \eqn{\mu}{mu}.} \item{alpha}{This is a mixture parameter \eqn{\alpha}{alpha}, which must be positive.} \item{beta}{This is a mixture parameter \eqn{\beta}{beta}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density 1: \eqn{p(\theta) = \frac{1}{\alpha + \beta} \exp(\frac{\theta - \mu}{\alpha}), \theta \le \mu}{p(theta) = (1/(alpha+beta)) exp((theta-mu)/alpha), theta <= mu} \item Density 2: \eqn{p(\theta) = \frac{1}{\alpha + \beta} \exp(\frac{\mu - \theta}{\beta}), \theta > \mu}{p(theta) = (1/(alpha+beta)) exp((mu-theta)/beta), theta > mu} \item Inventor: Fieller, et al. (1992) \item Notation 1: \eqn{\theta \sim \mathcal{SL}(\mu, \alpha, \beta)}{theta ~ SL(mu, alpha, beta)} \item Notation 2: \eqn{p(\theta) = \mathcal{SL}(\theta | \mu, \alpha, \beta)}{p(theta) = SL(theta | mu, alpha, beta)} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: mixture parameter \eqn{\alpha > 0}{alpha > 0} \item Parameter 3: mixture parameter \eqn{\beta > 0}{beta > 0} \item Mean: \eqn{E(\theta) = \mu + \beta - \alpha}{E(theta) = mu + beta - alpha} \item Variance: \eqn{var(\theta) = \alpha^2 + \beta^2}{var(theta) = alpha^2 + beta^2} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } This is the three-parameter general skew-Laplace distribution, which is an extension of the two-parameter central skew-Laplace distribution. The general form allows the mode to be shifted along the real line with parameter \eqn{\mu}{mu}. In contrast, the central skew-Laplace has mode zero, and may be reproduced here by setting \eqn{\mu=0}{mu=0}. The general skew-Laplace distribution is a mixture of a negative exponential distribution with mean \eqn{\beta}{beta}, and the negative of an exponential distribution with mean \eqn{\alpha}{alpha}. The weights of the positive and negative components are proportional to their means. The distribution is symmetric when \eqn{\alpha=\beta}{alpha=beta}, in which case the mean is \eqn{\mu}{mu}. These functions are similar to those in the \code{HyperbolicDist} package. } \value{ \code{dslaplace} gives the density, \code{pslaplace} gives the distribution function, \code{qslaplace} gives the quantile function, and \code{rslaplace} generates random deviates. } \references{ Fieller, N.J., Flenley, E.C., and Olbricht, W. (1992). "Statistics of Particle Size Data". \emph{Applied Statistics}, 41, p. 127--146. } \seealso{ \code{\link{dalaplace}}, \code{\link{dexp}}, \code{\link{dlaplace}}, \code{\link{dlaplacep}}, and \code{\link{dsdlaplace}}. } \examples{ library(LaplacesDemon) x <- dslaplace(1,0,1,1) x <- pslaplace(1,0,1,1) x <- qslaplace(0.5,0,1,1) x <- rslaplace(100,0,1,1) #Plot Probability Functions x <- seq(from=0.1, to=3, by=0.01) plot(x, dslaplace(x,0,1,1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dslaplace(x,0,0.5,2), type="l", col="green") lines(x, dslaplace(x,0,2,0.5), type="l", col="blue") legend(1.5, 0.9, expression(paste(mu==0, ", ", alpha==1, ", ", beta==1), paste(mu==0, ", ", alpha==0.5, ", ", beta==2), paste(mu==0, ", ", alpha==2, ", ", beta==0.5)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/dist.Multivariate.Power.Exponential.Rd0000755000176200001440000001071415144316355023030 0ustar liggesusers\name{dist.Multivariate.Power.Exponential} \alias{dmvpe} \alias{rmvpe} \title{Multivariate Power Exponential Distribution} \description{ These functions provide the density and random number generation for the multivariate power exponential distribution. } \usage{ dmvpe(x=c(0,0), mu=c(0,0), Sigma=diag(2), kappa=1, log=FALSE) rmvpe(n, mu=c(0,0), Sigma=diag(2), kappa=1) } \arguments{ \item{x}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{n}{This is the number of random draws.} \item{mu}{This is mean vector \eqn{\mu}{mu} with length \eqn{k} or matrix with \eqn{k} columns.} \item{Sigma}{This is the \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma}.} \item{kappa}{This is the kurtosis parameter, \eqn{\kappa}{kappa}, and must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{k\Gamma(k/2)}{\pi^{k/2} \sqrt{|\Sigma|} \Gamma(1 + k/(2\kappa)) 2^{1 + k/(2\kappa)}} \exp(-\frac{1}{2}(\theta-\mu)^T \Sigma (\theta-\mu))^{\kappa}}{p(theta) = ((k*Gamma(k/2)) / (pi^(k/2) * sqrt(|Sigma|) * Gamma(1 + k/(2*kappa)) * 2^(1 + k/(2*kappa)))) * exp(-(1/2)*(theta-mu)^T Sigma (theta-mu))^kappa} \item Inventor: Gomez, Gomez-Villegas, and Marin (1998) \item Notation 1: \eqn{\theta \sim \mathcal{MPE}(\mu, \Sigma, \kappa)}{theta ~ MPE(mu, Sigma, kappa)} \item Notation 2: \eqn{\theta \sim \mathcal{PE}_k(\mu, \Sigma, \kappa)}{theta ~ PE[k](mu, Sigma, kappa)} \item Notation 3: \eqn{p(\theta) = \mathcal{MPE}(\theta | \mu, \Sigma, \kappa)}{p(theta) = MPE(theta | mu, Sigma, kappa)} \item Notation 4: \eqn{p(\theta) = \mathcal{PE}_k(\theta | \mu, \Sigma, \kappa)}{p(theta) = PE[k](theta | mu, Sigma, kappa)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma} \item Parameter 3: kurtosis parameter \eqn{\kappa}{kappa} \item Mean: \eqn{E(\theta) = }{E(theta) = } \item Variance: \eqn{var(\theta) =}{var(theta) = } \item Mode: \eqn{mode(\theta) = }{mode(theta) = } } The multivariate power exponential distribution, or multivariate exponential power distribution, is a multidimensional extension of the one-dimensional or univariate power exponential distribution. Gomez-Villegas (1998) and Sanchez-Manzano et al. (2002) proposed multivariate and matrix generalizations of the PE family of distributions and studied their properties in relation to multivariate Elliptically Contoured (EC) distributions. The multivariate power exponential distribution includes the multivariate normal distribution (\eqn{\kappa = 1}{kappa = 1}) and multivariate Laplace distribution (\eqn{\kappa = 0.5}{kappa = 0.5}) as special cases, depending on the kurtosis or \eqn{\kappa}{kappa} parameter. A multivariate uniform occurs as \eqn{\kappa \rightarrow \infty}{kappa -> infinity}. If the goal is to use a multivariate Laplace distribution, the \code{dmvl} function will perform faster and more accurately. The \code{rmvpe} function is a modified form of the rmvpowerexp function in the MNM package. } \value{ \code{dmvpe} gives the density and \code{rmvpe} generates random deviates. } \references{ Gomez, E., Gomez-Villegas, M.A., and Marin, J.M. (1998). "A Multivariate Generalization of the Power Exponential Family of Distributions". \emph{Communications in Statistics-Theory and Methods}, 27(3), p. 589--600. Sanchez-Manzano, E.G., Gomez-Villegas, M.A., and Marn-Diazaraque, J.M. (2002). "A Matrix Variate Generalization of the Power Exponential Family of Distributions". \emph{Communications in Statistics, Part A - Theory and Methods} [Split from: J(CommStat)], 31(12), p. 2167--2182. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dlaplace}}, \code{\link{dmvl}}, \code{\link{dmvn}}, \code{\link{dmvnp}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, and \code{\link{dpe}}. } \examples{ library(LaplacesDemon) n <- 100 k <- 3 x <- matrix(runif(n*k),n,k) mu <- matrix(runif(n*k),n,k) Sigma <- diag(k) dmvpe(x, mu, Sigma, kappa=1) X <- rmvpe(n, mu, Sigma, kappa=1) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/plot.importance.Rd0000755000176200001440000000416315144316355017157 0ustar liggesusers\name{plot.importance} \alias{plot.importance} \title{Plot Variable Importance} \description{ This may be used to plot variable importance with BPIC, predictive concordance, a discrepancy statistic, or the L-criterion regarding an object of class \code{importance}. } \usage{\method{plot}{importance}(x, Style="BPIC", \dots)} \arguments{ \item{x}{This required argument is an object of class \code{importance}.} \item{Style}{When \code{Style="BPIC"}, BPIC is shown, and \code{BPIC} is the default. Otherwise, predictive concordance is plotted when \code{Style="Concordance"}, a discrepancy statistic is plotted when \code{Style="Discrep"}, or the L-criterion is plotted when \code{Style="L-criterion"}.} \item{\dots}{Additional arguments are unused.} } \details{ The x-axis is either BPIC (Ando, 2007), predictive concordance (Gelfand, 1996), a discrepancy statistic (Gelman et al., 1996), or the L-criterion (Laud and Ibrahim, 1995) of the \code{\link{Importance}} function (depending on the \code{Style} argument), and variables are on the y-axis. A more important variable is associated with a dot that is plotted farther to the right. For more information on variable importance, see the \code{\link{Importance}} function. } \references{ Ando, T. (2007). "Bayesian Predictive Information Criterion for the Evaluation of Hierarchical Bayesian and Empirical Bayes Models". \emph{Biometrika}, 94(2), p. 443--458. Gelfand, A. (1996). "Model Determination Using Sampling Based Methods". In Gilks, W., Richardson, S., Spiegehalter, D., Chapter 9 in Markov Chain Monte Carlo in Practice. Chapman and Hall: Boca Raton, FL. Gelman, A., Meng, X.L., and Stern H. (1996). "Posterior Predictive Assessment of Model Fitness via Realized Discrepancies". \emph{Statistica Sinica}, 6, p. 733--807. Laud, P.W. and Ibrahim, J.G. (1995). "Predictive Model Selection". \emph{Journal of the Royal Statistical Society}, B 57, p. 247--262. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{Importance}}} \keyword{Plot}LaplacesDemon/man/dist.Normal.Precision.Rd0000755000176200001440000001143615144316355020166 0ustar liggesusers\name{dist.Normal.Precision} \alias{dnormp} \alias{pnormp} \alias{qnormp} \alias{rnormp} \title{Normal Distribution: Precision Parameterization} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate normal distribution with mean \eqn{\mu}{mu} and precision \eqn{\tau}{tau}. } \usage{ dnormp(x, mean=0, prec=1, log=FALSE) pnormp(q, mean=0, prec=1, lower.tail=TRUE, log.p=FALSE) qnormp(p, mean=0, prec=1, lower.tail=TRUE, log.p=FALSE) rnormp(n, mean=0, prec=1) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mean}{This is the mean parameter \eqn{\mu}{mu}.} \item{prec}{This is the precision parameter \eqn{\tau}{tau}, which must be positive.} \item{log, log.p}{Logical. If \code{TRUE}, then probabilities \eqn{p} are given as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{Logical. If \code{TRUE} (default), then probabilities are \eqn{Pr[X \le x]}{Pr[X <= x]}, otherwise, \eqn{Pr[X > x]}{Pr[X > x]}.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \sqrt{\frac{\tau}{2\pi}} \exp(-\frac{\tau}{2} (\theta-\mu)^2)}{p(theta) = sqrt(tau/(2*pi)) * exp(-(tau/2)*(x-mu)^2)} \item Inventor: Carl Friedrich Gauss or Abraham De Moivre \item Notation 1: \eqn{\theta \sim \mathcal{N}(\mu, \tau^{-1})}{theta ~ N(mu, tau^(-1))} \item Notation 2: \eqn{p(\theta) = \mathcal{N}(\theta | \mu, \tau^{-1})}{p(theta) = N(theta | mu, tau^(-1))} \item Parameter 1: mean parameter \eqn{\mu}{mu} \item Parameter 2: precision parameter \eqn{\tau > 0}{tau > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = \tau^{-1}}{var(theta) = tau^(-1)} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The normal distribution, also called the Gaussian distribution and the Second Law of Laplace, is usually parameterized with mean and variance, or in Bayesian inference, with mean and precision, where precision is the inverse of the variance. In contrast, \code{Base R} parameterizes the normal distribution with the mean and standard deviation. These functions provide the precision parameterization for convenience and familiarity. Some authors attribute credit for the normal distribution to Abraham de Moivre in 1738. In 1809, Carl Friedrich Gauss published his monograph ``Theoria motus corporum coelestium in sectionibus conicis solem ambientium'', in which he introduced the method of least squares, method of maximum likelihood, and normal distribution, among many other innovations. Gauss, himself, characterized this distribution according to mean and precision, though his definition of precision differed from the modern one. The modern Bayesian use of precision \eqn{\tau}{tau} developed because it was more straightforward to estimate \eqn{\tau}{tau} with a gamma distribution as a conjugate prior, than to estimate \eqn{\sigma^2}{sigma^2} with an inverse-gamma distribution as a conjugate prior. Although the normal distribution is very common, it often does not fit data as well as more robust alternatives with fatter tails, such as the Laplace or Student t distribution. A flat distribution is obtained in the limit as \eqn{\tau \rightarrow 0}{tau -> 0}. For models where the dependent variable, y, is specified to be normally distributed given the model, the Jarque-Bera test (see \code{\link{plot.demonoid.ppc}} or \code{\link{plot.laplace.ppc}}) may be used to test the residuals. These functions are similar to those in \code{base R}. } \value{ \code{dnormp} gives the density, \code{pnormp} gives the distribution function, \code{qnormp} gives the quantile function, and \code{rnormp} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dlaplace}}, \code{\link{dnorm}}, \code{\link{dnormv}}, \code{\link{prec2var}}, \code{\link{dst}}, \code{\link{dt}}, \code{\link{plot.demonoid.ppc}}, and \code{\link{plot.laplace.ppc}}. } \examples{ library(LaplacesDemon) x <- dnormp(1,0,1) x <- pnormp(1,0,1) x <- qnormp(0.5,0,1) x <- rnormp(100,0,1) #Plot Probability Functions x <- seq(from=-5, to=5, by=0.1) plot(x, dnormp(x,0,0.5), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dnormp(x,0,1), type="l", col="green") lines(x, dnormp(x,0,5), type="l", col="blue") legend(2, 0.9, expression(paste(mu==0, ", ", tau==0.5), paste(mu==0, ", ", tau==1), paste(mu==0, ", ", tau==5)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/Blocks.Rd0000755000176200001440000002400715144316355015255 0ustar liggesusers\name{Blocks} \alias{Blocks} \title{Blocks} \description{ The \code{Blocks} function returns a list of \eqn{N} blocks of parameters, for use with some MCMC algorithms in the \code{\link{LaplacesDemon}} function. Blocks may be created either sequentially, or from a hierarchical clustering of the posterior correlation matrix. } \usage{ Blocks(Initial.Values, N, PostCor=NULL) } \arguments{ \item{Initial.Values}{This required argument is a vector of initial values.} \item{N}{This optional argument indicates the desired number of blocks. If omitted, then the truncated square root of the number of initial values is used. If a posterior correlation matrix is supplied to \code{PostCor}, then \code{N} may be a scalar, or have length two. If \code{N} has length two, then the first element indicates the minimum number of blocks, and the second element indicates the maximum number of blocks, and the number of blocks is the maximum of the mean silhouette width for each hierarchical cluster solution.} \item{PostCor}{This optional argument defaults to \code{NULL}, in which case sequential blocking is performed. If a posterior correlation matrix is supplied, then blocks are created based on hierarchical clustering.} } \details{ Usually, there is more than one target distribution in MCMC, in which case it must be determined whether it is best to sample from target distributions individually, in groups, or all at once. Blockwise sampling (also called block updating) refers to splitting a multivariate vector into groups called blocks, and each block is sampled separately. A block may contain one or more parameters. Parameters are usually grouped into blocks such that parameters within a block are as correlated as possible, and parameters between blocks are as independent as possible. This strategy retains as much of the parameter correlation as possible for blockwise sampling, as opposed to componentwise sampling where parameter correlation is ignored. The \code{\link{PosteriorChecks}} function can be used on the output of previous runs to find highly correlated parameters. See examples below. Advantages of blockwise sampling are that a different MCMC algorithm may be used for each block (or parameter, for that matter), creating a more specialized approach (though different algorithms by block are not supported here), the acceptance of a newly proposed state is likely to be higher than sampling from all target distributions at once in high dimensions, and large proposal covariance matrices can be reduced in size, which is most helpful again in high dimensions. Disadvantages of blockwise sampling are that correlations probably exist between parameters between blocks, and each block is updated while holding the other blocks constant, ignoring these correlations of parameters between blocks. Without simultaneously taking everything into account, the algorithm may converge slowly or never arrive at the proper solution. However, there are instances when it may be best when everything is not taken into account at once, such as in state-space models. Also, as the number of blocks increases, more computation is required, which slows the algorithm. In general, blockwise sampling allows a more specialized approach at the expense of accuracy, generalization, and speed. Blockwise sampling is offered in the following algorithms: Adaptive-Mixture Metropolis (AMM), Adaptive Metropolis-within-Gibbs (AMWG), Automated Factor Slice Sampler (AFSS), Elliptical Slice Sampler (ESS), Hit-And-Run Metropolis (HARM), Metropolis-within-Gibbs (MWG), Random-Walk Metropolis (RWM), Robust Adaptive Metropolis (RAM), Slice Sampler (Slice), and the Univariate Eigenvector Slice Sampler (UESS). Large-dimensional models often require blockwise sampling. For example, with thousands of parameters, a componentwise algorithm must evaluate the model specification function once per parameter per iteration, resulting in an algorithm that may take longer than is acceptable to produce samples. Algorithms that require derivatives, such as the family of Hamiltonian Monte Carlo (HMC), require even more evaluations of the model specification function per iteration, and quickly become too costly in large dimensions. Finally, algorithms with multivariate proposals often have difficulty producing an accepted proposal in large-dimensional models. The most practical solution is to group parameters into \eqn{N} blocks, and each iteration the algorithm evaluates the model specification function \eqn{N} times, each with a reduced set of parameters. The \code{Blocks} function performs either a sequential assignment of parameters to blocks when posterior correlation is not supplied, or uses hierarchical clustering to create blocks based on posterior correlation. If posterior correlation is supplied, then the user may specify a range of the number of blocks to consider, and the optimal number of blocks is considered to be the maximum of the mean silhouette width of each hierarchical clustering. Silhouette width is calculated as per the \code{cluster} package. Hierarchical clustering is performed on the distance matrix calculated from the dissimilarity matrix (1 - abs(PostCor)) of the posterior correlation matrix. With sequential assignment, the number of parameters per block is approximately equal. With hierarchical clustering, the number of parameters per block may vary widely. Creating blocks from hierarchical clustering performs well in practice, though there are many alternative methods the user may consider outside of this function, such as using factor analysis, model-based clustering, or other methods. Aside from sequentially-assigned blocks, or blocks based on posterior correlation, it is also common to group parameters with similar uses, such as putting regression effects parameters into one block, and autocorrelation parameters into another block. Another popular way to group parameters into blocks is by time-period for some time-series models. These alternative blocking strategies are unsupported in the \code{Blocks} function, and best left to user discretion. Some MCMC algorithms that accept blocked parameters also require blocked variance-covariance matrices. The \code{Blocks} function does not return these matrices, because it may not be necessary, or when it is, the user may prefer identity matrices, scaled identity matrices, or matrices with explicitly-defined elements. If the user is looking for a place to begin with blockwise sampling, then the recommended, default approach (when blocked parameters by time-period are not desired in a time-series) is to begin with a trial run of the adaptive, unblocked HARM algorithm (since covariance matrices are not required) for the purposes of obtaining a posterior correlation matrix. Next, create blocks with the \code{Blocks} function based on the posterior correlation matrix obtained from the trial run. Finally, run the desired, blocked algorithm with the newly created blocks (and possibly user-specified covariance matrices), beginning where the trial run ended. If hierarchical clustering is used, then it is important to note that hierarchical clustering has no idea that the user intends to perform blockwise sampling in MCMC. If hierarchical clustering returns numerous small blocks, then the user may consider combining some or all of those blocks. For example, if several 1-parameter blocks are returned, then blockwise sampling will equal componentwise sampling for those blocks, which will iterate slower. Conversely, if hierarchical clustering returns one or more big blocks, each with enough parameters that multivariate sampling will have difficulty getting an accepted proposal, or an accepted proposal that moves more than a small amount, then the user may consider subdividing these big blocks into smaller, more manageable blocks, though with the understanding that more posterior correlation is unaccounted for. } \value{ The \code{Blocks} function returns an object of class \code{blocks}, which is a list. Each component of the list is a block of parameters, and parameters are indicated by their position in the initial values vector. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplacesDemon}} and \code{\link{PosteriorChecks}}. } \examples{ library(LaplacesDemon) ### Create the default number of sequentially assigned blocks: Initial.Values <- rep(0,1000) MyBlocks <- Blocks(Initial.Values) MyBlocks ### Or, a pre-specified number of sequentially assigned blocks: #Initial.Values <- rep(0,1000) #MyBlocks <- Blocks(Initial.Values, N=20) ### If scaled diagonal covariance matrices are desired: #VarCov <- list() #for (i in 1:length(MyBlocks)) # VarCov[[i]] <- diag(length(MyBlocks[[i]]))*2.38^2/length(MyBlocks[[i]]) ### Or, determine the number of blocks in the range of 2 to 50 from ### hierarchical clustering on the posterior correlation matrix of an ### object, say called Fit, output from LaplacesDemon: #MyBlocks <- Blocks(Initial.Values, N=c(2,50), # PostCor=cor(Fit$Posterior1)) #lapply(MyBlocks, length) #See the number of parameters per block ### Or, create a pre-specified number of blocks from hierarchical ### clustering on the posterior correlation matrix of an object, ### say called Fit, output from LaplacesDemon: #MyBlocks <- Blocks(Initial.Values, N=20, PostCor=cor(Fit$Posterior1)) ### Posterior correlation from a previous trial run could be obtained ### with either method below (though cor() will be fastest because ### additional checks are not calculated for the parameters): #rho <- cor(Fit$Posterior1) #rho <- PosteriorChecks(Fit)$Posterior.Correlation } \keyword{MCMC} \keyword{Multicollinearity} \keyword{Posterior Correlation} \keyword{Utility} LaplacesDemon/man/dist.Student.t.Rd0000755000176200001440000001135015144316355016667 0ustar liggesusers\name{dist.Student.t} \alias{dst} \alias{pst} \alias{qst} \alias{rst} \title{Student t Distribution: Univariate} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate Student t distribution with location parameter \eqn{\mu}{mu}, scale parameter \eqn{\sigma}{sigma}, and degrees of freedom parameter \eqn{\nu}{nu}. } \usage{ dst(x, mu=0, sigma=1, nu=10, log=FALSE) pst(q, mu=0, sigma=1, nu=10, lower.tail=TRUE, log.p=FALSE) qst(p, mu=0, sigma=1, nu=10, lower.tail=TRUE, log.p=FALSE) rst(n, mu=0, sigma=1, nu=10) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mu}{This is the location parameter \eqn{\mu}{mu}.} \item{sigma}{This is the scale parameter \eqn{\sigma}{sigma}, which must be positive.} \item{nu}{This is the degrees of freedom parameter \eqn{\nu}{nu}, which must be positive.} \item{lower.tail}{Logical. If \code{lower.tail=TRUE}, then probabilities are \eqn{Pr[X \le x]}{Pr[X <= x]}, otherwise, \eqn{Pr[X > x]}{Pr[X > x]}.} \item{log, log.p}{Logical. If \code{log=TRUE}, then the logarithm of the density or probability is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{\Gamma[(\nu+1)/2]}{\Gamma(\nu/2)} \sqrt{\nu \pi} \sigma[1 + \frac{1}{\nu}[\frac{\theta - \mu}{\sigma}]^2]^{(-\nu + 1)/2}}{p(theta) = [{Gamma[(nu + 1) / 2]} / Gamma(nu/2)]*sqrt(nu*pi)*sigma*[1 + (1/nu)*[(theta - mu)/sigma]^2]^[(-nu+ 1)/2]} \item Inventor: William Sealy Gosset (1908) \item Notation 1: \eqn{\theta \sim \mathrm{t}(\mu, \sigma, \nu)}{theta ~ t(mu, sigma,nu)} \item Notation 2: \eqn{p(\theta) = \mathrm{t}(\theta | \mu, \sigma, \nu)}{p(theta) = t(theta | mu, sigma,nu)} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: scale parameter \eqn{\sigma > 0}{sigma > 0} \item Parameter 3: degrees of freedom \eqn{\nu > 0}{nu > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu}, for \eqn{\nu > 1}{nu > 1}, otherwise undefined \item Variance: \eqn{var(\theta) = \frac{\nu}{\nu - 2}\sigma^2}{var(theta) = [nu / (nu - 2)]sigma^2}, for \eqn{\nu > 2}{nu> 2} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The Student t-distribution is often used as an alternative to the normal distribution as a model for data. It is frequently the case that real data have heavier tails than the normal distribution allows for. The classical approach was to identify outliers and exclude or downweight them in some way. However, it is not always easy to identify outliers (especially in high dimensions), and the Student t-distribution is a natural choice of model-form for such data. It provides a parametric approach to robust statistics. The degrees of freedom parameter, \eqn{\nu}{nu}, controls the kurtosis of the distribution, and is correlated with the scale parameter \eqn{\sigma}{sigma}. The likelihood can have multiple local maxima and, as such, it is often necessary to fix \eqn{\nu}{nu} at a fairly low value and estimate the other parameters taking this as given. Some authors report that values between 3 and 9 are often good choices, and some authors suggest 5 is often a good choice. In the limit \eqn{\nu \rightarrow \infty}{nu -> infinity}, the Student t-distribution approaches \eqn{\mathcal{N}(\mu, \sigma^2)}{N(mu, sigma^2)}. The case of \eqn{\nu = 1}{nu = 1} is the Cauchy distribution. The \code{pst} and \code{qst} functions are similar to those in the \code{gamlss.dist} package. } \value{ \code{dst} gives the density, \code{pst} gives the distribution function, \code{qst} gives the quantile function, and \code{rst} generates random deviates. } \seealso{ \code{\link{dcauchy}}, \code{\link{dmvt}}, \code{\link{dmvtp}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, \code{\link{dstp}}, and \code{\link{dt}}. } \examples{ library(LaplacesDemon) x <- dst(1,0,1,10) x <- pst(1,0,1,10) x <- qst(0.5,0,1,10) x <- rst(100,0,1,10) #Plot Probability Functions x <- seq(from=-5, to=5, by=0.1) plot(x, dst(x,0,1,0.1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dst(x,0,1,1), type="l", col="green") lines(x, dst(x,0,1,10), type="l", col="blue") legend(1, 0.9, expression(paste(mu==0, ", ", sigma==1, ", ", nu==0.5), paste(mu==0, ", ", sigma==1, ", ", nu==1), paste(mu==0, ", ", sigma==1, ", ", nu==10)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/plot.iterquad.ppc.Rd0000755000176200001440000004102515144316355017413 0ustar liggesusers\name{plot.iterquad.ppc} \alias{plot.iterquad.ppc} \title{Plots of Posterior Predictive Checks} \description{ This may be used to plot, or save plots of, samples in an object of class \code{iterquad.ppc}. A variety of plots is provided. } \usage{\method{plot}{iterquad.ppc}(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, \dots)} \arguments{ \item{x}{ This required argument is an object of class \code{iterquad.ppc}.} \item{Style}{ This optional argument specifies one of several styles of plots, and defaults to \code{NULL} (which is the same as \code{"Density"}). Styles of plots are indicated in quotes. Optional styles include \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"Density"}, \code{"DW"}, \code{"DW, Multivariate, C"}, \code{"ECDF"}, \code{"Fitted"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Predictive Quantiles"}, \code{"Residual Density"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}. Details are given below.} \item{Data}{ This optional argument accepts the data set used when updating the model. Data is required only with certain plot styles, including \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"DW, Multivariate, C"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}.} \item{Rows}{ This optional argument is for a vector of row numbers that specify the records associated by row in the object of class \code{iterquad.ppc}. Only these rows are plotted. The default is to plot all rows. Some plots do not allow rows to be specified.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{\dots}{Additional arguments are unused.} } \details{ This function can be used to produce a variety of posterior predictive plots, and the style of plot is selected with the \code{Style} argument. Below are some notes on the styles of plots. \code{Covariates} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is not categorical. \code{Covariates, Categorical DV} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is categorical. \code{Density} plots show the kernel density of the posterior predictive distribution for each selected row of y (all are selected by default). A vertical red line indicates the position of the observed y along the x-axis. When the vertical red line is close to the middle of a normal posterior predictive distribution, then there is little discrepancy between y and the posterior predictive distribution. When the vertical red line is in the tail of the distribution, or outside of the kernel density altogether, then there is a large discrepancy between y and the posterior predictive distribution. Large discrepancies may be considered outliers, and moreover suggest that an improvement in model fit should be considered. \code{DW} plots the distributions of the Durbin-Watson (DW) test statistics (Durbin and Watson, 1950), both observed (\eqn{d^{obs}}{d.obs} as a transparent, black density) and replicated (\eqn{d^{rep}}{d.rep} as a transparent, red density). The distribution of \eqn{d^{obs}}{d.obs} is estimated from the model, and \eqn{d^{rep}}{d.rep} is simulated from normal residuals without autocorrelation, where the number of simulations are the same as the observed number. This DW test may be applied to the residuals of univariate time-series models (or otherwise ordered residuals) to detect first-order autocorrelation. Autocorrelated residuals are not independent. The DW test is applicable only when the residuals are normally-distributed, higher-order autocorrelation is not present, and y is not used also as a lagged predictor. The DW test statistic, \eqn{d^{obs}}{d[obs]}, occurs in the interval (0,4), where 0 is perfect positive autocorrelation, 2 is no autocorrelation, and 4 is perfect negative autocorrelation. The following summary is reported on the plot: the mean of \eqn{d^{obs}}{d[obs]} (and its 95\% probability interval), the probability that \eqn{d^{obs} > d^{rep}}{d[obs] > d[rep]}, and whether or not autocorrelation is found. Positive autocorrelation is reported when the observed process is greater than the replicated process in 2.5\% of the samples, and negative autocorrelation is reported when the observed process is greater than the replicated process in 97.5\% of the samples. \code{DW, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Durbin-Watson test, as in \code{DW} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for first-order autocorrelation. \code{ECDF} (Empirical Cumulative Distribution Function) plots compare the ECDF of y with three ECDFs of yhat based on the 2.5\%, 50\% (median), and 97.5\% of its distribution. The ECDF(y) is defined as the proportion of values less than or equal to y. This plot is appropriate when y is univariate and at least ordinal. \code{Fitted} plots compare y with the probability interval of its replicate, and provide loess smoothing. This plot is appropriate when y is univariate and not categorical. \code{Fitted, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each column-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen column-wise. \code{Fitted, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each row-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen row-wise. \code{Jarque-Bera} plots the distributions of the Jarque-Bera (JB) test statistics (Jarque and Bera, 1980), both observed (\eqn{JB^{obs}}{JB.obs} as a transparent black density) and replicated (\eqn{JB^{rep}}{JB.rep} as a transparent red density). The distribution of \eqn{JB^{obs}}{JB.obs} is estimated from the model, and \eqn{JB^{rep}}{JB.rep} is simulated from normal residuals, where the number of simulations are the same as the observed number. This Jarque-Bera test may be applied to the residuals of univariate models to test for normality. The Jarque-Bera test does not test normality per se, but whether or not the distribution has kurtosis and skewness that match a normal distribution, and is therefore a test of the moments of a normal distribution. The following summary is reported on the plot: the mean of \eqn{JB^{obs}}{JB[obs]} (and its 95\% probability interval), the probability that \eqn{JB^{obs} > JB^{rep}}{JB[obs] > JB[rep]}, and whether or not normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Jarque-Bera, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Jarque-Bera test, as in \code{Jarque-Bera} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for normality. \code{Mardia} plots the distributions of the skewness (K3) and kurtosis (K4) test statistics (Mardia, 1970), both observed (\eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} as transparent black density) and replicated (\eqn{K3^{rep}}{K3.rep} and \eqn{K4^{rep}}{K4.rep} as transparent red density). The distributions of \eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} are estimated from the model, and both \eqn{K3^{rep}}{K3.rep} \eqn{K4^{rep}}{K4.rep} are simulated from multivariate normal residuals, where the number of simulations are the same as the observed number. This Mardia's test may be applied to the residuals of multivariate models to test for multivariate normality. Mardia's test does not test for multivariate normality per se, but whether or not the distribution has kurtosis and skewness that match a multivariate normal distribution, and is therefore a test of the moments of a multivariate normal distribution. The following summary is reported on the plots: the means of \eqn{K3^{obs}}{K3[obs]} and \eqn{K4^{obs}}{K4[obs]} (and the associated 95\% probability intervals), the probabilities that \eqn{K3^{obs} > K3^{rep}}{K3[obs] > K3[rep]} and \eqn{K4^{obs} > K4^{rep}}{K4[obs] > K4[rep]}, and whether or not multivariate normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Mardia} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. \code{Y} must be a \eqn{N \times P}{N x P} matrix of \eqn{N}{N} records and \eqn{P}{P} variables. Source code was modified from the deprecated package QRMlib. \code{Predictive Quantiles} plots compare y with the predictive quantile (PQ) of its replicate. This may be useful in looking for patterns with outliers. Instances outside of the gray lines are considered outliers. \code{Residual Density} plots the residual density of the median of the samples. A vertical red line occurs at zero. This plot may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when y is univariate and continuous. \code{Residual Density, Multivariate C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are column-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen column-wise. \code{Residual Density, Multivariate R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are row-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen row-wise. \code{Residuals} plots compare y with its residuals. The probability interval is plotted as a line. This plot is appropriate when y is univariate. \code{Residuals, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each column-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen column-wise. \code{Residuals, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each row-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen row-wise. \code{Space-Time by Space} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one time-series plot per point s in space, for a total of S plots. Therefore, these are time-series plots for each point s in space across T time-periods. See \code{Time-Series} plots below. \code{Space-Time by Time} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one spatial plot per time-period, and T plots will be produced. See \code{Spatial} plots below. \code{Spatial} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows yrep plotted according to its coordinates, and is color-coded so that higher values of yrep become more red, and lower values become more yellow. \code{Spatial Uncertainty} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows the probability interval of yrep plotted according to its coordinates, and is color-coded so that wider probability intervals become more red, and lower values become more yellow. \code{Time-Series} plots compare y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is univariate and ordered by time. \code{Time-Series, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by column in Y. \code{Time-Series, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each row-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by row in Y, such as is typically true in panel models. } \references{ Durbin, J., and Watson, G.S. (1950). "Testing for Serial Correlation in Least Squares Regression, I." \emph{Biometrika}, 37, p. 409--428. Jarque, C.M. and Bera, A.K. (1980). "Efficient Tests for Normality, Homoscedasticity and Serial Independence of Regression Residuals". \emph{Economics Letters}, 6(3), p. 255--259. Mardia, K.V. (1970). "Measures of Multivariate Skewness and Kurtosis with Applications". \emph{Biometrika}, 57(3), p. 519--530. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{IterativeQuadrature}} and \code{\link{predict.iterquad}}. } \examples{### See the IterativeQuadrature function for an example.} \keyword{Plot}LaplacesDemon/man/plot.laplace.Rd0000755000176200001440000000437615144316355016425 0ustar liggesusers\name{plot.laplace} \alias{plot.laplace} \title{Plot the output of \code{\link{LaplaceApproximation}}} \description{ This may be used to plot, or save plots of, the iterated history of the parameters and, if posterior samples were taken, density plots of parameters and monitors in an object of class \code{laplace}. } \usage{\method{plot}{laplace}(x, Data, PDF=FALSE, Parms, \dots)} \arguments{ \item{x}{ This required argument is an object of class \code{laplace}.} \item{Data}{ This required argument must receive the list of data that was supplied to \code{\link{LaplaceApproximation}} to create the object of class \code{laplace}.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{Parms}{ This argument accepts a vector of quoted strings to be matched for selecting parameters for plotting. This argument defaults to \code{NULL} and selects every parameter for plotting. Each quoted string is matched to one or more parameter names with the \code{grep} function. For example, if the user specifies \code{Parms=c("eta", "tau")}, and if the parameter names are beta[1], beta[2], eta[1], eta[2], and tau, then all parameters will be selected, because the string \code{eta} is within \code{beta}. Since \code{grep} is used, string matching uses regular expressions, so beware of meta-characters, though these are acceptable: ".", "[", and "]".} \item{\dots}{Additional arguments are unused.} } \details{ The plots are arranged in a \eqn{2 \times 2}{2 x 2} matrix. The purpose of the iterated history plots is to show how the value of each parameter and the deviance changed by iteration as the \code{\link{LaplaceApproximation}} attempted to maximize the logarithm of the unnormalized joint posterior density. If the algorithm converged, and if \code{sir=TRUE} in \code{\link{LaplaceApproximation}}, then plots are produced of selected parameters and all monitored variables. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{LaplaceApproximation}}} \examples{### See the LaplaceApproximation function for an example.} \keyword{Plot}LaplacesDemon/man/CenterScale.Rd0000755000176200001440000000716415144316355016235 0ustar liggesusers\name{CenterScale} \alias{CenterScale} \title{Centering and Scaling} \description{ This function either centers and scales a continuous variable and provides options for binary variables, or returns an untransformed variable from a centered and scaled variable. } \usage{ CenterScale(x, Binary="none", Inverse=FALSE, mu, sigma, Range, Min) } \arguments{ \item{x}{This is a vector to be centered and scaled, or to be untransformed if \code{Inverse=TRUE}.} \item{Binary}{This argument indicates how binary variables will be treated, and defaults to \code{"none"}, which keeps the original scale, or transforms the variable to the 0-1 range, if not already there. With \code{"center"}, it will center the binary variable by subtracting the mean. With \code{"center0"}, it centers the binary variable at zero, recoding a 0 to -0.5, and a 1 to 0.5. Finally, \code{"centerscale"} will center and scale the binary variable, subtracting the mean and dividing by two standard deviations.} \item{Inverse}{Logical. If \code{TRUE}, then a centered and scaled variable \code{x} will be transformed to its original, un-centered and un-scaled state. This defaults to \code{FALSE}.} \item{mu, sigma, Range, Min}{These arguments are required only when \code{Inverse=TRUE}, where \code{mu} is the mean, \code{sigma} is the standard deviation, \code{Range} is the range, and \code{Min} is the minimum of the original \code{x}. \code{Range} and \code{Min} are used only when \code{Binary="none"} or \code{Binary="center0"}.} } \details{ Gelman (2008) recommends centering and scaling continuous predictors to facilitate MCMC convergence and enable comparisons between coefficients of centered and scaled continuous predictors with coefficients of untransformed binary predictors. A continuous predictor is centered and scaled as follows: \code{x.cs <- (x - mean(x)) / (2*sd(x))}. This is an improvement over the usual practice of standardizing predictors, which is \code{x.z <- (x - mean(x)) / sd(x)}, where coefficients cannot be validly compared between binary and continuous predictors. In MCMC, such as in \code{\link{LaplacesDemon}}, a centered and scaled predictor often results in a higher effective sample size (\code{\link{ESS}}), and therefore the chain mixes better. Centering and scaling is a method of re-parameterization to improve mixing. Griffin and Brown (2013) also assert that the user may not want to scale predictors that are measured on the same scale, since scaling in this case may increase noisy, low signals. In this case, centering (without scaling) is recommended. To center a predictor, subtract its mean. } \value{ The \code{CenterScale} function returns a centered and scaled vector, or the untransformed vector. } \references{ Gelman, A. (2008). "Scaling Regression Inputs by Dividing by Two Standard Devations". \emph{Statistics in Medicine}, 27, p. 2865--2873. Griffin, J.E. and Brown, P.J. (2013) "Some Priors for Sparse Regression Modelling". \emph{Bayesian Analysis}, 8(3), p. 691--702. } \seealso{ \code{\link{ESS}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, and \code{\link{PMC}}. } \examples{ ### See the LaplacesDemon function for an example in use. library(LaplacesDemon) x <- rnorm(100,10,1) x.cs <- CenterScale(x) x.orig <- CenterScale(x.cs, Inverse=TRUE, mu=mean(x), sigma=sd(x)) } \keyword{Center} \keyword{Centering} \keyword{Predictor} \keyword{Scale} \keyword{Scaling} \keyword{Transformation}LaplacesDemon/man/Gelman.Diagnostic.Rd0000755000176200001440000002207215144316355017326 0ustar liggesusers\name{Gelman.Diagnostic} \alias{Gelman.Diagnostic} \title{Gelman and Rubin's MCMC Convergence Diagnostic} \description{ Gelman and Rubin (1992) proposed a general approach to monitoring convergence of MCMC output in which \eqn{m > 1} parallel chains are updated with initial values that are overdispersed relative to each target distribution, which must be normally distributed. Convergence is diagnosed when the chains have `forgotten' their initial values, and the output from all chains is indistinguishable. The \code{Gelman.Diagnostic} function makes a comparison of within-chain and between-chain variances, and is similar to a classical analysis of variance. A large deviation between these two variances indicates non-convergence. This diagnostic is popular as a stopping rule, though it requires parallel chains. The \code{\link{LaplacesDemon.hpc}} function is an extension of \code{\link{LaplacesDemon}} to enable parallel chains. As an alternative, the popular single-chain stopping rule is based on \code{\link{MCSE}}. } \usage{Gelman.Diagnostic(x, confidence=0.95, transform=FALSE)} \arguments{ \item{x}{This required argument accepts an object of class \code{demonoid.hpc}, or a list of multiple objects of class \code{demonoid}, where the number of components in the list is the number of chains.} \item{confidence}{This is the coverage probability of the confidence interval for the potential scale reduction factor (PSRF).} \item{transform}{Logical. If \code{TRUE}, then marginal posterior distributions in \code{x} may be transformed to improve the normality of the distribution, which is assumed. A log-transform is applied to marginal posterior distributions in the interval \eqn{(0, \infty]}{(0, Inf]}, or a logit-transform is applied to marginal posterior distributions in the interval \eqn{(0,1)}.} } \value{ A list is returned with the following components: \item{PSRF}{This is a list containing the point-estimates of the potential scale reduction factor (labelled \code{Point Est.}) and the associated upper confidence limits (labelled \code{Upper C.I.}).} \item{MPSRF}{This is the point-estimate of the multivariate potential scale reduction factor.} } \details{ To use the \code{Gelman.Diagnostic} function, the user must first have multiple MCMC chains for the same model, and three chains is usually sufficient. The easiest way to obtain multiple chains is with the \code{\link{LaplacesDemon.hpc}} function. Although the \code{\link{LaplacesDemon}} function does not simultaneously update multiple MCMC chains, it is easy enough to obtain multiple chains, and if the computer has multiple processors (which is common), then multiple chains may be obtained simultaneously as follows. The model file may be opened in separate, concurrent R sessions, and it is recommended that a maximum number of sessions is equal to the number of processors, minus one. Each session constitutes its own chain, and the code is identical, except the initial values should be randomized with the \code{\link{GIV}} function so the chains begin in different places. The resulting object of class \code{demonoid} for each chain is saved, all objects are read into one session, put into a list, and passed to the \code{Gelman.Diagnostic} function. Initial values must be overdispersed with respect to each target distribution, though these distributions are unknown in the beginning. Since the \code{Gelman.Diagnostic} function relies heavily on overdispersion with respect to the target distribution, the user should consider using MCMC twice, first to estimate the target distributions, and secondly to overdisperse initial values with respect to them. This may help identify multimodal target distributions. If multiple modes are found, it remain possible that more modes exist. When multiple modes are found, and if chains are combined with the \code{\link{Combine}} function, each mode is probably not represented in a proportion correct to the distribution. The `potential scale reduction factor' (PSRF) is an estimated factor by which the scale of the current distribution for the target distribution might be reduced if the simulations were continued for an infinite number of iterations. Each PSRF declines to 1 as the number of iterations approaches infinity. PSRF is also often represented as R-hat. PSRF is calculated for each marginal posterior distribution in \code{x}, together with upper and lower confidence limits. Approximate convergence is diagnosed when the upper limit is close to 1. The recommended proximity of each PSRF to 1 varies with each problem, but a general goal is to achieve PSRF < 1.1. PSRF is an estimate of how much narrower the posterior might become with an infinite number of iterations. When PSRF = 1.1, for example, it may be interpreted as a potential reduction of 10\% in posterior interval width, given infinite iterations. The multivariate form bounds above the potential scale reduction factor for any linear combination of the (possibly transformed) variables. The confidence limits are based on the assumption that the target distribution is stationary and normally distributed. The \code{transform} argument may be used to improve the normal approximation. A large PSRF indicates that the between-chain variance is substantially greater than the within-chain variance, so that longer simulation is needed. If a PSRF is close to 1, then the associated chains are likely to have converged to one target distribution. A large PSRF (perhaps generally when a PSRF > 1.2) indicates convergence failure, and can indicate the presence of a multimodal marginal posterior distribution in which different chains may have converged to different local modes (see \code{\link{is.multimodal}}), or the need to update the associated chains longer, because burn-in (see \code{\link{burnin}}) has yet to be completed. The \code{Gelman.Diagnostic} is essentially the same as the \code{gelman.diag} function in the \code{coda} package, but here it is programmed to work with objects of class \code{demonoid}. There are two ways to estimate the variance of the stationary distribution: the mean of the empirical variance within each chain, \eqn{W}, and the empirical variance from all chains combined, which can be expressed as \deqn{ \widehat{\sigma}^2 = \frac{(n-1) W}{n} + \frac{B}{n}}{sigma.hat^2 = (n-1)W/n + B/n} where \eqn{n} is the number of iterations and \eqn{B/n} is the empirical between-chain variance. If the chains have converged, then both estimates are unbiased. Otherwise the first method will \emph{underestimate} the variance, since the individual chains have not had time to range all over the stationary distribution, and the second method will \emph{overestimate} the variance, since the initial values were chosen to be overdispersed (and this assumes the target distribution is known, see above). This convergence diagnostic is based on the assumption that each target distribution is normal. A Bayesian probability interval (see \code{\link{p.interval}}) can be constructed using a t-distribution with mean \deqn{\widehat{\mu}=\mbox{Sample mean of all chains combined,}}{mu.hat = Sample mean of all chains combined,} variance \deqn{\widehat{V} = \widehat{\sigma}^2 + \frac{B}{mn},}{V.hat = sigma.hat2 + B/(mn),} and degrees of freedom estimated by the method of moments \deqn{d = \frac{2\widehat{V}^2}{\mbox{Var}(\widehat{V})}}{d = 2*V.hat^2 / Var(V.hat)} Use of the t-distribution accounts for the fact that the mean and variance of the posterior distribution are estimated. The convergence diagnostic itself is \deqn{R=\sqrt{\frac{(d+3) \widehat{V}}{(d+1)W}}}{R=sqrt((d+3) V.hat /((d+1)W)} Values substantially above 1 indicate lack of convergence. If the chains have not converged, then Bayesian probability intervals based on the t-distribution are too wide, and have the potential to shrink by this factor if the MCMC run is continued. The multivariate version of Gelman and Rubin's diagnostic was proposed by Brooks and Gelman (1998). Unlike the univariate proportional scale reduction factor, the multivariate version does not include an adjustment for the estimated number of degrees of freedom. } \references{ Brooks, S.P. and Gelman, A. (1998). "General Methods for Monitoring Convergence of Iterative Simulations". \emph{Journal of Computational and Graphical Statistics}, 7, p. 434--455. Gelman, A. and Rubin, D.B. (1992). "Inference from Iterative Simulation using Multiple Sequences". \emph{Statistical Science}, 7, p. 457--511. } \seealso{ \code{\link{Combine}}, \code{\link{GIV}}, \code{\link{is.multimodal}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{MCSE}}, and \code{\link{p.interval}}. } \examples{ #library(LaplacesDemon) ###After updating multiple chains with LaplacesDemon.hpc, do: #Gelman.Diagnostic(Fit) } \keyword{Diagnostic} \keyword{MCMC} \keyword{Multiple Chains} \keyword{Parallel Chains} LaplacesDemon/man/PMC.RAM.Rd0000755000176200001440000001356515144316355015104 0ustar liggesusers\name{PMC.RAM} \alias{PMC.RAM} \title{PMC RAM Estimate} \description{ This function estimates the random-access memory (RAM) required to update a given model and data with \code{\link{PMC}}. \emph{Warning:} Unwise use of this function may crash a computer, so please read the details below. } \usage{ PMC.RAM(Model, Data, Iterations, Thinning, M, N) } \arguments{ \item{Model}{This is a model specification function. For more information, see \code{\link{PMC}}.} \item{Data}{This is a list of Data. For more information, see \code{\link{PMC}}.} \item{Iterations}{This is the number of iterations for which \code{\link{PMC}} would update. For more information, see \code{\link{PMC}}.} \item{Thinning}{This is the amount of thinning applied to the samples in \code{\link{PMC}}.For more information, see \code{\link{PMC}}.} \item{M}{This is the number of mixture components in \code{\link{PMC}}.} \item{N}{This is the number of samples in \code{\link{PMC}}.} } \details{ The \code{PMC.RAM} function uses the \code{\link{object.size}} function to estimate the size in MB of RAM required to update in \code{\link{PMC}} for a given model and data, and for a number of iterations and specified thinning. When RAM is exceeded, the computer will crash. This function can be useful when trying to estimate how many samples and iterations to update a model without crashing the computer. However, when estimating the required RAM, \code{PMC.RAM} actually creates several large objects, such as \code{post} (see below). If too many iterations are given as an argument to \code{PMC.RAM}, for example, then it will crash the computer while trying to estimate the required RAM. The best way to use this function is as follows. First, prepare the model specification and list of data. Second, observe how much RAM the computer is using at the moment, as well as the maximum available RAM. The majority of the difference of these two is the amount of RAM the computer may dedicate to updating the model. Next, use this function with a small number of iterations. Note the estimated RAM. Increase the number of iterations, and again note the RAM. Continue to increase the number of iterations until, say, arbitrarily within 90\% of the above-mentioned difference in RAM. The computer operating system uses RAM, as does any other software running at the moment. R is currently using RAM, and other functions in the \code{LaplacesDemon} package, and any other package that is currently activated, are using RAM. There are numerous small objects that are not included in the returned list, that use RAM. For example, perplexity is a small vector, etc. A potentially large objects that is not included is a matrix used for estimating \code{\link{LML}}. } \value{ \code{PMC.RAM} returns a list with several components. Each component is an estimate in MB for an object. The list has the following components: \item{alpha}{This is the estimated size in MB of RAM required for the matrix of mixture probabilities by iteration.} \item{Covar}{This is the estimated size in MB of RAM required for the covariance matrix or matrices.} \item{Data}{This is the estimated size in MB of RAM required for the list of data.} \item{Deviance}{This is the estimated size in MB of RAM required for the deviance vector before thinning.} \item{Initial.Values}{This is the estimated size in MB of RAM required for the matrix or vector of initial values.} \item{LH}{This is the estimated size in MB of RAM required for the \eqn{N \times T \times M}{N x T x M} array \code{LH}, where \eqn{N} is the number of samples, \eqn{T} is the number of iterations, and \eqn{M} is the number of mixture components. The \code{LH} array is not returned by \code{\link{PMC}}.} \item{LP}{This is the estimated size in MB of RAM required for the \eqn{N \times T \times M}{N x T x M} array \code{LP}, where \eqn{N} is the number of samples, \eqn{T} is the number of iterations, and \eqn{M} is the number of mixture components. The \code{LP} array is not returned by \code{\link{PMC}}.} \item{Model}{This is the estimated size in MB of RAM required for the model specification function.} \item{Monitor}{This is the estimated size in MB of RAM required for the \eqn{N \times J}{N x J} matrix \code{Monitor}, where \eqn{N} is the number of unthinned samples and J is the number of monitored variables. Although it is thinned later in the algorithm, the full matrix is created.} \item{Posterior1}{This is the estimated size in MB of RAM required for the \eqn{N \times J \times T \times M}{N x J x T x M} array \code{Posterior1}, where \eqn{N} is the number of samples, \eqn{J} is the number of parameters, \eqn{T} is the number of iterations, and \eqn{M} is the number of mixture components.} \item{Posterior2}{This is the estimated size in MB of RAM required for the \eqn{N \times J}{N x J} matrix \code{Posterior2}, where \eqn{N} is the number of samples and \eqn{J} is the number of initial values or parameters. Although this is thinned later, at one point it is un-thinned.} \item{Summary}{This is the estimated size in MB of RAM required for the summary table.} \item{W}{This is the estimated size in MB of RAM required for the matrix of importance weights.} \item{Total}{This is the estimated size in MB of RAM required in total to update with \code{\link{PMC}} for a given model and data, and for a number of iterations, specified thinning, mixture components, and number of samples.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{BigData}}, \code{\link{LML}}, \code{\link{object.size}}, and \code{\link{PMC}}. } \keyword{Memory} LaplacesDemon/man/summary.pmc.ppc.Rd0000755000176200001440000003767615144316355017114 0ustar liggesusers\name{summary.pmc.ppc} \alias{summary.pmc.ppc} \title{Posterior Predictive Check Summary} \description{ This may be used to summarize either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}). Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is summarized, depending on \code{\link{predict.pmc}}. } \usage{\method{summary}{pmc.ppc}(object, Categorical, Rows, Discrep, d, Quiet, \dots)} \arguments{ \item{object}{An object of class \code{pmc.ppc} is required.} \item{Categorical}{Logical. If \code{TRUE}, then \code{y} and \code{yhat} are considered to be categorical (such as y=0 or y=1), rather than continuous.} \item{Rows}{An optional vector of row numbers, for example \code{c(1:10)}. All rows will be estimated, but only these rows will appear in the summary.} \item{Discrep}{A character string indicating a discrepancy test. \code{Discrep} defaults to \code{NULL}. Valid character strings when \code{y} is continuous are: \code{"Chi-Square"}, \code{"Chi-Square2 "}, \code{"Kurtosis"}, \code{"L-criterion"}, \code{"MASE"}, \code{"MSE"}, \code{"PPL"}, \code{"Quadratic Loss"}, \code{"Quadratic Utility"}, \code{"RMSE"}, \code{"Skewness"}, \code{"max(yhat[i,]) > max(y)"}, \code{"mean(yhat[i,]) > mean(y)"}, \code{"mean(yhat[i,] > d)"}, \code{"mean(yhat[i,] > mean(y))"}, \code{"min(yhat[i,]) < min(y)"}, \code{"round(yhat[i,]) = d"}, and \code{"sd(yhat[i,]) > sd(y)"}. Valid character strings when \code{y} is categorical are: \code{"p(yhat[i,] != y[i])"}. Kurtosis and skewness are not discrepancies, but are included here for convenience.} \item{d}{This is an optional integer to be used with the \code{Discrep} argument above, and it defaults to \code{d=0}.} \item{Quiet}{This logical argument defaults to \code{FALSE} and will print results to the console. When \code{TRUE}, results are not printed.} \item{\dots}{Additional arguments are unused.} } \details{ This function summarizes an object of class \code{pmc.ppc}, which consists of posterior predictive checks on either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]}, depending respectively on whether unobserved instances of \eqn{\textbf{y}}{y} or the model sample of \eqn{\textbf{y}}{y} was used in the \code{\link{predict.demonoid}} function. The purpose of a posterior predictive check is to assess how well (or poorly) the model fits the data, or to assess discrepancies between the model and the data. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. When \eqn{\textbf{y}}{y} is continuous and known, this function estimates the predictive concordance between \eqn{\textbf{y}}{y} and \eqn{\textbf{y}^{rep}}{y[rep]} as per Gelfand (1996), and the predictive quantile (PQ), which is for record-level outlier detection used to calculate Gelfand's predictive concordance. When \eqn{\textbf{y}}{y} is categorical and known, this function estimates the record-level lift, which is \code{p(yhat[i,] = y[i]) / [p(y = j) / n]}, or the number of correctly predicted samples over the rate of that category of \eqn{\textbf{y}}{y} in vector \eqn{\textbf{y}}{y}. A discrepancy measure is an approach to studying discrepancies between the model and data (Gelman et al., 1996). Below is a list of discrepancy measures, followed by a brief introduction to discrepancy analysis: \itemize{ \item The \code{"Chi-Square"} discrepancy measure is the chi-square goodness-of-fit test that is recommended by Gelman. For each record i=1:N, this returns (y[i] - E(y[i]))^2 / var(yhat[i,]). \item The \code{"Chi-Square2"} discrepancy measure returns the following for each record: Pr(chisq.rep[i,] > chisq.obs[i,]), where chisq.obs[i,] <- (y[i] - E(y[i]))^2 / E(y[i]), and chisq.rep[i,] <- (yhat[i,] - E(yhat[i,]))^2 / E(yhat[i,]), and the overall discrepancy is the percent of records that were outside of the 95\% quantile-based probability interval (see \code{\link{p.interval}}). \item The \code{"Kurtosis"} discrepancy measure returns the kurtosis of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding kurtotic replicate distributions. \item The \code{"L-criterion"} discrepancy measure of Laud and Ibrahim (1995) provides the record-level combination of two components (see below), and the discrepancy statistic is the sum, \code{L}, as well as a calibration number, \code{S.L}. For more information on the L-criterion, see the accompanying vignette entitled "Bayesian Inference". \item The \code{"MASE"} (Mean Absolute Scaled Error) is a discrepancy measure for the accuracy of time-series forecasts, estimated as \code{(|y - yhat|) / mean(abs(diff(y)))}. The discrepancy statistic is the mean of the record-level values. \item The \code{"MSE"} (Mean Squared Error) discrepancy measure provides the MSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level MSEs. MSE and quadratic loss are identical. \item The \code{"PPL"} (Posterior Predictive Loss) discrepancy measure of Gelfand and Ghosh (1998) provides the record-level combination of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The \code{d=0} argument applies the following weight to the accuracy component, which is then added to the variance component: \eqn{d/(d+1)}. For \eqn{\textbf{y}^{new}}{y[new]}, use \eqn{d=0}. For \eqn{\textbf{y}^{rep}}{y[rep]} and model comparison, \eqn{d} is commonly set to 1, 10, or 100000. Larger values of \eqn{d} put more stress on fit and downgrade the precision of the estimates. \item The \code{"Quadratic Loss"} discrepancy measure provides the mean quadratic loss for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic losses. Quadratic loss and MSE are identical, and quadratic loss is the negative of quadratic utility. \item The \code{"Quadratic Utility"} discrepancy measure provides the mean quadratic utility for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic utilities. Quadratic utility is the negative of quadratic loss. \item The \code{"RMSE"} (Root Mean Squared Error) discrepancy measure provides the RMSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level RMSEs. \item The \code{"Skewness"} discrepancy measure returns the skewness of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding skewed replicate distributions. \item The \code{"max(yhat[i,]) > max(y)"} discrepancy measure returns a record-level indicator when a record's maximum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} exceeds the maximum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications that exceed the maximum of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,]) > mean(y)"} discrepancy measure returns a record-level indicator when the mean of a record's \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is greater than the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with mean replications that exceed the mean of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,] > d)"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds a specified value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"mean(yhat[i,] > mean(y))"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"min(yhat[i,]) < min(y)"} discrepancy measure returns a record-level indicator when a record's minimum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is less than the minimum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications less than the minimum of \eqn{\textbf{y}}{y}. \item The \code{"round(yhat[i,]) = d"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that, when rounded, is equal to a specified discrete value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"sd(yhat[i,]) > sd(y)"} discrepancy measure returns a record-level indicator when the standard deviation of replicates is larger than the standard deviation of all of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with larger standard deviations than \eqn{\textbf{y}}{y}. \item The \code{"p(yhat[i,] != y[i])"} discrepancy measure returns the record-level probability that \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is not equal to \eqn{\textbf{y}}{y}. This is valid when \eqn{\textbf{y}}{y} is categorical and \code{yhat} is the predicted category. The probability is the proportion of replicates. } After observing a discrepancy statistic, the user attempts to improve the model by revising the model to account for discrepancies between data and the current model. This approach to model revision relies on an analysis of the discrepancy statistic. Given a discrepancy measure that is based on model fit, such as the L-criterion, the user may correlate the record-level discrepancy statistics with the dependent variable, independent variables, and interactions of independent variables. The discrepancy statistic should not correlate with the dependent and independent variables. Interaction variables may be useful for exploring new relationships that are not in the current model. Alternatively, a decision tree may be applied to the record-level discrepancy statistics, given the independent variables, in an effort to find relationships in the data that may be helpful in the model. Model revision may involve the addition of a finite mixture component to account for outliers in discrepancy, or specifying the model with a distribution that is more robust to outliers. There are too many suggestions to include here, and discrepancy analysis varies by model. } \value{ This function returns a list with the following components: \item{BPIC}{The Bayesian Predictive Information Criterion (BPIC) was introduced by Ando (2007). BPIC is a variation of the Deviance Information Criterion (DIC) that has been modified for predictive distributions. For more information on DIC (Spiegelhalter et al., 2002), see the accompanying vignette entitled "Bayesian Inference". \eqn{BPIC = Dbar + 2pD}. The goal is to minimize BPIC.} \item{Concordance}{This is the percentage of the records of y that are within the 95\% quantile-based probability interval (see \code{\link{p.interval}}) of \eqn{\textbf{y}^{rep}}{y[rep]}. Gelfand's suggested goal is to achieve 95\% predictive concordance. Lower percentages indicate too many outliers and a poor fit of the model to the data, and higher percentages may suggest overfitting. Concordance occurs only when \eqn{\textbf{y}}{y} is continuous.} \item{Mean Lift}{This is the mean of the record-level lifts, and occurs only when \eqn{\textbf{y}}{y} is specified as categorical with \code{Categorical=TRUE}.} \item{Discrepancy.Statistic}{This is only reported if the \code{Discrep} argument receives a valid discrepancy measure as listed above. The \code{Discrep} applies to each record of \eqn{\textbf{y}}{y}, and the \code{Discrepancy.Statistic} reports the results of the discrepancy measure on the entire data set. For example, if \code{Discrep="min(yhat[i,]) < min(y)"}, then the overall result is the proportion of records in which the minimum sample of yhat was less than the overall minimum \eqn{\textbf{y}}{y}. This is \code{Pr(min(yhat[i,]) < min(y) | y, Theta)}, where \code{Theta} is the parameter set.} \item{L-criterion}{The L-criterion (Laud and Ibrahim, 1995) was developed for model and variable selection. It is a sum of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The L-criterion measures model performance with a combination of how close its predictions are to the observed data and variability of the predictions. Better models have smaller values of \code{L}. \code{L} is measured in the same units as the response variable, and measures how close the data vector \eqn{\textbf{y}}{y} is to the predictive distribution. In addition to the value of \code{L}, there is a value for \code{S.L}, which is the calibration number of \code{L}, and is useful in determining how much of a decrease is necessary between models to be noteworthy.} \item{Summary}{When \eqn{\textbf{y}}{y} is continuous, this is a \eqn{N \times 8}{N x 8} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and there are 8 columns, as follows: y, Mean, SD, LB (the 2.5\% quantile), Median, UB (the 97.5\% quantile), PQ (the predictive quantile, which is \eqn{Pr(\textbf{y}^{rep} \ge \textbf{y})}{Pr(y[rep] >= y)}), and Test, which shows the record-level result of a test, if specified. When \eqn{\textbf{y}}{y} is categorical, this matrix has a number of columns equal to the number of categories of \eqn{\textbf{y}}{y} plus 3, also including \code{y}, \code{Lift}, and \code{Discrep}.} } \references{ Ando, T. (2007). "Bayesian Predictive Information Criterion for the Evaluation of Hierarchical Bayesian and Empirical Bayes Models". \emph{Biometrika}, 94(2), p. 443--458. Gelfand, A. (1996). "Model Determination Using Sampling Based Methods". In Gilks, W., Richardson, S., Spiegehalter, D., Chapter 9 in Markov Chain Monte Carlo in Practice. Chapman and Hall: Boca Raton, FL. Gelfand, A. and Ghosh, S. (1998). "Model Choice: A Minimum Posterior Predictive Loss Approach". \emph{Biometrika}, 85, p. 1--11. Gelman, A., Meng, X.L., and Stern H. (1996). "Posterior Predictive Assessment of Model Fitness via Realized Discrepancies". \emph{Statistica Sinica}, 6, p. 733--807. Laud, P.W. and Ibrahim, J.G. (1995). "Predictive Model Selection". \emph{Journal of the Royal Statistical Society}, B 57, p. 247--262. Spiegelhalter, D.J., Best, N.G., Carlin, B.P., and van der Linde, A. (2002). "Bayesian Measures of Model Complexity and Fit (with Discussion)". \emph{Journal of the Royal Statistical Society}, B 64, p. 583--639. } \author{Statisticat, LLC.} \seealso{ \code{\link{PMC}}, \code{\link{predict.pmc}}, and \code{\link{p.interval}}. } \examples{### See the PMC function for an example.} \keyword{BPIC} \keyword{Chi-Square} \keyword{Kurtosis} \keyword{L-criterion} \keyword{MASE} \keyword{MSE} \keyword{Posterior Predictive Checks} \keyword{Posterior Predictive Loss} \keyword{Quadratic Loss} \keyword{Quadratic Utility} \keyword{RMSE} \keyword{Skewness} \keyword{summary} LaplacesDemon/man/dist.ContinuousRelaxation.Rd0000755000176200001440000000634215144316355021201 0ustar liggesusers\name{dist.ContinuousRelaxation} \alias{dcrmrf} \alias{rcrmrf} \title{Continuous Relaxation of a Markov Random Field Distribution} \description{ This is the density function and random generation from the continuous relaxation of a Markov random field (MRF) distribution. } \usage{ dcrmrf(x, alpha, Omega, log=FALSE) rcrmrf(n, alpha, Omega) } \arguments{ \item{x}{This is a vector of length \eqn{k}.} \item{n}{This is the number of random deviates to generate.} \item{alpha}{This is a vector of length \eqn{k} of shape parameters.} \item{Omega}{This is the \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) \propto \exp(-\frac{1}{2} \theta^T \Omega^{-1} \theta) \prod_i (1 + \exp(\theta_i + alpha_i))}{p(theta) = exp(-0.5 theta^T Omega^(-1) theta) prod i=1 (1 + exp(theta[i] + alpha[i]))} \item Inventor: Zhang et al. (2012) \item Notation 1: \eqn{\theta \sim \mathcal{CRMRF}(\alpha, \Omega)}{theta ~ CRMRF(alpha, Omega)} \item Notation 2: \eqn{p(\theta) = \mathcal{CRMRF}(\theta | \alpha, \Omega)}{p(theta) = CRMRF(theta | alpha, Omega)} \item Parameter 1: shape vector \eqn{\alpha}{alpha} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} matrix \eqn{\Omega}{Omega} \item Mean: \eqn{E(\theta)}{E(theta)} \item Variance: \eqn{var(\theta)}{var(theta)} \item Mode: \eqn{mode(\theta)}{mode(theta)} } It is often easier to solve or optimize a problem with continuous variables rather than a problem that involves discrete variables. A continuous variable may also have a gradient, contour, and curvature that may be useful for optimization or sampling. Continuous MCMC samplers are far more common. Zhang et al. (2012) introduced a generalized form of the Gaussian integral trick from statistical physics to transform a discrete variable so that it may be estimated with continuous variables. An auxiliary Gaussian variable is added to a discrete Markov random field (MRF) so that discrete dependencies cancel out, allowing the discrete variable to be summed away, and leaving a continuous problem. The resulting continuous representation of the problem allows the model to be updated with a continuous MCMC sampler, and may benefit from a MCMC sampler that uses derivatives. Another advantage of continuous MCMC is that stationarity of discrete Markov chains is problematic to assess. A disadvantage of solving a discrete problem with continuous parameters is that the continuous solution requires more parameters. } \value{ \code{dcrmrf} gives the density and \code{rcrmrf} generates random deviates. } \references{ Zhang, Y., Ghahramani, Z., Storkey, A.J., and Sutton, C.A. (2012). "Continuous Relaxations for Discrete Hamiltonian Monte Carlo". \emph{Advances in Neural Information Processing Systems}, 25, p. 3203--3211. } \seealso{ \code{\link{dmvn}} } \examples{ library(LaplacesDemon) x <- dcrmrf(rnorm(5), rnorm(5), diag(5)) x <- rcrmrf(10, rnorm(5), diag(5)) } \keyword{Distribution} LaplacesDemon/man/Levene.Test.Rd0000755000176200001440000001134515144316355016175 0ustar liggesusers\name{Levene.Test} \alias{Levene.Test} \title{Levene's Test} \description{ The \code{Levene.Test} function is a Bayesian form of Levene's test (Levene, 1960) of equality of variances. } \usage{ Levene.Test(x, Method="U", G=NULL, Data=NULL) } \arguments{ \item{x}{This required argument must be an object of class \code{demonoid.ppc}, \code{iterquad.ppc}, \code{laplace.ppc}, \code{pmc.ppc}, or \code{vb.ppc}.} \item{Method}{The method defaults to \code{U} for a univariate dependent variable (DV), y. When the DV is multivariate, \code{Method="C"} applies Levene's test to each column associated in Y. When \code{Method="R"}, Levene's test is applied to each row associated in Y.} \item{G}{This argument defaults to \code{NULL}, or is required to have the same dimensions as the DV. For example, if the DV is univariate, then G must have a length equal to y, which is usually represented with a length of N for the number of records or T for the number of time-periods. If the DV is multivariate, then \code{G} must be a matrix, like Y, and have the same number of rows and columns. The purpose of the \code{G} argument is to allow the user to specify each element of y or Y to be in a particular group, so the variance of the groups can be tested. As such, each element of \code{G} must consist of an integer from one to the number of groups desired to be tested. The reason this test allows this degree of specificity is so the user can specify groups, such as according to covariate levels. By default, 4 groups are specified, where the first quarter of the records are group 1 and the last quarter of the records are group 4.} \item{Data}{This argument is required when the DV is multivariate, hence when \code{Method="C"} or \code{Method="R"}. The DV is required to be named Y.} } \details{ This function is a Bayesian form of Levene's test. Levene's test is used to assess the probability of the equality of residual variances in different groups. When residual variance does not differ by group, it is often called homoscedastic (or homoskedastic) residual variance. Homoskedastic residual variance is a common assumption. An advantage of Levene's test to other tests of homoskedastic residual variance is that Levene's test does not require normality of the residuals. The \code{Levene.Test} function estimates the test statistic, \eqn{W}{W}, as per Levene's test. This Bayesian form, however, estimates \eqn{W}{W} from the observed residuals as \eqn{W^{obs}}{W.obs}, and \eqn{W}{W} from residuals that are replicated from a homoskedastic process as \eqn{W^{rep}}{W.rep}. Further, \eqn{W^{obs}}{W.obs} and \eqn{W^{rep}}{W.rep} are estimated for each posterior sample. Finally, the probability that the distribution of \eqn{W^{obs}}{W.obs} is greater than the distribution of \eqn{W^{rep}}{W.rep} is reported (see below). } \value{ The \code{Levene.Test} function returns a plot (or for multivariate Y, a series of plots), and a vector with a length equal to the number of Levene's tests conducted. One plot is produced per univariate application of Levene's test. Each plot shows the test statistic W, both from the observed process (W.obs as a black density) and the replicated process (W.rep as a red line). The mean of W.obs is reported, along with its 95\% quantile-based probability interval (see \code{\link{p.interval}}), the probability \eqn{p(W^{obs} > W^{rep})}{p(W.obs > W.rep)}, and the indicated results, either homoskedastic or heteroskedastic. Each element of the returned vector is the probability \eqn{p(W^{obs} > W^{rep})}{p(W.obs > W.rep)}. When the probability is \eqn{p < 0.025}{p < 0.025} or \eqn{p > 0.975}{p > 0.975}, heteroskedastic variance is indicated. Otherwise, the variances of the groups are assumed not to differ effectively. } \references{ Levene, H. (1960). "Robust Tests for Equality of Variances". In I. Olkins, S. G. Ghurye, W. Hoeffding, W. G. Madow, & H. B. Mann (Eds.), \emph{Contributions to Probability and Statistics}, p. 278--292. Stanford University Press: Stanford, CA. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, \code{\link{p.interval}}, and \code{\link{VariationalBayes}}. } \examples{ #First, update the model with IterativeQuadrature, LaplaceApproximation, # LaplacesDemon, PMC, or VariationalBayes. #Then, use the predict function, creating, say, object Pred. #Finally: #Levene.Test(Pred) } \keyword{Homoskedasticity} \keyword{Utility} LaplacesDemon/man/as.parm.names.Rd0000755000176200001440000000702615144316355016505 0ustar liggesusers\name{as.parm.names} \alias{as.parm.names} \title{Parameter Names} \description{ This function creates a vector of parameter names from a list of parameters, and the list may contain any combination of scalars, vectors, matrices, upper-triangular matrices, and arrays. } \usage{ as.parm.names(x, uppertri=NULL) } \arguments{ \item{x}{This required argument is a list of named parameters. The list may contain scalars, vectors, matrices, and arrays. The value of the named parameters does not matter here, though they are usually set to zero. However, if a missing value occurs, then the associated element is omitted in the output.} \item{uppertri}{This optional argument must be a vector with a length equal to the number of named parameters. Each element in \code{uppertri} must be either a 0 or 1, where a 1 indicates that an upper triangular matrix will be used for the associated element in the vector of named parameters. Each element of \code{uppertri} is associated with a named parameter. The \code{uppertri} argument does not function with arrays.} } \details{ Each \code{model} function for \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}} requires a vector of parameters (specified at first as \code{Initial.Values}) and a list of data. One component in the list of data must be named \code{parm.names}. Each element of \code{parm.names} is a name associated with the corresponding parameter in \code{Initial.Values}. The \code{parm.names} vector is easy to program explicitly for a simple model, but can require considerably more programming effort for more complicated models. The \code{as.parm.names} function is a utility function designed to minimize programming by the user. For example, a simple model may only require \code{parm.names <- c("alpha", "beta[1]", "beta[2]", "sigma")}. A more complicated model may contain hundreds of parameters that are a combination of scalars, vectors, matrices, upper-triangular matrices, and arrays, and is the reason for the \code{as.parm.names} function. The code for the above is \code{as.parm.names(list(alpha=0, beta=rep(0,2), sigma=0))}. In the case of an upper-triangular matrix, simply pass the full matrix to \code{as.parm.names} and indicate that only the upper-triangular will be used via the \code{uppertri} argument. For example, \code{as.parm.names(list(beta=rep(0,J),U=diag(K)), uppertri=c(0,1))} creates parameter names for a vector of \eqn{\beta} parameters of length \eqn{J} and an upper-triangular matrix \eqn{\textbf{U}} of dimension \eqn{K}. Numerous examples may be found in the accompanying ``Examples'' vignette. } \value{ This function returns a vector of parameter names. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{IterativeQuadrature}} \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) N <- 100 J <- 5 y <- rnorm(N,0,1) X <- matrix(runif(N*J,-2,2),N,J) S <- diag(J) T <- diag(2) mon.names <- c("LP","sigma") parm.names <- as.parm.names(list(log.sigma=0, beta=rep(0,J), S=diag(J), T=diag(2)), uppertri=c(0,0,0,1)) MyData <- list(J=J, N=N, S=S, T=T, X=X, mon.names=mon.names, parm.names=parm.names, y=y) MyData } \keyword{Parameter Names} \keyword{Utility}LaplacesDemon/man/AcceptanceRate.Rd0000755000176200001440000000747615144316355016715 0ustar liggesusers\name{AcceptanceRate} \alias{AcceptanceRate} \title{Acceptance Rate} \description{ The \code{Acceptance.Rate} function calculates the acceptance rate per chain from a matrix of posterior MCMC samples. } \usage{ AcceptanceRate(x) } \arguments{ \item{x}{This required argument accepts a \eqn{S \times J}{S x J} numeric matrix of \eqn{S} posterior samples for \eqn{J} variables, such as \code{Posterior1} or \code{Posterior2} from an object of class \code{demonoid}.} } \details{ The acceptance rate of an MCMC algorithm is the percentage of iterations in which the proposals were accepted. Optimal Acceptance Rates\cr The optimal acceptance rate varies with the number of parameters and by algorithm. Algorithms with componentwise Gaussian proposals have an optimal acceptance rate of 0.44, regardless of the number of parameters. Algorithms that update with multivariate Gaussian proposals tend to have an optimal acceptance rate that ranges from 0.44 for one parameter (one IID Gaussian target distribution) to 0.234 for an infinite number of parameters (IID Gaussian target distributions), and 0.234 is approached quickly as the number of parameters increases. The AHMC, HMC, and THMC algorithms have an optimal acceptance rate of 0.67, except with the algorithm specification \code{L=1}, where the optimal acceptance rate is 0.574. The target acceptance rate is specified in HMCDA and NUTS, and the recommended rate is 0.65 and 0.60 respectively. Some algorithms have an acceptance rate of 1, such as AGG, ESS, GG, GS (MISS only), SGLD, or Slice. Global and Local Acceptance Rates\cr \code{\link{LaplacesDemon}} reports the global acceptance rate for the un-thinned chains. However, componentwise algorithms make a proposal per parameter, and therefore have a local acceptance rate for each parameter. Since only the global acceptance rate is reported, the \code{AcceptanceRate} function may be used to calculate the local acceptance rates from a matrix of un-thinned posterior samples. Thinning\cr Thinned samples tend to have higher local acceptance rates than un-thinned samples. With enough samples and enough thinning, local acceptance rates approach 1. Local acceptance rates do not need to approach the optimal acceptance rates above. Conversely, local acceptance rates do not need to approach 1, because too much information may possibly be discarded by thinning. For more information on thinning, see the \code{\link{Thin}} function. Diagnostics\cr The \code{AcceptanceRate} function may be used to calculate local acceptance rates on a matrix of thinned or un-thinned samples. Any chain with a local acceptance rate that is an outlier may be studied for reasons that may cause the outlier. A local acceptance rate outlier does not violate theory and is often acceptable, but may indicate a potential problem. Only some of the many potential problems include: identifiability, model misspecification, multicollinearity, multimodality, choice of prior distributions, or becoming trapped in a low-probability space. The solution to local acceptance rate outliers tends to be either changing the MCMC algorithm or re-specifying the model or priors. For example, an MCMC algorithm that makes multivariate Gaussian proposals for a large number of parameters may have low global and local acceptance rates when far from the target distributions. } \value{ The \code{AcceptanceRate} function returns a vector of acceptance rates, one for each chain. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplacesDemon}}, \code{\link{MISS}}, \code{\link{PosteriorChecks}}, and \code{\link{Thin}}. } \examples{ library(LaplacesDemon) AcceptanceRate(matrix(rnorm(5000),1000,5)) } \keyword{Diagnostic} \keyword{MCMC} \keyword{Utility} LaplacesDemon/man/dist.Normal.Wishart.Rd0000755000176200001440000000563715144316355017662 0ustar liggesusers\name{dist.Normal.Wishart} \alias{dnormwishart} \alias{rnormwishart} \title{Normal-Wishart Distribution} \description{ These functions provide the density and random number generation for the normal-Wishart distribution. } \usage{ dnormwishart(mu, mu0, lambda, Omega, S, nu, log=FALSE) rnormwishart(n=1, mu0, lambda, S, nu) } \arguments{ \item{mu}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{mu0}{This is mean vector \eqn{\mu_0}{mu[0]} with length \eqn{k} or matrix with \eqn{k} columns.} \item{lambda}{This is a positive-only scalar.} \item{n}{This is the number of random draws.} \item{nu}{This is the scalar degrees of freedom \eqn{\nu}{nu}.} \item{Omega}{This is a \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega}.} \item{S}{This is the symmetric, positive-semidefinite, \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\mu, \Omega) = \mathcal{N}(\mu | \mu_0, (\lambda\Omega)^{-1}) \mathcal{W}(\Omega | \nu, \textbf{S})}{p(mu, Omega) = N(mu | mu[0], (lambda Omega)^(-1)) W(Omega | nu, S)} \item Inventors: Unknown \item Notation 1: \eqn{(\mu, \Omega) \sim \mathcal{NW}(\mu_0, \lambda, \textbf{S}, \nu)}{(mu, Omega) ~ NW(mu[0], lambda, S, nu)} \item Notation 2: \eqn{p(\mu, \Omega) = \mathcal{NW}(\mu, \Omega | \mu_0, \lambda, \textbf{S}, \nu)}{p(mu, Omega) = NW(mu, Omega | mu[0], lambda, S, nu)} \item Parameter 1: location vector \eqn{\mu_0}{mu[0]} \item Parameter 2: \eqn{\lambda > 0}{lambda > 0} \item Parameter 3: symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S} \item Parameter 4: degrees of freedom \eqn{\nu \ge k}{nu >= k} \item Mean: Unknown \item Variance: Unknown \item Mode: Unknown } The normal-Wishart distribution, or Gaussian-Wishart distribution, is a multivariate four-parameter continuous probability distribution. It is the conjugate prior of a multivariate normal distribution with unknown mean and precision matrix. } \value{ \code{dnormwishart} gives the density and \code{rnormwishart} generates random deviates and returns a list with two components. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dmvnp}} and \code{\link{dwishart}}. } \examples{ library(LaplacesDemon) K <- 3 mu <- rnorm(K) mu0 <- rnorm(K) nu <- K + 1 S <- diag(K) lambda <- runif(1) #Real scalar Omega <- as.positive.definite(matrix(rnorm(K^2),K,K)) x <- dnormwishart(mu, mu0, lambda, Omega, S, nu, log=TRUE) out <- rnormwishart(n=10, mu0, lambda, S, nu) joint.density.plot(out$mu[,1], out$mu[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/predict.demonoid.Rd0000755000176200001440000000766315144316355017300 0ustar liggesusers\name{predict.demonoid} \alias{predict.demonoid} \title{Posterior Predictive Checks} \description{ This may be used to predict either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}), and then perform posterior predictive checks. Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is predicted given an object of class \code{demonoid}, the model specification, and data. } \usage{\method{predict}{demonoid}(object, Model, Data, CPUs=1, Type="PSOCK", \dots)} \arguments{ \item{object}{An object of class \code{demonoid} is required.} \item{Model}{The model specification function is required.} \item{Data}{A data set in a list is required. The dependent variable is required to be named either \code{y} or \code{Y}.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} \item{\dots}{Additional arguments are unused.} } \details{ This function passes each iteration of marginal posterior samples along with data to \code{Model}, where the fourth component in the return list is labeled \code{yhat}, and is a vector of expectations of \eqn{\textbf{y}}{y}, given the samples, model specification, and data. Stationary samples are used if detected, otherwise non-stationary samples will be used. To predict \eqn{\textbf{y}^{rep}}{y[rep]}, simply supply the data set used to estimate the model. To predict \eqn{\textbf{y}^{new}}{y[new]}, supply a new data set instead (though for some model specifications, this cannot be done, and \eqn{\textbf{y}_{new}}{y[new]} must be specified in the \code{Model} function). If the new data set does not have \eqn{\textbf{y}}{y}, then create \code{y} in the list and set it equal to something sensible, such as \code{mean(y)} from the original data set. The variable \code{y} must be a vector. If instead it is matrix \code{Y}, then it will be converted to vector \code{y}. The vectorized length of \code{y} or \code{Y} must be equal to the vectorized length of \code{yhat}, the fourth component of the return list of the \code{Model} function. Parallel processing may be performed when the user specifies \code{CPUs} to be greater than one, implying that the specified number of CPUs exists and is available. Parallelization may be performed on a multicore computer or a computer cluster. Either a Simple Network of Workstations (SNOW) or Message Passing Interface is used (MPI). With small data sets and few samples, parallel processing may be slower, due to computer network communication. With larger data sets and more samples, the user should experience a faster run-time. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. } \value{ This function returns an object of class \code{demonoid.ppc} (where ppc stands for posterior predictive checks). The returned object is a list with the following components: \item{y}{This stores the vectorized form of \eqn{\textbf{y}}{y}, the dependent variable.} \item{yhat}{This is a \eqn{N \times S}{N x S} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and \eqn{S} is the number of posterior samples.} \item{Deviance}{This is a vector of predictive deviance.} } \author{Statisticat, LLC.} \seealso{ \code{\link{LaplacesDemon}} } \keyword{High Performance Computing} \keyword{Posterior Predictive Checks} \keyword{Predict} LaplacesDemon/man/Elicitation.Rd0000755000176200001440000001264115144316355016305 0ustar liggesusers\name{Elicitation} \alias{delicit} \alias{elicit} \title{Prior Elicitation} \description{ Prior elicitation is the act of inducing personal opinion to be expressed by the probabilities the person associates with an event (Savage, 1971). The \code{elicit} function elicits personal opinion and the \code{delicit} function estimates probability density to be used with model specification in the \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}} functions. } \usage{ delicit(theta, x, a=-Inf, b=Inf, log=FALSE) elicit(n, cats, cat.names, show.plot=FALSE) } \arguments{ \item{theta}{This is a scalar or vector of parameters for which the density is estimated with respect to the kernel density estimate of \code{x}.} \item{x}{This is the elicited vector.} \item{a}{This is an optional lower bound for support.} \item{b}{This is an optional upper bound for support.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} \item{n}{This is the number of chips.} \item{cats}{This is a vector of \eqn{k} categories, bins, or intervals. When the variable is continuous, the mid-point of each category is used. For example, if the continuous interval [0,1] has 5 equal-sized categories, then \code{cats=c(0.1,0.3,0.5,0.7,0.9)}.} \item{cat.names}{This is a vector of category names. For example, if the continuous interval [0,1] has 5 equal-sized categories, then one way or naming the categories may be \code{cat.names=c("0:<.2", ".2:<.4", ".4:<.6", ".6:<.8", ".8:1")}.} \item{show.plot}{Logical. If \code{show.plot=TRUE}, then a barplot is shown after each allocation of chips.} } \details{ The \code{elicit} function elicits a univariate, discrete, non-conjugate, informative, prior probability distribution by offering a number of chips (specified as \code{n} by the statistician) for the user to allocate into categories specified by the statistician. The results of multiple elicitations (meaning, with multiple people), each the output of \code{elicit}, may be combined with the \code{c} function in base R. This discrete distribution is included with the data for a model and supplied to a model specification function, where in turn it is supplied to the \code{delicit} function, which estimates the density at the current value of the prior distribution, \eqn{p(\theta)}{p(theta)}. The prior distribution may be either continuous or discrete, will be proper, and may have bounded support (constrained to an interval). For a minimal example, a statistician elicits the prior probability distribution for a regression effect, \eqn{\beta}. Non-statisticians would not be asked about expected parameters, but could be asked about how much \eqn{\textbf{y}}{y} would be expected to change given a one-unit change in \eqn{\textbf{x}}{x}. After consulting with others who have prior knowledge, the support does not need to be bounded, and their guesses at the range result in the statistician creating 5 catgories from the interval [-1,4], where each interval has a width of one. The statistician schedules time with 3 people, and each person participates when the statistician runs the following R code: \code{x <- elicit(n=10, cats=c(-0.5, 0.5, 1.5, 2.5, 3.5), cat.names=c("-1:<0", "0:<1", "1:<2", "2:<3", "3:4"), show.plot=TRUE)} Each of the 3 participants receives 10 chips to allocate among the 5 categories according to personal beliefs in the probability of the regression effect. When the statistician and each participant accept their elicited distribution, all 3 vectors are combined into one vector. In the model form, the prior is expressed as \deqn{p(\beta) \sim \mathcal{EL}}{p(beta) ~ EL} and the code for the model specification is \code{elicit.prior <- delicit(beta, x, log=TRUE)} This method is easily extended to priors that are multivariate, correlated, or conditional. As an alternative, Hahn (2006) also used a categorical approach, eliciting judgements about the relative likelihood of each category, and then minimizes the KLD (for more information on KLD, see the \code{\link{KLD}} function). } \references{ Hahn, E.D. (2006). "Re-examining Informative Prior Elicitation Through the Lens of Markov chain Monte Carlo Methods". \emph{Journal of the Royal Statistical Society}, A 169 (1), p. 37--48. Savage, L.J. (1971). "Elicitation of Personal Probabilities and Expectations". \emph{Journal of the American Statistical Association}, 66(336), p. 783--801. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{de.Finetti.Game}}, \code{\link{KLD}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) x <- c(1,2,2,3,3,3,4,7,8,8,9,10) #Elicited with elicit function theta <- seq(from=-5,to=15,by=.1) plot(theta, delicit(theta,x), type="l", xlab=expression(theta), ylab=expression("p(" * theta * ")")) } \keyword{Elicitation} \keyword{Personal Probability} \keyword{Prior} \keyword{Subjective Probability} \keyword{Utility}LaplacesDemon/man/Model.Spec.Time.Rd0000755000176200001440000002447715144316355016701 0ustar liggesusers\name{Model.Specification.Time} \alias{Model.Spec.Time} \title{Model Specification Time} \description{ The \code{Model.Spec.Time} function returns the time in minutes to evaluate a model specification a number of times, as well as the evaluations per minute, and componentwise iterations per minute. } \usage{ Model.Spec.Time(Model, Initial.Values, Data, n=1000) } \arguments{ \item{Model}{This requried argument is a model specification function. For more information, see \code{\link{LaplacesDemon}}.} \item{Initial.Values}{This required argument is a vector of initial values for the parameters.} \item{Data}{This required argument is a list of data. For more information, see \code{\link{LaplacesDemon}}.} \item{n}{This is the number of evaluations of the model specification, and accuracy increases with \code{n}.} } \details{ The largest single factor to affect the run-time of an algorithm -- whether it is with \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}} -- is the time that it takes to evaluate the model specification. This has also been observed in Rosenthal (2007). It is highly recommended that a user of the \code{LaplacesDemon} package should attempt to reduce the run-time of the model specification, usually by testing alternate forms of code for speed. This is especially true with big data, such as with the \code{\link{BigData}} function. Every function in the LaplacesDemon package is byte-compiled, which is a recent option in R. This reduces run-time, thanks to Tierney's compiler package in base R. The model specification, however, is specified by the user, and should be byte-compiled. The reduction in run-time may range from mild to dramatic, depending on the model. It is highly recommended that users concerned with run-time activate the compiler package and use the \code{cmpfun} function, as per the example below. A model specification function that is optimized for speed and involves many records may result in a model update run-time that is considerably less than other popular MCMC-based software algorithms that loop through records, even when those algorithms are coded in \code{C} or other fast languages. For a comparison, see the ``Laplace's Demon Tutorial'' vignette. However, if a model specification function in the LaplacesDemon package is not fully vectorized (contains \code{for} loops and \code{apply} functions), then run-time will typically be slower than other popular MCMC-based software algorithms. The speed of calculating the model specification function is affected by parameter constraints, such as with the \code{\link{interval}} function. Parameter constraints may add considerable variability to the speed of this calculation, and usually more variation occurs with initial values that are far from the target distributions. Distributions in the \code{LaplacesDemon} package usually have logical checks to ensure correctness. These checks may slow the calculation of the density, for example. If the user is confident these checks are unnecessary for their model, then the user may copy the code to a new function name and comment-out the checks to improve speed. When speed is of paramount importance, a user is encouraged to experiment with writing the model specification function in another language such as in \code{C++} with the \code{Rcpp} package, and calling drop-in replacement functions from within the \code{Model} function, or re-writing the model function entirely in \code{C++}. For an introduction to including \code{C++} in \pkg{LaplacesDemon}, see \url{https://web.archive.org/web/20150227225556/http://www.bayesian-inference.com/softwarearticlescppsugar}. When a model specification function is computationally expensive, another approach to reduce run-time may be for the user to write parallelized code within the model, splitting up difficult tasks and assigning each to a separate CPU. Another use for \code{Model.Spec.Time} is to allow the user to make an informed decision about which MCMC algorithm to select, given the speed of their model specification. For example, the Adaptive Metropolis-within-Gibbs (AMWG) of Roberts and Rosenthal (2009) is currently the adaptive MCMC algorithm of choice in general in many cases, but this choice is conditional on run-time. While other MCMC algorithms in \code{LaplacesDemon} evaluate the model specification function once per iteration, componentwise algorithms such as in the MWG family evaluate it once per parameter per iteration, significantly increasing run-time per iteration in large models. The \code{Model.Spec.Time} function may forewarn the user of the associated run-time, and if it should be decided to go with an alternate MCMC algorithm, such as AMM, in which each element of its covariance matrix must stabilize for the chains to become stationary. AMM, for example, will require many more iterations of burn-in (for more information, see the \code{\link{burnin}} function), but with numerous iterations, allows more thinning. A general recommendation may be to use AMWG when \code{Componentwise.Iters.per.Minute} >= 1000, but this is subjective and best determined by each user for each model. A better decision may be made by comparing MCMC algorithms with the \code{\link{Juxtapose}} function for a particular model. Following are a few common suggestions for increasing the speed of \code{R} code in the model specification function. There are often exceptions to these suggestions, so case-by-case experimentation is also suggested. \itemize{ \item Replace exponents with multiplied terms, such as \code{x^2} with \code{x*x}. \item Replace \code{mean(x)} with \code{sum(x)/length(x)}. \item Replace parentheses (when possible) with curly brackets, such as \code{x*(a+b)} with \code{x*\{a+b\}}. \item Replace \code{tcrossprod(Data$X, t(beta))} with \code{Data$X \%*\% beta} when there are few predictors, and avoid \code{tcrossprod(beta, Data$X)}, which is always slowest. \item Vectorize functions and eliminate \code{apply} and \code{for} functions. There are often specialized functions. For example, \code{max.col(X)} is faster than \code{apply(X, 1, which.max)}. } When seeking speed, things to consider beyond the LaplacesDemon package are the Basic Linear Algebra System (BLAS) and hardware. The ATLAS (Automatically Tuned Linear Algebra System) should be worth installing (and there are several alternatives), but this discussion is beyond the scope of this documentation. Lastly, the speed at which the computer can process iterations is limited by its hardware, and more should be considered than merely the CPU (Central Processing Unit). Again, though, this is beyond the scope of this documentation. } \value{ The \code{Model.Spec.Time} function returns a list with three components: \item{Time}{This is the time in minutes to evaluate the model specification \code{n} times.} \item{Evals.per.Minute}{This is the number of evaluations of the model specification per minute: \code{n} / \code{Time}. This is also the number of iterations per minute in an algorithm that is not componentwise, where one evaluation occurs per iteration.} \item{Componentwise.Iters.per.Minute}{This is the number of iterations per minute in a componentwise MCMC algorithm, such as AMWG or MWG. It is the evaluations per minute divided by the number of parameters, since an evaluation must occur for each parameter, for each iteration.} } \references{ Roberts, G.O. and Rosenthal, J.S. (2009). "Examples of Adaptive MCMC". \emph{Computational Statistics and Data Analysis}, 18, p. 349--367. } \author{Statisticat, LLC.} \seealso{ \code{\link{.C}}, \code{\link{.Fortran}}, \code{\link{apply}}, \code{\link{BigData}}, \code{\link{interval}}, \code{\link{IterativeQuadrature}}, \code{\link{Juxtapose}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{max.col}}, \code{\link{PMC}}, \code{\link{system.time}}, and \code{\link{VariationalBayes}}. } \examples{ # The accompanying Examples vignette is a compendium of examples. #################### Load the LaplacesDemon Library ##################### library(LaplacesDemon) ############################## Demon Data ############################### data(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) J <- ncol(X) for (j in 2:J) {X[,j] <- CenterScale(X[,j])} ######################### Data List Preparation ######################### mon.names <- "LP" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) return(c(rnormv(Data$J,0,10), rhalfcauchy(1,5))) MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ########################## Model Specification ########################## Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log of Prior Densities beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(Data$X, t(beta)) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + beta.prior + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } set.seed(666) ############################ Initial Values ############################# Initial.Values <- GIV(Model, MyData, PGF=TRUE) ############################ Model.Spec.Time ############################ ### Not byte-compiled Model.Spec.Time(Model, Initial.Values, MyData) ### Byte-compiled library(compiler) Model <- cmpfun(Model) Model.Spec.Time(Model, Initial.Values, MyData) } \keyword{Utility} LaplacesDemon/man/dist.Generalized.Poisson.Rd0000755000176200001440000000751115144316355020665 0ustar liggesusers\name{dist.Generalized.Poisson} \alias{dgpois} \title{Generalized Poisson Distribution} \description{ The density function is provided for the univariate, discrete, generalized Poisson distribution with location parameter \eqn{\lambda}{lambda} and scale parameter \eqn{\omega}{omega}. } \usage{ dgpois(x, lambda=0, omega=0, log=FALSE) } \arguments{ \item{x}{This is a vector of quantiles.} \item{lambda}{This is the parameter \eqn{\lambda}{lambda}.} \item{omega}{This is the parameter \eqn{\omega}{omega}, which should be in the interval [0,1) for positive counts.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Discrete Univariate \item Density: \eqn{p(\theta) = (1 - \omega) \lambda \frac{[(1 - \omega) \lambda + \omega \theta]^{\theta - 1}}{\theta!} \exp{-[(1 - \omega) \lambda + \omega \theta]}}{(1 - omega) lambda (((1 - omega) lambda + omega theta)^(y-1) / theta!) e(-((1 - omega) lambda + omega theta))} \item Inventor: Consul (1989) and Ntzoufras et al. (2005) \item Notation 1: \eqn{\theta \sim \mathrm{GP}(\lambda,\omega)}{theta ~ GP(lambda, omega)} \item Notation 2: \eqn{p(\theta) = \mathrm{GP}(\theta | \lambda, \omega)}{p(theta) = GP(theta | lambda, omega)} \item Parameter 1: location parameter \eqn{\lambda}{lambda} \item Parameter 2: scale parameter \eqn{\omega \in [0,1)}{omega in [0,1)} \item Mean: \eqn{E(\theta) = \lambda}{E(theta) = lambda} \item Variance: \eqn{var(\theta) = \lambda(1 - \omega)^{-2}}{var(theta) = lambda(1 - omega)^(-2)} } The generalized Poisson distribution (Consul, 1989) is also called the Lagrangian Poisson distribution. The simple Poisson distribution is a special case of the generalized Poisson distribution. The generalized Poisson distribution is used in generalized Poisson regression as an extension of Poisson regression that accounts for overdispersion. The \code{dgpois} function is parameterized according to Ntzoufras et al. (2005), which is easier to interpret and estimates better with MCMC. Valid values for omega are in the interval [0,1) for positive counts. For \eqn{\omega = 0}{omega = 0}, the generalized Poisson reduces to a simple Poisson with mean \eqn{\lambda}{lambda}. Note that it is possible for \eqn{\omega < 0}{omega < 0}, but this implies underdispersion in count data, which is uncommon. The \code{dgpois} function returns warnings or errors, so \eqn{\omega}{omega} should be non-negative here. The dispersion index (DI) is a variance-to-mean ratio, and is \eqn{DI = (1 - \omega)^{-2}}{DI = (1 - omega)^(-2)}. A simple Poisson has DI=1. When DI is far from one, the assumption that the variance equals the mean of a simple Poisson is violated. } \value{ \code{dgpois} gives the density. } \references{ Consul, P. (1989). `"Generalized Poisson Distribution: Properties and Applications". Marcel Decker: New York, NY. Ntzoufras, I., Katsis, A., and Karlis, D. (2005). "Bayesian Assessment of the Distribution of Insurance Claim Counts using Reversible Jump MCMC", \emph{North American Actuarial Journal}, 9, p. 90--108. } \seealso{ \code{\link{dnbinom}} and \code{\link{dpois}}. } \examples{ library(LaplacesDemon) y <- rpois(100, 5) lambda <- rpois(100, 5) x <- dgpois(y, lambda, 0.5) #Plot Probability Functions x <- seq(from=0, to=20, by=1) plot(x, dgpois(x,1,0.5), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dlaplace(x,1,0.6), type="l", col="green") lines(x, dlaplace(x,1,0.7), type="l", col="blue") legend(2, 0.9, expression(paste(lambda==1, ", ", omega==0.5), paste(lambda==1, ", ", omega==0.6), paste(lambda==1, ", ", omega==0.7)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/dist.Multivariate.Cauchy.Cholesky.Rd0000755000176200001440000000764215144316355022451 0ustar liggesusers\name{dist.Multivariate.Cauchy.Cholesky} \alias{dmvcc} \alias{rmvcc} \title{Multivariate Cauchy Distribution: Cholesky Parameterization} \description{ These functions provide the density and random number generation for the multivariate Cauchy distribution, given the Cholesky parameterization. } \usage{ dmvcc(x, mu, U, log=FALSE) rmvcc(n=1, mu, U) } \arguments{ \item{x}{This is either a vector of length \eqn{k} or a matrix with a number of columns, \eqn{k}, equal to the number of columns in scale matrix \eqn{\textbf{S}}{S}.} \item{n}{This is the number of random draws.} \item{mu}{This is a numeric vector representing the location parameter, \eqn{\mu}{mu} (the mean vector), of the multivariate distribution It must be of length \eqn{k}, as defined above.} \item{U}{This is the \eqn{k \times k}{k x k} upper-triangular matrix that is Cholesky factor \eqn{\textbf{U}}{U} of the positive-definite scale matrix \eqn{\textbf{S}}{S}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{\Gamma[(1+k)/2]}{\Gamma(1/2)1^{k/2}\pi^{k/2}|\Sigma|^{1/2}[1+(\theta-\mu)^{\mathrm{T}}\Sigma^{-1}(\theta-\mu)]^{(1+k)/2}}}{p(theta) = Gamma[(1+k)/2] / {Gamma(1/2)1^(k/2)pi^(k/2)|Sigma|^(1/2)[1+(theta-mu)^T*Sigma^(-1)(theta-mu)]^[(1+k)/2]}} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathcal{MC}_k(\mu, \Sigma)}{theta ~ MC[k](mu, Sigma)} \item Notation 2: \eqn{p(\theta) = \mathcal{MC}_k(\theta | \mu, \Sigma)}{p(theta) = MC[k](theta | mu, Sigma)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} scale matrix \eqn{\Sigma}{Sigma} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = }{var(theta) = } \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate Cauchy distribution is a multidimensional extension of the one-dimensional or univariate Cauchy distribution. The multivariate Cauchy distribution is equivalent to a multivariate t distribution with 1 degree of freedom. A random vector is considered to be multivariate Cauchy-distributed if every linear combination of its components has a univariate Cauchy distribution. The Cauchy distribution is known as a pathological distribution because its mean and variance are undefined, and it does not satisfy the central limit theorem. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, the Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dmvc}, \code{dmvcc} must additionally matrix-multiply the Cholesky back to the scake matrix, but it does not have to check for or correct the scale matrix to positive-definiteness, which overall is slower. Compared with \code{rmvc}, \code{rmvcc} is faster because the Cholesky decomposition has already been performed. } \value{ \code{dmvcc} gives the density and \code{rmvcc} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{chol}}, \code{\link{dcauchy}}, \code{\link{dinvwishartc}}, \code{\link{dmvcpc}}, \code{\link{dmvtc}}, and \code{\link{dmvtpc}}. } \examples{ library(LaplacesDemon) x <- seq(-2,4,length=21) y <- 2*x+10 z <- x+cos(y) mu <- c(1,12,2) Sigma <- matrix(c(1,2,0,2,5,0.5,0,0.5,3), 3, 3) U <- chol(Sigma) f <- dmvcc(cbind(x,y,z), mu, U) X <- rmvcc(1000, rep(0,2), diag(2)) X <- X[rowSums((X >= quantile(X, probs=0.025)) & (X <= quantile(X, probs=0.975)))==2,] joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution} LaplacesDemon/man/print.demonoid.Rd0000755000176200001440000000171615144337635016777 0ustar liggesusers\name{print.demonoid} \alias{print.demonoid} \title{Print an object of class \code{demonoid} to the screen} \description{ This may be used to print the contents of an object of class \code{demonoid} to the screen. } \usage{\method{print}{demonoid}(x, \dots)} \arguments{ \item{x}{An object of class \code{demonoid} is required.} \item{\dots}{Additional arguments are unused.} } \details{ If the user has an object of class \code{demonoid.hpc}, then the \code{print} function may still be used by specifying the chain as a component in a list, such as printing the second chain with \code{print(Fit[[2]])} when the \code{demonoid.hpc} object is named \code{Fit}, for example. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{Consort}}, \code{\link{LaplacesDemon}}, and \code{\link{LaplacesDemon.hpc}}. } \examples{### See the LaplacesDemon function for an example.} \keyword{print} LaplacesDemon/man/predict.iterquad.Rd0000755000176200001440000001162115144316355017305 0ustar liggesusers\name{predict.iterquad} \alias{predict.iterquad} \title{Posterior Predictive Checks} \description{ This may be used to predict either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}), and then perform posterior predictive checks. Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is predicted given an object of class \code{iterquad}, the model specification, and data. This function requires that posterior samples were produced with \code{\link{IterativeQuadrature}}. } \usage{\method{predict}{iterquad}(object, Model, Data, CPUs=1, Type="PSOCK", \dots)} \arguments{ \item{object}{An object of class \code{iterquad} is required.} \item{Model}{The model specification function is required.} \item{Data}{A data set in a list is required. The dependent variable is required to be named either \code{y} or \code{Y}.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} \item{\dots}{Additional arguments are unused.} } \details{ Since iterative quadrature characterizes marginal posterior distributions with means and variances, and posterior predictive checks involve samples, the \code{predict.iterquad} function requires the use of independent samples of the marginal posterior distributions, provided by \code{\link{IterativeQuadrature}} when \code{sir=TRUE}. The samples of the marginal posterior distributions of the target distributions (the parameters) are passed along with the data to the \code{Model} specification and used to draw samples from the deviance and monitored variables. At the same time, the fourth component in the returned list, which is labeled \code{yhat}, is a vector of expectations of \eqn{\textbf{y}}{y}, given the samples, model specification, and data. To predict \eqn{\textbf{y}^{rep}}{y[rep]}, simply supply the data set used to estimate the model. To predict \eqn{\textbf{y}^{new}}{y[new]}, supply a new data set instead (though for some model specifications, this cannot be done, and \eqn{\textbf{y}_{new}}{y[new]} must be specified in the \code{Model} function). If the new data set does not have \eqn{\textbf{y}}{y}, then create \code{y} in the list and set it equal to something sensible, such as \code{mean(y)} from the original data set. The variable \code{y} must be a vector. If instead it is matrix \code{Y}, then it will be converted to vector \code{y}. The vectorized length of \code{y} or \code{Y} must be equal to the vectorized length of \code{yhat}, the fourth component of the returned list of the \code{Model} function. Parallel processing may be performed when the user specifies \code{CPUs} to be greater than one, implying that the specified number of CPUs exists and is available. Parallelization may be performed on a multicore computer or a computer cluster. Either a Simple Network of Workstations (SNOW) or Message Passing Interface is used (MPI). With small data sets and few samples, parallel processing may be slower, due to computer network communication. With larger data sets and more samples, the user should experience a faster run-time. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. } \value{ This function returns an object of class \code{iterquad.ppc} (where ``ppc'' stands for posterior predictive checks). The returned object is a list with the following components: \item{y}{ This stores \eqn{\textbf{y}}{y}, the dependent variable.} \item{yhat}{ This is a \eqn{N \times S}{N x S} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and \eqn{S} is the number of posterior samples.} \item{Deviance}{ This is a vector of length \eqn{S}, where \eqn{S} is the number of independent posterior samples. Samples are obtained with the sampling importance resampling algorithm, \code{\link{SIR}}.} \item{monitor}{ This is a \eqn{N \times S}{N x S} matrix, where \eqn{N} is the number of monitored variables and \eqn{S} is the number of independent posterior samples. Samples are obtained with the sampling importance resampling algorithm, \code{\link{SIR}}.} } \author{Statisticat, LLC.} \seealso{ \code{\link{IterativeQuadrature}} and \code{\link{SIR}}. } \keyword{High Performance Computing} \keyword{Posterior Predictive Checks} \keyword{Predict} LaplacesDemon/man/dist.Dirichlet.Rd0000755000176200001440000000773515144316355016722 0ustar liggesusers\name{dist.Dirichlet} \alias{ddirichlet} \alias{rdirichlet} \title{Dirichlet Distribution} \description{ This is the density function and random generation from the Dirichlet distribution. } \usage{ ddirichlet(x, alpha, log=FALSE) rdirichlet(n, alpha) } \arguments{ \item{x}{This is a vector containing a single deviate or matrix containing one random deviate per row. Each vector, or matrix row, must sum to 1.} \item{n}{This is the number of random deviates to generate.} \item{alpha}{This is a vector or matrix of shape parameters.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{\gamma(\alpha_1 + \dots + \alpha_k)}{\gamma \alpha_1 \dots \gamma \alpha_k} \theta^{(\alpha[1]-1)}_1 \dots \theta^{(\alpha[k]-1)}_k, \quad \theta_1, \dots, \theta_k > 0, \quad \sum^k_{j=1} \theta_j = 1}{p(theta) = (gamma(alpha[1] + ... + alpha[k]) / (gamma(alpha[1]) ... gamma(alpha[k]))) * theta[1]^(alpha[1] - 1) ... theta[k]^(alpha[k] - 1) theta[1],...,theta[k] >= 0, (the sum of j=1 to k of) theta[j] = 1} \item Inventor: Johann Peter Gustav Lejeune Dirichlet (1805-1859) \item Notation 1: \eqn{\theta \sim}{theta ~} Dirichlet(\eqn{\alpha_1,\dots,\alpha_k}{alpha[1],..., alpha[k]}) \item Notation 2: \eqn{p(\theta) =}{p(theta) =} Dirichlet(\eqn{\theta | \alpha_1,\dots,\alpha_k}{theta | alpha[1],...,alpha[k]}) \item Notation 3: \eqn{\theta \sim \mathcal{DIR}(\alpha_1,\dots,\alpha_k)}{theta ~ Dir(alpha[1],..., alpha[k])} \item Notation 4: \eqn{p(\theta) = \mathcal{DIR}(\theta | \alpha_1,\dots,\alpha_k)}{p(theta) = Dir(theta | alpha[1],...,alpha[k])} \item Parameter: 'prior sample sizes' \eqn{\alpha_j > 0, \alpha_0 = \sum^k_{j=1} \alpha_j}{alpha[j] > 0, alpha[0] = (the sum from j=1 to k of) alpha[j]} \item Mean: \eqn{E(\theta_j) = \frac{\alpha_j}{\alpha_0}}{E(theta[j]) = alpha[j] / alpha[0]} \item Variance: \eqn{var(\theta_j) = \frac{\alpha_j (\alpha_0 - \alpha_j)}{\alpha^2_0 (\alpha_0 + 1)}}{var(theta[j]) = (alpha[j] * (alpha[0] - alpha[j])) / (alpha[0]^2 * (alpha[0]+ 1))} \item Covariance: \eqn{cov(\theta_i, \theta_j) = - \frac{\alpha_i \alpha_j}{\alpha^2_0 (\alpha_0 + 1)}}{cov(theta[i], theta[j]) = - ((alpha[i]*alpha[j]) / (alpha[0]^2 * (alpha[0] + 1)))} \item Mode: \eqn{mode(\theta_j) = \frac{\alpha_j - 1}{\alpha_0 - k}}{mode(theta[j]) = (alpha[j] - 1) / (alpha[0] - k)} } The Dirichlet distribution is the multivariate generalization of the univariate beta distribution. Its probability density function returns the belief that the probabilities of \eqn{k} rival events are \eqn{\theta_j}{theta[j]} given that each event has been observed \eqn{\alpha_j - 1}{alpha[j] - 1} times. The Dirichlet distribution is commonly used as a prior distribution in Bayesian inference. The Dirichlet distribution is the conjugate prior distribution for the parameters of the categorical and multinomial distributions. A very common special case is the symmetric Dirichlet distribution, where all of the elements in parameter vector \eqn{\alpha}{alpha} have the same value. Symmetric Dirichlet distributions are often used as vague or weakly informative Dirichlet prior distributions, so that one component is not favored over another. The single value that is entered into all elements of \eqn{\alpha}{alpha} is called the concentration parameter. } \value{ \code{ddirichlet} gives the density and \code{rdirichlet} generates random deviates. } \seealso{ \code{\link{dbeta}}, \code{\link{dcat}}, \code{\link{dmvpolya}}, \code{\link{dmultinom}}, and \code{\link{TransitionMatrix}}. } \examples{ library(LaplacesDemon) x <- ddirichlet(c(.1,.3,.6), c(1,1,1)) x <- rdirichlet(10, c(1,1,1)) } \keyword{Distribution} LaplacesDemon/man/IAT.Rd0000755000176200001440000000603115144316355014452 0ustar liggesusers\name{IAT} \alias{IAT} \title{Integrated Autocorrelation Time} \description{ The \code{IAT} function estimates integrated autocorrelation time, which is the computational inefficiency of a continuous chain or MCMC sampler. IAT is also called the IACT, ACT, autocorrelation time, autocovariance time, correlation time, or inefficiency factor. A lower value of \code{IAT} is better. \code{IAT} is a MCMC diagnostic that is an estimate of the number of iterations, on average, for an independent sample to be drawn, given a continuous chain or Markov chain. Put another way, \code{IAT} is the number of correlated samples with the same variance-reducing power as one independent sample. IAT is a univariate function. A multivariate form is not included. } \usage{ IAT(x) } \arguments{ \item{x}{This requried argument is a vector of samples from a chain.} } \details{ \code{IAT} is a MCMC diagnostic that is often used to compare continuous chains of MCMC samplers for computational inefficiency, where the sampler with the lowest \code{IAT}s is the most efficient sampler. Otherwise, chains may be compared within a model, such as with the output of \code{\link{LaplacesDemon}} to learn about the inefficiency of the continuous chain. For more information on comparing MCMC algorithmic inefficiency, see the \code{\link{Juxtapose}} function. \code{IAT} is also estimated in the \code{\link{PosteriorChecks}} function. \code{IAT} is usually applied to a stationary, continuous chain after discarding burn-in iterations (see \code{\link{burnin}} for more information). The \code{IAT} of a continuous chain correlates with the variability of the mean of the chain, and relates to Effective Sample Size (\code{\link{ESS}}) and Monte Carlo Standard Error (\code{\link{MCSE}}). \code{IAT} and \code{\link{ESS}} are inversely related, though not perfectly, because each is estimated a little differently. Given \eqn{N}{N} samples and taking autocorrelation into account, \code{\link{ESS}} estimates a reduced number of \eqn{M}{M} samples. Conversely, \code{IAT} estimates the number of autocorrelated samples, on average, required to produce one independently drawn sample. The \code{IAT} function is similar to the \code{IAT} function in the \code{Rtwalk} package of Christen and Fox (2010), which is currently unavailabe on CRAN. } \value{ The \code{IAT} function returns the integrated autocorrelation time of a chain. } \references{ Christen, J.A. and Fox, C. (2010). "A General Purpose Sampling Algorithm for Continuous Distributions (the t-walk)". \emph{Bayesian Analysis}, 5(2), p. 263--282. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{burnin}}, \code{\link{Compare}}, \code{\link{ESS}}, \code{\link{LaplacesDemon}}, \code{\link{MCSE}}, and \code{\link{PosteriorChecks}}. } \examples{ library(LaplacesDemon) theta <- rnorm(100) IAT(theta) } \keyword{Diagnostic} \keyword{MCMC} LaplacesDemon/man/dist.Multivariate.Laplace.Rd0000755000176200001440000001401515144316355021006 0ustar liggesusers\name{dist.Multivariate.Laplace} \alias{dmvl} \alias{rmvl} \title{Multivariate Laplace Distribution} \description{ These functions provide the density and random number generation for the multivariate Laplace distribution. } \usage{ dmvl(x, mu, Sigma, log=FALSE) rmvl(n, mu, Sigma) } \arguments{ \item{x}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{n}{This is the number of random draws.} \item{mu}{This is mean vector \eqn{\mu}{mu} with length \eqn{k} or matrix with \eqn{k} columns.} \item{Sigma}{This is the \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{2}{(2\pi)^{k/2} |\Sigma|^{1/2}} \frac{(\pi/(2\sqrt{2(\theta - \mu)^T \Sigma^{-1} (\theta - \mu)}))^{1/2} \exp(-\sqrt{2(\theta - \mu)^T \Sigma^{-1} (\theta - \mu)})}{\sqrt{((\theta - \mu)^T \Sigma^{-1} (\theta - \mu) / 2)}^{k/2-1}}}{p(theta) = (2 / ((2*pi)^(k/2) * |Sigma|^(1/2))) ((sqrt(pi/(2*sqrt(2*(theta-mu)^TSigma^(-1)(theta-mu)))) * exp(-sqrt(2*(theta-mu)^TSigma^(-1)(theta-mu)))) / sqrt((theta-mu)^TSigma^(-1)(theta-mu)/2)^(k/2-1))} \item Inventor: Fang et al. (1990) \item Notation 1: \eqn{\theta \sim \mathcal{MVL}(\mu, \Sigma)}{theta ~ MVL(mu, Sigma)} \item Notation 2: \eqn{\theta \sim \mathcal{L}_k(\mu, \Sigma)}{theta ~ L[k](mu, Sigma)} \item Notation 3: \eqn{p(\theta) = \mathcal{MVL}(\theta | \mu, \Sigma)}{p(theta) = MVL(theta | mu, Sigma)} \item Notation 4: \eqn{p(\theta) = \mathcal{L}_k(\theta | \mu, \Sigma)}{p(theta) = L[k](theta | mu, Sigma)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = \Sigma}{var(theta) = Sigma} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate Laplace distribution is a multidimensional extension of the one-dimensional or univariate symmetric Laplace distribution. There are multiple forms of the multivariate Laplace distribution. The bivariate case was introduced by Ulrich and Chen (1987), and the first form in larger dimensions may have been Fang et al. (1990), which requires a Bessel function. Alternatively, multivariate Laplace was soon introduced as a special case of a multivariate Linnik distribution (Anderson, 1992), and later as a special case of the multivariate power exponential distribution (Fernandez et al., 1995; Ernst, 1998). Bayesian considerations appear in Haro-Lopez and Smith (1999). Wainwright and Simoncelli (2000) presented multivariate Laplace as a Gaussian scale mixture. Kotz et al. (2001) present the distribution formally. Here, the density is calculated with the asymptotic formula for the Bessel function as presented in Wang et al. (2008). The multivariate Laplace distribution is an attractive alternative to the multivariate normal distribution due to its wider tails, and remains a two-parameter distribution (though alternative three-parameter forms have been introduced as well), unlike the three-parameter multivariate t distribution, which is often used as a robust alternative to the multivariate normal distribution. } \value{ \code{dmvl} gives the density, and \code{rmvl} generates random deviates. } \references{ Anderson, D.N. (1992). "A Multivariate Linnik Distribution". \emph{Statistical Probability Letters}, 14, p. 333--336. Eltoft, T., Kim, T., and Lee, T. (2006). "On the Multivariate Laplace Distribution". \emph{IEEE Signal Processing Letters}, 13(5), p. 300--303. Ernst, M. D. (1998). "A Multivariate Generalized Laplace Distribution". \emph{Computational Statistics}, 13, p. 227--232. Fang, K.T., Kotz, S., and Ng, K.W. (1990). "Symmetric Multivariate and Related Distributions". Monographs on Statistics and Probability, 36, Chapman-Hall, London. Fernandez, C., Osiewalski, J. and Steel, M.F.J. (1995). "Modeling and Inference with v-spherical Distributions". \emph{Journal of the American Statistical Association}, 90, p. 1331--1340. Gomez, E., Gomez-Villegas, M.A., and Marin, J.M. (1998). "A Multivariate Generalization of the Power Exponential Family of Distributions". \emph{Communications in Statistics-Theory and Methods}, 27(3), p. 589--600. Haro-Lopez, R.A. and Smith, A.F.M. (1999). "On Robust Bayesian Analysis for Location and Scale Parameters". \emph{Journal of Multivariate Analysis}, 70, p. 30--56. Kotz., S., Kozubowski, T.J., and Podgorski, K. (2001). "The Laplace Distribution and Generalizations: A Revisit with Applications to Communications, Economics, Engineering, and Finance". Birkhauser: Boston, MA. Ulrich, G. and Chen, C.C. (1987). "A Bivariate Double Exponential Distribution and its Generalization". \emph{ASA Proceedings on Statistical Computing}, p. 127--129. Wang, D., Zhang, C., and Zhao, X. (2008). "Multivariate Laplace Filter: A Heavy-Tailed Model for Target Tracking". \emph{Proceedings of the 19th International Conference on Pattern Recognition}: FL. Wainwright, M.J. and Simoncelli, E.P. (2000). "Scale Mixtures of Gaussians and the Statistics of Natural Images". \emph{Advances in Neural Information Processing Systems}, 12, p. 855--861. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{daml}}, \code{\link{dlaplace}}, \code{\link{dmvn}}, \code{\link{dmvnp}}, \code{\link{dmvpe}}, \code{\link{dmvt}}, \code{\link{dnorm}}, \code{\link{dnormp}}, and \code{\link{dnormv}}. } \examples{ library(LaplacesDemon) x <- dmvl(c(1,2,3), c(0,1,2), diag(3)) X <- rmvl(1000, c(0,1,2), diag(3)) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/plot.pmc.Rd0000755000176200001440000000635615144316355015603 0ustar liggesusers\name{plot.pmc} \alias{plot.pmc} \title{Plot samples from the output of PMC} \description{ This may be used to plot, or save plots of, samples in an object of class \code{pmc}. Plots include a trace plot and density plot for parameters, a density plot for deviance and monitored variables, and convergence plots. } \usage{ \method{plot}{pmc}(x, BurnIn=0, Data, PDF=FALSE, Parms, \dots) } \arguments{ \item{x}{This required argument is an object of class \code{pmc}.} \item{BurnIn}{This argument requires zero or a positive integer that indicates the number of iterations to discard as burn-in for the purposes of plotting.} \item{Data}{This required argument must receive the list of data that was supplied to \code{\link{PMC}} to create the object of class \code{pmc}.} \item{PDF}{This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{Parms}{This argument accepts a vector of quoted strings to be matched for selecting parameters for plotting. This argument defaults to \code{NULL} and selects every parameter for plotting. Each quoted string is matched to one or more parameter names with the \code{grep} function. For example, if the user specifies \code{Parms=c("eta", "tau")}, and if the parameter names are beta[1], beta[2], eta[1], eta[2], and tau, then all parameters will be selected, because the string \code{eta} is within \code{beta}. Since \code{grep} is used, string matching uses regular expressions, so beware of meta-characters, though these are acceptable: ".", "[", and "]".} \item{\dots}{Additional arguments are unused.} } \details{ The plots are arranged in a \eqn{2 \times 2}{2 x 2} matrix. Each row represents a parameter, the deviance, or a monitored variable. For parameters, the left column displays trace plots and the right column displays kernel density plots. Trace plots show the history of the distribution of independent importance samples. When multiple mixture components are used, each mixture component has a different color. These plots are unavailable for the deviance and monitored variables. Kernel density plots depict the marginal posterior distribution. Although there is no distributional assumption about this density, kernel density estimation uses Gaussian basis functions. Following these plots are three plots for convergence. First, ESSN (red) and perplexity (black) are plotted by iteration. Convergence occurs when both of these seem to stabilize, and higher is better. The second plot shows the distribution of the normalized importance weights by iteration. The third plot appears only when multiple mixture components are used. The third plot displays the probabilities of each mixture component by iteration. Although the last two plots are not formally convergence plots, they are provided so the user can verify the distribution of importance weights and the mixture probabilities have become stable. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{ESS}} and \code{\link{PMC}}.} \examples{### See the PMC function for an example.} \keyword{Plot}LaplacesDemon/man/Gelfand.Diagnostic.Rd0000755000176200001440000000433415144316355017464 0ustar liggesusers\name{Gelfand.Diagnostic} \alias{Gelfand.Diagnostic} \title{Gelfand's Convergence Diagnostic} \description{ Gelfand et al. (1990) proposed a convergence diagnostic for Markov chains. The \code{Gelfand.Diagnostic} function is an interpretation of Gelfand's ``thick felt-tip pen'' MCMC convergence diagnostic. This diagnostic plots a series of kernel density plots at \eqn{k} intervals of cumulative samples. Given a vector of \eqn{S} samples from a marginal posterior distribution, \eqn{\theta}{theta}, multiple kernel density lines are plotted together, where each includes samples from a different interval. It is assumed that \code{\link{burnin}} iterations have been discarded. Gelfand et al. (1990) assert that convergence is violated when the plotted lines are farther apart than the width of a thick, felt-tip pen. This depends on the size of the plot, and, of course, the pen. The estimated width of a ``thick felt-tip pen'' is included as a black, vertical line. The pen in \code{Gelfand.Diagnostic} is included for historical reasons. This diagnostic requires numerous samples. } \usage{ Gelfand.Diagnostic(x, k=3, pen=FALSE) } \arguments{ \item{x}{This required argument is a vector of marginal posterior samples, such as selected from the output of \code{\link{LaplacesDemon}}.} \item{k}{This argument specifies the number \eqn{k} of kernel density plots given cumulative intervals of samples. This argument defaults to \eqn{k=3}{k=3}.} \item{pen}{Logical. This argument defaults to \code{pen=FALSE}. When \code{pen=TRUE}, the thick felt-tip pen is included as a black, vertical line.} } \value{ The \code{Gelfand.Diagnostic} returns a plot. } \references{ Gelfand, A.E., Hills, S., Racine-Poon, A., and Smith, A.F.M. (1990). "Illustration of Bayesian Inference in Normal Data Models Using Gibbs Sampling". \emph{Journal of the American Statistical Association}, 85, p. 972--985. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{burnin}} and \code{\link{LaplacesDemon}}. } \examples{ library(LaplacesDemon) x <- rnorm(1000) Gelfand.Diagnostic(x) } \keyword{Diagnostic} \keyword{MCMC} LaplacesDemon/man/summary.iterquad.ppc.Rd0000755000176200001440000004044415144316355020136 0ustar liggesusers\name{summary.iterquad.ppc} \alias{summary.iterquad.ppc} \title{Posterior Predictive Check Summary} \description{ This may be used to summarize either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}). Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is summarized, depending on \code{\link{predict.iterquad}}. } \usage{\method{summary}{iterquad.ppc}(object, Categorical, Rows, Discrep, d, Quiet, \dots)} \arguments{ \item{object}{An object of class \code{iterquad.ppc} is required.} \item{Categorical}{Logical. If \code{TRUE}, then \code{y} and \code{yhat} are considered to be categorical (such as y=0 or y=1), rather than continuous.} \item{Rows}{An optional vector of row numbers, for example \code{c(1:10)}. All rows will be estimated, but only these rows will appear in the summary.} \item{Discrep}{A character string indicating a discrepancy test. \code{Discrep} defaults to \code{NULL}. Valid character strings when \code{y} is continuous are: \code{"Chi-Square"}, \code{"Chi-Square2"}, \code{"Kurtosis"}, \code{"L-criterion"}, \code{"MASE"}, \code{"MSE"}, \code{"PPL"}, \code{"Quadratic Loss"}, \code{"Quadratic Utility"}, \code{"RMSE"}, \code{"Skewness"}, \code{"max(yhat[i,]) > max(y)"}, \code{"mean(yhat[i,]) > mean(y)"}, \code{"mean(yhat[i,] > d)"}, \code{"mean(yhat[i,] > mean(y))"}, \code{"min(yhat[i,]) < min(y)"}, \code{"round(yhat[i,]) = d"}, and \code{"sd(yhat[i,]) > sd(y)"}. Valid character strings when \code{y} is categorical are: \code{"p(yhat[i,] != y[i])"}. Kurtosis and skewness are not discrepancies, but are included here for convenience.} \item{d}{This is an optional integer to be used with the \code{Discrep} argument above, and it defaults to \code{d=0}.} \item{Quiet}{This logical argument defaults to \code{FALSE} and will print results to the console. When \code{TRUE}, results are not printed.} \item{\dots}{Additional arguments are unused.} } \details{ This function summarizes an object of class \code{iterquad.ppc}, which consists of posterior predictive checks on either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]}, depending respectively on whether unobserved instances of \eqn{\textbf{y}}{y} or the model sample of \eqn{\textbf{y}}{y} was used in the \code{\link{predict.iterquad}} function. The deviance and monitored variables are also summarized. The purpose of a posterior predictive check is to assess how well (or poorly) the model fits the data, or to assess discrepancies between the model and the data. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. When \eqn{\textbf{y}}{y} is continuous and known, this function estimates the predictive concordance between \eqn{\textbf{y}}{y} and \eqn{\textbf{y}^{rep}}{y[rep]} as per Gelfand (1996), and the predictive quantile (PQ), which is for record-level outlier detection used to calculate Gelfand's predictive concordance. When \eqn{\textbf{y}}{y} is categorical and known, this function estimates the record-level lift, which is \code{p(yhat[i,] = y[i]) / [p(y = j) / n]}, or the number of correctly predicted samples over the rate of that category of \eqn{\textbf{y}}{y} in vector \eqn{\textbf{y}}{y}. A discrepancy measure is an approach to studying discrepancies between the model and data (Gelman et al., 1996). Below is a list of discrepancy measures, followed by a brief introduction to discrepancy analysis: \itemize{ \item The \code{"Chi-Square"} discrepancy measure is the chi-square goodness-of-fit test that is recommended by Gelman. For each record i=1:N, this returns (y[i] - E(y[i]))^2 / var(yhat[i,]). \item The \code{"Chi-Square2"} discrepancy measure returns the following for each record: Pr(chisq.rep[i,] > chisq.obs[i,]), where chisq.obs[i,] <- (y[i] - E(y[i]))^2 / E(y[i]), and chisq.rep[i,] <- (yhat[i,] - E(yhat[i,]))^2 / E(yhat[i,]), and the overall discrepancy is the percent of records that were outside of the 95\% quantile-based probability interval (see \code{\link{p.interval}}). \item The \code{"Kurtosis"} discrepancy measure returns the kurtosis of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding kurtotic replicate distributions. \item The \code{"L-criterion"} discrepancy measure of Laud and Ibrahim (1995) provides the record-level combination of two components (see below), and the discrepancy statistic is the sum, \code{L}, as well as a calibration number, \code{S.L}. For more information on the L-criterion, see the accompanying vignette entitled "Bayesian Inference". \item The \code{"MASE"} (Mean Absolute Scaled Error) is a discrepancy measure for the accuracy of time-series forecasts, estimated as \code{(|y - yhat|) / mean(abs(diff(y)))}. The discrepancy statistic is the mean of the record-level values. \item The \code{"MSE"} (Mean Squared Error) discrepancy measure provides the MSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level MSEs. MSE and quadratic loss are identical. \item The \code{"PPL"} (Posterior Predictive Loss) discrepancy measure of Gelfand and Ghosh (1998) provides the record-level combination of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The \code{d=0} argument applies the following weight to the accuracy component, which is then added to the variance component: \eqn{d/(d+1)}. For \eqn{\textbf{y}^{new}}{y[new]}, use \eqn{d=0}. For \eqn{\textbf{y}^{rep}}{y[rep]} and model comparison, \eqn{d} is commonly set to 1, 10, or 100000. Larger values of \eqn{d} put more stress on fit and downgrade the precision of the estimates. \item The \code{"Quadratic Loss"} discrepancy measure provides the mean quadratic loss for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic losses. Quadratic loss and MSE are identical, and quadratic loss is the negative of quadratic utility. \item The \code{"Quadratic Utility"} discrepancy measure provides the mean quadratic utility for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic utilities. Quadratic utility is the negative of quadratic loss. \item The \code{"RMSE"} (Root Mean Squared Error) discrepancy measure provides the RMSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level RMSEs. \item The \code{"Skewness"} discrepancy measure returns the skewness of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding skewed replicate distributions. \item The \code{"max(yhat[i,]) > max(y)"} discrepancy measure returns a record-level indicator when a record's maximum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} exceeds the maximum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications that exceed the maximum of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,]) > mean(y)"} discrepancy measure returns a record-level indicator when the mean of a record's \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is greater than the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with mean replications that exceed the mean of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,] > d)"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds a specified value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"mean(yhat[i,] > mean(y))"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"min(yhat[i,]) < min(y)"} discrepancy measure returns a record-level indicator when a record's minimum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is less than the minimum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications less than the minimum of \eqn{\textbf{y}}{y}. \item The \code{"round(yhat[i,]) = d"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that, when rounded, is equal to a specified discrete value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"sd(yhat[i,]) > sd(y)"} discrepancy measure returns a record-level indicator when the standard deviation of replicates is larger than the standard deviation of all of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with larger standard deviations than \eqn{\textbf{y}}{y}. \item The \code{"p(yhat[i,] != y[i])"} discrepancy measure returns the record-level probability that \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is not equal to \eqn{\textbf{y}}{y}. This is valid when \eqn{\textbf{y}}{y} is categorical and \code{yhat} is the predicted category. The probability is the proportion of replicates. } After observing a discrepancy statistic, the user attempts to improve the model by revising the model to account for discrepancies between data and the current model. This approach to model revision relies on an analysis of the discrepancy statistic. Given a discrepancy measure that is based on model fit, such as the L-criterion, the user may correlate the record-level discrepancy statistics with the dependent variable, independent variables, and interactions of independent variables. The discrepancy statistic should not correlate with the dependent and independent variables. Interaction variables may be useful for exploring new relationships that are not in the current model. Alternatively, a decision tree may be applied to the record-level discrepancy statistics, given the independent variables, in an effort to find relationships in the data that may be helpful in the model. Model revision may involve the addition of a finite mixture component to account for outliers in discrepancy, or specifying the model with a distribution that is more robust to outliers. There are too many suggestions to include here, and discrepancy analysis varies by model. } \value{ This function returns a list with the following components: \item{BPIC}{The Bayesian Predictive Information Criterion (BPIC) was introduced by Ando (2007). BPIC is a variation of the Deviance Information Criterion (DIC) that has been modified for predictive distributions. For more information on DIC (Spiegelhalter et al., 2002), see the accompanying vignette entitled "Bayesian Inference". \eqn{BPIC = Dbar + 2pD}. The goal is to minimize BPIC.} \item{Concordance}{This is the percentage of the records of y that are within the 95\% quantile-based probability interval (see \code{\link{p.interval}}) of \eqn{\textbf{y}^{rep}}{y[rep]}. Gelfand's suggested goal is to achieve 95\% predictive concordance. Lower percentages indicate too many outliers and a poor fit of the model to the data, and higher percentages may suggest overfitting. Concordance occurs only when \eqn{\textbf{y}}{y} is continuous.} \item{Mean Lift}{This is the mean of the record-level lifts, and occurs only when \eqn{\textbf{y}}{y} is specified as categorical with \code{Categorical=TRUE}.} \item{Discrepancy.Statistic}{This is only reported if the \code{Discrep} argument receives a valid discrepancy measure as listed above. The \code{Discrep} applies to each record of \eqn{\textbf{y}}{y}, and the \code{Discrepancy.Statistic} reports the results of the discrepancy measure on the entire data set. For example, if \code{Discrep="min(yhat[i,]) < min(y)"}, then the overall result is the proportion of records in which the minimum sample of yhat was less than the overall minimum \eqn{\textbf{y}}{y}. This is \code{Pr(min(yhat[i,]) < min(y) | y, Theta)}, where \code{Theta} is the parameter set.} \item{L-criterion}{The L-criterion (Laud and Ibrahim, 1995) was developed for model and variable selection. It is a sum of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The L-criterion measures model performance with a combination of how close its predictions are to the observed data and variability of the predictions. Better models have smaller values of \code{L}. \code{L} is measured in the same units as the response variable, and measures how close the data vector \eqn{\textbf{y}}{y} is to the predictive distribution. In addition to the value of \code{L}, there is a value for \code{S.L}, which is the calibration number of \code{L}, and is useful in determining how much of a decrease is necessary between models to be noteworthy.} \item{Monitor}{This is a \eqn{N \times 5}{N x 5} matrix, where \eqn{N} is the number of monitored variables and there are 5 columns, as follows: Mean, SD, LB (the 2.5\% quantile), Median, and UB (the 97.5\% quantile).} \item{Summary}{When \eqn{\textbf{y}}{y} is continuous, this is a \eqn{N \times 8}{N x 8} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and there are 8 columns, as follows: y, Mean, SD, LB (the 2.5\% quantile), Median, UB (the 97.5\% quantile), PQ (the predictive quantile, which is \eqn{Pr(\textbf{y}^{rep} \ge \textbf{y})}{Pr(y[rep] >= y)}), and Test, which shows the record-level result of a test, if specified. When \eqn{\textbf{y}}{y} is categorical, this matrix has a number of columns equal to the number of categories of \eqn{\textbf{y}}{y} plus 3, also including \code{y}, \code{Lift}, and \code{Discrep}.} } \references{ Ando, T. (2007). "Bayesian Predictive Information Criterion for the Evaluation of Hierarchical Bayesian and Empirical Bayes Models". \emph{Biometrika}, 94(2), p. 443--458. Gelfand, A. (1996). "Model Determination Using Sampling Based Methods". In Gilks, W., Richardson, S., Spiegehalter, D., Chapter 9 in Markov Chain Monte Carlo in Practice. Chapman and Hall: Boca Raton, FL. Gelfand, A. and Ghosh, S. (1998). "Model Choice: A Minimum Posterior Predictive Loss Approach". \emph{Biometrika}, 85, p. 1--11. Gelman, A., Meng, X.L., and Stern H. (1996). "Posterior Predictive Assessment of Model Fitness via Realized Discrepancies". \emph{Statistica Sinica}, 6, p. 733--807. Laud, P.W. and Ibrahim, J.G. (1995). "Predictive Model Selection". \emph{Journal of the Royal Statistical Society}, B 57, p. 247--262. Spiegelhalter, D.J., Best, N.G., Carlin, B.P., and van der Linde, A. (2002). "Bayesian Measures of Model Complexity and Fit (with Discussion)". \emph{Journal of the Royal Statistical Society}, B 64, p. 583--639. } \author{Statisticat, LLC.} \seealso{ \code{\link{IterativeQuadrature}}, \code{\link{predict.iterquad}}, and \code{\link{p.interval}}. } \examples{### See the IterativeQuadrature function for an example.} \keyword{BPIC} \keyword{Chi-Square} \keyword{Kurtosis} \keyword{L-criterion} \keyword{MASE} \keyword{MSE} \keyword{Posterior Predictive Checks} \keyword{Posterior Predictive Loss} \keyword{Quadratic Loss} \keyword{Quadratic Utility} \keyword{RMSE} \keyword{Skewness} \keyword{summary} LaplacesDemon/man/Stick.Rd0000755000176200001440000000703615144316355015120 0ustar liggesusers\name{Stick} \alias{Stick} \title{Truncated Stick-Breaking} \description{ The \code{Stick} function provides the utility of truncated stick-breaking regarding the vector \eqn{\theta}{theta}. Stick-breaking is commonly referred to as a stick-breaking process, and is used often in a Dirichlet process (Sethuraman, 1994). It is commonly associated with infinite-dimensional mixtures, but in practice, the `infinite' number is truncated to a finite number, since it is impossible to estimate an infinite number of parameters (Ishwaran and James, 2001). } \usage{ Stick(theta) } \arguments{ \item{theta}{This required argument, \eqn{\theta}{theta} is a vector of length \eqn{(M-1)}{M-1} regarding \eqn{M}{M} mixture components.} } \details{ The Dirichlet process (DP) is a stochastic process used in Bayesian nonparametric modeling, most commonly in DP mixture models, otherwise known as infinite mixture models. A DP is a distribution over distributions. Each draw from a DP is itself a discrete distribution. A DP is an infinite-dimensional generalization of Dirichlet distributions. It is called a DP because it has Dirichlet-distributed, finite-dimensional, marginal distributions, just as the Gaussian process has Gaussian-distributed, finite-dimensional, marginal distributions. Distributions drawn from a DP cannot be described using a finite number of parameters, thus the classification as a nonparametric model. The truncated stick-breaking (TSB) process is associated with a truncated Dirichlet process (TDP). An example of a TSB process is cluster analysis, where the number of clusters is unknown and treated as mixture components. In such a model, the TSB process calculates probability vector \eqn{\pi}{pi} from \eqn{\theta}{theta}, given a user-specified maximum number of clusters to explore as \eqn{C}{C}, where \eqn{C}{C} is the length of \eqn{\theta + 1}{theta + 1}. Vector \eqn{\pi}{pi} is assigned a TSB prior distribution (for more information, see \code{\link{dStick}}). Elsewhere, each element of \eqn{\theta}{theta} is constrained to the interval (0,1), and the original TSB form is beta-distributed with the \eqn{\alpha}{alpha} parameter of the beta distribution constrained to 1 (Ishwaran and James, 2001). The \eqn{\beta}{beta} hyperparameter in the beta distribution is usually gamma-distributed. A larger value for a given \eqn{\theta_m}{theta[m]} is associated with a higher probability of the associated mixture component, however, the proportion changes according to the position of the element in the \eqn{\theta}{theta} vector. A variety of stick-breaking processes exist. For example, rather than each \eqn{\theta}{theta} being beta-distributed, there have been other forms introduced such as logistic and probit, among others. } \value{ The \code{Stick} function returns a probability vector wherein each element relates to a mixture component. } \references{ Ishwaran, H. and James, L. (2001). "Gibbs Sampling Methods for Stick Breaking Priors". \emph{Journal of the American Statistical Association}, 96(453), p. 161--173. Sethuraman, J. (1994). "A Constructive Definition of Dirichlet Priors". \emph{Statistica Sinica}, 4, p. 639--650. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{ddirichlet}}, \code{\link{dmvpolya}}, and \code{\link{dStick}}. } \keyword{Stick-Breaking Process} \keyword{Truncated Stick-Breaking Process} \keyword{Utility} LaplacesDemon/man/p.interval.Rd0000755000176200001440000001662215144316355016126 0ustar liggesusers\name{p.interval} \alias{p.interval} \title{Probability Interval} \description{ This function returns one or more probability intervals of posterior samples. } \usage{ p.interval(obj, HPD=TRUE, MM=TRUE, prob=0.95, plot=FALSE, PDF=FALSE, \dots) } \arguments{ \item{obj}{This can be either a vector or matrix of posterior samples, or an object of class \code{demonoid}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}. If it is an object of class \code{demonoid}, then it will use only stationary posterior samples and monitored target distributions (automatically discarding the burn-in; if stationarity does not exist, then it will use all samples).} \item{HPD}{Logical. This argument defaults to \code{TRUE}, in which case one or more Highest Posterior Density (HPD) intervals is returned. When \code{FALSE}, one or more quantile-based probability intervals is returned.} \item{MM}{Logical. This argument defaults to \code{TRUE}, in which case each column vector is checked for multimodality, and if found, the multimodal form of a Highest Posterior Density (HPD) interval is additionally estimated, even when \code{HPD=FALSE}.} \item{prob}{This is a numeric scalar in the interval (0,1) giving the target probability interval, and defaults to 0.95, representing a 95\% probability interval. A 95\% probability interval, for example, is an interval that contains 95\% of a posterior probability distribution.} \item{plot}{Logical. When \code{plot=TRUE}, each kernel density is plotted and shaded gray, and the area under the curve within the probability interval is shaded black. If the kernel density is considered to be multimodal, then up to three intervals are shaded black. A vertical, red, dotted line is added at zero. The \code{plot} argument defaults to \code{FALSE}.} \item{PDF}{Logical. When \code{PDF=TRUE}, and only when \code{plot=TRUE}, plots are saved as a .pdf file in the working directory.} \item{\dots}{Additional arguments are unused.} } \details{ A probability interval, also called a credible interval or Bayesian confidence interval, is an interval in the domain of a posterior probability distribution. When generalized to multivariate forms, it is called a probability region (or credible region), though some sources refer to a probability region (or credible region) as the area within the probability interval. Bivariate probability regions may be plotted with the \code{\link{joint.pr.plot}} function. The \code{p.interval} function may return different probability intervals: a quantile-based probability interval, a unimodal Highest Posterior Density (HPD) interval, and multimodal HPD intervals. Another type of probability interval is the Lowest Posterior Loss (LPL) interval, which is calculated with the \code{\link{LPL.interval}} function. The quantile-based probability interval is used most commonly, possibly because it is simple, the fastest to calculate, invariant under transformation, and more closely resembles the frequentist confidence interval. The lower and upper bounds of the quantile-based probability interval are calculated with the \code{quantile} function. A 95\% quantile-based probability interval reports the values of the posterior probability distribution that indicate the 2.5\% and 97.5\% quantiles, which contain the central 95\% of the distribution. The quantile-based probability interval is centered around the median and has equal-sized tails. The HPD (highest posterior density) interval is identical to the quantile-based probability interval when the posterior probability distribution is unimodal and symmetric. Otherwise, the HPD interval is the smallest interval, because it is estimated as the interval that contains the highest posterior density. Unlike the quantile-based probability interval, the HPD interval could be one-tailed or two-tailed, whichever is more appropriate. However, unlike the quantile-based interval, the HPD interval is not invariant to reparameterization (Bernardo, 2005). The unimodal HPD interval is estimated from the empirical CDF of the sample for each parameter (or deviance or monitored variable) as the shortest interval for which the difference in the ECDF values of the end-points is the user-specified probability width. This assumes the distribution is not severely multimodal. As an example, imagine an exponential posterior distribution. A quantile-based probability interval would report the highest density region near zero to be outside of its interval. In contrast, the unimodal HPD interval is recommended for such skewed posterior distributions. When \code{MM=TRUE}, the \code{\link{is.multimodal}} function is applied to each column vector after the unimodal interval (either quantile-based or HPD) is estimated. If multimodality is found, then multimodal HPD intervals are estimated with kernel density and printed to the screen as a character string. The original unimodal intervals are returned in the output matrix, because the matrix is constrained to have a uniform number of columns per row, and because multimodal HPD intervals may be disjoint. Disjoint multimodal HPD intervals have multiple intervals for one posterior probability distribution. An example may be when there is a bimodal, Gaussian distribution with means -10 and 10, variances of 1 and 1, and a 95\% probability interval is specified. In this case, there is not enough density between these two distant modes to have only one probability interval. The user should also consider \code{\link{LPL.interval}}, since it is invariant to reparameterization like the quantile-based probability interval, but could be one- or two-tailed, whichever is more appropriate, like the HPD interval. A comparison of the quantile-based probability interval, HPD interval, and LPL interval is available here: \url{https://web.archive.org/web/20150214090353/http://www.bayesian-inference.com/credible}. } \value{ A matrix is returned with rows corresponding to the parameters (or deviance or monitored variables), and columns \code{"Lower"} and \code{"Upper"}. The elements of the matrix are the unimodal probability intervals. The attribute \code{"Probability"} is the user-selected probability width. If \code{MM=TRUE} and multimodal posterior distributions are found, then multimodal HPD intervals are printed to the screen in a character string. } \references{ Bernardo, J.M. (2005). "Intrinsic Credible Regions: An Objective Bayesian Approach to Interval Estimation". \emph{Sociedad de Estadistica e Investigacion Operativa}, 14(2), p. 317--384. } \author{Statisticat, LLC} \seealso{ \code{\link{is.multimodal}}, \code{\link{IterativeQuadrature}}, \code{\link{joint.pr.plot}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LPL.interval}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{ ##First, update the model with the LaplacesDemon function. ##Then #p.interval(Fit, HPD=TRUE, MM=TRUE, prob=0.95) } \keyword{Credible Interval} \keyword{Credible Region} \keyword{Credible Set} \keyword{HPD} \keyword{HPDI} \keyword{Probability Interval} \keyword{Probability Region} \keyword{Probability Set} LaplacesDemon/man/is.model.Rd0000755000176200001440000000431015144316355015545 0ustar liggesusers\name{is.model} \alias{is.model} \title{Logical Check of a Model} \description{ This function provides a logical test of whether or not a \code{Model} specification function meets mininum requirements to be considered as such. } \usage{ is.model(Model, Initial.Values, Data) } \arguments{ \item{Model}{This is a model specification function. For more information, see the \code{\link{LaplacesDemon}} function.} \item{Initial.Values}{This is a vector of initial values, or current parameter values. For more information, see the \code{\link{LaplacesDemon}} function.} \item{Data}{This is a list of data. For more information, see the \code{\link{LaplacesDemon}} function.} } \details{ This function tests for minimum criteria for \code{Model} to be considered a model specification function. Specifically, it tests: \itemize{ \item \code{Model} must be a function \item \code{Model} must execute without errors \item \code{Model} must return a list \item \code{Model} must have five components in the list \item The first component must be named LP and have length 1 \item The second component must be named Dev and have length 1 \item The third component must be named Monitor \item The lengths of Monitor and mon.names must be equal \item The fourth component must be named yhat \item The fifth component must be named parm \item The lengths of parm and parm.names must be equal } This function is not extensive, and checks only for these minimum criteria. Additional checks are conducted in \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \value{ The \code{is.model} function returns a logical value of \code{TRUE} when \code{Model} meets minimum criteria of a model specification function, and \code{FALSE} otherwise. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \keyword{Utility}LaplacesDemon/man/dist.Skew.Discrete.Laplace.Rd0000755000176200001440000000773115144316355021021 0ustar liggesusers\name{dist.Skew.Discrete.Laplace} \alias{dsdlaplace} \alias{psdlaplace} \alias{qsdlaplace} \alias{rsdlaplace} \title{Skew Discrete Laplace Distribution: Univariate} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate, skew discrete Laplace distribution with parameters \eqn{p}{p} and \eqn{q}{q}. } \usage{ dsdlaplace(x, p, q, log=FALSE) psdlaplace(x, p, q) qsdlaplace(prob, p, q) rsdlaplace(n, p, q) } \arguments{ \item{x}{This is a vector of data.} \item{p}{This is a scalar or vector of parameter \eqn{p \in [0,1]}{p in [0,1]}.} \item{q}{This is a scalar or vector of parameter \eqn{q \in [0,1]}{q in [0,1]}.} \item{prob}{This is a probability scalar or vector.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Discrete Univariate \item Density 1: \eqn{p(\theta) = \frac{(1-p)(1-q)}{1-pq}p^\theta; \theta=0,1,2,3,\dots}{p(theta) = (1-p)(1-q) / (1-pq)p^theta, theta=0,1,2,3,...} \item Density 2: \eqn{p(\theta) = \frac{(1-p)(1-q)}{1-pq}q^{|\theta|}; x=0,-1,-2,-3,\dots}{p(theta) = (1-p)(1-q) / (1-pq)q^(|theta|),; x=0,-1,-2,-3,...} \item Inventor: Kozubowski, T.J. and Inusah, S. (2006) \item Notation 1: \eqn{\theta \sim \mathcal{DL}(p, q)}{theta ~ DL(p, q)} \item Notation 2: \eqn{p(\theta) = \mathcal{DL}(\theta | p, q)}{p(theta) = DL(theta | p, q)} \item Parameter 1: \eqn{p \in [0,1]}{p in [0,1]} \item Parameter 2: \eqn{q \in [0,1]}{q in [0,1]} \item Mean 1: \eqn{E(\theta) = \frac{1}{1-p}-\frac{1}{1-q}=\frac{p}{1-p}-\frac{q}{1-q}}{E(theta) = (1 / (1-p)) - (1 / (1-q)) = (p / (1-p)) - (q / (1-q))} \item Mean 2: \eqn{E(|\theta|) = \frac{q(1-p)^2+p(1-q)^2}{(1-qp)(1-q)(1-p)}}{E(|theta|) = (q(1-p)^2+p(1-q)^2) / ((1-qp)(1-q)(1-p))} \item Variance: \eqn{var(\theta) = \frac{1}{(1-p)^2(1-q)^2}[\frac{q(1-p)^3(1+q)+p(1-q)^3(1+p)}{1-pq}-(p-q)^2]}{var(theta) = (1 / ((1-p)^2(1-q)^2))[(q(1-p)^3(1+q)+p(1-q)^3(1+p)) / (1-pq) - (p-q)^2]} \item Mode: } This is a discrete form of the skew-Laplace distribution. The symmetric discrete Laplace distribution occurs when \eqn{p=q}{p=q}. DL(p,0) is a geometric distribution, and DL(0,q) is a geometric distribution of non-positive integers. The distribution is degenerate when DL(0,0). Since the geometric distribution is a discrete analog of the exponential distribution, the distribution of the difference of two geometric variables is a discrete Laplace distribution. These functions are similar to those in the \code{DiscreteLaplace} package. } \value{ \code{dslaplace} gives the density, \code{pslaplace} gives the distribution function, \code{qslaplace} gives the quantile function, and \code{rslaplace} generates random deviates. } \references{ Kozubowski, T.J. and Inusah, S. (2006). "A Skew Laplace Distribution on Integers". \emph{AISM}, 58, p. 555--571. } \seealso{ \code{\link{dalaplace}}, \code{\link{dexp}}, \code{\link{dlaplace}}, \code{\link{dlaplacep}}, and \code{\link{dslaplace}}. } \examples{ library(LaplacesDemon) x <- dsdlaplace(1,0.5,0.5) x <- psdlaplace(1,0.5,0.5) x <- qsdlaplace(0.5,0.5,0.5) x <- rsdlaplace(5,0.5,0.5) #Plot Probability Functions x <- c(-3:3) plot(x, dsdlaplace(x,0.5,0.5), ylim=c(0,0.6), type="l", main="Probability Function", ylab="density", col="red") lines(x, dsdlaplace(x,0.3,0.6), type="l", col="green") lines(x, dsdlaplace(x,0.9,0.1), type="l", col="blue") legend(-2.5, 0.5, expression(paste(p==0.5, ", ", q==0.5), paste(p==0.3, ", ", q==0.6), paste(p==0.9, ", ", q==0.1)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/print.heidelberger.Rd0000755000176200001440000000127715144337635017624 0ustar liggesusers\name{print.heidelberger} \alias{print.heidelberger} \title{Print an object of class \code{heidelberger} to the screen} \description{ This may be used to print the contents of an object of class \code{heidelberger} to the screen. } \usage{\method{print}{heidelberger}(x, digits=3, \dots)} \arguments{ \item{x}{An object of class \code{heidelberger} is required.} \item{digits}{This is the number of digits to print.} \item{\dots}{Additional arguments are unused.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{Heidelberger.Diagnostic}}. } \examples{### See the Heidelberger.Diagnostic function for an example.} \keyword{print} LaplacesDemon/man/MCSE.Rd0000755000176200001440000001434415144316355014572 0ustar liggesusers\name{MCSE} \alias{MCSE} \alias{MCSS} \title{Monte Carlo Standard Error} \description{ Monte Carlo Standard Error (MCSE) is an estimate of the inaccuracy of Monte Carlo samples, usually regarding the expectation of posterior samples, \eqn{\mathrm{E}(\theta)}{E(theta)}, from Monte Carlo or Markov chain Monte Carlo (MCMC) algorithms, such as with the \code{\link{LaplacesDemon}} or \code{\link{LaplacesDemon.hpc}} functions. MCSE approaches zero as the number of independent posterior samples approaches infinity. MCSE is essentially a standard deviation around the posterior mean of the samples, \eqn{\mathrm{E}(\theta)}{E(theta)}, due to uncertainty associated with using an MCMC algorithm, or Monte Carlo methods in general. The acceptable size of the MCSE depends on the acceptable uncertainty associated around the marginal posterior mean, \eqn{\mathrm{E}(\theta)}{E(theta)}, and the goal of inference. It has been argued that MCSE is generally unimportant when the goal of inference is \eqn{\theta}{theta} rather than \eqn{\mathrm{E}(\theta)}{E(theta)} (Gelman et al., 2004, p. 277), and that a sufficient \code{\link{ESS}} is more important. Others perceive MCSE to be a vital part of reporting any Bayesian model, and as a stopping rule (Flegal et al., 2008). In \code{\link{LaplacesDemon}}, MCSE is part of the posterior summaries because it is easy to estimate, and Laplace's Demon prefers to continue updating until each MCSE is less than 6.27\% of its associated marginal posterior standard deviation (for more information on this stopping rule, see the \code{\link{Consort}} function), since MCSE has been demonstrated to be an excellent stopping rule. Acceptable error may be specified, if known, in the \code{MCSS} (Monte Carlo Sample Size) function to estimate the required number of posterior samples. \code{MCSE} is a univariate function that is often applied to each marginal posterior distribution. A multivariate form is not included. By chance alone due to multiple independent tests, 5\% of the parameters should indicate unacceptable MSCEs, even when acceptable. Assessing convergence is difficult. } \usage{ MCSE(x, method="IMPS", batch.size="sqrt", warn=FALSE) MCSS(x, a) } \arguments{ \item{x}{This is a vector of posterior samples for which MCSE or MCSS will be estimated.} \item{a}{This is a scalar argument of acceptable error for the mean of \code{x}, and \code{a} must be positive. As acceptable error decreases, the required number of samples increases.} \item{method}{This is an optional argument for the method of MCSE estimation, and defaults to Geyer's \code{"IMPS"} method. Optional methods include \code{"sample.variance"} and \code{"batch.mean"}. Note that \code{"batch.mean"} is recommended only when the number of posterior samples is at least 1,000.} \item{batch.size}{This is an optional argument that corresponds only with \code{method="batch.means"}, and determines either the size of the batches (accepting a numerical argument) or the method of creating the size of batches, which is either \code{"sqrt"} or \code{"cuberoot"}, and refers to the length of \code{x}. The default argument is \code{"sqrt"}.} \item{warn}{Logical. If \code{warn=TRUE}, then a warning is provided with \code{method="batch.means"} whenever posterior sample size is less than 1,000, or a warning is produced when more autcovariance is recommended with \code{method="IMPS"}.} } \details{ The default method for estimating MCSE is Geyer's Initial Monotone Positive Sequence (IMPS) estimator (Geyer, 1992), which takes the asymptotic variance into account and is time-series based. This method goes by other names, such as Initial Positive Sequence (IPS). The simplest method for estimating MCSE is to modify the formula for standard error, \eqn{\sigma(\textbf{x}) / \sqrt{N}}{sigma(x) / sqrt(N)}, to account for non-independence in the sequence \eqn{\textbf{x}}{x} of posterior samples. Non-independence is estimated with the \code{ESS} function for Effective Sample Size (see the \code{\link{ESS}} function for more details), where \eqn{M = ESS(\textbf{x})}{m = ESS(x)}, and MCSE is \eqn{\sigma(\textbf{x}) / \sqrt{M}}{sigma(x) / sqrt(M)}. Although this is the fastest and easiest method of estimation, it does not incorporate an estimate of the asymptotic variance of \eqn{\textbf{x}}{x}. The batch means method (Jones et al., 2006; Flegal et al., 2008) separates elements of \eqn{\textbf{x}}{x} into batches and estimates MCSE as a function of multiple batches. This method is excellent, but is not recommended when the number of posterior samples is less than 1,000. These journal articles also assert that MCSE is a better stopping rule than MCMC convergence diagnostics. The \code{MCSS} function estimates the required number of posterior samples, given the user-specified acceptable error, posterior samples \code{x}, and the observed variance (rather than asymptotic variance). Due to the observed variance, this is a rough estimate. } \references{ Flegal, J.M., Haran, M., and Jones, G.L. (2008). "Markov chain Monte Carlo: Can We Trust the Third Significant Figure?". \emph{Statistical Science}, 23, p. 250--260. Gelman, A., Carlin, J., Stern, H., and Rubin, D. (2004). "Bayesian Data Analysis, Texts in Statistical Science, 2nd ed.". Chapman and Hall, London. Geyer, C.J. (1992). "Practical Markov Chain Monte Carlo". \emph{Statistical Science}, 7, 4, p. 473--483. Jones, G.L., Haran, M., Caffo, B.S., and Neath, R. (2006). "Fixed-Width Output Analysis for Markov chain Monte Carlo". \emph{Journal of the American Statistical Association}, 101(1), p. 1537--1547. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{Consort}}, \code{\link{ESS}}, \code{\link{LaplacesDemon}}, and \code{\link{LaplacesDemon.hpc}}. } \examples{ library(LaplacesDemon) x <- rnorm(1000) MCSE(x) MCSE(x, method="batch.means") MCSE(x, method="sample.variance") MCSS(x, a=0.01) } \keyword{Diagnostic} \keyword{MCMC} \keyword{MCSE} \keyword{MCSS} \keyword{Utility} LaplacesDemon/man/dist.Matrix.Gamma.Rd0000755000176200001440000000541415144316355017270 0ustar liggesusers\name{dist.Matrix.Gamma} \alias{dmatrixgamma} \title{Matrix Gamma Distribution} \description{ This function provides the density for the matrix gamma distribution. } \usage{ dmatrixgamma(X, alpha, beta, Sigma, log=FALSE) } \arguments{ \item{X}{This is a \eqn{k \times k}{k x k} positive-definite precision matrix.} \item{alpha}{This is a scalar shape parameter (the degrees of freedom), \eqn{\alpha}{alpha}.} \item{beta}{This is a scalar, positive-only scale parameter, \eqn{\beta}{beta}.} \item{Sigma}{This is a \eqn{k \times k}{k x k} positive-definite scale matrix.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate Matrix \item Density: \eqn{p(\theta) = \frac{|\Sigma|^{-\alpha}}{\beta^{k \alpha} \Gamma_k(\alpha)} |\theta|^{\alpha-(k+1)/2}\exp(tr(-\frac{1}{\beta}\Sigma^{-1}\theta))}{p(theta) = {|Sigma|^(-alpha) / [beta^(k alpha) Gamma[k](alpha)]} |theta|^[alpha-(k+1)/2] exp(tr(-(1/beta)Sigma^(-1)theta))} \item Inventors: Unknown \item Notation 1: \eqn{\theta \sim \mathcal{MG}_k(\alpha, \beta, \Sigma)}{theta ~ MG[k](alpha, beta, Sigma)} \item Notation 2: \eqn{p(\theta) = \mathcal{MG}_k(\theta | \alpha, \beta, \Sigma)}{p(theta) = MG[k](theta | alpha, beta, Sigma)} \item Parameter 1: shape \eqn{\alpha > 2}{alpha > 2} \item Parameter 2: scale \eqn{\beta > 0}{beta > 0} \item Parameter 3: positive-definite \eqn{k \times k}{k x k} scale matrix \eqn{\Sigma}{Sigma} \item Mean: \item Variance: \item Mode: } The matrix gamma (MG), also called the matrix-variate gamma, distribution is a generalization of the gamma distribution to positive-definite matrices. It is a more general and flexible version of the Wishart distribution (\code{\link{dwishart}}), and is a conjugate prior of the precision matrix of a multivariate normal distribution (\code{\link{dmvnp}}) and matrix normal distribution (\code{\link{dmatrixnorm}}). The compound distribution resulting from compounding a matrix normal with a matrix gamma prior over the precision matrix is a generalized matrix t-distribution. The matrix gamma distribution is identical to the Wishart distribution when \eqn{\alpha = \nu / 2}{alpha = nu / 2} and \eqn{\beta = 2}{beta = 2}. } \value{ \code{dmatrixgamma} gives the density. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dgamma}} \code{\link{dmatrixnorm}}, \code{\link{dmvnp}}, and \code{\link{dwishart}} } \examples{ library(LaplacesDemon) k <- 10 dmatrixgamma(X=diag(k), alpha=(k+1)/2, beta=2, Sigma=diag(k), log=TRUE) dwishart(Omega=diag(k), nu=k+1, S=diag(k), log=TRUE) } \keyword{Distribution}LaplacesDemon/man/BayesTheorem.Rd0000755000176200001440000001321415144316355016425 0ustar liggesusers\name{BayesTheorem} \alias{BayesTheorem} \title{Bayes' Theorem} \description{ Bayes' theorem shows the relation between two conditional probabilities that are the reverse of each other. This theorem is named after Reverend Thomas Bayes (1702-1761), and is also referred to as Bayes' law or Bayes' rule (Bayes and Price, 1763). Bayes' theorem expresses the conditional probability, or `posterior probability', of an event \eqn{A} after \eqn{B} is observed in terms of the `prior probability' of \eqn{A}, prior probability of \eqn{B}, and the conditional probability of \eqn{B} given \eqn{A}. Bayes' theorem is valid in all common interpretations of probability. This function provides one of several forms of calculations that are possible with Bayes' theorem. } \usage{ BayesTheorem(PrA, PrBA) } \arguments{ \item{PrA}{This required argument is the prior probability of \eqn{A}, or \eqn{\Pr(A)}{Pr(A)}.} \item{PrBA}{This required argument is the conditional probability of \eqn{B} given \eqn{A} or \eqn{\Pr(B | A)}{Pr(B | A)}, and is known as the data, evidence, or likelihood.} } \value{ The \code{BayesTheorem} function returns the conditional probability of \eqn{A} given \eqn{B}, known in Bayesian inference as the posterior. The returned object is of class \code{bayestheorem}. } \details{ Bayes' theorem provides an expression for the conditional probability of \eqn{A} given \eqn{B}, which is equal to \deqn{\Pr(A | B) = \frac{\Pr(B | A)\Pr(A)}{\Pr(B)}}{Pr(A | B) = (Pr(B | A)Pr(A)) / Pr(B)} For example, suppose one asks the question: what is the probability of going to Hell, conditional on consorting (or given that a person consorts) with Laplace's Demon. By replacing \eqn{A} with \eqn{Hell} and \eqn{B} with \eqn{Consort}, the question becomes \deqn{\Pr(\mathrm{Hell} | \mathrm{Consort}) = \frac{\Pr(\mathrm{Consort} | \mathrm{Hell})\Pr(\mathrm{Hell})}{\Pr(\mathrm{Consort})}}{Pr(Hell | Consort) = (Pr(Consort | Hell)Pr(Hell)) / Pr(Consort)} Note that a common fallacy is to assume that \eqn{\Pr(A | B) = \Pr(B | A)}{Pr(A | B) = Pr(B | A)}, which is called the conditional probability fallacy. Another way to state Bayes' theorem (and this is the form in the provided function) is \deqn{\Pr(A_i | B) = \frac{\Pr(B | A_i)\Pr(A_i)}{\Pr(B | A_i)\Pr(A_i) +\dots+ \Pr(B | A_n)\Pr(A_n)}}{Pr(A[i] | B) = (Pr(B | A[i])Pr(A[i])) / (Pr(B | A[i])Pr(A[i]) +...+ Pr(B | A[n])Pr(A[n]))} Let's examine our \emph{burning} question, by replacing \eqn{A_i}{A[i]} with Hell or Heaven, and replacing \eqn{B} with Consort \itemize{ \item \eqn{\Pr(A_1) = \Pr(\mathrm{Hell})}{Pr(A[1] = Pr(Hell)} \item \eqn{\Pr(A_2) = \Pr(\mathrm{Heaven})}{Pr(A[2] = Pr(Heaven)} \item \eqn{\Pr(B) = \Pr(\mathrm{Consort})}{Pr(B) = Pr(Consort)} \item \eqn{\Pr(A_1 | B) = \Pr(\mathrm{Hell} | \mathrm{Consort})}{Pr(A[1] | B) = Pr(Hell | Consort)} \item \eqn{\Pr(A_2 | B) = \Pr(\mathrm{Heaven} | \mathrm{Consort})}{Pr(A[2] | B) = Pr(Heaven | Consort)} \item \eqn{\Pr(B | A_1) = \Pr(\mathrm{Consort} | \mathrm{Hell})}{Pr(B | A[1]) = Pr(Consort | Heaven)} \item \eqn{\Pr(B | A_2) = \Pr(\mathrm{Consort} | \mathrm{Heaven})}{Pr(B | A[2]) = Pr(Consort | Heaven)} } Laplace's Demon was conjured and asked for some data. He was glad to oblige. \itemize{ \item 6 people consorted out of 9 who went to Hell. \item 5 people consorted out of 7 who went to Heaven. \item 75\% of the population goes to Hell. \item 25\% of the population goes to Heaven. } Now, Bayes' theorem is applied to the data. Four pieces are worked out as follows \itemize{ \item \eqn{\Pr(\mathrm{Consort} | \mathrm{Hell}) = 6/9 = 0.666}{Pr(Consort | Hell) = 6/9 = 0.666} \item \eqn{\Pr(\mathrm{Consort} | \mathrm{Heaven}) = 5/7 = 0.714}{Pr(Consort | Heaven) = 5/7 = 0.714} \item \eqn{\Pr(\mathrm{Hell}) = 0.75}{Pr(Hell) = 0.75} \item \eqn{\Pr(\mathrm{Heaven}) = 0.25}{Pr(Heaven) = 0.25} } Finally, the desired conditional probability \eqn{\Pr(\mathrm{Hell} | \mathrm{Consort})}{Pr(Hell | Consort)} is calculated using Bayes' theorem \itemize{ \item \eqn{\Pr(\mathrm{Hell} | \mathrm{Consort}) = \frac{0.666(0.75)}{0.666(0.75) + 0.714(0.25)}}{Pr(Hell | Consort) = 0.666(0.75) / (0.666(0.75) + 0.714(0.25))} \item \eqn{\Pr(\mathrm{Hell} | \mathrm{Consort}) = 0.737}{Pr(Hell | Consort) = 0.737} } The probability of someone consorting with Laplace's Demon and going to Hell is 73.7\%, which is less than the prevalence of 75\% in the population. According to these findings, consorting with Laplace's Demon does not increase the probability of going to Hell. For an introduction to model-based Bayesian inference, see the accompanying vignette entitled ``Bayesian Inference'' or \url{https://web.archive.org/web/20150206004608/http://www.bayesian-inference.com/bayesian}. } \references{ Bayes, T. and Price, R. (1763). "An Essay Towards Solving a Problem in the Doctrine of Chances". By the late Rev. Mr. Bayes, communicated by Mr. Price, in a letter to John Canton, M.A. and F.R.S. \emph{Philosophical Transactions of the Royal Statistical Society of London}, 53, p. 370--418. } \author{Statisticat, LLC.} \seealso{ \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{ # Pr(Hell|Consort) = PrA <- c(0.75,0.25) PrBA <- c(6/9, 5/7) BayesTheorem(PrA, PrBA) } \keyword{Bayesian} \keyword{Probability} LaplacesDemon/man/dist.HalfNorm.Rd0000755000176200001440000000552215144316355016511 0ustar liggesusers\name{dist.HalfNormal} \alias{dhalfnorm} \alias{phalfnorm} \alias{qhalfnorm} \alias{rhalfnorm} \title{Half-Normal Distribution} \description{ These functions provide the density, distribution function, quantile function, and random generation for the half-normal distribution. } \usage{ dhalfnorm(x, scale=sqrt(pi/2), log=FALSE) phalfnorm(q, scale=sqrt(pi/2), lower.tail=TRUE, log.p=FALSE) qhalfnorm(p, scale=sqrt(pi/2), lower.tail=TRUE, log.p=FALSE) rhalfnorm(n, scale=sqrt(pi/2)) } \arguments{ \item{x,q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{scale}{This is the scale parameter \eqn{\sigma}{sigma}, which must be positive.} \item{log,log.p}{Logical. If \code{log=TRUE}, then the logarithm of the density or result is returned.} \item{lower.tail}{Logical. If \code{lower.tail=TRUE} (default), probabilities are \eqn{Pr[X \le x]}{Pr[X <= x]}, otherwise, \eqn{Pr[X > x]}{Pr[X > x]}.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{2 \sigma}{\pi} \exp(-\frac{\theta^2 \sigma^2}{\pi}), \quad \theta \ge 0}{p(theta) = 2*sigma/pi e^-(theta^2*sigma^2/pi), theta >= 0} \item Inventor: Derived from the normal or Gaussian \item Notation 1: \eqn{\theta \sim \mathcal{HN}(\sigma)}{theta ~ HALF-N(sigma)} \item Notation 2: \eqn{p(\theta) = \mathcal{HN}(\theta | \sigma)}{p(theta) = HN(theta | sigma)} \item Parameter 1: scale parameter \eqn{\sigma > 0}{sigma > 0} \item Mean: \eqn{E(\theta) = \frac{1}{\sigma}}{E(theta) = 1 / sigma} \item Variance: \eqn{var(\theta) = \frac{\pi-2}{2 \sigma^2}}{var(theta) = (pi-2)/(2*sigma^2)} \item Mode: \eqn{mode(\theta) = 0}{mode(theta) = 0} } The half-normal distribution is recommended as a weakly informative prior distribution for a scale parameter that may be useful as an alternative to the half-Cauchy, half-t, or vague gamma. } \value{ \code{dhalfnorm} gives the density, \code{phalfnorm} gives the distribution function, \code{qhalfnorm} gives the quantile function, and \code{rhalfnorm} generates random deviates. } \seealso{ \code{\link{dnorm}}, \code{\link{dnormp}}, and \code{\link{dnormv}}. } \examples{ library(LaplacesDemon) x <- dhalfnorm(1) x <- phalfnorm(1) x <- qhalfnorm(0.5) x <- rhalfnorm(10) #Plot Probability Functions x <- seq(from=0.1, to=20, by=0.1) plot(x, dhalfnorm(x,0.1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dhalfnorm(x,0.5), type="l", col="green") lines(x, dhalfnorm(x,1), type="l", col="blue") legend(2, 0.9, expression(sigma==0.1, sigma==0.5, sigma==1), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/de.Finetti.Game.Rd0000755000176200001440000000357715144316355016712 0ustar liggesusers\name{de.Finetti.Game} \alias{de.Finetti.Game} \title{de Finetti's Game} \description{ The \code{de.Finetti.Game} function estimates the interval of a subjective probability regarding a possible event in the near future. } \usage{ de.Finetti.Game(width) } \arguments{ \item{width}{This is the maximum acceptable width of the interval for the returned subjective probability. The user must specify a width between 0 and 1.} } \details{ This function is a variation on the game introduced by de Finetti, who is one of the main developers of subjective probability, along with Ramsey and Savage. In the original context, de Finetti proposed a gamble regarding life on Mars one billion years ago. The frequentist interpretation of probability defines the probability of an event as the limit of its relative frequency in a large number of trials. Frequentist inference is undefined, for example, when there are no trials from which to calculate a probability. By defining probability relative to frequencies of physical events, frequentists attempt to objectify probability. However, de Finetti asserts that the frequentist (or objective) interpretation always reduces to a subjective interpretation of probability, because probability is a human construct and does not exist independently of humans in nature. Therefore, probability is a degree of belief, and is called subjective or personal probability. } \value{ The \code{de.Finetti.Game} function returns a vector of length two. The respective elements are the lower and upper bounds of the subjective probability of the participant regarding the possible event in the near future. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{elicit}} } \keyword{Personal Probability} \keyword{Subjective Probability} \keyword{Utility} LaplacesDemon/man/WAIC.Rd0000755000176200001440000000705515144316355014567 0ustar liggesusers\name{WAIC} \alias{WAIC} \title{Widely Applicable Information Criterion} \description{ This function calculates the Widely Applicable Information Criterion (WAIC), also known as the Widely Available Information Criterion or the Watanable-Akaike, of Watanabe (2010). } \usage{ WAIC(x) } \arguments{ \item{x}{This required argument accepts a \eqn{N \times S}{N x S} matrix of log-likelihood (LL) for \eqn{N} records and \eqn{S} samples.} } \details{ WAIC is an extension of the Akaike Information Criterion (AIC) that is more fully Bayesian than the Deviance Information Criterion (DIC). Like DIC, WAIC estimates the effective number of parameters to adjust for overfitting. Two adjustments have been proposed. pWAIC1 is similar to pD in the original DIC. In contrast, pWAIC2 is calculated with variance more similarly to pV, which Gelman proposed for DIC. Gelman et al. (2014, p.174) recommends pWAIC2 because its results are closer in practice to the results of leave-one-out cross-validation (LOO-CV). pWAIC is considered an approximation to the number of unconstrained and uninformed parameters, where a parameter counts as 1 when estimated without contraint or any prior information, 0 if fully constrained or all information comes from the prior distribution, or an intermediate number if both the data and prior are informative, which is usually the case. Gelman et al. (2014, p. 174) scale the WAIC of Watanabe (2010) by a factor of 2 so that it is comparable to AIC and DIC. WAIC is then reported as \eqn{-2(lppd - pWAIC)}. Gelman et al. (2014) prefer WAIC to AIC or DIC when feasible, which is less often than AIC or DIC. The \code{\link{LaplacesDemon}} function requires the model specification function to return the model-level deviance, which is \eqn{-2(LL)}, where \eqn{LL} is the sum of the record-level log-likelihood. Therefore, if the user desires to calculate WAIC, then the record-level log-likelihood must be monitored. } \value{ The \code{WAIC} argument returns a list with four components: \item{WAIC}{This is the Widely Applicable Information Criterion (WAIC), which is \eqn{-2(lppd - pWAIC)}.} \item{lppd}{This is the log pointwise predictive density. For more information, see Gelman et al. (2014, p. 168).} \item{pWAIC}{This is the effective number of parameters preferred by Gelman et al. (2014).} \item{pWAIC1}{This is the effective number of parameters, is calculated with an alternate method, and is included here for completeness. It is not used to calculate WAIC in the \code{WAIC} function.} } \references{ Gelman, A., Carlin, J.B., Stern, H.S., Dunson, D.B., Vehtari, A., and Rubin, D.B. (2014). "Bayesian Data Analysis, 3rd ed.". CRC Press: Boca Raton, FL. Watanabe, S. (2010). "Asymptotic Equivalence of Bayes Cross Validation and Widely Applicable Information Criterion in Singular Learning Theory". \emph{Journal of Machine Learning Research}, 11, p. 3571--3594. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplacesDemon}} } \examples{ #library(LaplacesDemon) #N <- 10 #Number of records #S <- 1000 #Number of samples #LL <- t(rmvn(S, -70+rnorm(N), # as.positive.definite(matrix(rnorm(N*N),N,N)))) #WAIC(LL) ### Compare with DIC: #Dev <- -2*colSums(LL) #DIC <- list(DIC=mean(Dev) + var(Dev)/2, Dbar=mean(Dev), pV=var(Dev)/2) #DIC } \keyword{Diagnostic} \keyword{Information Criterion} \keyword{MCMC} \keyword{Monte Carlo} \keyword{Utility} LaplacesDemon/man/dist.Wishart.Rd0000755000176200001440000001100415144316355016414 0ustar liggesusers\name{dist.Wishart} \alias{dwishart} \alias{rwishart} \title{Wishart Distribution} \description{ These functions provide the density and random number generation for the Wishart distribution. } \usage{ dwishart(Omega, nu, S, log=FALSE) rwishart(nu, S) } \arguments{ \item{Omega}{This is the symmetric, positive-definite \eqn{k \times k}{k x k} matrix \eqn{\Omega}{Omega}.} \item{nu}{This is the scalar degrees of freedom \eqn{\nu}{nu}.} \item{S}{This is the symmetric, positive-semidefinite, \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = (2^{\nu k/2} \pi^{k(k-1)/4} \prod^k_{i=1} \Gamma(\frac{\nu+1-i}{2}))^{-1} |\textbf{S}|^{-nu/2} |\Omega|^{(nu-k-1)/2} \exp(-\frac{1}{2} tr(\textbf{S}^{-1} \Omega))}{p(theta) = (2^(nu*k/2) * pi^(k(k-1)/4) * [Gamma((nu+1-i)/2) * ... * Gamma((nu+1-k)/2)])^(-1) * |S|^(-nu/2) * |Omega|^((nu-k-1)/2) * exp(-(1/2) * tr(S^(-1) Omega))} \item Inventor: John Wishart (1928) \item Notation 1: \eqn{\Omega \sim \mathcal{W}_{\nu}(\textbf{S})}{Omega ~ W[nu](S)} \item Notation 2: \eqn{p(\Omega) = \mathcal{W}_{\nu}(\Omega | \textbf{S})}{p(Omega) = W[nu](Omega | S)} \item Parameter 1: degrees of freedom \eqn{\nu \ge k}{nu >= k} \item Parameter 2: symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S} \item Mean: \eqn{E(\Omega) = \nu \textbf{S}}{E(Omega) = nuS} \item Variance: \eqn{var(\Omega) = \nu (\textbf{S}^2_{i,j} + \textbf{S}_{i,i} \textbf{S}_{j,j})}{var(Omega) = nu(S[i,j]^2 + S[i,i]S[j,j])} \item Mode: \eqn{mode(\Omega) = (\nu - k - 1) \textbf{S}}{mode(Omega) = (nu-k-1)S}, for \eqn{\nu \ge k + 1}{nu >= k + 1} } The Wishart distribution is a generalization to multiple dimensions of the chi-square distribution, or, in the case of non-integer degrees of freedom, of the gamma distribution. However, the Wishart distribution is not called the multivariate chi-squared distribution because the marginal distribution of the off-diagonal elements is not chi-squared. The Wishart is the conjugate prior distribution for the precision matrix \eqn{\Omega}{Omega}, the inverse of which (covariance matrix \eqn{\Sigma}{Sigma}) is used in a multivariate normal distribution. The integral is finite when \eqn{\nu \ge k}{nu >= k}, where \eqn{\nu}{nu} is the scalar degrees of freedom parameter, and \eqn{k} is the dimension of scale matrix \eqn{\textbf{S}}{S}. The density is finite when \eqn{\nu ge k + 1}{nu >= k + 1}, which is recommended. The degrees of freedom, \eqn{\nu}{nu}, is equivalent to specifying a prior sample size, indicating the confidence in \eqn{\textbf{S}}{S}, where \eqn{\textbf{S}}{S} is a prior guess at the order of covariance matrix \eqn{\Sigma}{Sigma}. A flat prior distribution is obtained as \eqn{\nu \rightarrow 0}{nu -> 0}. When applicable, the alternative Cholesky parameterization should be preferred. For more information, see \code{\link{dwishartc}}. The Wishart prior lacks flexibility, having only one parameter, \eqn{\nu}{nu}, to control the variability for all \eqn{k(k + 1)/2} elements. Popular choices for the scale matrix \eqn{\textbf{S}}{S} include an identity matrix or sample covariance matrix. When the model sample size is small, the specification of the scale matrix can be influential. Although the related inverse Wishart distribution has a dependency between variance and correlation, the Wishart distribution does not have this dependency. The matrix gamma (\code{\link{dmatrixgamma}}) distribution is a more general version of the Wishart distribution, and the Yang-Berger (\code{\link{dyangberger}}) distribution is an alterative that is a least informative prior (LIP). } \value{ \code{dwishart} gives the density and \code{rwishart} generates random deviates. } \references{ Wishart, J. (1928). "The Generalised Product Moment Distribution in Samples from a Normal Multivariate Population". \emph{Biometrika}, 20A(1-2), p. 32--52. } \seealso{ \code{\link{dchisq}}, \code{\link{dgamma}}, \code{\link{dinvwishart}}, \code{\link{dmatrixgamma}}, \code{\link{dmvnp}}, \code{\link{dwishartc}}, \code{\link{Prec2Cov}}, and \code{\link{dyangberger}}. } \examples{ library(LaplacesDemon) x <- dwishart(matrix(c(2,-.3,-.3,4),2,2), 3, matrix(c(1,.1,.1,1),2,2)) x <- rwishart(3, matrix(c(1,.1,.1,1),2,2)) } \keyword{Distribution} LaplacesDemon/man/dist.LASSO.Rd0000755000176200001440000000752415144316355015670 0ustar liggesusers\name{dist.LASSO} \alias{dlasso} \alias{rlasso} \title{LASSO Distribution} \description{ These functions provide the density and random generation for the Bayesian LASSO prior distribution. } \usage{ dlasso(x, sigma, tau, lambda, a=1, b=1, log=FALSE) rlasso(n, sigma, tau, lambda, a=1, b=1) } \arguments{ \item{x}{This is a location vector of length \eqn{J} at which to evaluate density.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{sigma}{This is a positive-only scalar hyperparameter \eqn{\sigma}{sigma}, which is also the residual standard deviation.} \item{tau}{This is a positive-only vector of hyperparameters, \eqn{\tau}{tau}, of length \eqn{J} regarding local sparsity.} \item{lambda}{This is a positive-only scalar hyperhyperparameter, \eqn{\lambda}{lambda}, of global sparsity.} \item{a, b}{These are positive-only scalar hyperhyperhyperparameters for gamma distributed \eqn{\lambda}{lambda}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Multivariate Scale Mixture \item Density: \eqn{p(\theta) \sim \mathcal{N}_k(0, \sigma^2 diag(\tau^2))(\frac{1}{sigma^2}) \mathcal{EXP}(\frac{\lambda^2}{2}) \mathcal{G}(a,b)}{p(theta) ~ N[k](0, sigma^2 diag(tau^2))(1/sigma^2) EXP(lambda^2/2) G(a,b)} \item Inventor: Parks and Casella (2008) \item Notation 1: \eqn{\theta \sim \mathcal{LASSO}(\sigma, \tau, \lambda, a, b)}{theta ~ LASSO(sigma, tau, lambda, a, b)} \item Notation 2: \eqn{p(\theta) = \mathcal{LASSO}(\theta | \sigma, \tau, \lambda, a, b)}{p(theta) = LASSO(theta | sigma, tau, lambda, a, b)} \item Parameter 1: hyperparameter global scale \eqn{\sigma > 0}{sigma > 0} \item Parameter 2: hyperparameter local scale \eqn{\tau > 0}{tau > 0} \item Parameter 3: hyperhyperparameter global scale \eqn{\lambda > 0}{lambda > 0} \item Parameter 4: hyperhyperhyperparameter scale \eqn{a > 0} \item Parameter 5: hyperhyperhyperparameter scale \eqn{b > 0} \item Mean: \eqn{E(\theta)}{E(theta)} \item Variance: \item Mode: } The Bayesian LASSO distribution (Parks and Casella, 2008) is a heavy-tailed mixture distribution that can be considered a variance mixture, and it is in the family of multivariate scale mixtures of normals. The LASSO distribution was proposed as a prior distribution, as a Bayesian version of the frequentist LASSO, introduced by Tibshirani (1996). It is applied as a shrinkage prior in the presence of sparsity for \eqn{J} regression effects. LASSO priors are most appropriate in large-dimensional models where dimension reduction is necessary to avoid overly complex models that predict poorly. The Bayesian LASSO results in regression effects that are a compromise between regression effects in the frequentist LASSO and ridge regression. The Bayesian LASSO applies more shrinkage to weak regression effects than ridge regression. The Bayesian LASSO is an alternative to horseshoe regression and ridge regression. } \value{ \code{dlasso} gives the density and \code{rlasso} generates random deviates. } \references{ Park, T. and Casella, G. (2008). "The Bayesian Lasso". \emph{Journal of the American Statistical Association}, 103, p. 672--680. Tibshirani, R. (1996). "Regression Shrinkage and Selection via the Lasso". \emph{Journal of the Royal Statistical Society}, Series B, 58, p. 267--288. } \seealso{ \code{\link{dhs}} } \examples{ library(LaplacesDemon) x <- rnorm(100) sigma <- rhalfcauchy(1, 5) tau <- rhalfcauchy(100, 5) lambda <- rhalfcauchy(1, 5) x <- dlasso(x, sigma, tau, lambda, log=TRUE) x <- rlasso(length(tau), sigma, tau, lambda) } \keyword{Distribution} LaplacesDemon/man/IterativeQuadrature.Rd0000755000176200001440000006627715144316355020051 0ustar liggesusers\name{IterativeQuadrature} \alias{IterativeQuadrature} \title{Iterative Quadrature} \description{ The \code{IterativeQuadrature} function iteratively approximates the first two moments of marginal posterior distributions of a Bayesian model with deterministic integration. } \usage{ IterativeQuadrature(Model, parm, Data, Covar=NULL, Iterations=100, Algorithm="CAGH", Specs=NULL, Samples=1000, sir=TRUE, Stop.Tolerance=c(1e-5,1e-15), CPUs=1, Type="PSOCK") } \arguments{ \item{Model}{This required argument receives the model from a user-defined function. The user-defined function is where the model is specified. \code{IterativeQuadrature} passes two arguments to the model function, \code{parms} and \code{Data}. For more information, see the \code{\link{LaplacesDemon}} function and ``LaplacesDemon Tutorial'' vignette.} \item{parm}{This argument requires a vector of initial values equal in length to the number of parameters. \code{IterativeQuadrature} will attempt to approximate these initial values for the parameters as means (or posterior modes) of normal integrals. The \code{\link{GIV}} function may be used to randomly generate initial values. Parameters must be continuous.} \item{Data}{This required argument accepts a list of data. The list of data must include \code{mon.names} which contains monitored variable names, and \code{parm.names} which contains parameter names.} \item{Covar}{This argument accepts a \eqn{J \times J}{J x J} covariance matrix for \eqn{J} initial values. When a covariance matrix is not supplied, a scaled identity matrix is used.} \item{Iterations}{This argument accepts an integer that determines the number of iterations that \code{IterativeQuadrature} will attempt to approximate the posterior with normal integrals. \code{Iterations} defaults to 100. \code{IterativeQuadrature} will stop before this number of iterations if the tolerance is less than or equal to the \code{Stop.Tolerance} criterion. The required amount of computer memory increases with \code{Iterations}. If computer memory is exceeded, then all will be lost.} \item{Algorithm}{This optional argument accepts a quoted string that specifies the iterative quadrature algorithm. The default method is \code{Method="CAGH"}. Options include \code{"AGHSG"} for Adaptive Gauss-Hermite Sparse Grid, and \code{"CAGH"} for Componentwise Adaptive Gaussian-Hermite.} \item{Specs}{This argument accepts a list of specifications for an algorithm.} \item{Samples}{This argument indicates the number of posterior samples to be taken with sampling importance resampling via the \code{\link{SIR}} function, which occurs only when \code{sir=TRUE}. Note that the number of samples should increase with the number and intercorrelations of the parameters.} \item{sir}{This logical argument indicates whether or not Sampling Importance Resampling (SIR) is conducted via the \code{\link{SIR}} function to draw independent posterior samples. This argument defaults to \code{TRUE}. Even when \code{TRUE}, posterior samples are drawn only when \code{IterativeQuadrature} has converged. Posterior samples are required for many other functions, including \code{plot.iterquad} and \code{predict.iterquad}. Less time can be spent on sampling by increasing \code{CPUs}, if available, which parallelizes the sampling.} \item{Stop.Tolerance}{This argument accepts a vector of two positive numbers, and defaults to \code{1e-5,1e-15}. Tolerance is calculated each iteration, and the criteria varies by algorithm. The algorithm is considered to have converged to the user-specified \code{Stop.Tolerance} when the tolerance is less than or equal to the value of \code{Stop.Tolerance}, and the algorithm terminates at the end of the current iteration. Unless stated otherwise, the first element is the stop tolerance for the change in \eqn{\mu}, the second element is the stop tolerance for the change in mean integration error, and the first tolerance must be met before the second tolerance is considered.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur. When multiple CPUs are specified, model function evaluations are parallelized across the nodes, and sampling with \code{\link{SIR}} is parallelized when \code{sir=TRUE}.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} } \details{ Quadrature is a historical term in mathematics that means determining area. Mathematicians of ancient Greece, according to the Pythagorean doctrine, understood determination of area of a figure as the process of geometrically constructing a square having the same area (squaring). Thus the name quadrature for this process. In medieval Europe, quadrature meant the calculation of area by any method. With the invention of integral calculus, quadrature has been applied to the computation of a univariate definite integral. Numerical integration is a broad family of algorithms for calculating the numerical value of a definite integral. Numerical quadrature is a synonym for quadrature applied to one-dimensional integrals. Multivariate quadrature, also called cubature, is the application of quadrature to multidimensional integrals. A quadrature rule is an approximation of the definite integral of a function, usually stated as a weighted sum of function values at specified points within the domain of integration. The specified points are referred to as abscissae, abscissas, integration points, or nodes, and have associated weights. The calculation of the nodes and weights of the quadrature rule differs by the type of quadrature. There are numerous types of quadrature algorithms. Bayesian forms of quadrature usually use Gauss-Hermite quadrature (Naylor and Smith, 1982), and placing a Gaussian Process on the function is a common extension (O'Hagan, 1991; Rasmussen and Ghahramani, 2003) that is called `Bayesian Quadrature'. Often, these and other forms of quadrature are also referred to as model-based integration. Gauss-Hermite quadrature uses Hermite polynomials to calculate the rule. However, there are two versions of Hermite polynomials, which result in different kernels in different fields. In physics, the kernel is \code{exp(-x^2)}, while in probability the kernel is \code{exp(-x^2/2)}. The weights are a normal density. If the parameters of the normal distribution, \eqn{\mu} and \eqn{\sigma^2}{sigma^2}, are estimated from data, then it is referred to as adaptive Gauss-Hermite quadrature, and the parameters are the conditional mean and conditional variance. Outside of Gauss-Hermite quadrature, adaptive quadrature implies that a difficult range in the integrand is subdivided with more points until it is well-approximated. Gauss-Hermite quadrature performs well when the integrand is smooth, and assumes normality or multivariate normality. Adaptive Gauss-Hermite quadrature has been demonstrated to outperform Gauss-Hermite quadrature in speed and accuracy. A goal in quadrature is to minimize integration error, which is the error between the evaluations and the weights of the rule. Therefore, a goal in Bayesian Gauss-Hermite quadrature is to minimize integration error while approximating a marginal posterior distribution that is assumed to be smooth and normally-distributed. This minimization often occurs by increasing the number of nodes until a change in mean integration error is below a tolerance, rather than minimizing integration error itself, since the target may be only approximately normally distributed, or minimizing the sum of integration error, which would change with the number of nodes. To approximate integrals in multiple dimensions, one approach applies \eqn{N} nodes of a univariate quadrature rule to multiple dimensions (using the \code{\link{GaussHermiteCubeRule}} function for example) via the product rule, which results in many more multivariate nodes. This requires the number of function evaluations to grow exponentially as dimension increases. Multidimensional quadrature is usually limited to less than ten dimensions, both due to the number of nodes required, and because the accuracy of multidimensional quadrature algorithms decreases as the dimension increases. Three methods may overcome this curse of dimensionality in varying degrees: componentwise quadrature, sparse grids, and Monte Carlo. Componentwise quadrature is the iterative application of univariate quadrature to each parameter. It is applicable with high-dimensional models, but sacrifices the ability to calculate the conditional covariance matrix, and calculates only the variance of each parameter. Sparse grids were originally developed by Smolyak for multidimensional quadrature. A sparse grid is based on a one-dimensional quadrature rule. Only a subset of the nodes from the product rule is included, and the weights are appropriately rescaled. Although a sparse grid is more efficient because it reduces the number of nodes to achieve the same accuracy, the user must contend with increasing the accuracy of the grid, and it remains inapplicable to high-dimensional integrals. Monte Carlo is a large family of sampling-based algorithms. O'Hagan (1987) asserts that Monte Carlo is frequentist, inefficient, regards irrelevant information, and disregards relevant information. Quadrature, he maintains (O'Hagan, 1992), is the most Bayesian approach, and also the most efficient. In high dimensions, he concedes, a popular subset of Monte Carlo algorithms is currently the best for cheap model function evaluations. These algorithms are called Markov chain Monte Carlo (MCMC). High-dimensional models with expensive model evaluation functions, however, are not well-suited to MCMC. A large number of MCMC algorithms is available in the \code{\link{LaplacesDemon}} function. Following are some reasons to consider iterative quadrature rather than MCMC. Once an MCMC sampler finds equilibrium, it must then draw enough samples to represent all targets. Iterative quadrature does not need to continue drawing samples. Multivariate quadrature is consistently reported as more efficient than MCMC when its assumptions hold, though multivariate quadrature is limited to small dimensions. High-dimensional models therefore default to MCMC, between the two. Componentwise quadrature algorithms like CAGH, however, may also be more efficient with cloc-time than MCMC in high dimensions, especially against componentwise MCMC algorithms. Another reason to consider iterative quadrature are that assessing convergence in MCMC is a difficult topic, but not for iterative quadrature. A user of iterative quadrature does not have to contend with effective sample size and autocorrelation, assessing stationarity, acceptance rates, diminishing adaptation, etc. Stochastic sampling in MCMC is less efficient when samples occur in close proximity (such as when highly autocorrelated), whereas in quadrature the nodes are spread out by design. In general, the conditional means and conditional variances progress smoothly to the target in multidimensional quadrature. For componentwise quadrature, movement to the target is not smooth, and often resembles a Markov chain or optimization algorithm. Iterative quadrature is often applied after \code{\link{LaplaceApproximation}} to obtain a more reliable estimate of parameter variance or covariance than the negative inverse of the \code{\link{Hessian}} matrix of second derivatives, which is suitable only when the contours of the logarithm of the unnormalized joint posterior density are approximately ellipsoidal (Naylor and Smith, 1982, p. 224). When \code{Algorithm="AGH"}, the Naylor and Smith (1982) algorithm is used. The AGH algorithm uses multivariate quadrature with the physicist's (not the probabilist's) kernel. There are four algorithm specifications: \code{N} is the number of univariate nodes, \code{Nmax} is the maximum number of univariate nodes, \code{Packages} accepts any package required for the model function when parallelized, and \code{Dyn.libs} accepts dynamic libraries for parallelization, if required. The number of univariate nodes begins at \eqn{N} and increases by one each iteration. The number of multivariate nodes grows quickly with \eqn{N}. Naylor and Smith (1982) recommend beginning with as few nodes as \eqn{N=3}. Any of the following events will cause \eqn{N} to increase by 1 when \eqn{N} is less than \code{Nmax}: \itemize{ \item All LP weights are zero (and non-finite weights are set to zero) \item \eqn{\mu} does not result in an increase in LP \item All elements in \eqn{\Sigma} are not finite \item The square root of the sum of the squared changes in \eqn{\mu} is less than or equal to the \code{Stop.Tolerance} } Tolerance includes two metrics: change in mean integration error and change in parameters. Including the change in parameters for tolerance was not mentioned in Naylor and Smith (1982). Naylor and Smith (1982) consider a transformation due to correlation. This is not included here. The AGH algorithm does not currently handle constrained parameters, such as with the \code{\link{interval}} function. If a parameter is constrained and changes during a model evaluation, this changes the node and the multivariate weight. This is currently not corrected. An advantage of AGH over componentwise adaptive quadrature is that AGH estimates covariance, where a componentwise algorithm ignores it. A disadvantage of AGH over a componentwise algorithm is that the number of nodes increases so quickly with dimension, that AGH is limited to small-dimensional models. When \code{Algorithm="AGHSG"}, the Naylor and Smith (1982) algorithm is applied to a sparse grid, rather than a traditional multivariate quadrature rule. This is identical to the AGH algorithm above, except that a sparse grid replaces the multivariate quadrature rule. The sparse grid reduces the number of nodes. The cost of reducing the number of nodes is that the user must consider the accuracy, \eqn{K}. There are four algorithm specifications: \code{K} is the accuracy (as a positive integer), \code{Kmax} is the maximum accuracy, \code{Packages} accepts any package required for the model function when parallelized, and \code{Dyn.libs} accepts dynamic libraries for parallelization, if required. These arguments represent accuracy rather than the number of univariate nodes, but otherwise are similar to the AGH algorithm. When \code{Algorithm="CAGH"}, a componentwise version of the adaptive Gauss-Hermite quadrature of Naylor and Smith (1982) is used. Each iteration, each marginal posterior distribution is approximated sequentially, in a random order, with univariate quadrature. The conditional mean and conditional variance are also approximated each iteration, making it an adaptive algorithm. There are four algorithm specifications: \code{N} is the number of nodes, \code{Nmax} is the maximum number of nodes, \code{Packages} accepts any package required for the model function when parallelized, and \code{Dyn.libs} accepts dynamic libraries for parallelization, if required. The number of nodes begins at \eqn{N}. All parameters have the same number of nodes. Any of the following events will cause \eqn{N} to increase by 1 when \eqn{N} is less than \code{Nmax}, and these conditions refer to all parameters (not individually): \itemize{ \item Any LP weights are not finite \item All LP weights are zero \item \eqn{\mu} does not result in an increase in LP \item The square root of the sum of the squared changes in \eqn{\mu} is less than or equal to the \code{Stop.Tolerance} } It is recommended to begin with \code{N=3} and set \code{Nmax} between 10 and 100. As long as CAGH does not experience problematic weights, and as long as CAGH is improving LP with \eqn{\mu}, the number of nodes does not increase. When CAGH becomes either universally problematic or universally stable, then \eqn{N} slowly increases until the sum of both the mean integration error and the sum of the squared changes in \eqn{\mu} is less than the \code{Stop.Tolerance} for two consecutive iterations. If the highest LP occurs at the lowest or highest node, then the value at that node becomes the conditional mean, rather than calculating it from all weighted samples; this facilitates movement when the current integral is poorly centered toward a well-centered integral. If all weights are zero, then a random proposal is generated with a small variance. Tolerance includes two metrics: change in mean integration error and change in parameters, as the square root of the sum of the squared differences. When a parameter constraint is encountered, the node and weight of the quadrature rule is recalculated. An advantage of CAGH over multidimensional adaptive quadrature is that CAGH may be applied in large dimensions. Disadvantages of CAGH are that only variance, not covariance, is estimated, and ignoring covariance may be problematic. } \value{ \code{IterativeQuadrature} returns an object of class \code{iterquad} that is a list with the following components: \item{Algorithm}{This is the name of the iterative quadrature algorithm.} \item{Call}{This is the matched call of \code{IterativeQuadrature}.} \item{Converged}{This is a logical indicator of whether or not \code{IterativeQuadrature} converged within the specified \code{Iterations} according to the supplied \code{Stop.Tolerance} criterion. Convergence does not indicate that the global maximum has been found, but only that the tolerance was less than or equal to the \code{Stop.Tolerance} criteria.} \item{Covar}{This is the estimated covariance matrix. The \code{Covar} matrix may be scaled and input into the \code{Covar} argument of the \code{\link{LaplacesDemon}} or \code{\link{PMC}} function for further estimation. To scale this matrix for use with Laplace's Demon or PMC, multiply it by \eqn{2.38^2/d}, where \eqn{d} is the number of initial values.} \item{Deviance}{This is a vector of the iterative history of the deviance in the \code{IterativeQuadrature} function, as it sought convergence.} \item{History}{This is a matrix of the iterative history of the parameters in the \code{IterativeQuadrature} function, as it sought convergence.} \item{Initial.Values}{This is the vector of initial values that was originally given to \code{IterativeQuadrature} in the \code{parm} argument.} \item{LML}{This is an approximation of the logarithm of the marginal likelihood of the data (see the \code{\link{LML}} function for more information). When the model has converged and \code{sir=TRUE}, the NSIS method is used. When the model has converged and \code{sir=FALSE}, the LME method is used. This is the logarithmic form of equation 4 in Lewis and Raftery (1997). As a rough estimate of Kass and Raftery (1995), the LME-based LML is worrisome when the sample size of the data is less than five times the number of parameters, and \code{LML} should be adequate in most problems when the sample size of the data exceeds twenty times the number of parameters (p. 778). The LME is inappropriate with hierarchical models. However \code{LML} is estimated, it is useful for comparing multiple models with the \code{BayesFactor} function.} \item{LP.Final}{This reports the final scalar value for the logarithm of the unnormalized joint posterior density.} \item{LP.Initial}{This reports the initial scalar value for the logarithm of the unnormalized joint posterior density.} \item{LPw}{This is the latest matrix of the logarithm of the unnormalized joint posterior density. It is weighted and normalized so that each column sums to one.} \item{M}{This is the final \eqn{N \times J}{N x J} matrix of quadrature weights that have been corrected for non-standard normal distributions, where \eqn{N} is the number of nodes and \eqn{J} is the number of parameters.} \item{Minutes}{This is the number of minutes that \code{IterativeQuadrature} was running, and this includes the initial checks as well as drawing posterior samples and creating summaries.} \item{Monitor}{When \code{sir=TRUE}, a number of independent posterior samples equal to \code{Samples} is taken, and the draws are stored here as a matrix. The rows of the matrix are the samples, and the columns are the monitored variables.} \item{N}{This is the final number of nodes.} \item{Posterior}{When \code{sir=TRUE}, a number of independent posterior samples equal to \code{Samples} is taken, and the draws are stored here as a matrix. The rows of the matrix are the samples, and the columns are the parameters.} \item{Summary1}{This is a summary matrix that summarizes the point-estimated posterior means. Uncertainty around the posterior means is estimated from the covariance matrix. Rows are parameters. The following columns are included: Mean, SD (Standard Deviation), LB (Lower Bound), and UB (Upper Bound). The bounds constitute a 95\% probability interval.} \item{Summary2}{This is a summary matrix that summarizes the posterior samples drawn with sampling importance resampling (\code{\link{SIR}}) when \code{sir=TRUE}, given the point-estimated posterior modes and the covariance matrix. Rows are parameters. The following columns are included: Mean, SD (Standard Deviation), LB (Lower Bound), and UB (Upper Bound). The bounds constitute a 95\% probability interval.} \item{Tolerance.Final}{This is the last \code{Tolerance} of the \code{LaplaceApproxiation} algorithm.} \item{Tolerance.Stop}{This is the \code{Stop.Tolerance} criteria.} \item{Z}{This is the final \eqn{N \times J}{N x J} matrix of the conditional mean, where \eqn{N} is the number of nodes and \eqn{J} is the number of parameters.} } \references{ Naylor, J.C. and Smith, A.F.M. (1982). "Applications of a Method for the Efficient Computation of Posterior Distributions". \emph{Applied Statistics}, 31(3), p. 214--225. O'Hagan, A. (1987). "Monte Carlo is Fundamentally Unsound". \emph{The Statistician}, 36, p. 247--249. O'Hagan, A. (1991). "Bayes-Hermite Quadrature". \emph{Journal of Statistical Planning and Inference}, 29, p. 245--260. O'Hagan, A. (1992). "Some Bayesian Numerical Analysis". In Bernardo, J.M., Berger, J.O., David, A.P., and Smith, A.F.M., editors, \emph{Bayesian Statistics}, 4, p. 356--363, Oxford University Press. Rasmussen, C.E. and Ghahramani, Z. (2003). "Bayesian Monte Carlo". In Becker, S. and Obermayer, K., editors, \emph{Advances in Neural Information Processing Systems}, 15, MIT Press, Cambridge, MA. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{GaussHermiteCubeRule}}, \code{\link{GaussHermiteQuadRule}}, \code{\link{GIV}}, \code{\link{Hermite}}, \code{\link{Hessian}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LML}}, \code{\link{PMC}}, \code{\link{SIR}}, and \code{\link{SparseGrid}}. } \examples{ # The accompanying Examples vignette is a compendium of examples. #################### Load the LaplacesDemon Library ##################### library(LaplacesDemon) ############################## Demon Data ############################### data(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,10]+1))) J <- ncol(X) for (j in 2:J) X[,j] <- CenterScale(X[,j]) ######################### Data List Preparation ######################### mon.names <- "mu[1]" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ########################## Model Specification ########################## Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(Data$X, t(beta)) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + beta.prior + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=mu[1], yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } ############################ Initial Values ############################# #Initial.Values <- GIV(Model, MyData, PGF=TRUE) Initial.Values <- rep(0,J+1) ######################### Adaptive Gauss-Hermite ######################## #Fit <- IterativeQuadrature(Model, Initial.Values, MyData, Covar=NULL, # Iterations=100, Algorithm="AGH", # Specs=list(N=5, Nmax=7, Packages=NULL, Dyn.libs=NULL), CPUs=1) ################## Adaptive Gauss-Hermite Sparse Grid ################### #Fit <- IterativeQuadrature(Model, Initial.Values, MyData, Covar=NULL, # Iterations=100, Algorithm="AGHSG", # Specs=list(K=5, Kmax=7, Packages=NULL, Dyn.libs=NULL), CPUs=1) ################# Componentwise Adaptive Gauss-Hermite ################## #Fit <- IterativeQuadrature(Model, Initial.Values, MyData, Covar=NULL, # Iterations=100, Algorithm="CAGH", # Specs=list(N=3, Nmax=10, Packages=NULL, Dyn.libs=NULL), CPUs=1) #Fit #print(Fit) #PosteriorChecks(Fit) #caterpillar.plot(Fit, Parms="beta") #plot(Fit, MyData, PDF=FALSE) #Pred <- predict(Fit, Model, MyData, CPUs=1) #summary(Pred, Discrep="Chi-Square") #plot(Pred, Style="Covariates", Data=MyData) #plot(Pred, Style="Density", Rows=1:9) #plot(Pred, Style="Fitted") #plot(Pred, Style="Jarque-Bera") #plot(Pred, Style="Predictive Quantiles") #plot(Pred, Style="Residual Density") #plot(Pred, Style="Residuals") #Levene.Test(Pred) #Importance(Fit, Model, MyData, Discrep="Chi-Square") #End } \keyword{Adaptive} \keyword{Bayesian Inference} \keyword{Cubature} \keyword{Gauss-Hermite} \keyword{High Performance Computing} \keyword{Initial Values} \keyword{Integration} \keyword{Numerical Integration} \keyword{Quadrature} \keyword{Sparse Grid}LaplacesDemon/man/is.proper.Rd0000755000176200001440000001147015144316355015761 0ustar liggesusers\name{is.proper} \alias{is.proper} \title{Logical Check of Propriety} \description{ This function provides a logical check of the propriety of a univariate prior probability distribution or the joint posterior distribution. } \usage{ is.proper(f, a, b, tol=1e-5) } \arguments{ \item{f}{This is either a probability density function or an object of class \code{demonoid}, \code{laplace}, \code{pmc}, or \code{vb}.} \item{a}{This is the lower limit of integration, and may be negative infinity.} \item{b}{This is the upper limit of integration, and may be positive infinity.} \item{tol}{This is the tolerance, and indicates the allowable difference from one.} } \details{ A proper probability distribution is a probability distribution that integrates to one, and an improper probability distribution does not integrate to one. If a probability distribution integrates to any positive and finite value other than one, then it is an improper distribution, but is merely unnormalized. An unnormalized distribution may be multiplied by a constant so that it integrates to one. In Bayesian inference, the posterior probability distribution should be proper. An improper prior distribution can cause an improper posterior distribution. When the posterior distribution is improper, inferences are invalid, it is non-integrable, and Bayes factors cannot be used (though there are exceptions). To avoid these problems, it is suggested that the prior probability distribution should be proper, though it is possible to use an improper prior distribution and have it result in a proper posterior distribution. To check the propriety of a univariate prior probability distribution, create a function \code{f}. For example, to check the propriety of a vague normal distribution, such as \deqn{\theta \sim \mathcal{N}(0,1000)}{theta ~ N(0,1000)} the function is \code{function(x){dnormv(x,0,1000)}}. Next, set the lower and upper limits of integration, \code{a} and \code{b}. Internally, this function calls \code{integrate} from base R, which uses adaptive quadrature. By using \eqn{f(x)} as shorthand for the specified function, \code{is.proper} will check to see if the area of the following integral is one: \deqn{\int^b_a f(x)dx}{integral from a to b of f(x)dx} Multivariate prior probability distributions currently cannot be checked for approximate propriety. This is currently unavailable in this package. To check the propriety of the joint posterior distribution, the only argument to be supplied is an object of class \code{demonoid}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}. The \code{is.proper} function checks the logarithm of the marginal likelihood (see \code{\link{LML}}) for a finite value, and returns \code{TRUE} when the LML is finite. This indicates that the marginal likelihood is finite for all observed \eqn{\textbf{y}}{y} in the model data set. This implies: \deqn{\int p(\theta|\textbf{y})p(\theta)d\theta < \infty}{integral of p(theta|y)p(theta)dtheta < Inf} If the object is of class \code{demonoid} and the algorithm was adaptive, or if the object is of class \code{iterquad}, \code{laplace}, or \code{vb} and the algorithm did not converge, then \code{is.proper} will return \code{FALSE} because LML was not estimated. In this case, it is possible for the joint posterior to be proper, but \code{is.proper} will be unable to determine propriety without the estimate of LML. If desired, the \code{\link{LML}} may be estimated by the user, and if it is finite, then the joint posterior distribution is proper. } \value{ The \code{is.proper} function returns a logical value indicating whether or not the univariate prior or joint posterior probability distribution integrates to one within its specified limits. \code{TRUE} is returned for a proper univariate probability distribution. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dnormv}}, \code{\link{integrate}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LML}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) ### Prior Probability Distribution is.proper(function(x) {dnormv(x,0,1000)}, -Inf, Inf) #x ~ N(0,1000) is.proper(function(x) {dhalfcauchy(x,25)}, 0, Inf) #x ~ HC(25) is.proper(function(x) {dunif(x,0,1)}, 0, 1) #x ~ U(0,1) is.proper(function(x) {dunif(x,-Inf,Inf)}, -Inf, Inf) #x ~ U(-Inf,Inf) ### Joint Posterior Distribution ##This assumes that Fit is an object of class demonoid, iterquad, ## laplace, or pmc #is.proper(Fit) } \keyword{Diagnostic} \keyword{Distribution} \keyword{Utility}LaplacesDemon/man/is.class.Rd0000755000176200001440000001520315144316355015555 0ustar liggesusers\name{is.class} \alias{is.bayesfactor} \alias{is.blocks} \alias{is.bmk} \alias{is.demonoid} \alias{is.demonoid.hpc} \alias{is.demonoid.ppc} \alias{is.demonoid.val} \alias{is.hangartner} \alias{is.heidelberger} \alias{is.importance} \alias{is.iterquad} \alias{is.iterquad.ppc} \alias{is.juxtapose} \alias{is.laplace} \alias{is.laplace.ppc} \alias{is.miss} \alias{is.pmc} \alias{is.pmc.ppc} \alias{is.pmc.val} \alias{is.posteriorchecks} \alias{is.raftery} \alias{is.rejection} \alias{is.sensitivity} \alias{is.vb} \alias{is.vb.ppc} \title{Logical Check of Classes} \description{ These functions each provide a logical test of the class of an object. } \usage{ is.bayesfactor(x) is.blocks(x) is.bmk(x) is.demonoid(x) is.demonoid.hpc(x) is.demonoid.ppc(x) is.demonoid.val(x) is.hangartner(x) is.heidelberger(x) is.importance(x) is.iterquad(x) is.iterquad.ppc(x) is.juxtapose(x) is.laplace(x) is.laplace.ppc(x) is.miss(x) is.pmc(x) is.pmc.ppc(x) is.pmc.val(x) is.posteriorchecks(x) is.raftery(x) is.rejection(x) is.sensitivity(x) is.vb(x) is.vb.ppc(x) } \arguments{ \item{x}{This is an object that will be subjected to a logical test of its class.} } \details{ Functions in Laplace's Demon often assigns a class to an output object. For example, after updating a model with the \code{\link{LaplacesDemon}} or \code{\link{LaplacesDemon.hpc}} function, an output object is created. The output object is of class \code{demonoid} or \code{demonoid.hpc}, respectively. Likewise, after passing a model to the \code{\link{LaplaceApproximation}} function, an output object is created, and it is of class \code{laplace}. The class of these and other objects may be logically tested. By assigning a class to an output object, the package is able to discern which other functions are appropriate for it. For example, after updating a model with \code{\link{LaplacesDemon}}, which creates an object of class \code{demonoid}, the user may desire to plot its output. Since it is assigned a class, the user may use the generic \code{plot} function, which internally selects the \code{\link{plot.demonoid}} function, which differs from \code{\link{plot.laplace}} for objects of class \code{laplace}. For more information on object classes, see the \code{\link{class}} function. } \value{ The \code{is.bayesfactor} function returns a logical value indicating whether or not the supplied object is of class \code{bayesfactor}. The \code{is.blocks} function returns a logical value indicating whether or not the supplied object is of class \code{blocks}. The \code{is.bmk} function returns a logical value indicating whether or not the supplied object is of class \code{bmk}. The \code{is.demonoid} function returns a logical value indicating whether or not the supplied object is of class \code{demonoid}. The \code{is.demonoid.hpc} function returns a logical value indicating whether or not the supplied object is of class \code{demonoid.hpc}. The \code{is.demonoid.ppc} function returns a logical value indicating whether or not the supplied object is of class \code{demonoid.ppc}. The \code{is.demonoid.val} function returns a logical value indicating whether or not the supplied object is of class \code{demonoid.val}. The \code{is.hangartner} function returns a logical value indicating whether or not the supplied object is of class \code{hangartner}. The \code{is.heidelberger} function returns a logical value indicating whether or not the supplied object is of class \code{heidelberger}. The \code{is.importance} function returns a logical value indicating whether or not the supplied object is of class \code{importance}. The \code{is.iterquad} function returns a logical value indicating whether or not the supplied object is of class \code{iterquad}. The \code{is.iterquad.ppc} function returns a logical value indicating whether or not the supplied object is of class \code{iterquad.ppc}. The \code{is.juxtapose} function returns a logical value indicating whether or not the supplied object is of class \code{juxtapose}. The \code{is.laplace} function returns a logical value indicating whether or not the supplied object is of class \code{laplace}. The \code{is.laplace.ppc} function returns a logical value indicating whether or not the supplied object is of class \code{laplace.ppc}. The \code{is.miss} function returns a logical value indicating whether or not the supplied object is of class \code{miss}. The \code{is.pmc} function returns a logical value indicating whether or not the supplied object is of class \code{pmc}. The \code{is.pmc.ppc} function returns a logical value indicating whether or not the supplied object is of class \code{pmc.ppc}. The \code{is.pmc.val} function returns a logical value indicating whether or not the supplied object is of class \code{pmc.val}. The \code{is.posteriorchecks} function returns a logical value indicating whether or not the supplied object is of class \code{posteriorchecks}. The \code{is.raftery} function returns a logical value indicating whether or not the supplied object is of class \code{raftery}. The \code{is.rejection} function returns a logical value indicating whether or not the supplied object is of class \code{rejection}. The \code{is.sensitivity} function returns a logical value indicating whether or not the supplied object is of class \code{sensitivity}. The \code{is.vb} function returns a logical value indicating whether or not the supplied object is of class \code{vb}. The \code{is.vb.ppc} function returns a logical value indicating whether or not the supplied object is of class \code{vb.ppc}. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{BayesFactor}}, \code{\link{Blocks}}, \code{\link{BMK.Diagnostic}}, \code{\link{class}}, \code{\link{Hangartner.Diagnostic}}, \code{\link{Heidelberger.Diagnostic}}, \code{\link{Importance}}, \code{\link{IterativeQuadrature}}, \code{\link{Juxtapose}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{MISS}}, \code{\link{PMC}}, \code{\link{PosteriorChecks}}, \code{\link{predict.demonoid}}, \code{\link{predict.laplace}}, \code{\link{predict.pmc}}, \code{\link{predict.vb}}, \code{\link{Raftery.Diagnostic}}, \code{\link{RejectionSampling}}, \code{\link{SensitivityAnalysis}}, \code{\link{Validate}}, and \code{\link{VariationalBayes}}. } \keyword{Utility}LaplacesDemon/man/dist.Multivariate.Power.Exponential.Cholesky.Rd0000755000176200001440000001236515144316355024614 0ustar liggesusers\name{dist.Multivariate.Power.Exponential.Cholesky} \alias{dmvpec} \alias{rmvpec} \title{Multivariate Power Exponential Distribution: Cholesky Parameterization} \description{ These functions provide the density and random number generation for the multivariate power exponential distribution, given the Cholesky parameterization. } \usage{ dmvpec(x=c(0,0), mu=c(0,0), U, kappa=1, log=FALSE) rmvpec(n, mu=c(0,0), U, kappa=1) } \arguments{ \item{x}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{n}{This is the number of random draws.} \item{mu}{This is mean vector \eqn{\mu}{mu} with length \eqn{k} or matrix with \eqn{k} columns.} \item{U}{This is the \eqn{k \times k}{k x k} upper-triangular matrix that is Cholesky factor \eqn{\textbf{U}}{U} of covariance matrix \eqn{\Sigma}{Sigma}.} \item{kappa}{This is the kurtosis parameter, \eqn{\kappa}{kappa}, and must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{k\Gamma(k/2)}{\pi^{k/2} \sqrt{|\Sigma|} \Gamma(1 + k/(2\kappa)) 2^{1 + k/(2\kappa)}} \exp(-\frac{1}{2}(\theta-\mu)^T \Sigma (\theta-\mu))^{\kappa}}{p(theta) = ((k*Gamma(k/2)) / (pi^(k/2) * sqrt(|Sigma|) * Gamma(1 + k/(2*kappa)) * 2^(1 + k/(2*kappa)))) * exp(-(1/2)*(theta-mu)^T Sigma (theta-mu))^kappa} \item Inventor: Gomez, Gomez-Villegas, and Marin (1998) \item Notation 1: \eqn{\theta \sim \mathcal{MPE}(\mu, \Sigma, \kappa)}{theta ~ MPE(mu, Sigma, kappa)} \item Notation 2: \eqn{\theta \sim \mathcal{PE}_k(\mu, \Sigma, \kappa)}{theta ~ PE[k](mu, Sigma, kappa)} \item Notation 3: \eqn{p(\theta) = \mathcal{MPE}(\theta | \mu, \Sigma, \kappa)}{p(theta) = MPE(theta | mu, Sigma, kappa)} \item Notation 4: \eqn{p(\theta) = \mathcal{PE}_k(\theta | \mu, \Sigma, \kappa)}{p(theta) = PE[k](theta | mu, Sigma, kappa)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma} \item Parameter 3: kurtosis parameter \eqn{\kappa}{kappa} \item Mean: \eqn{E(\theta) = }{E(theta) = } \item Variance: \eqn{var(\theta) =}{var(theta) = } \item Mode: \eqn{mode(\theta) = }{mode(theta) = } } The multivariate power exponential distribution, or multivariate exponential power distribution, is a multidimensional extension of the one-dimensional or univariate power exponential distribution. Gomez-Villegas (1998) and Sanchez-Manzano et al. (2002) proposed multivariate and matrix generalizations of the PE family of distributions and studied their properties in relation to multivariate Elliptically Contoured (EC) distributions. The multivariate power exponential distribution includes the multivariate normal distribution (\eqn{\kappa = 1}{kappa = 1}) and multivariate Laplace distribution (\eqn{\kappa = 0.5}{kappa = 0.5}) as special cases, depending on the kurtosis or \eqn{\kappa}{kappa} parameter. A multivariate uniform occurs as \eqn{\kappa \rightarrow \infty}{kappa -> infinity}. If the goal is to use a multivariate Laplace distribution, the \code{dmvlc} function will perform faster and more accurately. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, the Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dmvpe}, \code{dmvpec} must additionally matrix-multiply the Cholesky back to the covariance matrix, but it does not have to check for or correct the covariance matrix to positive-definiteness, which overall is slower. Compared with \code{rmvpe}, \code{rmvpec} is faster because the Cholesky decomposition has already been performed. The \code{rmvpec} function is a modified form of the rmvpowerexp function in the MNM package. } \value{ \code{dmvpec} gives the density and \code{rmvpec} generates random deviates. } \references{ Gomez, E., Gomez-Villegas, M.A., and Marin, J.M. (1998). "A Multivariate Generalization of the Power Exponential Family of Distributions". \emph{Communications in Statistics-Theory and Methods}, 27(3), p. 589--600. Sanchez-Manzano, E.G., Gomez-Villegas, M.A., and Marn-Diazaraque, J.M. (2002). "A Matrix Variate Generalization of the Power Exponential Family of Distributions". \emph{Communications in Statistics, Part A - Theory and Methods} [Split from: J(CommStat)], 31(12), p. 2167--2182. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{chol}}, \code{\link{dlaplace}}, \code{\link{dmvlc}}, \code{\link{dmvnc}}, \code{\link{dmvnpc}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, and \code{\link{dpe}}. } \examples{ library(LaplacesDemon) n <- 100 k <- 3 x <- matrix(runif(n*k),n,k) mu <- matrix(runif(n*k),n,k) Sigma <- diag(k) U <- chol(Sigma) dmvpec(x, mu, U, kappa=1) X <- rmvpec(n, mu, U, kappa=1) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/is.appeased.Rd0000755000176200001440000000320515144316355016231 0ustar liggesusers\name{is.appeased} \alias{is.appeased} \title{Appeased} \description{ This function returns \code{TRUE} if Laplace's Demon is appeased by the object of class \code{demonoid}, and \code{FALSE} otherwise. If appeased, then the object passes several tests that indicate potential convergence of the Markov chains. } \usage{ is.appeased(x) } \arguments{ \item{x}{This is an object of class \code{demonoid}.} } \details{ After updating a model with the \code{\link{LaplacesDemon}} function, an output object is created. The output object is of class \code{demonoid}. The object may be passed to the \code{\link{Consort}} function, which will apply several criteria regarding the potential convergence of its Markov chains. If all criteria are met, then Laplace's Demon is appeased. Otherwise, Laplace's Demon suggests R code to be copy/pasted and executed. The \code{\link{Consort}} function prints a large amount of information to the screen. The \code{is.appeased} function may be applied as an alternative, though it only informs the user as to whether or not Laplace's Demon was appeased, as \code{TRUE} or \code{FALSE}. } \value{ The \code{is.appeased} function returns a logical value indicating whether or not the supplied object passes several potential Markov chain convergence criteria. If the object passes all criteria, then Laplace's Demon is appeased, and the logical value returned is \code{TRUE}. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{Consort}} and \code{\link{LaplacesDemon}}. } \keyword{Diagnostic} \keyword{Utility}LaplacesDemon/man/is.data.Rd0000755000176200001440000000333715144316355015366 0ustar liggesusers\name{is.data} \alias{is.data} \title{Logical Check of Data} \description{ This function provides a logical test of whether or not a given list of data meets minimum criteria to be considered data for \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}}. } \usage{ is.data(Data) } \arguments{ \item{Data}{This is a list of data. For more information, see the \code{\link{LaplacesDemon}} function.} } \details{ This function is useful for testing whether or not a list of data meets minimum criteria to be considered data in this package. The minimum requirements are that \code{Data} is a list, and it contains \code{mon.names} and \code{parm.names}. This function is not extensive. For example, it does not match the length of \code{parm.names} with the length of \code{Initial.Values}, or compare the length of \code{mon.names} to the number of monitored variables output from the \code{Model} specification function. Additional checks are conducted in \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \value{ The \code{is.data} function returns a logical value. It returns \code{TRUE} if \code{Data} meets minimum requirements to be considered data in this package, and \code{FALSE} otherwise. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{IterativeQuadrature}} \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \keyword{Utility}LaplacesDemon/man/summary.demonoid.ppc.Rd0000755000176200001440000003777615144316355020134 0ustar liggesusers\name{summary.demonoid.ppc} \alias{summary.demonoid.ppc} \title{Posterior Predictive Check Summary} \description{ This may be used to summarize either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}). Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is summarized, depending on \code{\link{predict.demonoid}}. } \usage{\method{summary}{demonoid.ppc}(object, Categorical, Rows, Discrep, d, Quiet, \dots)} \arguments{ \item{object}{An object of class \code{demonoid.ppc} is required.} \item{Categorical}{Logical. If \code{TRUE}, then \code{y} and \code{yhat} are considered to be categorical (such as y=0 or y=1), rather than continuous.} \item{Rows}{An optional vector of row numbers, for example \code{c(1:10)}. All rows will be estimated, but only these rows will appear in the summary.} \item{Discrep}{A character string indicating a discrepancy test. \code{Discrep} defaults to \code{NULL}. Valid character strings when \code{y} is continuous are: \code{"Chi-Square"}, \code{"Chi-Square2 "}, \code{"Kurtosis"}, \code{"L-criterion"}, \code{"MASE"}, \code{"MSE"}, \code{"PPL"}, \code{"Quadratic Loss"}, \code{"Quadratic Utility"}, \code{"RMSE"}, \code{"Skewness"}, \code{"max(yhat[i,]) > max(y)"}, \code{"mean(yhat[i,]) > mean(y)"}, \code{"mean(yhat[i,] > d)"}, \code{"mean(yhat[i,] > mean(y))"}, \code{"min(yhat[i,]) < min(y)"}, \code{"round(yhat[i,]) = d"}, and \code{"sd(yhat[i,]) > sd(y)"}. Valid character strings when \code{y} is categorical are: \code{"p(yhat[i,] != y[i])"}. Kurtosis and skewness are not discrepancies, but are included here for convenience.} \item{d}{This is an optional integer to be used with the \code{Discrep} argument above, and it defaults to \code{d=0}.} \item{Quiet}{This logical argument defaults to \code{FALSE} and will print results to the console. When \code{TRUE}, results are not printed.} \item{\dots}{Additional arguments are unused.} } \details{ This function summarizes an object of class \code{demonoid.ppc}, which consists of posterior predictive checks on either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]}, depending respectively on whether unobserved instances of \eqn{\textbf{y}}{y} or the model sample of \eqn{\textbf{y}}{y} was used in the \code{\link{predict.demonoid}} function. The purpose of a posterior predictive check is to assess how well (or poorly) the model fits the data, or to assess discrepancies between the model and the data. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. When \eqn{\textbf{y}}{y} is continuous and known, this function estimates the predictive concordance between \eqn{\textbf{y}}{y} and \eqn{\textbf{y}^{rep}}{y[rep]} as per Gelfand (1996), and the predictive quantile (PQ), which is for record-level outlier detection used to calculate Gelfand's predictive concordance. When \eqn{\textbf{y}}{y} is categorical and known, this function estimates the record-level lift, which is \code{p(yhat[i,] = y[i]) / [p(y = j) / n]}, or the number of correctly predicted samples over the rate of that category of \eqn{\textbf{y}}{y} in vector \eqn{\textbf{y}}{y}. A discrepancy measure is an approach to studying discrepancies between the model and data (Gelman et al., 1996). Below is a list of discrepancy measures, followed by a brief introduction to discrepancy analysis: \itemize{ \item The \code{"Chi-Square"} discrepancy measure is the chi-square goodness-of-fit test that is recommended by Gelman. For each record i=1:N, this returns (y[i] - E(y[i]))^2 / var(yhat[i,]). \item The \code{"Chi-Square2"} discrepancy measure returns the following for each record: Pr(chisq.rep[i,] > chisq.obs[i,]), where chisq.obs[i,] <- (y[i] - E(y[i]))^2 / E(y[i]), and chisq.rep[i,] <- (yhat[i,] - E(yhat[i,]))^2 / E(yhat[i,]), and the overall discrepancy is the percent of records that were outside of the 95\% quantile-based probability interval (see \code{\link{p.interval}}). \item The \code{"Kurtosis"} discrepancy measure returns the kurtosis of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding kurtotic replicate distributions. \item The \code{"L-criterion"} discrepancy measure of Laud and Ibrahim (1995) provides the record-level combination of two components (see below), and the discrepancy statistic is the sum, \code{L}, as well as a calibration number, \code{S.L}. For more information on the L-criterion, see the accompanying vignette entitled "Bayesian Inference". \item The \code{"MASE"} (Mean Absolute Scaled Error) is a discrepancy measure for the accuracy of time-series forecasts, estimated as \code{(|y - yhat|) / mean(abs(diff(y)))}. The discrepancy statistic is the mean of the record-level values. \item The \code{"MSE"} (Mean Squared Error) discrepancy measure provides the MSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level MSEs. MSE and quadratic loss are identical. \item The \code{"PPL"} (Posterior Predictive Loss) discrepancy measure of Gelfand and Ghosh (1998) provides the record-level combination of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The \code{d=0} argument applies the following weight to the accuracy component, which is then added to the variance component: \eqn{d/(d+1)}. For \eqn{\textbf{y}^{new}}{y[new]}, use \eqn{d=0}. For \eqn{\textbf{y}^{rep}}{y[rep]} and model comparison, \eqn{d} is commonly set to 1, 10, or 100000. Larger values of \eqn{d} put more stress on fit and downgrade the precision of the estimates. \item The \code{"Quadratic Loss"} discrepancy measure provides the mean quadratic loss for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic losses. Quadratic loss and MSE are identical, and quadratic loss is the negative of quadratic utility. \item The \code{"Quadratic Utility"} discrepancy measure provides the mean quadratic utility for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic utilities. Quadratic utility is the negative of quadratic loss. \item The \code{"RMSE"} (Root Mean Squared Error) discrepancy measure provides the RMSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level RMSEs. \item The \code{"Skewness"} discrepancy measure returns the skewness of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding skewed replicate distributions. \item The \code{"max(yhat[i,]) > max(y)"} discrepancy measure returns a record-level indicator when a record's maximum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} exceeds the maximum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications that exceed the maximum of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,]) > mean(y)"} discrepancy measure returns a record-level indicator when the mean of a record's \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is greater than the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with mean replications that exceed the mean of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,] > d)"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds a specified value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"mean(yhat[i,] > mean(y))"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"min(yhat[i,]) < min(y)"} discrepancy measure returns a record-level indicator when a record's minimum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is less than the minimum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications less than the minimum of \eqn{\textbf{y}}{y}. \item The \code{"round(yhat[i,]) = d"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that, when rounded, is equal to a specified discrete value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"sd(yhat[i,]) > sd(y)"} discrepancy measure returns a record-level indicator when the standard deviation of replicates is larger than the standard deviation of all of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with larger standard deviations than \eqn{\textbf{y}}{y}. \item The \code{"p(yhat[i,] != y[i])"} discrepancy measure returns the record-level probability that \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is not equal to \eqn{\textbf{y}}{y}. This is valid when \eqn{\textbf{y}}{y} is categorical and \code{yhat} is the predicted category. The probability is the proportion of replicates. } After observing a discrepancy statistic, the user attempts to improve the model by revising the model to account for discrepancies between data and the current model. This approach to model revision relies on an analysis of the discrepancy statistic. Given a discrepancy measure that is based on model fit, such as the L-criterion, the user may correlate the record-level discrepancy statistics with the dependent variable, independent variables, and interactions of independent variables. The discrepancy statistic should not correlate with the dependent and independent variables. Interaction variables may be useful for exploring new relationships that are not in the current model. Alternatively, a decision tree may be applied to the record-level discrepancy statistics, given the independent variables, in an effort to find relationships in the data that may be helpful in the model. Model revision may involve the addition of a finite mixture component to account for outliers in discrepancy, or specifying the model with a distribution that is more robust to outliers. There are too many suggestions to include here, and discrepancy analysis varies by model. } \value{ This function returns a list with the following components: \item{BPIC}{The Bayesian Predictive Information Criterion (BPIC) was introduced by Ando (2007). BPIC is a variation of the Deviance Information Criterion (DIC) that has been modified for predictive distributions. For more information on DIC (Spiegelhalter et al., 2002), see the accompanying vignette entitled "Bayesian Inference". \eqn{BPIC = Dbar + 2pD}. The goal is to minimize BPIC.} \item{Concordance}{This is the percentage of the records of y that are within the 95\% quantile-based probability interval (see \code{\link{p.interval}}) of \eqn{\textbf{y}^{rep}}{y[rep]}. Gelfand's suggested goal is to achieve 95\% predictive concordance. Lower percentages indicate too many outliers and a poor fit of the model to the data, and higher percentages may suggest overfitting. Concordance occurs only when \eqn{\textbf{y}}{y} is continuous.} \item{Mean Lift}{This is the mean of the record-level lifts, and occurs only when \eqn{\textbf{y}}{y} is specified as categorical with \code{Categorical=TRUE}.} \item{Discrepancy.Statistic}{This is only reported if the \code{Discrep} argument receives a valid discrepancy measure as listed above. The \code{Discrep} applies to each record of \eqn{\textbf{y}}{y}, and the \code{Discrepancy.Statistic} reports the results of the discrepancy measure on the entire data set. For example, if \code{Discrep="min(yhat[i,]) < min(y)"}, then the overall result is the proportion of records in which the minimum sample of yhat was less than the overall minimum \eqn{\textbf{y}}{y}. This is \code{Pr(min(yhat[i,]) < min(y) | y, Theta)}, where \code{Theta} is the parameter set.} \item{L-criterion}{The L-criterion (Laud and Ibrahim, 1995) was developed for model and variable selection. It is a sum of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The L-criterion measures model performance with a combination of how close its predictions are to the observed data and variability of the predictions. Better models have smaller values of \code{L}. \code{L} is measured in the same units as the response variable, and measures how close the data vector \eqn{\textbf{y}}{y} is to the predictive distribution. In addition to the value of \code{L}, there is a value for \code{S.L}, which is the calibration number of \code{L}, and is useful in determining how much of a decrease is necessary between models to be noteworthy.} \item{Summary}{When \eqn{\textbf{y}}{y} is continuous, this is a \eqn{N \times 8}{N x 8} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and there are 8 columns, as follows: y, Mean, SD, LB (the 2.5\% quantile), Median, UB (the 97.5\% quantile), PQ (the predictive quantile, which is \eqn{Pr(\textbf{y}^{rep} \ge \textbf{y})}{Pr(y[rep] >= y)}), and Test, which shows the record-level result of a test, if specified. When \eqn{\textbf{y}}{y} is categorical, this matrix has a number of columns equal to the number of categories of \eqn{\textbf{y}}{y} plus 3, also including \code{y}, \code{Lift}, and \code{Discrep}.} } \references{ Ando, T. (2007). "Bayesian Predictive Information Criterion for the Evaluation of Hierarchical Bayesian and Empirical Bayes Models". \emph{Biometrika}, 94(2), p. 443--458. Gelfand, A. (1996). "Model Determination Using Sampling Based Methods". In Gilks, W., Richardson, S., Spiegehalter, D., Chapter 9 in Markov Chain Monte Carlo in Practice. Chapman and Hall: Boca Raton, FL. Gelfand, A. and Ghosh, S. (1998). "Model Choice: A Minimum Posterior Predictive Loss Approach". \emph{Biometrika}, 85, p. 1--11. Gelman, A., Meng, X.L., and Stern H. (1996). "Posterior Predictive Assessment of Model Fitness via Realized Discrepancies". \emph{Statistica Sinica}, 6, p. 733--807. Laud, P.W. and Ibrahim, J.G. (1995). "Predictive Model Selection". \emph{Journal of the Royal Statistical Society}, B 57, p. 247--262. Spiegelhalter, D.J., Best, N.G., Carlin, B.P., and van der Linde, A. (2002). "Bayesian Measures of Model Complexity and Fit (with Discussion)". \emph{Journal of the Royal Statistical Society}, B 64, p. 583--639. } \author{Statisticat, LLC.} \seealso{ \code{\link{LaplacesDemon}}, \code{\link{predict.demonoid}}, and \code{\link{p.interval}}. } \examples{### See the LaplacesDemon function for an example.} \keyword{BPIC} \keyword{Chi-Square} \keyword{Kurtosis} \keyword{L-criterion} \keyword{MASE} \keyword{MSE} \keyword{Posterior Predictive Checks} \keyword{Posterior Predictive Loss} \keyword{Quadratic Loss} \keyword{Quadratic Utility} \keyword{RMSE} \keyword{Skewness} \keyword{summary} LaplacesDemon/man/Hangartner.Diagnostic.Rd0000755000176200001440000000435115144316355020214 0ustar liggesusers\name{Hangartner.Diagnostic} \alias{Hangartner.Diagnostic} \title{Hangartner's Convergence Diagnostic} \description{ Hangartner et al. (2011) proposed a convergence diagnostic for discrete Markov chains. A simple Pearson's Chi-squared test for two or more non-overlapping periods of a discrete Markov chain is a reliable diagnostic of convergence. It does not rely upon the estimation of spectral density, on suspect normality assumptions, or determining overdispersion within a small number of outcomes, all of which can be problematic with discrete measures. A discrete Markov chain is split into two or more non-overlapping windows. Two windows are recommended, and results may be sensitive to the number of selected windows, as well as sample size. As such, a user may try several window configurations before concluding there is no evidence of non-convergence. As the number of discrete events in the sample space increases, this diagnostic becomes less appropriate and standard diagnostics become more appropriate. } \usage{ Hangartner.Diagnostic(x, J=2) } \arguments{ \item{x}{This required argument is a vector of marginal posterior samples of a discrete Markov chain, such as selected from the output of \code{\link{LaplacesDemon}}.} \item{J}{This argument specifies the number \eqn{J} of windows to be used, and defaults to \eqn{J=2}.} } \value{ The \code{Hangartner.Diagnostic} returns an object of class \code{hangartner}, including the output from a Pearson's Chi-squared test. A frequentist p-value less than or equal to 0.05 is usually considered to be indicative of non-convergence. } \references{ Hangartner, D., Gill, J., and Cranmer, S., (2011). "An MCMC Diagnostic for Purely Discrete Parameters". Paper presented at the annual meeting of the Southern Political Science Association, Hotel InterContinental, New Orleans, Louisiana Online. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplacesDemon}} and \code{\link{TransitionMatrix}}. } \examples{ library(LaplacesDemon) N <- 1000 K <- 3 x <- rcat(N, rep(1/K,K)) hd <- Hangartner.Diagnostic(x, J=2) hd } \keyword{Diagnostic} \keyword{MCMC} LaplacesDemon/man/deburn.Rd0000755000176200001440000000273415144316355015322 0ustar liggesusers\name{deburn} \alias{deburn} \title{De-Burn} \description{ The \code{deburn} function discards or removes a user-specified number of burn-in iterations from an object of class \code{demonoid}. } \usage{ deburn(x, BurnIn=0) } \arguments{ \item{x}{This is an object of class \code{demonoid}.} \item{BurnIn}{This argument defaults to \code{BurnIn=0}, and accepts an integer that indicates the number of iterations to discard as burn-in.} } \details{ Documentation for the \code{\link{burnin}} function provides an introduction to the concept of burn-in as it relates to Markov chains. The \code{deburn} function discards a number of the first posterior samples, as specified by the \code{BurnIn} argument. Stationarity is not checked, because it is assumed the user has a reason for using the \code{deburn} function, rather than using the results from the object of class \code{demonoid}. Therefore, the posterior samples in \code{Posterior1} and \code{Posterior2} are identical, as are \code{Summary1} and \code{Summary2}. } \value{ The \code{deburn} function returns an object of class \code{demonoid}. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{burnin}} and \code{\link{LaplacesDemon}}. } \examples{ ### Assuming the user has Fit which is an object of class demonoid: #library(LaplacesDemon) #Fit2 <- deburn(Fit, BurnIn=100) } \keyword{Stationarity} \keyword{Utility} LaplacesDemon/man/SIR.Rd0000755000176200001440000001446515144316355014504 0ustar liggesusers\name{SIR} \alias{SIR} \title{Sampling Importance Resampling} \description{ The \code{SIR} function performs Sampling Importance Resampling, also called Sequential Importance Resampling, and uses a multivariate normal proposal density. } \usage{ SIR(Model, Data, mu, Sigma, n=1000, CPUs=1, Type="PSOCK") } \arguments{ \item{Model}{This is a model specification function. For more information, see \code{\link{LaplaceApproximation}}.} \item{Data}{This is a list of data. For more information, see \code{\link{LaplaceApproximation}}.} \item{mu}{This is a mean vector, \eqn{\mu}{mu}, for a multivariate normal distribution, and is usually the posterior means from an object of class \code{iterquad} (from \code{\link{IterativeQuadrature}}) or class \code{vb} (from \code{\link{VariationalBayes}}), or the posterior modes from an object of class \code{laplace} (from \code{\link{LaplaceApproximation}}).} \item{Sigma}{This is a covariance matrix, \eqn{\Sigma}{Sigma}, for a multivariate normal distribution, and is usually the \code{Covar} component of an object of class \code{iterquad}, \code{laplace}, or \code{vb}.} \item{n}{This is the number of samples to be drawn from the posterior distribution.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} } \details{ Sampling Importance Resampling (SIR) was introduced in Gordon, et al. (1993), and is the original particle filtering algorithm (and this family of algorithms is also known as Sequential Monte Carlo). A distribution is approximated with importance weights, which are approximations to the relative posterior densities of the particles, and the sum of the weights is one. In this terminology, each sample in the distribution is a ``particle''. SIR is a sequential or recursive form of importance sampling. As in importance sampling, the expectation of a function can be approximated as a weighted average. The optimal proposal distribution is the target distribution. In the \code{LaplacesDemon} package, the main use of the \code{SIR} function is to produce posterior samples for iterative quadrature, Laplace Approximation, or Variational Bayes, and \code{SIR} is called behind-the-scenes by the \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, or \code{\link{VariationalBayes}} function. Iterative quadrature estimates the posterior mean and the associated covariance matrix. Assuming normality, this output characterizes the marginal posterior distributions. However, it is often useful to have posterior samples, in which case the \code{SIR} function is used to draw samples. The number of samples, \code{n}, should increase with the number and intercorrelations of the parameters. Otherwise, multimodal posterior distributions may occur. Laplace Approximation estimates the posterior mode and the associated covariance matrix. Assuming normality, this output characterizes the marginal posterior distributions. However, it is often useful to have posterior samples, in which case the \code{SIR} function is used to draw samples. The number of samples, \code{n}, should increase with the number and intercorrelations of the parameters. Otherwise, multimodal posterior distributions may occur. Variational Bayes estimates both the posterior mean and variance. Assuming normality, this output characterizes the marginal posterior distributions. However, it is often useful to have posterior samples, in which case the \code{SIR} function is used to draw samples. The number of samples, \code{n}, should increase with the number of intercorrelations of the parameters. Otherwise, multimodal posterior distributions may occur. SIR is also commonly used when considering a mild change in a prior distribution. For example, suppose a model was updated in \code{\link{LaplacesDemon}}, and it had a least-informative prior distribution, but the statistician would like to estimate the impact of changing to a weakly-informative prior distribution. The change is made in the model specification function, and the posterior means and covariance are supplied to the \code{SIR} function. The returned samples are estimates of the posterior, given the different prior distribution. This is akin to sensitivity analysis (see the \code{SensitivityAnalysis} function). In other contexts (for which this function is not designed), SIR is used with dynamic linear models (DLMs) and state-space models (SSMs) for state filtering. Parallel processing may be performed when the user specifies \code{CPUs} to be greater than one, implying that the specified number of CPUs exists and is available. Parallelization may be performed on a multicore computer or a computer cluster. Either a Simple Network of Workstations (SNOW) or Message Passing Interface (MPI) is used. With small data sets and few samples, parallel processing may be slower, due to computer network communication. With larger data sets and more samples, the user should experience a faster run-time. This function was adapted from the \code{sir} function in the \code{LearnBayes} package. } \value{ The \code{SIR} function returns a matrix of samples drawn from the posterior distribution. } \references{ Gordon, N.J., Salmond, D.J., and Smith, A.F.M. (1993). "Novel Approach to Nonlinear/Non-Gaussian Bayesian State Estimation". \emph{IEEE Proceedings F on Radar and Signal Processing}, 140(2), p. 107--113. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dmvn}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{SensitivityAnalysis}}, and \code{\link{VariationalBayes}}. } \keyword{High Performance Computing} \keyword{Sampling Importance Resampling} \keyword{Sequential Importance Resampling} \keyword{Utility} LaplacesDemon/man/dist.Inverse.Wishart.Rd0000755000176200001440000001030215144316355020026 0ustar liggesusers\name{dist.Inverse.Wishart} \alias{dinvwishart} \alias{rinvwishart} \title{Inverse Wishart Distribution} \description{ These functions provide the density and random number generation for the inverse Wishart distribution. } \usage{ dinvwishart(Sigma, nu, S, log=FALSE) rinvwishart(nu, S) } \arguments{ \item{Sigma}{This is the symmetric, positive-definite \eqn{k \times k}{k x k} matrix \eqn{\Sigma}{Sigma}.} \item{nu}{This is the scalar degrees of freedom, \eqn{\nu}{nu}.} \item{S}{This is the symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = (2^{\nu k/2} \pi^{k(k-1)/4} \prod^k_{i=1} \Gamma(\frac{\nu+1-i}{2}))^{-1} |\textbf{S}|^{\nu/2} |\Sigma|^{-(\nu+k+1)/2} \exp(-\frac{1}{2} tr(\textbf{S} \Sigma^{-1}))}{p(theta) = (2^(nu*k/2) * pi^(k(k-1)/4) * [Gamma((nu+1-i)/2) * ... * Gamma((nu+1-k)/2)])^(-1) * |S|^(nu/2) * |Sigma|^(-(nu+k+1)/2) * exp(-(1/2) * tr(S Sigma^(-1)))} \item Inventor: John Wishart (1928) \item Notation 1: \eqn{\Sigma \sim \mathcal{W}^{-1}_{\nu}(\textbf{S}^{-1})}{Sigma ~ W^(-1)[nu](S^(-1))} \item Notation 2: \eqn{p(\Sigma) = \mathcal{W}^{-1}_{\nu}(\Sigma | \textbf{S}^{-1})}{p(Sigma) = W^-1[nu](Sigma | S^(-1))} \item Parameter 1: degrees of freedom \eqn{\nu}{nu} \item Parameter 2: symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S} \item Mean: \eqn{E(\Sigma) = \frac{\textbf{S}}{\nu - k - 1}}{E(Sigma) = S / (nu - k - 1)} \item Variance: \item Mode: \eqn{mode(\Sigma) = \frac{\textbf{S}}{\nu + k + 1}}{mode(Sigma) = S / (nu + k + 1)} } The inverse Wishart distribution is a probability distribution defined on real-valued, symmetric, positive-definite matrices, and is used as the conjugate prior for the covariance matrix, \eqn{\Sigma}{Sigma}, of a multivariate normal distribution. The inverse-Wishart density is always finite, and the integral is always finite. A degenerate form occurs when \eqn{\nu < k}{nu < k}. When applicable, the alternative Cholesky parameterization should be preferred. For more information, see \code{\link{dinvwishartc}}. The inverse Wishart prior lacks flexibility, having only one parameter, \eqn{\nu}{nu}, to control the variability for all \eqn{k(k + 1)/2} elements. Popular choices for the scale matrix \eqn{\textbf{S}}{S} include an identity matrix or sample covariance matrix. When the model sample size is small, the specification of the scale matrix can be influential. The inverse Wishart distribution has a dependency between variance and correlation, although its relative for a precision matrix (inverse covariance matrix), the Wishart distribution, does not have this dependency. This relationship becomes weaker with more degrees of freedom. Due to these limitations (lack of flexibility, and dependence between variance and correlation), alternative distributions have been developed. Alternative distributions that are available here include Huang-Wand (\code{\link{dhuangwand}}), inverse matrix gamma (\code{\link{dinvmatrixgamma}}), Scaled Inverse Wishart (\code{\link{dsiw}}), and Yang-Berger (\code{\link{dyangberger}}). These functions are parameterized as per Gelman et al. (2004). } \value{ \code{dinvwishart} gives the density and \code{rinvwishart} generates random deviates. } \references{ Gelman, A., Carlin, J., Stern, H., and Rubin, D. (2004). "Bayesian Data Analysis, Texts in Statistical Science, 2nd ed.". Chapman and Hall, London. Wishart, J. (1928). "The Generalised Product Moment Distribution in Samples from a Normal Multivariate Population". \emph{Biometrika}, 20A(1-2), p. 32--52. } \seealso{ \code{\link{dhuangwand}}, \code{\link{dinvmatrixgamma}}, \code{\link{dinvwishartc}}, \code{\link{dmvn}}, \code{\link{dsiw}}, \code{\link{dwishart}}, and \code{\link{dyangberger}}. } \examples{ library(LaplacesDemon) x <- dinvwishart(matrix(c(2,-.3,-.3,4),2,2), 3, matrix(c(1,.1,.1,1),2,2)) x <- rinvwishart(3, matrix(c(1,.1,.1,1),2,2)) } \keyword{Distribution} LaplacesDemon/man/RejectionSampling.Rd0000755000176200001440000001443015144316355017454 0ustar liggesusers\name{RejectionSampling} \alias{RejectionSampling} \title{Rejection Sampling} \description{ The \code{RejectionSampling} function implements rejection sampling of a target density given a proposal density. } \usage{ RejectionSampling(Model, Data, mu, S, df=Inf, logc, n=1000, CPUs=1, Type="PSOCK") } \arguments{ \item{Model}{This is a model specification function. For more information, see \code{\link{LaplaceApproximation}}.} \item{Data}{This is a list of data. For more information, see \code{\link{LaplaceApproximation}}.} \item{mu}{This is a mean vector \eqn{\mu}{mu} for the multivariate normal or multivariate t proposal density.} \item{S}{This is a convariance matrix \eqn{\Sigma}{Sigma} for the multivariate normal or multivariate t proposal density.} \item{df}{This is a scalar degrees of freedom parameter \eqn{\nu}{nu}. It defaults to infinity, in which case the multivariate normal density is used.} \item{logc}{This is the logarithm of the rejection sampling constant.} \item{n}{This is the number of independent draws to be simulated from the proposal density.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} } \details{ Rejection sampling (von Neumann, 1951) is a Monte Carlo method for drawing independent samples from a distribution that is proportional to the target distribution, \eqn{f(x)}, given a sampling distribution, \eqn{g(x)}, from which samples can readily be drawn, and for which there is a finite constant \eqn{c}. Here, the target distribution, \eqn{f(x)}, is the result of the \code{Model} function. The sampling distribution, \eqn{g(x)}, is either a multivariate normal or multivariate t-distribution. The parameters of \eqn{g(x)} (\code{mu}, \code{S}, and \code{df}) are used to create random draws, \eqn{\theta}{theta}, of the sampling distribution, \eqn{g(x)}. These draws, \eqn{\theta}{theta}, are used to evaluate the target distribution, \eqn{f(x)}, via the \code{Model} specification function. The evaluations of the target distribution, sampling distribution, and the constant are used to create a probability of acceptance for each draw, by comparing to a vector of \eqn{n} uniform draws, \eqn{u}. Each draw, \eqn{\theta}{theta} is accepted if \deqn{u \le \frac{f(\theta|\textbf{y})}{cg(\theta)}}{u <= f(theta|y)/[cg(theta)]} Before beginning rejection sampling, a goal of the user is to find the bounding constant, \eqn{c}, such that \eqn{f(\theta|\textbf{y}) \le cg(\theta)}{f(theta|y) <= cg(theta)} for all \eqn{\theta}{theta}. These are all expressed in logarithms, so the goal is to find \eqn{\log f(\theta|\textbf{y}) - \log g(\theta) \le \log(c)}{log[f(theta|y)] - log[g(theta)] <= log(c)} for all \eqn{\theta}{theta}. This is done by maximizing \eqn{\log f(\theta|\textbf{y}) - \log g(\theta)}{log[f(theta|y)] - log[g(theta)]} over all \eqn{\theta}{theta}. By using, say, \code{\link{LaplaceApproximation}} to find the modes of the parameters of interest, and using the resultant \code{LP}, the mode of the logarithm of the joint posterior distribution, as \eqn{\log(c)}{log(c)}. The \code{RejectionSampling} function performs one iteration of rejection sampling. Rejection sampling is often iterated, then called the rejection sampling algorithm, until a sufficient number or proportion of \eqn{\theta}{theta} is accepted. An efficient rejection sampling algorithm has a high acceptance rate. However, rejection sampling becomes less efficient as the model dimension (the number of parameters) increases. Extensions of rejection sampling include Adaptive Rejection Sampling (ARS) (either derivative-based or derivative-free) and Adaptive Rejection Metropolis Sampling (ARMS), as in Gilks et al. (1995). The random-walk Metropolis algorithm (Metropolis et al., 1953) combined the rejection sampling (a method of Monte Carlo simulation) of von Neumann (1951) with Markov chains. Parallel processing may be performed when the user specifies \code{CPUs} to be greater than one, implying that the specified number of CPUs exists and is available. Parallelization may be performed on a multicore computer or a computer cluster. Either a Simple Network of Workstations (SNOW) or Message Passing Interface (MPI) is used. With small data sets and few samples, parallel processing may be slower, due to computer network communication. With larger data sets and more samples, the user should experience a faster run-time. This function is similar to the \code{rejectsampling} function in the \code{LearnBayes} package. } \value{ The \code{RejectionSampling} function returns an object of class \code{rejection}, which is a matrix of accepted, independent, simulated draws from the target distribution. } \references{ Gilks, W.R., Best, N.G., Tan, K.K.C. (1995). "Adaptive Rejection Metropolis Sampling within Gibbs Sampling". Journal of the Royal Statistical Society. Series C (Applied Statistics), Vol. 44, No. 4, p. 455--472. Metropolis, N., Rosenbluth, A.W., Rosenbluth, M.N., and Teller, E. (1953). "Equation of State Calculations by Fast Computing Machines". Journal of Chemical Physics, 21, p. 1087-1092. von Neumann, J. (1951). "Various Techniques Used in Connection with Random Digits. Monte Carlo Methods". National Bureau Standards, 12, p. 36--38. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dmvn}}, \code{\link{dmvt}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) ### Suppose an output object of class laplace is called Fit: #rs <- RejectionSampling(Model, MyData, mu=Fit$Summary1[,1], # S=Fit$Covar, df=Inf, logc=Fit$LP.Final, n=1000) #rs } \keyword{High Performance Computing} \keyword{Monte Carlo} LaplacesDemon/man/plotSamples.Rd0000755000176200001440000000477515144316355016355 0ustar liggesusers\name{plotSamples} \alias{plotSamples} \title{Plot Samples} \description{ This function provides basic plots that are extended to include samples. } \usage{ plotSamples(X, Style="KDE", LB=0.025, UB=0.975, Title=NULL) } \arguments{ \item{X}{This required argument is a \eqn{N \times S}{N x S} numerical matrix of \eqn{N} records and \eqn{S} samples.} \item{Style}{This argument accepts the following quoted strings: "barplot", "dotchart", "hist", "KDE", or "Time-Series". It defaults to \code{Style="KDE"}.} \item{LB}{This argument accepts the lower bound of a probability interval, which must be in the interval [0,0.5).} \item{UB}{This argument accepts the upper bound of a probability interval, which must be in the interval (0.5,1].} \item{Title}{This argument defaults to \code{NULL}, and otherwise accepts a quoted string that will be the title of the plot.} } \details{ The \code{plotSamples} function extends several basic plots from points to samples. For example, it is common to use the \code{hist} function to plot a histogram from a column vector. However, the user may desire to plot a histogram of a column vector that was sampled numerous times, rather than a simple column vector, in which a (usually 95\%) probability interval is also plotted to show the uncertainty around the sampled median of each bin in the histogram. The \code{plotSamples} function extends the \code{barplot}, \code{dotchart}, and \code{hist} functions to include uncertainty due to samples. The \code{KDE} style of plot is added so that a probability interval is shown around a sampled kernel density estimate of a distribution, and the \code{Time-Series} style of plot is added so that a probability interval is shown around a sampled univariate time-series. For each style of plot, three quantiles are plotted: the lower bound (LB), median, and upper bound (UB). One of many potential Bayesian applications is to examine the uncertainty in a predictive distribution. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \examples{ #library(LaplacesDemon) #N <- 100 #S <- 100 #X <- matrix(rnorm(N*S),N,S) #rownames(X) <- 1:100 #plotSamples(X, Style="barplot", LB=0.025, UB=0.975) #plotSamples(X[1:10,], Style="dotchart", LB=0.025, UB=0.975) #plotSamples(X, Style="hist", LB=0.025, UB=0.975) #plotSamples(X, Style="KDE", LB=0.025, UB=0.975) #plotSamples(X, Style="Time-Series", LB=0.025, UB=0.975) } \keyword{Plot}LaplacesDemon/man/VariationalBayes.Rd0000755000176200001440000004760715144316355017310 0ustar liggesusers\name{VariationalBayes} \alias{VariationalBayes} \title{Variational Bayes} \description{ The \code{VariationalBayes} function is a numerical approximation method for deterministically estimating the marginal posterior distributions, target distributions, in a Bayesian model with approximated distributions by minimizing the Kullback-Leibler Divergence (\code{\link{KLD}}) between the target and its approximation. } \usage{ VariationalBayes(Model, parm, Data, Covar=NULL, Interval=1.0E-6, Iterations=1000, Method="Salimans2", Samples=1000, sir=TRUE, Stop.Tolerance=1.0E-5, CPUs=1, Type="PSOCK") } \arguments{ \item{Model}{This required argument receives the model from a user-defined function. The user-defined function is where the model is specified. \code{VariationalBayes} passes two arguments to the model function, \code{parms} and \code{Data}. For more information, see the \code{\link{LaplacesDemon}} function and ``LaplacesDemon Tutorial'' vignette.} \item{parm}{This argument requires a vector of initial values equal in length to the number of parameters. \code{VariationalBayes} will attempt to optimize these initial values for the parameters, where the optimized values are the posterior means, for later use with the \code{\link{IterativeQuadrature}}, \code{\link{LaplacesDemon}}, or \code{\link{PMC}} function. The \code{\link{GIV}} function may be used to randomly generate initial values. Parameters must be continuous.} \item{Data}{This required argument accepts a list of data. The list of data must include \code{mon.names} which contains monitored variable names, and \code{parm.names} which contains parameter names. \code{VariationalBayes} must be able to determine the sample size of the data, and will look for a scalar sample size variable \code{n} or \code{N}. If not found, it will look for variable \code{y} or \code{Y}, and attempt to take its number of rows as sample size. \code{VariationalBayes} needs to determine sample size due to the asymptotic nature of this method. Sample size should be at least \eqn{\sqrt{J}}{sqrt(J)} with \eqn{J} exchangeable parameters.} \item{Covar}{This argument defaults to \code{NULL}, but may otherwise accept a \eqn{K \times K}{K x K} covariance matrix (where \eqn{K} is the number of dimensions or parameters) of the parameters. When the model is updated for the first time and prior variance or covariance is unknown, then \code{Covar=NULL} should be used. Once \code{VariationalBayes} has finished updating, it may be desired to continue updating where it left off, in which case the covariance matrix from the last run can be input into the next run.} \item{Interval}{This argument receives an interval for estimating approximate gradients. The logarithm of the unnormalized joint posterior density of the Bayesian model is evaluated at the current parameter value, and again at the current parameter value plus this interval.} \item{Iterations}{This argument accepts an integer that determines the number of iterations that \code{VariationalBayes} will attempt to maximize the logarithm of the unnormalized joint posterior density. \code{Iterations} defaults to 1000. \code{VariationalBayes} will stop before this number of iterations if the tolerance is less than or equal to the \code{Stop.Tolerance} criterion. The required amount of computer memory increases with \code{Iterations}. If computer memory is exceeded, then all will be lost.} \item{Method}{This optional argument currently accepts only \code{Salimans2}, which is the second algorithm in Salimans and Knowles (2013).} \item{Samples}{This argument indicates the number of posterior samples to be taken with sampling importance resampling via the \code{\link{SIR}} function, which occurs only when \code{sir=TRUE}. Note that the number of samples should increase with the number and intercorrelations of the parameters.} \item{sir}{This logical argument indicates whether or not Sampling Importance Resampling (SIR) is conducted via the \code{\link{SIR}} function to draw independent posterior samples. This argument defaults to \code{TRUE}. Even when \code{TRUE}, posterior samples are drawn only when \code{VariationalBayes} has converged. Posterior samples are required for many other functions, including \code{plot.vb} and \code{predict.vb}. The only time that it is advantageous for \code{sir=FALSE} is when \code{VariationalBayes} is used to help the initial values for \code{\link{IterativeQuadrature}}, \code{\link{LaplacesDemon}}, or \code{\link{PMC}}, and it is unnecessary for time to be spent on sampling. Less time can be spent on sampling by increasing \code{CPUs}, which parallelizes the sampling.} \item{Stop.Tolerance}{This argument accepts any positive number and defaults to 1.0E-3. Tolerance is calculated each iteration, and the criteria varies by algorithm. The algorithm is considered to have converged to the user-specified \code{Stop.Tolerance} when the tolerance is less than or equal to the value of \code{Stop.Tolerance}, and the algorithm terminates at the end of the current iteration. Often, multiple criteria are used, in which case the maximum of all criteria becomes the tolerance. For example, when partial derivatives are taken, it is commonly required that the Euclidean norm of the partial derivatives is a criterion, and another common criterion is the Euclidean norm of the differences between the current and previous parameter values. Several algorithms have other, specific tolerances.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur. Parallelization occurs only for sampling with \code{\link{SIR}} when \code{sir=TRUE}.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} } \details{ Variational Bayes (VB) is a family of numerical approximation algorithms that is a subset of variational inference algorithms, or variational methods. Some examples of variational methods include the mean-field approximation, loopy belief propagation, tree-reweighted belief propagation, and expectation propagation (EP). Variational inference for probabilistic models was introduced in the field of machine learning, influenced by statistical physics literature (Saul et al., 1996; Saul and Jordan, 1996; Jaakkola, 1997). The mean-field methods in Neal and Hinton (1999) led to variational algorithms. Variational inference algorithms were later generalized for conjugate exponential-family models (Attias, 1999, 2000; Wiegerinck, 2000; Ghahramani and Beal, 2001; Xing et al., 2003). These algorithms still require different designs for different model forms. Salimans and Knowles (2013) introduced general-purpose VB algorithms for Gaussian posteriors. A VB algorithm deterministically estimates the marginal posterior distributions (target distributions) in a Bayesian model with approximated distributions by minimizing the Kullback-Leibler Divergence (\code{\link{KLD}}) between the target and its approximation. The complicated posterior distribution is approximated with a simpler distribution. The simpler, approximated distribution is called the variational approximation, or approximation distribution, of the posterior. The term variational is derived from the calculus of variations, and regards optimization algorithms that select the best function (which is a distribution in VB), rather than merely selecting the best parameters. VB algorithms often use Gaussian distributions as approximating distributions. In this case, both the mean and variance of the parameters are estimated. Usually, a VB algorithm is slower to convergence than a Laplace Approximation algorithm, and faster to convergence than a Monte Carlo algorithm such as Markov chain Monte Carlo (MCMC). VB often provides solutions with comparable accuracy to MCMC in less time. Though Monte Carlo algorithms provide a numerical approximation to the exact posterior using a set of samples, VB provides a locally-optimal, exact analytical solution to an approximation of the posterior. VB is often more applicable than MCMC to big data or large-dimensional models. Since VB is deterministic, it is asymptotic and subject to the same limitations with respect to sample size as Laplace Approximation. However, VB estimates more parameters than Laplace Approximation, such as when Laplace Approximation optimizes the posterior mode of a Gaussian distribution, while VB optimizes both the Gaussian mean and variance. Traditionally, VB algorithms required customized equations. The \code{VariationalBayes} function uses general-purpose algorithms. A general-purpose VB algorithm is less efficient than an algorithm custom designed for the model form. However, a general-purpose algorithm is applied consistently and easily to numerous model forms. When \code{Method="Salimans2"}, the second algorithm of Salimans and Knowles (2013) is used. This requires the gradient and Hessian, which is more efficient with a small number of parameters as long as the posterior is twice differentiable. The step size is constant. This algorithm is suitable for marginal posterior distributions that are Gaussian and unimodal. A stochastic approximation algorithm is used in the context of fixed-form VB, inspired by considering fixed-form VB to be equivalent to performing a linear regression with the sufficient statistics of the approximation as independent variables and the unnormalized logarithm of the joint posterior density as the dependent variable. The number of requested iterations should be large, since the step-size decreases for larger requested iterations, and a small step-size will eventually converge. A large number of requested iterations results in a smaller step-size and better convergence properties, so hope for early convergence. However convergence is checked only in the last half of the iterations after the algorithm begins to average the mean and variance from the samples of the stochastic approximation. The history of stochastic samples is returned. } \value{ \code{VariationalBayes} returns an object of class \code{vb} that is a list with the following components: \item{Call}{This is the matched call of \code{VariationalBayes}.} \item{Converged}{This is a logical indicator of whether or not \code{VariationalBayes} converged within the specified \code{Iterations} according to the supplied \code{Stop.Tolerance} criterion. Convergence does not indicate that the global maximum has been found, but only that the tolerance was less than or equal to the \code{Stop.Tolerance} criterion.} \item{Covar}{This is the estimated covariance matrix. The \code{Covar} matrix may be scaled and input into the \code{Covar} argument of the \code{\link{LaplacesDemon}} or \code{\link{PMC}} function for further estimation, or the diagonal of this matrix may be used to represent the posterior variance of the parameters, provided the algorithm converged and matrix inversion was successful. To scale this matrix for use with Laplace's Demon or PMC, multiply it by \eqn{2.38^2/d}, where \eqn{d} is the number of initial values.} \item{Deviance}{This is a vector of the iterative history of the deviance in the \code{VariationalBayes} function, as it sought convergence.} \item{History}{This is an array of the iterative history of the parameters in the \code{VariationalBayes} function, as it sought convergence. The first matrix is for means and the second matrix is for variances.} \item{Initial.Values}{This is the vector of initial values that was originally given to \code{VariationalBayes} in the \code{parm} argument.} \item{LML}{This is an approximation of the logarithm of the marginal likelihood of the data (see the \code{\link{LML}} function for more information). When the model has converged and \code{sir=TRUE}, the NSIS method is used. When the model has converged and \code{sir=FALSE}, the LME method is used. This is the logarithmic form of equation 4 in Lewis and Raftery (1997). As a rough estimate of Kass and Raftery (1995), the LME-based LML is worrisome when the sample size of the data is less than five times the number of parameters, and \code{LML} should be adequate in most problems when the sample size of the data exceeds twenty times the number of parameters (p. 778). The LME is inappropriate with hierarchical models. However \code{LML} is estimated, it is useful for comparing multiple models with the \code{BayesFactor} function.} \item{LP.Final}{This reports the final scalar value for the logarithm of the unnormalized joint posterior density.} \item{LP.Initial}{This reports the initial scalar value for the logarithm of the unnormalized joint posterior density.} \item{Minutes}{This is the number of minutes that \code{VariationalBayes} was running, and this includes the initial checks as well as drawing posterior samples and creating summaries.} \item{Monitor}{When \code{sir=TRUE}, a number of independent posterior samples equal to \code{Samples} is taken, and the draws are stored here as a matrix. The rows of the matrix are the samples, and the columns are the monitored variables.} \item{Posterior}{When \code{sir=TRUE}, a number of independent posterior samples equal to \code{Samples} is taken, and the draws are stored here as a matrix. The rows of the matrix are the samples, and the columns are the parameters.} \item{Step.Size.Final}{This is the final, scalar \code{Step.Size} value at the end of the \code{VariationalBayes} algorithm.} \item{Step.Size.Initial}{This is the initial, scalar \code{Step.Size}.} \item{Summary1}{This is a summary matrix that summarizes the point-estimated posterior means and variances. Uncertainty around the posterior means is estimated from the estimated covariance matrix. Rows are parameters. The following columns are included: Mean, SD (Standard Deviation), LB (Lower Bound), and UB (Upper Bound). The bounds constitute a 95\% probability interval.} \item{Summary2}{This is a summary matrix that summarizes the posterior samples drawn with sampling importance resampling (\code{\link{SIR}}) when \code{sir=TRUE}, given the point-estimated posterior means and covariance matrix. Rows are parameters. The following columns are included: Mean, SD (Standard Deviation), LB (Lower Bound), and UB (Upper Bound). The bounds constitute a 95\% probability interval.} \item{Tolerance.Final}{This is the last \code{Tolerance} of the \code{VariationalBayes} algorithm.} \item{Tolerance.Stop}{This is the \code{Stop.Tolerance} criterion.} } \references{ Attias, H. (1999). "Inferring Parameters and Structure of Latent Variable Models by Variational Bayes". In \emph{Uncertainty in Artificial Intelligence}. Attias, H. (2000). "A Variational Bayesian Framework for Graphical Models". In \emph{Neural Information Processing Systems}. Ghahramani, Z. and Beal, M. (2001). "Propagation Algorithms for Variational Bayesian Learning". In \emph{Neural Information Processing Systems}, p. 507--513. Jaakkola, T. (1997). "Variational Methods for Inference and Estimation in Graphical Models". PhD thesis, Massachusetts Institute of Technology. Salimans, T. and Knowles, D.A. (2013). "Fixed-Form Variational Posterior Approximation through Stochastic Linear Regression". \emph{Bayesian Analysis}, 8(4), p. 837--882. Neal, R. and Hinton, G. (1999). "A View of the EM Algorithm that Justifies Incremental, Sparse, and Other Variants". In Learning in Graphical Models, p. 355--368. MIT Press, 1999. Saul, L. and Jordan, M. (1996). "Exploiting Tractable Substructures in Intractable Networks". \emph{Neural Information Processing Systems}. Saul, L., Jaakkola, T., and Jordan, M. (1996). "Mean Field Theory for Sigmoid Belief Networks". \emph{Journal of Artificial Intelligence Research}, 4, p. 61--76. Wiegerinck, W. (2000). "Variational Approximations Between Mean Field Theory and the Junction Tree Algorithm". In \emph{Uncertainty in Artificial Intelligence}. Xing, E., Jordan, M., and Russell, S. (2003). "A Generalized Mean Field Algorithm for Variational Inference in Exponential Families". In \emph{Uncertainty in Artificial Intelligence}. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{BayesFactor}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{GIV}}, \code{\link{LML}}, \code{\link{PMC}}, and \code{\link{SIR}}. } \examples{ # The accompanying Examples vignette is a compendium of examples. #################### Load the LaplacesDemon Library ##################### library(LaplacesDemon) ############################## Demon Data ############################### data(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,10]+1))) J <- ncol(X) for (j in 2:J) X[,j] <- CenterScale(X[,j]) ######################### Data List Preparation ######################### mon.names <- "mu[1]" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ########################## Model Specification ########################## Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(Data$X, t(beta)) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + beta.prior + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=mu[1], yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } ############################ Initial Values ############################# #Initial.Values <- GIV(Model, MyData, PGF=TRUE) Initial.Values <- rep(0,J+1) #Fit <- VariationalBayes(Model, Initial.Values, Data=MyData, Covar=NULL, # Iterations=1000, Method="Salimans2", Stop.Tolerance=1e-3, CPUs=1) #Fit #print(Fit) #PosteriorChecks(Fit) #caterpillar.plot(Fit, Parms="beta") #plot(Fit, MyData, PDF=FALSE) #Pred <- predict(Fit, Model, MyData, CPUs=1) #summary(Pred, Discrep="Chi-Square") #plot(Pred, Style="Covariates", Data=MyData) #plot(Pred, Style="Density", Rows=1:9) #plot(Pred, Style="Fitted") #plot(Pred, Style="Jarque-Bera") #plot(Pred, Style="Predictive Quantiles") #plot(Pred, Style="Residual Density") #plot(Pred, Style="Residuals") #Levene.Test(Pred) #Importance(Fit, Model, MyData, Discrep="Chi-Square") #Fit$Covar is scaled (2.38^2/d) and submitted to LaplacesDemon as Covar. #Fit$Summary[,1] is submitted to LaplacesDemon as Initial.Values. #End } \keyword{Adaptive} \keyword{Optimization} LaplacesDemon/man/CSF.Rd0000755000176200001440000001432115144316355014451 0ustar liggesusers\name{CSF} \alias{CSF} \title{Cumulative Sample Function} \description{ The Cumulative Sample Function (CSF) is a visual MCMC diagnostic in which the user may select a measure (such as a variable, summary statistic, or other diagnostic), and observe a plot of how the measure changes over cumulative posterior samples from MCMC, such as the output of \code{\link{LaplacesDemon}}. This may be considered to be a generalized extension of the \code{cumuplot} in the coda package, which is a more restrictive form of the cusum diagnostic introduced by Yu and Myckland (1998). Yu and Myckland (1998) suggest that CSF plots should be examined after traditional trace plots seem convergent, and assert that faster mixing chains (which are more desirable) result in CSF plots that are more `hairy' (as opposed to smooth), though this is subjective and has been debated. The \code{LaplacesDemon} package neither supports nor contradicts the suggestion of mixing and `hairiness', but suggests that CSF plots may be used to provide additional information about a chain. For example, a user may decide on a practical \code{\link{burnin}} given when a conditional mean obtains a certain standard error. } \usage{ CSF(x, name, method="Quantiles", quantiles=c(0.025,0.500,0.975), output=FALSE) } \arguments{ \item{x}{This is a vector of posterior samples from MCMC.} \item{name}{This is an optional name for vector \code{x}, and is input as a quoted string, such as \code{name="theta"}.} \item{method}{This is a measure that will be observed over the course of cumulative samples of \code{x}. It defaults to \code{method="Quantiles"}, and optional methods include: \code{"ESS"}, \code{"Geweke.Diagnostic"}, \code{"HPD"}, \code{"is.stationary"}, \code{"Kurtosis"}, \code{"MCSE"}, \code{"MCSE.bm"}, \code{"MCSE.sv"}, \code{"Mean"}, \code{"Mode"}, \code{"N.Modes"}, \code{"Precision"}, \code{"Quantiles"}, and \code{"Skewness"}.} \item{quantiles}{This optional argument applies only when \code{method="Quantiles"}, in which case this vector indicates the probabilities that will be observed. It defaults to the median and 95\% probability interval bounds (see \code{\link{p.interval}} for more information).} \item{output}{Logical. If \code{output=TRUE}, then the results of the measure over the course of the cumulative samples will be output as an object, either a vector or matrix, depending on the \code{method} argument. The \code{output} argument defaults to \code{FALSE}.} } \details{ When \code{method="ESS"}, the effective sample size (ESS) is observed as a function of the cumulative samples of \code{x}. For more information, see the \code{\link{ESS}} function. When \code{method="Geweke.Diagnostic"}, the Z-score output of the Geweke diagnostic is observed as a function of the cumulative samples of \code{x}. For more information, see the \code{\link{Geweke.Diagnostic}} function. When \code{method="HPD"}, the Highest Posterior Density (HPD) interval is observed as a function of the cumulative samples of \code{x}. For more information, see the \code{\link{p.interval}} function. When \code{method="is.stationary"}, stationarity is logically tested and the result is observed as a function of the cumulative samples of \code{x}. For more information, see the \code{\link{is.stationary}} function. When \code{method="Kurtosis"}, kurtosis is observed as a function of the cumulative samples of \code{x}. When \code{method="MCSE"}, the Monte Carlo Standard Error (MCSE) estimated with the \code{IMPS} method is observed as a function of the cumulative samples of \code{x}. For more information, see the \code{\link{MCSE}} function. When \code{method="MCSE.bm"}, the Monte Carlo Standard Error (MCSE) estimated with the \code{batch.means} method is observed as a function of the cumulative samples of \code{x}. For more information, see the \code{\link{MCSE}} function. When \code{method="MCSE.sv"}, the Monte Carlo Standard Error (MCSE) estimated with the \code{sample.variance} method is observed as a function of the cumulative samples of \code{x}. For more information, see the \code{\link{MCSE}} function. When \code{method="Mean"}, the mean is observed as a function of the cumulative samples of \code{x}. When \code{method="Mode"}, the estimated mode is observed as a function of the cumulative samples of \code{x}. For more information, see the \code{\link{Mode}} function. When \code{method="N.Modes"}, the estimated number of modes is observed as a function of the cumulative samples of \code{x}. For more information, see the \code{\link{Modes}} function. When \code{method="Precision"}, the precision (inverse variance) is observed as a function of the cumulative samples of \code{x}. When \code{method="Quantiles"}, the quantiles selected with the \code{quantiles} argument are observed as a function of the cumulative samples of \code{x}. When \code{method="Skewness"}, skewness is observed as a function of the cumulative samples of \code{x}. } \references{ Yu, B. and Myckland, P. (1997). "Looking at Markov Samplers through Cusum Path Plots: A Simple Diagnostic Idea". \emph{Statistics and Computing}, 8(3), p. 275--286. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{burnin}}, \code{\link{ESS}}, \code{\link{Geweke.Diagnostic}}, \code{\link{is.stationary}}, \code{\link{LaplacesDemon}}, \code{\link{MCSE}}, \code{\link{Mode}}, \code{\link{Modes}}, and \code{\link{p.interval}}. } \examples{ #Commented-out because of run-time for package builds #library(LaplacesDemon) #x <- rnorm(1000) #CSF(x, method="ESS") #CSF(x, method="Geweke.Diagnostic") #CSF(x, method="HPD") #CSF(x, method="is.stationary") #CSF(x, method="Kurtosis") #CSF(x, method="MCSE") #CSF(x, method="MCSE.bm") #CSF(x, method="MCSE.sv") #CSF(x, method="Mean") #CSF(x, method="Mode") #CSF(x, method="N.Modes") #CSF(x, method="Precision") #CSF(x, method="Quantiles") #CSF(x, method="Skewness") } \keyword{Diagnostic} \keyword{MCMC} \keyword{Plot} \keyword{Utility} LaplacesDemon/man/dist.Inverse.Gamma.Rd0000755000176200001440000000610715144316355017437 0ustar liggesusers\name{dist.Inverse.Gamma} \alias{dinvgamma} \alias{rinvgamma} \title{Inverse Gamma Distribution} \description{ This is the density function and random generation from the inverse gamma distribution. } \usage{ dinvgamma(x, shape=1, scale=1, log=FALSE) rinvgamma(n, shape=1, scale=1) } \arguments{ \item{n}{This is the number of draws from the distribution.} \item{x}{This is the scalar location to evaluate density.} \item{shape}{This is the scalar shape parameter \eqn{\alpha}{alpha}, which defaults to one.} \item{scale}{This is the scalar scale parameter \eqn{\beta}{beta}, which defaults to one.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{\beta^\alpha}{\Gamma(\alpha)} \theta^{-(\alpha + 1)} \exp(-\frac{\beta}{\theta}), \quad \theta > 0}{p(theta) = (beta^alpha / Gamma(alpha)) * theta^(-(alpha + 1)) * exp(-beta / theta), theta > 0} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathcal{G}^{-1}(\alpha, \beta)}{theta ~ G^-1(alpha, beta)} \item Notation 2: \eqn{p(\theta) = \mathcal{G}^{-1}(\theta | \alpha, \beta)}{p(theta) = G^-1(theta | alpha, beta)} \item Parameter 1: shape \eqn{\alpha > 0}{alpha > 0} \item Parameter 2: scale \eqn{\beta > 0}{beta > 0} \item Mean: \eqn{E(\theta) = \frac{\beta}{\alpha - 1}}{E(theta) = beta / (alpha - 1)}, for \eqn{\alpha > 1}{alpha > 1} \item Variance: \eqn{var(\theta) = \frac{\beta^2}{(\alpha - 1)^2 (\alpha - 2)}, \alpha > 2}{var(theta) = beta^2 / ((alpha - 1)^2 * (alpha - 2)), alpha > 2} \item Mode: \eqn{mode(\theta) = \frac{\beta}{\alpha + 1}}{mode(theta) = beta / (alpha + 1)} } The inverse-gamma is the conjugate prior distribution for the normal or Gaussian variance, and has been traditionally specified as a vague prior in that application. The density is always finite; its integral is finite if \eqn{\alpha > 0}{alpha > 0}. Prior information decreases as \eqn{\alpha, \beta \rightarrow 0}{alpha, beta -> 0}. These functions are similar to those in the \code{MCMCpack} package. } \value{ \code{dinvgamma} gives the density and \code{rinvgamma} generates random deviates. The parameterization is consistent with the Gamma Distribution in the stats package. } \seealso{ \code{\link{dgamma}}, \code{\link{dnorm}}, \code{\link{dnormp}}, and \code{\link{dnormv}}. } \examples{ library(LaplacesDemon) x <- dinvgamma(4.3, 1.1) x <- rinvgamma(10, 3.3) #Plot Probability Functions x <- seq(from=0.1, to=20, by=0.1) plot(x, dinvgamma(x,1,1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dinvgamma(x,1,0.6), type="l", col="green") lines(x, dinvgamma(x,0.6,1), type="l", col="blue") legend(2, 0.9, expression(paste(alpha==1, ", ", beta==1), paste(alpha==1, ", ", beta==0.6), paste(alpha==0.6, ", ", beta==1)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution} LaplacesDemon/man/Thin.Rd0000755000176200001440000000433015144316355014737 0ustar liggesusers\name{Thin} \alias{Thin} \title{Thin} \description{ This function reduces the number of posterior samples by retaining every \eqn{k}th sample. } \usage{ Thin(x, By=1) } \arguments{ \item{x}{This is a vector or matrix of posterior samples to be thinned.} \item{By}{This argument specifies that every \eqn{k}th posterior sample will be retained, and \code{By} defaults to 1, meaning that thinning will not occur, because every sample will be retained.} } \details{ A thinned matrix of posterior samples is a matrix in which only every \eqn{k}th posterior sample (or row) in the original matrix is retained. The act of thinning posterior samples has been criticized as throwing away information, which is correct. However, it is common practice to thin posterior samples, usually associated with MCMC such as \code{\link{LaplacesDemon}}, for two reasons. First, Each chain (column vector) in a matrix of posterior samples probably has higher autocorrelation than desired, which reduces the effective sample size (see \code{\link{ESS}} for more information). Therefore, a thinned matrix usually contains posterior samples that are closer to independent than an un-thinned matrix. The other reason for the popularity of thinning is that it a user may not have the random-access memory (RAM) to store large, un-thinned matrices of posterior samples. \code{\link{LaplacesDemon}} and \code{\link{PMC}} automatically thin posterior samples, deviance samples, and samples of monitored variables, according to its own user-specified argument. The \code{Thin} function is made available here, should it be necessary to thin posterior samples outside of objects of class \code{demonoid} or \code{pmc}. } \value{ The \code{Thin} argument returns a thinned matrix. When \code{x} is a vector, the returned object is a matrix with 1 column. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{ESS}}, \code{\link{LaplacesDemon}}, and \code{\link{PMC}}. } \examples{ library(LaplacesDemon) x <- matrix(runif(100), 10, 10) Thin(x, By=2) } \keyword{Diagnostic} \keyword{MCMC} \keyword{Monte Carlo} \keyword{Utility} LaplacesDemon/man/data.demonchoice.Rd0000755000176200001440000000373615144316355017233 0ustar liggesusers\name{data.demonchoice} \alias{demonchoice} \title{Demon Choice Data Set} \usage{data(demonchoice)} \description{ This data set is for discrete choice models and consists of the choice of commuting route to school: arterial, two-lane, or freeway. There were 151 Pennsylvania commuters who started from a residential complex in State College, PA, and commute to downtown State College. } \format{ This data frame contains 151 rows of individual choices and 9 columns. The following data dictionary describes each variable or column. \describe{ \item{\code{Choice}}{This is the route choice: four-lane arterial (35 MPH speed limit), two-lane highway (35 MPH speed limit, with one lane in each direction), or a limited-access four-lane freeway (55 MPH speed liimit.)} \item{\code{HH.Income}}{This is an ordinal variable of annual household income of the commuter in USD. There are four categories: 1 is less than 20,000 USD, 2 is 20,000-29,999 USD, 3 is 30,000-39,999 USD, and 4 is 40,000 USD or greater.} \item{\code{Vehicle.Age}}{This is the age in years of the vehicle of the commuter.} \item{\code{Stop.Signs.Arterial}}{This is the number of stop signs along the arterial route.} \item{\code{Stop.Signs.Two.Lane}}{This is the number of stop signs along the two-lane route.} \item{\code{Stop.Signs.Freeway}}{This is the number of stop signs along the freeway route.} \item{\code{Distance.Arterial}}{This is distance in miles of the arterial route.} \item{\code{Distance.Two.Lane}}{This is the distance in miles of the two-lane route.} \item{\code{Distance.Freeway}}{This is the distance in miles of the freeway route.} } } \source{Washington, S., Congdon, P., Karlaftis, M., and Mannering, F. (2009). "Bayesian Multinomial Logit: Theory and Route Choice Example". Transportation Research Record, 2136, p. 28--36.} \keyword{datasets} LaplacesDemon/man/GIV.Rd0000755000176200001440000001743315144316355014472 0ustar liggesusers\name{GIV} \alias{GIV} \title{Generate Initial Values} \description{ The \code{GIV} function generates initial values for use with the \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}} functions. } \usage{ GIV(Model, Data, n=1000, PGF=FALSE) } \arguments{ \item{Model}{This required argument is a model specification function. For more information, see \code{\link{LaplacesDemon}}.} \item{Data}{This required argument is a list of data. For more information, see \code{\link{LaplacesDemon}}.} \item{n}{This is the number of attempts to generate acceptable initial values.} \item{PGF}{Logical. When \code{TRUE}, a Parameter-Generating Function (PGF) is required to be in \code{Data}, and \code{GIV} will generate initial values according to the user-specified PGF. This argument defaults to \code{FALSE}, in which case initial values are generated randomly without respect to a user-specified function.} } \details{ Initial values are required for optimization or sampling algorithms. A user may specify initial values, or use the \code{GIV} function for random generation. Initial values determined by the user may fail to produce a finite posterior in complicated models, and the \code{GIV} function is here to help. \code{GIV} has several uses. First, the \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, and \code{\link{VariationalBayes}} functions use \code{GIV} internally if unacceptable initial values are discovered. Second, the user may use \code{GIV} when developing their model specification function, \code{Model}, to check for potential problems. Third, the user may prefer to randomly generate acceptable initial values. Lastly, \code{GIV} is recommended when running multiple or parallel chains with the \code{\link{LaplacesDemon.hpc}} function (such as for later use with the \code{Gelman.Diagnostic}) for dispersed starting locations. For dispersed starting locations, \code{GIV} should be run once for each parallel chain, and the results should be stored per row in a matrix of initial values. For more information, see the \code{LaplacesDemon.hpc} documentation for initial values. It is strongly recommended that the user specifies a Parameter-Generating Function (PGF), and includes this function in the list of data. Although the PGF may be specified according to the prior distributions (possibly considered as a Prior-Generating Function), it is often specified with a more restricted range. For example, if a user has a model with the following prior distributions \deqn{\beta_j \sim \mathcal{N}(0, 1000), j=1,\dots,5}{beta_j ~ N(0, 1000), j=1,\dots,5} \deqn{\sigma \sim \mathcal{HC}(25)}{sigma ~ HC(25)} then the PGF, given the prior distributions, is \code{PGF <- function(Data) return(c(rnormv(5,0,1000),rhalfcauchy(1,25)))} However, the user may not want to begin with initial values that could be so far from zero (as determined by the variance of 1000), and may instead prefer \code{PGF <- function(Data) return(c(rnormv(5,0,10),rhalfcauchy(1,5)))} When \code{PGF=FALSE}, initial values are attempted to be constrained to the interval \eqn{[-100,100]}. This is done to prevent numeric overflows with parameters that are exponentiated within the model specification function. First, \code{GIV} passes the upper and lower bounds of this interval to the model, and any changed parameters are noted. At this point, it is hoped that a non-finite posterior is not found. If found, then the remainder of the process is random and without the previous bounds. This can be particularly problematic in the case of, say, initial values that are the elements of a matrix that must be positive-definite, especially with large matrices. If a random solution is not found, then \code{GIV} will fail. If the posterior is finite and \code{PGF=FALSE}, then initial values are randomly generated with a normal proposal and a small variance at the center of the returned range of each parameter. As \code{GIV} fails to find acceptable initial values, the algorithm iterates toward its maximum number of iterations, \code{n}. In each iteration, the variance increases for the proposal. Initial values are considered acceptable only when the first two returned components of \code{Model} (which are \code{LP} and \code{Dev}) are finite, and when initial values do not change through constraints, as returned in the fifth component of the list: \code{parm}. If \code{GIV} fails to return acceptable initial values, then it is best to study the model specification function. When the model is complicated, here is a suggestion. Remove the log-likelihood, \code{LL}, from the equation that calculates the logarithm of the unnormalized joint posterior density, \code{LP}. For example, convert \code{LP <- LL + beta.prior} to \code{LP <- beta.prior}. Now, maximize \code{LP}, which is merely the set of prior densities, with any optimization algorithm. Replace \code{LL}, and run the model with initial values that are in regions of high prior density (preferably with \code{PGF=TRUE}. If this fails, then the model specification should be studied closely, because a non-finite posterior should (especially) never be associated with regions of high prior density. } \value{ The \code{GIV} function returns a vector equal in length to the number of parameters, and each element is an initial value for the associated parameter in \code{Data$parm.names}. When \code{GIV} fails to find acceptable initial values, each returned element is \code{NA}. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{as.initial.values}}, \code{\link{Gelman.Diagnostic}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) ############################## Demon Data ############################### data(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) J <- ncol(X) for (j in 2:J) X[,j] <- CenterScale(X[,j]) ######################### Data List Preparation ######################### mon.names <- c("LP","sigma") parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ########################## Model Specification ########################## Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(Data$X, t(beta)) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + beta.prior + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } ######################## Generate Initial Values ######################## Initial.Values <- GIV(Model, MyData, PGF=TRUE) } \keyword{Initial Values} \keyword{Utility} LaplacesDemon/man/dist.Multivariate.Cauchy.Rd0000755000176200001440000000616715144316355020672 0ustar liggesusers\name{dist.Multivariate.Cauchy} \alias{dmvc} \alias{rmvc} \title{Multivariate Cauchy Distribution} \description{ These functions provide the density and random number generation for the multivariate Cauchy distribution. } \usage{ dmvc(x, mu, S, log=FALSE) rmvc(n=1, mu, S) } \arguments{ \item{x}{This is either a vector of length \eqn{k} or a matrix with a number of columns, \eqn{k}, equal to the number of columns in scale matrix \eqn{\textbf{S}}{S}.} \item{n}{This is the number of random draws.} \item{mu}{This is a numeric vector representing the location parameter, \eqn{\mu}{mu} (the mean vector), of the multivariate distribution It must be of length \eqn{k}, as defined above.} \item{S}{This is a \eqn{k \times k}{k x k} positive-definite scale matrix \eqn{\textbf{S}}{S}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{\Gamma[(1+k)/2]}{\Gamma(1/2)1^{k/2}\pi^{k/2}|\Sigma|^{1/2}[1+(\theta-\mu)^{\mathrm{T}}\Sigma^{-1}(\theta-\mu)]^{(1+k)/2}}}{p(theta) = Gamma[(1+k)/2] / {Gamma(1/2)1^(k/2)pi^(k/2)|Sigma|^(1/2)[1+(theta-mu)^T*Sigma^(-1)(theta-mu)]^[(1+k)/2]}} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathcal{MC}_k(\mu, \Sigma)}{theta ~ MC[k](mu, Sigma)} \item Notation 2: \eqn{p(\theta) = \mathcal{MC}_k(\theta | \mu, \Sigma)}{p(theta) = MC[k](theta | mu, Sigma)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} scale matrix \eqn{\Sigma}{Sigma} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = undefined}{var(theta) = undefined} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate Cauchy distribution is a multidimensional extension of the one-dimensional or univariate Cauchy distribution. The multivariate Cauchy distribution is equivalent to a multivariate t distribution with 1 degree of freedom. A random vector is considered to be multivariate Cauchy-distributed if every linear combination of its components has a univariate Cauchy distribution. The Cauchy distribution is known as a pathological distribution because its mean and variance are undefined, and it does not satisfy the central limit theorem. } \value{ \code{dmvc} gives the density and \code{rmvc} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dcauchy}}, \code{\link{dinvwishart}}, \code{\link{dmvcp}}, \code{\link{dmvt}}, and \code{\link{dmvtp}}. } \examples{ library(LaplacesDemon) x <- seq(-2,4,length=21) y <- 2*x+10 z <- x+cos(y) mu <- c(1,12,2) Sigma <- matrix(c(1,2,0,2,5,0.5,0,0.5,3), 3, 3) f <- dmvc(cbind(x,y,z), mu, Sigma) X <- rmvc(1000, rep(0,2), diag(2)) X <- X[rowSums((X >= quantile(X, probs=0.025)) & (X <= quantile(X, probs=0.975)))==2,] joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution} LaplacesDemon/man/BMK.Diagnostic.Rd0000755000176200001440000000777015144316355016544 0ustar liggesusers\name{BMK.Diagnostic} \alias{BMK.Diagnostic} \title{BMK Convergence Diagnostic} \description{ Given a matrix of posterior samples from MCMC, the \code{BMK.Diagnostic} function calculates Hellinger distances between consecutive batches for each chain. This is useful for monitoring convergence of MCMC chains. } \usage{ BMK.Diagnostic(X, batches=10) } \arguments{ \item{X}{This required argument accepts a matrix of posterior samples or an object of class \code{demonoid}, in which case it uses the posterior samples in \code{X$Posterior1}.} \item{batches}{This is the number of batches on which the convergence diagnostic will be calculated. The \code{batches} argument defaults to 10.} } \details{ Hellinger distance is used to quantify dissimilarity between two probability distributions. It is based on the Hellinger integral, introduced by Hellinger (1909). Traditionally, Hellinger distance is bound to the interval [0,1], though another popular form occurs in the interval [0,\eqn{\sqrt{2}}{sqrt(2)}]. A higher value of Hellinger distance is associated with more dissimilarity between the distributions. Convergence is assumed when Hellinger distances are below a threshold, indicating that posterior samples are similar between consecutive batches. If all Hellinger distances beyond a given batch of samples is below the threshold, then \code{burnin} is suggested to occur immediately before the first batch of satisfactory Hellinger distances. As an aid to interpretation, consider a matrix of 1,000 posterior samples from three chains: \code{beta[1]}, \code{beta[2]}, and \code{beta[3]}. With 10 batches, the column names are: 100, 200, \dots, 900. A Hellinger distance for the chain \code{beta[1]} at 100 is the Hellinger distance between two batches: samples 1-100, and samples 101:200. A benefit to using \code{BMK.Diagnostic} is that the resulting Hellinger distances may easily be plotted with the \code{plotMatrix} function, allowing the user to see quickly which consecutive batches of which chains were dissimilar. This makes it easier to find problematic chains. The \code{BMK.Diagnostic} is calculated automatically in the \code{\link{LaplacesDemon}} function, and is one of the criteria in the \code{\link{Consort}} function regarding the recommendation of when to stop updating the Markov chain Monte Carlo (MCMC) sampler in \code{\link{LaplacesDemon}}. For more information on the related topics of burn-in and stationarity, see the \code{burnin} and \code{\link{is.stationary}} functions, and the accompanying vignettes. } \value{ The \code{BMK.Diagnostic} function returns an object of class \code{bmk} that is a \eqn{J \times B}{J x B} matrix of Hellinger distances between consecutive batches for \eqn{J} parameters of posterior samples. The number of columns, \eqn{B} is equal to the number of batches minus one. The \code{BMK.Diagnostic} function is similar to the \code{bmkconverge} function in package BMK. } \references{ Boone, E.L., Merrick, J.R. and Krachey, M.J. (2013). "A Hellinger Distance Approach to MCMC Diagnostics". \emph{Journal of Statistical Computation and Simulation}, in press. Hellinger, E. (1909). "Neue Begrundung der Theorie quadratischer Formen von unendlichvielen Veranderlichen" (in German). \emph{Journal fur die reine und angewandte Mathematik}, 136, p. 210--271. } \seealso{ \code{\link{burnin}}, \code{\link{Consort}}, \code{\link{is.stationary}}, and \code{\link{LaplacesDemon}}. } \examples{ library(LaplacesDemon) N <- 1000 #Number of posterior samples J <- 10 #Number of parameters Theta <- matrix(runif(N*J),N,J) colnames(Theta) <- paste("beta[", 1:J, "]", sep="") for (i in 2:N) {Theta[i,1] <- Theta[i-1,1] + rnorm(1)} HD <- BMK.Diagnostic(Theta, batches=10) plot(HD, title="Hellinger distance between batches") } \keyword{Diagnostic} \keyword{MCMC} \keyword{Stationarity} \keyword{Utility} LaplacesDemon/man/plot.vb.ppc.Rd0000755000176200001440000004074715144316355016216 0ustar liggesusers\name{plot.vb.ppc} \alias{plot.vb.ppc} \title{Plots of Posterior Predictive Checks} \description{ This may be used to plot, or save plots of, samples in an object of class \code{vb.ppc}. A variety of plots is provided. } \usage{\method{plot}{vb.ppc}(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, \dots)} \arguments{ \item{x}{ This required argument is an object of class \code{vb.ppc}.} \item{Style}{ This optional argument specifies one of several styles of plots, and defaults to \code{NULL} (which is the same as \code{"Density"}). Styles of plots are indicated in quotes. Optional styles include \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"Density"}, \code{"DW"}, \code{"DW, Multivariate, C"}, \code{"ECDF"}, \code{"Fitted"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Predictive Quantiles"}, \code{"Residual Density"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}. Details are given below.} \item{Data}{ This optional argument accepts the data set used when updating the model. Data is required only with certain plot styles, including \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"DW, Multivariate, C"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}.} \item{Rows}{ This optional argument is for a vector of row numbers that specify the records associated by row in the object of class \code{vb.ppc}. Only these rows are plotted. The default is to plot all rows. Some plots do not allow rows to be specified.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{\dots}{Additional arguments are unused.} } \details{ This function can be used to produce a variety of posterior predictive plots, and the style of plot is selected with the \code{Style} argument. Below are some notes on the styles of plots. \code{Covariates} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is not categorical. \code{Covariates, Categorical DV} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is categorical. \code{Density} plots show the kernel density of the posterior predictive distribution for each selected row of y (all are selected by default). A vertical red line indicates the position of the observed y along the x-axis. When the vertical red line is close to the middle of a normal posterior predictive distribution, then there is little discrepancy between y and the posterior predictive distribution. When the vertical red line is in the tail of the distribution, or outside of the kernel density altogether, then there is a large discrepancy between y and the posterior predictive distribution. Large discrepancies may be considered outliers, and moreover suggest that an improvement in model fit should be considered. \code{DW} plots the distributions of the Durbin-Watson (DW) test statistics (Durbin and Watson, 1950), both observed (\eqn{d^{obs}}{d.obs} as a transparent, black density) and replicated (\eqn{d^{rep}}{d.rep} as a transparent, red density). The distribution of \eqn{d^{obs}}{d.obs} is estimated from the model, and \eqn{d^{rep}}{d.rep} is simulated from normal residuals without autocorrelation, where the number of simulations are the same as the observed number. This DW test may be applied to the residuals of univariate time-series models (or otherwise ordered residuals) to detect first-order autocorrelation. Autocorrelated residuals are not independent. The DW test is applicable only when the residuals are normally-distributed, higher-order autocorrelation is not present, and y is not used also as a lagged predictor. The DW test statistic, \eqn{d^{obs}}{d[obs]}, occurs in the interval (0,4), where 0 is perfect positive autocorrelation, 2 is no autocorrelation, and 4 is perfect negative autocorrelation. The following summary is reported on the plot: the mean of \eqn{d^{obs}}{d[obs]} (and its 95\% probability interval), the probability that \eqn{d^{obs} > d^{rep}}{d[obs] > d[rep]}, and whether or not autocorrelation is found. Positive autocorrelation is reported when the observed process is greater than the replicated process in 2.5\% of the samples, and negative autocorrelation is reported when the observed process is greater than the replicated process in 97.5\% of the samples. \code{DW, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Durbin-Watson test, as in \code{DW} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for first-order autocorrelation. \code{ECDF} (Empirical Cumulative Distribution Function) plots compare the ECDF of y with three ECDFs of yhat based on the 2.5\%, 50\% (median), and 97.5\% of its distribution. The ECDF(y) is defined as the proportion of values less than or equal to y. This plot is appropriate when y is univariate and at least ordinal. \code{Fitted} plots compare y with the probability interval of its replicate, and provide loess smoothing. This plot is appropriate when y is univariate and not categorical. \code{Fitted, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each column-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen column-wise. \code{Fitted, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each row-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen row-wise. \code{Jarque-Bera} plots the distributions of the Jarque-Bera (JB) test statistics (Jarque and Bera, 1980), both observed (\eqn{JB^{obs}}{JB.obs} as a transparent black density) and replicated (\eqn{JB^{rep}}{JB.rep} as a transparent red density). The distribution of \eqn{JB^{obs}}{JB.obs} is estimated from the model, and \eqn{JB^{rep}}{JB.rep} is simulated from normal residuals, where the number of simulations are the same as the observed number. This Jarque-Bera test may be applied to the residuals of univariate models to test for normality. The Jarque-Bera test does not test normality per se, but whether or not the distribution has kurtosis and skewness that match a normal distribution, and is therefore a test of the moments of a normal distribution. The following summary is reported on the plot: the mean of \eqn{JB^{obs}}{JB[obs]} (and its 95\% probability interval), the probability that \eqn{JB^{obs} > JB^{rep}}{JB[obs] > JB[rep]}, and whether or not normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Jarque-Bera, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Jarque-Bera test, as in \code{Jarque-Bera} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for normality. \code{Mardia} plots the distributions of the skewness (K3) and kurtosis (K4) test statistics (Mardia, 1970), both observed (\eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} as transparent black density) and replicated (\eqn{K3^{rep}}{K3.rep} and \eqn{K4^{rep}}{K4.rep} as transparent red density). The distributions of \eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} are estimated from the model, and both \eqn{K3^{rep}}{K3.rep} \eqn{K4^{rep}}{K4.rep} are simulated from multivariate normal residuals, where the number of simulations are the same as the observed number. This Mardia's test may be applied to the residuals of multivariate models to test for multivariate normality. Mardia's test does not test for multivariate normality per se, but whether or not the distribution has kurtosis and skewness that match a multivariate normal distribution, and is therefore a test of the moments of a multivariate normal distribution. The following summary is reported on the plots: the means of \eqn{K3^{obs}}{K3[obs]} and \eqn{K4^{obs}}{K4[obs]} (and the associated 95\% probability intervals), the probabilities that \eqn{K3^{obs} > K3^{rep}}{K3[obs] > K3[rep]} and \eqn{K4^{obs} > K4^{rep}}{K4[obs] > K4[rep]}, and whether or not multivariate normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Mardia} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. \code{Y} must be a \eqn{N \times P}{N x P} matrix of \eqn{N}{N} records and \eqn{P}{P} variables. Source code was modified from the deprecated package QRMlib. \code{Predictive Quantiles} plots compare y with the predictive quantile (PQ) of its replicate. This may be useful in looking for patterns with outliers. Instances outside of the gray lines are considered outliers. \code{Residual Density} plots the residual density of the median of the samples. A vertical red line occurs at zero. This plot may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when y is univariate and continuous. \code{Residual Density, Multivariate C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are column-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen column-wise. \code{Residual Density, Multivariate R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are row-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen row-wise. \code{Residuals} plots compare y with its residuals. The probability interval is plotted as a line. This plot is appropriate when y is univariate. \code{Residuals, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each column-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen column-wise. \code{Residuals, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each row-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen row-wise. \code{Space-Time by Space} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one time-series plot per point s in space, for a total of S plots. Therefore, these are time-series plots for each point s in space across T time-periods. See \code{Time-Series} plots below. \code{Space-Time by Time} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one spatial plot per time-period, and T plots will be produced. See \code{Spatial} plots below. \code{Spatial} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows yrep plotted according to its coordinates, and is color-coded so that higher values of yrep become more red, and lower values become more yellow. \code{Spatial Uncertainty} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows the probability interval of yrep plotted according to its coordinates, and is color-coded so that wider probability intervals become more red, and lower values become more yellow. \code{Time-Series} plots compare y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is univariate and ordered by time. \code{Time-Series, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by column in Y. \code{Time-Series, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each row-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by row in Y, such as is typically true in panel models. } \references{ Durbin, J., and Watson, G.S. (1950). "Testing for Serial Correlation in Least Squares Regression, I." \emph{Biometrika}, 37, p. 409--428. Jarque, C.M. and Bera, A.K. (1980). "Efficient Tests for Normality, Homoscedasticity and Serial Independence of Regression Residuals". \emph{Economics Letters}, 6(3), p. 255--259. Mardia, K.V. (1970). "Measures of Multivariate Skewness and Kurtosis with Applications". \emph{Biometrika}, 57(3), p. 519--530. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{predict.vb}} and \code{\link{VariationalBayes}}. } \examples{### See the VariationalBayes function for an example.} \keyword{Plot}LaplacesDemon/man/dist.Normal.Laplace.Rd0000755000176200001440000001016115144316355017566 0ustar liggesusers\name{dist.Normal.Laplace} \alias{dnormlaplace} \alias{rnormlaplace} \title{Normal-Laplace Distribution: Univariate Asymmetric} \description{ These functions provide the density and random generation for the univariate, asymmetric, normal-Laplace distribution with location parameter \eqn{\mu}{mu}, scale parameter \eqn{\sigma}{\sigma}, and tail-behavior parameters \eqn{\alpha}{alpha} and \eqn{\beta}{beta}. } \usage{ dnormlaplace(x, mu=0, sigma=1, alpha=1, beta=1, log=FALSE) rnormlaplace(n, mu=0, sigma=1, alpha=1, beta=1) } \arguments{ \item{x}{This is a vector of data.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mu}{This is the location parameter \eqn{\mu}{mu}.} \item{sigma}{This is the scale parameter \eqn{\sigma}{sigma}, which must be positive.} \item{alpha}{This is shape parameter \eqn{\alpha}{alpha} for left-tail behavior.} \item{beta}{This is shape parameter \eqn{\beta}{beta} for right-tail behavior.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{\alpha\beta}{\alpha + \beta}\phi\frac{\theta - \mu}{\sigma} [R(\alpha\sigma - \frac{\theta - \mu}{\sigma}) + R(\beta\sigma + \frac{\theta - \mu}{\sigma})]}{p(theta) = [(alpha*beta)/(alpha + beta)] phi [(theta - mu) / sigma] [R(alpha*sigma - [(theta - mu) / sigma]) + R(beta*sigma + [(theta - mu) / sigma])]} \item Inventor: Reed (2006) \item Notation 1: \eqn{\theta \sim \mathrm{NL}(\mu,\sigma,\alpha,\beta)}{theta ~ NL(mu, sigma, alpha, beta)} \item Notation 2: \eqn{p(\theta) = \mathrm{NL}(\theta | \mu, \sigma, \alpha, \beta)}{p(theta) = NL(theta | mu, sigma, alpha, beta)} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: scale parameter \eqn{\sigma > 0}{sigma > 0} \item Parameter 3: shape parameter \eqn{\alpha > 0}{alpha > 0} \item Parameter 4: shape parameter \eqn{\beta > 0}{beta > 0} \item Mean: \item Variance: \item Mode: } The normal-Laplace (NL) distribution is the convolution of a normal distribution and a skew-Laplace distribution. When the NL distribution is symmetric (when \eqn{\alpha = \beta}{alpha = beta}), it behaves somewhat like the normal distribution in the middle of its range, somewhat like the Laplace distribution in its tails, and functions generally between the normal and Laplace distributions. Skewness is parameterized by including a skew-Laplace component. It may be applied, for example, to the logarithmic price of a financial instrument. Parameters \eqn{\alpha}{alpha} and \eqn{\beta}{beta} determine the behavior in the left and right tails, respectively. A small value corresponds to heaviness in the corresponding tail. As \eqn{\sigma}{sigma} approaches zero, the NL distribution approaches a skew-Laplace distribution. As \eqn{\beta}{beta} approaches infinity, the NL distribution approaches a normal distribution, though it never quite reaches it. } \value{ \code{dnormlaplace} gives the density, and \code{rnormlaplace} generates random deviates. } \references{ Reed, W.J. (2006). "The Normal-Laplace Distribution and Its Relatives". In \emph{Advances in Distribution Theory, Order Statistics and Inference}, p. 61--74, Birkhauser, Boston. } \seealso{ \code{\link{dalaplace}}, \code{\link{dallaplace}}, \code{\link{daml}}, \code{\link{dlaplace}}, and \code{\link{dnorm}} } \examples{ library(LaplacesDemon) x <- dnormlaplace(1,0,1,0.5,2) x <- rnormlaplace(100,0,1,0.5,2) #Plot Probability Functions x <- seq(from=-5, to=5, by=0.1) plot(x, dlaplace(x,0,0.5), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dlaplace(x,0,1), type="l", col="green") lines(x, dlaplace(x,0,2), type="l", col="blue") legend(2, 0.9, expression(paste(mu==0, ", ", lambda==0.5), paste(mu==0, ", ", lambda==1), paste(mu==0, ", ", lambda==2)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/dist.Inverse.Gaussian.Rd0000755000176200001440000000623415144316355020170 0ustar liggesusers\name{dist.Inverse.Gaussian} \alias{dinvgaussian} \alias{rinvgaussian} \title{Inverse Gaussian Distribution} \description{ This is the density function and random generation from the inverse gaussian distribution. } \usage{ dinvgaussian(x, mu, lambda, log=FALSE) rinvgaussian(n, mu, lambda) } \arguments{ \item{n}{This is the number of draws from the distribution.} \item{x}{This is the scalar location to evaluate density.} \item{mu}{This is the mean parameter, \eqn{\mu}{mu}.} \item{lambda}{This is the inverse-variance parameter, \eqn{\lambda}{lambda}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{\lambda}{(2 \pi \theta^3)^{1/2}} \exp(-\frac{\lambda (\theta - \mu)^2}{2 \mu^2 \theta}), \theta > 0}{p(theta) = (lambda / (2*pi*theta^3))^(1/2) * exp(-((lambda*(theta-mu)^2) / (2*mu^2*theta))), theta > 0} \item Inventor: Schrodinger (1915) \item Notation 1: \eqn{\theta \sim \mathcal{N}^{-1}(\mu, \lambda)}{theta ~ N^-1(mu, lambda)} \item Notation 2: \eqn{p(\theta) = \mathcal{N}^{-1}(\theta | \mu, \lambda)}{p(theta) = N^-1(theta | mu, lambda)} \item Parameter 1: shape \eqn{\mu > 0}{mu > 0} \item Parameter 2: scale \eqn{\lambda > 0}{lambda > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = \frac{\mu^3}{\lambda}}{var(theta) = mu^3/lambda} \item Mode: \eqn{mode(\theta) = \mu((1 + \frac{9 \mu^2}{4 \lambda^2})^{1/2} - \frac{3 \mu}{2 \lambda})}{mode(theta) = mu*((1 + ((9*mu^2)/(4*lambda^2)))^(1/2) - \frac{3*mu}{2*lambda})} } The inverse-Gaussian distribution, also called the Wald distribution, is used when modeling dependent variables that are positive and continuous. When \eqn{\lambda \rightarrow \infty}{lambda tends to infinity} (or variance to zero), the inverse-Gaussian distribution becomes similar to a normal (Gaussian) distribution. The name, inverse-Gaussian, is misleading, because it is not the inverse of a Gaussian distribution, which is obvious from the fact that \eqn{\theta}{theta} must be positive. } \value{ \code{dinvgaussian} gives the density and \code{rinvgaussian} generates random deviates. } \references{ Schrodinger E. (1915). "Zur Theorie der Fall-und Steigversuche an Teilchenn mit Brownscher Bewegung". \emph{Physikalische Zeitschrift}, 16, p. 289--295. } \seealso{ \code{\link{dnorm}}, \code{\link{dnormp}}, and \code{\link{dnormv}}. } \examples{ library(LaplacesDemon) x <- dinvgaussian(2, 1, 1) x <- rinvgaussian(10, 1, 1) #Plot Probability Functions x <- seq(from=1, to=20, by=0.1) plot(x, dinvgaussian(x,1,0.5), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dinvgaussian(x,1,1), type="l", col="green") lines(x, dinvgaussian(x,1,5), type="l", col="blue") legend(2, 0.9, expression(paste(mu==1, ", ", sigma==0.5), paste(mu==1, ", ", sigma==1), paste(mu==1, ", ", sigma==5)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution} LaplacesDemon/man/BayesFactor.Rd0000755000176200001440000002455515144316355016252 0ustar liggesusers\name{BayesFactor} \alias{BayesFactor} \title{Bayes Factor} \description{ This function calculates Bayes factors for two or more fitted objects of class \code{demonoid}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb} that were estimated respectively with the \code{\link{LaplacesDemon}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}} functions, and indicates the strength of evidence in favor of the hypothesis (that each model, \eqn{\mathcal{M}_i}{M[i]}, is better than another model, \eqn{\mathcal{M}_j}{M[j]}). } \usage{ BayesFactor(x) } \arguments{ \item{x}{This is a list of two or more fitted objects of class \code{demonoid}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}. The components are named in order beginning with model 1, \code{M1}, and \eqn{k} models are usually represented as \eqn{\mathcal{M}_1,\dots,\mathcal{M}_k}{M[1],...,M[k]}.} } \details{ Introduced by Harold Jeffreys, a 'Bayes factor' is a Bayesian alternative to frequentist hypothesis testing that is most often used for the comparison of multiple models by hypothesis testing, usually to determine which model better fits the data (Jeffreys, 1961). Bayes factors are notoriously difficult to compute, and the Bayes factor is only defined when the marginal density of \eqn{\textbf{y}}{y} under each model is proper (see \code{\link{is.proper}}). However, the Bayes factor is easy to approximate with the Laplace-Metropolis estimator (Lewis and Raftery, 1997) and other methods of approximating the logarithm of the marginal likelihood (for more information, see \code{\link{LML}}). Hypothesis testing with Bayes factors is more robust than frequentist hypothesis testing, since the Bayesian form avoids model selection bias, evaluates evidence in favor of the null hypothesis, includes model uncertainty, and allows non-nested models to be compared (though of course the model must have the same dependent variable). Also, frequentist significance tests become biased in favor of rejecting the null hypothesis with sufficiently large sample size. The Bayes factor for comparing two models may be approximated as the ratio of the marginal likelihood of the data in model 1 and model 2. Formally, the Bayes factor in this case is \deqn{B = \frac{p(\textbf{y}|\mathcal{M}_1)}{p(\textbf{y}|\mathcal{M}_2)} = \frac{\int p(\textbf{y}|\Theta_1,\mathcal{M}_1)p(\Theta_1|\mathcal{M}_1)d\Theta_1}{\int p(\textbf{y}|\Theta_2,\mathcal{M}_2)p(\Theta_2|\mathcal{M}_2)d\Theta_2}}{B = (p(y|M_1)) / p(y|M_2) = (integral of p(y|Theta_1,M_1)p(Theta_1|M_1)dTheta_1) / (integral of p(y|Theta_2,M_2)p(Theta_2|M_2)dTheta_2)} where \eqn{p(\textbf{y}|\mathcal{M}_1)}{p(y|M_1)} is the marginal likelihood of the data in model 1. The \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}} functions each return the \code{\link{LML}}, the approximate logarithm of the marginal likelihood of the data, in each fitted object of class \code{iterquad}, \code{laplace}, \code{demonoid}, \code{pmc}, or \code{vb}. The \code{BayesFactor} function calculates matrix \code{B}, a matrix of Bayes factors, where each element of matrix \code{B} is a comparison of two models. Each Bayes factor is calculated as the exponentiated difference of \code{LML} of model 1 (\eqn{\mathcal{M}_1}{M[1]}) and \code{LML} of model 2 (\eqn{\mathcal{M}_2}{M[2]}), and the hypothesis for each element of matrix \code{B} is that the model associated with the row is greater than the model associated with the column. For example, element \code{B[3,2]} is the Bayes factor that model 3 is greater than model 2. The 'Strength of Evidence' aids in the interpretation (Jeffreys, 1961). A table for the interpretation of the strength of evidence for Bayes factors is available at \url{https://web.archive.org/web/20150214194051/http://www.bayesian-inference.com/bayesfactors}. Each Bayes factor, \code{B}, is the posterior odds in favor of the hypothesis divided by the prior odds in favor of the hypothesis, where the hypothesis is usually \eqn{\mathcal{M}_1 > \mathcal{M}_2}{M[1] > M[2]}. For example, when \code{B[3,2]=2}, the data favor \eqn{\mathcal{M}_3}{M[3]} over \eqn{\mathcal{M}_2}{M[2]} with 2:1 odds. It is also popular to consider the natural logarithm of the Bayes factor. The scale of the logged Bayes factor is the same above and below one, which is more appropriate for visual comparisons. For example, when comparing two Bayes factors at 0.5 and 2, the logarithm of these Bayes factors is -0.69 and 0.69. Gelman finds Bayes factors generally to be irrelevant, because they compute the relative probabilities of the models conditional on one of them being true. Gelman prefers approaches that measure the distance of the data to each of the approximate models (Gelman et al., 2004, p. 180), such as with posterior predictive checks (see the \code{\link{predict.iterquad}} function regarding iterative quadrature, \code{\link{predict.laplace}} function in the context of Laplace Approximation, \code{\link{predict.demonoid}} function in the context of MCMC, \code{\link{predict.pmc}} function in the context of PMC, or \code{\link{predict.vb}} function in the context of Variational Bayes). Kass et al. (1995) asserts this can be done without assuming one model is the true model. } \value{ \code{BayesFactor} returns an object of class \code{bayesfactor} that is a list with the following components: \item{B}{This is a matrix of Bayes factors.} \item{Hypothesis}{ This is the hypothesis, and is stated as 'row > column', indicating that the model associated with the row of an element in matrix \code{B} is greater than the model associated with the column of that element.} \item{Strength.of.Evidence}{ This is the strength of evidence in favor of the hypothesis.} \item{Posterior.Probability}{ This is a vector of the posterior probability of each model, given flat priors.} } \references{ Gelman, A., Carlin, J., Stern, H., and Rubin, D. (2004). "Bayesian Data Analysis, Texts in Statistical Science, 2nd ed.". Chapman and Hall, London. Jeffreys, H. (1961). "Theory of Probability, Third Edition". Oxford University Press: Oxford, England. Kass, R.E. and Raftery, A.E. (1995). "Bayes Factors". \emph{Journal of the American Statistical Association}, 90(430), p. 773--795. Lewis, S.M. and Raftery, A.E. (1997). "Estimating Bayes Factors via Posterior Simulation with the Laplace-Metropolis Estimator". \emph{Journal of the American Statistical Association}, 92, p. 648--655. } \author{Statisticat, LLC.} \seealso{ \code{\link{is.bayesfactor}}, \code{\link{is.proper}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LML}}, \code{\link{PMC}}, \code{\link{predict.demonoid}}, \code{\link{predict.iterquad}}, \code{\link{predict.laplace}}, \code{\link{predict.pmc}}, \code{\link{predict.vb}}, and \code{\link{VariationalBayes}}. } \examples{ # The following example fits a model as Fit1, then adds a predictor, and # fits another model, Fit2. The two models are compared with Bayes # factors. library(LaplacesDemon) ############################## Demon Data ############################### data(demonsnacks) J <- 2 y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,10]+1))) X[,2] <- CenterScale(X[,2]) ######################### Data List Preparation ######################### mon.names <- "LP" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ########################## Model Specification ########################## Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(Data$X, t(beta)) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + beta.prior + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } ############################ Initial Values ############################# Initial.Values <- GIV(Model, MyData, PGF=TRUE) ######################## Laplace Approximation ########################## Fit1 <- LaplaceApproximation(Model, Initial.Values, Data=MyData, Iterations=10000) Fit1 ############################## Demon Data ############################### data(demonsnacks) J <- 3 y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) X[,2] <- CenterScale(X[,2]) X[,3] <- CenterScale(X[,3]) ######################### Data List Preparation ######################### mon.names <- c("sigma","mu[1]") parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) return(c(rnormv(Data$J,0,10), rhalfcauchy(1,5))) MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ############################ Initial Values ############################# Initial.Values <- GIV(Model, MyData, PGF=TRUE) ######################## Laplace Approximation ########################## Fit2 <- LaplaceApproximation(Model, Initial.Values, Data=MyData, Iterations=10000) Fit2 ############################# Bayes Factor ############################## Model.list <- list(M1=Fit1, M2=Fit2) BayesFactor(Model.list) } \keyword{Bayes Factor} \keyword{Hypothesis Testing} \keyword{Model Selection} LaplacesDemon/man/as.ppc.Rd0000755000176200001440000000270715144316355015227 0ustar liggesusers\name{as.ppc} \alias{as.ppc} \title{As Posterior Predictive Check} \description{ This function converts an object of class \code{demonoid.val} to an object of class \code{demonoid.ppc}. } \usage{ as.ppc(x, set=3) } \arguments{ \item{x}{This is an object of class \code{demonoid.val}.} \item{set}{This is an integer that indicates which list component is to be used. When \code{set=1}, the modeled data set is used. When \code{set=2}, the validation data set is used. When \code{set=3}, both data sets are used.} } \details{ After using the \code{\link{Validate}} function for holdout validation, it is often suggested to perform posterior predictive checks. The \code{as.ppc} function converts the output object of \code{\link{Validate}}, which is an object of class \code{demonoid.val}, to an object of class \code{demonoid.ppc}. The returned object is the same as if it were created with the \code{\link{predict.demonoid}} function, rather than the \code{\link{Validate}} function. After this conversion, the user may use posterior predictive checks, as usual, with the \code{\link{summary.demonoid.ppc}} function. } \value{ The returned object is an object of class \code{demonoid.ppc}. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{predict.demonoid}}, \code{\link{summary.demonoid.ppc}}, and \code{\link{Validate}}. } \keyword{Initial Values}LaplacesDemon/man/joint.pr.plot.Rd0000755000176200001440000000274515144316355016565 0ustar liggesusers\name{joint.pr.plot} \alias{joint.pr.plot} \title{Joint Probability Region Plot} \description{ Given two vectors, the \code{joint.pr.plot} function creates a scatterplot with ellipses of probability regions. } \usage{ joint.pr.plot(x, y, quantiles=c(0.25,0.50,0.75,0.95)) } \arguments{ \item{x}{This required argument is a vector.} \item{y}{This required argument is a vector.} \item{quantiles}{These are the quantiles for which probability regions are estimated with ellipses. The center of the ellipse is plotted by default. The 0.95 quantile creates a probability region that contains approximately 95\% of the data or samples of \code{x} and \code{y}. By default, four quantiles are included.} } \details{ A probability region is also commonly called a credible region. For more information on probability regions, see \code{\link{p.interval}}. Joint probability regions are plotted only for two variables, and the regions are estimated with functions modified from the \code{car} package. The internal ellipse functions assume bivariate normality. This function is often used to plot posterior distributions of samples, such as from the \code{\link{LaplacesDemon}} function. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplacesDemon}} and \code{\link{p.interval}} } \examples{ library(LaplacesDemon) x <- rnorm(100) y <- rnorm(100) joint.pr.plot(x, y) } \keyword{Plot} LaplacesDemon/man/Validate.Rd0000755000176200001440000001531215144316355015570 0ustar liggesusers\name{Validate} \alias{Validate} \title{Holdout Validation} \description{ This function performs holdout validation on an object of class \code{demonoid} or \code{pmc}, given both a modeled and validation data set. } \usage{ Validate(object, Model, Data, plot=FALSE, PDF=FALSE) } \arguments{ \item{object}{This is an object of class \code{demonoid} or \code{pmc}.} \item{Model}{This is a model specification function for \code{\link{LaplacesDemon}} or \code{\link{PMC}}.} \item{Data}{This is a list that contains two lists of data, as specified for \code{\link{LaplacesDemon}}. The first component in the list is the list of modeled data, and the second component in the list is the list of validation data.} \item{plot}{Logical. When \code{plot=TRUE}, two plots are displayed. The upper plot shows the density of the modeled deviance in black and the density of the validation deviance in red. The lower plot shows the density of the change in deviance in gray. The \code{plot} argument defaults to \code{FALSE}.} \item{PDF}{Logical. When \code{PDF=TRUE} (and \code{plot=TRUE}), the plot is saved as a .pdf file. The \code{PDF} argument defaults to \code{FALSE}.} } \details{ There are numerous ways to validate a model. In this context, validation means to assess the predictive performance of a model on out-of-sample data. If reasonable, leave-one-out cross-validation (LOOCV) via the conditional predictive ordinate (CPO) should be considered when using \code{\link{LaplacesDemon}} or \code{\link{PMC}}. For more information on CPO, see the accompanying vignettes entitled "Bayesian Inference" and "Examples". CPO is unavailable when using \code{\link{LaplaceApproximation}} or \code{\link{VariationalBayes}}. For \code{\link{LaplaceApproximation}} or \code{\link{VariationalBayes}}, it is recommended that the user perform holdout validation by comparing posterior predictive checks, comparing the differences in the specified discrepancy measure. When LOOCV is unreasonable, popular alternatives include k-fold cross-validation and holdout validation. Although k-fold cross-validation is not performed explicitly here, the user may accomplish it with some effort. Of these methods, holdout validation includes the most bias, but is the most common in applied use, since only one model is fitted, rather than \eqn{k-1} models in k-fold cross-validation. The \code{Validate} function performs holdout validation. For holdout validation, the observed data is sampled randomly into two data sets of approximately equal size, or three data sets that consists of two data sets of approximately equal size and a remainder data set. Of the two data sets approximately equal in size, one is called the modeled (or training) data set, and the other is called the validation (or test) data set. The modeled data set is used when updating the model. After the model is updated, both data sets are predicted in the \code{Validate} function, given the model. Predictive loss is estimated for the validation data set, relative to the modeled data set. Predictive loss is associated with overfitting, differences between the model and validation data set, or model misspecification. Bayesian inference is reputed to be much more robust to overfitting than frequentist inference. There are many ways to measure predictive loss, and within each approach, there are usually numerous possible loss functions. The log-likelihood of the model is a popular approximate utility function, and consequently, the deviance of the model is a popular loss function. A vector of model-level (rather than record-level) deviance samples is returned with each object of class \code{demonoid} or \code{pmc}. The \code{Validate} function obtains this vector for each data set, and then calculates the Bayesian Predictive Information Criterion (BPIC), as per Ando (2007). BPIC is a variation of the Deviance Information Criterion (DIC) that has been modified for predictive distributions. For more information on DIC (Spiegelhalter et al., 2002), see the accompanying vignette entitled "Bayesian Inference". The goal is to minimize BPIC. When DIC is applied after the model, such as with a predictive distribution, it is positively biased, or too small. The bias is due to the same data \eqn{\textbf{y}}{y} being used both to construct the posterior distributions and to evaluate pD, the penalty term for model complexity. For example, for validation data set \eqn{\textbf{y}_{new}}{ynew}, BPIC is: \deqn{BPIC = -2\mathrm{log}[p(\textbf{y}_{new}|\textbf{y},\Theta)] + 2pD}{BPIC = -2log[p(ynew|y,Theta)] + 2pD} When \code{plot=TRUE}, the distributions of the modeled and validation deviances are plotted above, and the lower plot is the modeled deviance subtracted from the validation deviance. When positive, this distribution of the change in deviance is the loss in predictive deviance associated with moving from the modeled data set to the validation data set. After using the \code{Validate} function, the user is encouraged to perform posterior predictive checks on each data set via the \code{\link{summary.demonoid.ppc}} or \code{\link{summary.pmc.ppc}} function. } \value{ This function returns a list with three components. The first two components are also lists. Each list consists of \code{y}, \code{yhat}, and \code{Deviance}. The third component is a matrix that reports the expected deviance, pD, and BPIC. The object is of class \code{demonoid.val} for \code{\link{LaplacesDemon}}, or \code{pmc.val} when associated with \code{\link{PMC}}. } \references{ Ando, T. (2007). "Bayesian Predictive Information Criterion for the Evaluation of Hierarchical Bayesian and Empirical Bayes Models". \emph{Biometrika}, 94(2), p. 443--458. Spiegelhalter, D.J., Best, N.G., Carlin, B.P., and van der Linde, A. (2002). "Bayesian Measures of Model Complexity and Fit (with Discussion)". \emph{Journal of the Royal Statistical Society}, B 64, p. 583--639. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) #Given an object called Fit of class demonoid, a Model specification, #and a modeled data set (MyData.M) and validation data set (MyData.V): #Validate(Fit, Model, Data=list(MyData.M=MyData.M, MyData.V=MyData.V)) } \keyword{BPIC} \keyword{Model Selection} \keyword{Posterior Predictive Checks} \keyword{Utility} LaplacesDemon/man/dist.Laplace.Mixture.Rd0000755000176200001440000000631515144316355020001 0ustar liggesusers\name{dist.Laplace.Mixture} \alias{dlaplacem} \alias{plaplacem} \alias{rlaplacem} \title{Mixture of Laplace Distributions} \description{ These functions provide the density, cumulative, and random generation for the mixture of univariate Laplace distributions with probability \eqn{p}, location \eqn{\mu}{mu} and scale \eqn{\sigma}{sigma}. } \usage{ dlaplacem(x, p, location, scale, log=FALSE) plaplacem(q, p, location, scale) rlaplacem(n, p, location, scale) } \arguments{ \item{x,q}{This is vector of values at which the density will be evaluated.} \item{p}{This is a vector of length \eqn{M} of probabilities for \eqn{M} components. The sum of the vector must be one.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{location}{This is a vector of length \eqn{M} that is the location parameter \eqn{\mu}{mu}.} \item{scale}{This is a vector of length \eqn{M} that is the scale parameter \eqn{\sigma}{sigma}, which must be positive.} \item{log}{Logical. If \code{TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \sum p_i \mathcal{L}(\mu_i, \sigma_i)}{p(theta) = sum p[i] L(mu[i], sigma[i])} \item Inventor: Unknown \item Notation 1: \eqn{\theta \sim \mathcal{L}(\mu, \sigma)}{theta ~ L(mu, sigma)} \item Notation 2: \eqn{p(\theta) = \mathcal{L}(\theta | \mu, \sigma)}{p(theta) = L(theta | mu, sigma)} \item Parameter 1: location parameters \eqn{\mu}{mu} \item Parameter 2: scale parameters \eqn{\sigma > 0}{sigma > 0} \item Mean: \eqn{E(\theta) = \sum p_i \mu_i}{E(theta) = sum p[i] mu[i]} \item Variance: \item Mode: } A mixture distribution is a probability distribution that is a combination of other probability distributions, and each distribution is called a mixture component, or component. A probability (or weight) exists for each component, and these probabilities sum to one. A mixture distribution (though not these functions here in particular) may contain mixture components in which each component is a different probability distribution. Mixture distributions are very flexible, and are often used to represent a complex distribution with an unknown form. When the number of mixture components is unknown, Bayesian inference is the only sensible approach to estimation. A Laplace mixture distribution is a combination of Laplace probability distributions. One of many applications of Laplace mixture distributions is the Laplace Mixture Model (LMM). } \value{ \code{dlaplacem} gives the density, \code{plaplacem} returns the CDF, and \code{rlaplacem} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{ddirichlet}} and \code{\link{dlaplace}}. } \examples{ library(LaplacesDemon) p <- c(0.3,0.3,0.4) mu <- c(-5, 1, 5) sigma <- c(1,2,1) x <- seq(from=-10, to=10, by=0.1) plot(x, dlaplacem(x, p, mu, sigma, log=FALSE), type="l") #Density plot(x, plaplacem(x, p, mu, sigma), type="l") #CDF plot(density(rlaplacem(10000, p, mu, sigma))) #Random Deviates } \keyword{Distribution}LaplacesDemon/man/LossMatrix.Rd0000755000176200001440000001602315144337635016150 0ustar liggesusers\name{LossMatrix} \alias{LossMatrix} \title{Loss Matrix} \description{ A loss matrix is useful in Bayesian decision theory for selecting the Bayes action, the optimal Bayesian decision, when there are a discrete set of possible choices (actions) and a discrete set of possible outcomes (states of the world). The Bayes action is the action that minimizes expected loss, which is equivalent to maximizing expected utility. } \usage{ LossMatrix(L, p.theta) } \arguments{ \item{L}{This required argument accepts a \eqn{S \times A}{S x A} matrix or \eqn{S \times A \times N}{S x A x N} array of losses, where \eqn{S} is the number of states of the world, \eqn{A} is the number of actions, and \eqn{N} is the number of samples. These losses have already been estimated, given a personal loss function. One or more personal losses has already been estimated for each combination of possible actions \eqn{a=1,\dots,A}{a=1,...,A} and possible states \eqn{s=1,\dots,S}{s=1,...,S}.} \item{p.theta}{This required argument accepts a \eqn{S \times A}{S x A} matrix or \eqn{S \times A \times N}{S x A x N} array of state prior probabilities, where \eqn{S} is the number of states of the world, \eqn{A} is the number of actions, and \eqn{N} is the number of samples. The sum of each column must equal one.} } \details{ Bayesian inference is often tied to decision theory (Bernardo and Smith, 2000), and decision theory has long been considered the foundations of statistics (Savage, 1954). Before using the \code{LossMatrix} function, the user should have already considered all possible actions (choices), states of the world (outcomes unknown at the time of decision-making), chosen a loss function \eqn{L(\theta, \alpha)}{L(theta, alpha)}, estimated loss, and elicited prior probabilities \eqn{p(\theta | x)}{p(theta | x)}. Although possible actions (choices) for the decision-maker and possible states (outcomes) may be continuous or discrete, the loss matrix is used for discrete actions and states. An example of a continuous action may be that a decision-maker has already decided to invest, and the remaining, current decision is how much to invest. Likewise, an example of continuous states of the world (outcomes) may be how much profit or loss may occur after a given continuous unit of time. The coded example provided below is taken from Berger (1985, p. 6-7) and described here. The set of possible actions for a decision-maker is to invest in bond ZZZ or alternatively in bond XXX, as it is called here. A real-world decision should include a mutually exhaustive list of actions, such as investing in neither, but perhaps the decision-maker has already decided to invest and narrowed the options down to these two bonds. The possible states of the world (outcomes unknown at the time of decision-making) are considered to be two states: either the chosen bond will not default or it will default. Here, the loss function is a negative linear identity of money, and hence a loss in element \code{L[1,1]} of -500 is a profit of 500, while a loss in \code{L[2,1]} of 1,000 is a loss of 1,000. The decision-maker's dilemma is that bond ZZZ may return a higher profit than bond XXX, however there is an estimated 10\% chance, the prior probability, that bond ZZZ will default and return a substantial loss. In contrast, bond XXX is considered to be a sure-thing and return a steady but smaller profit. The Bayes action is to choose the first action and invest in bond ZZZ, because it minimizes expected loss, even though there is a chance of default. A more realistic application of a loss matrix may be to replace the point-estimates of loss with samples given uncertainty around the estimated loss, and replace the point-estimates of the prior probability of each state with samples given the uncertainty of the probability of each state. The loss function used in the example is intuitive, but a more popular monetary loss function may be \eqn{-\log(E(W | R))}{-log(E(W | R))}, the negative log of the expectation of wealth, given the return. There are many alternative loss functions. Although isolated decision-theoretic problems exist such as the provided example, decision theory may also be applied to the results of a probability model (such as from \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}), or \code{\link{VariationalBayes}}, contingent on how a decision-maker is considering to use the information from the model. The statistician may pass the results of a model to a client, who then considers choosing possible actions, given this information. The statistician should further assist the client with considering actions, states of the world, then loss functions, and finally eliciting the client's prior probabilities (such as with the \code{\link{elicit}} function). When the outcome is finally observed, the information from this outcome may be used to refine the priors of the next such decision. In this way, Bayesian learning occurs. } \value{ The \code{LossMatrix} function returns a list with two components: \item{BayesAction}{This is a numeric scalar that indicates the action that minimizes expected loss.} \item{E.Loss}{This is a vector of expected losses, one for each action.} } \references{ Berger, J.O. (1985). "Statistical Decision Theory and Bayesian Analysis", Second Edition. Springer: New York, NY. Bernardo, J.M. and Smith, A.F.M. (2000). "Bayesian Theory". John Wiley & Sons: West Sussex, England. Savage, L.J. (1954). "The Foundations of Statistics". John Wiley & Sons: West Sussex, England. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{elicit}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) ### Point-estimated loss and state probabilities L <- matrix(c(-500,1000,-300,-300), 2, 2) rownames(L) <- c("s[1]: !Defaults","s[2]: Defaults") colnames(L) <- c("a[1]: Buy ZZZ", "a[2]: Buy XXX") L p.theta <- matrix(c(0.9, 0.1, 1, 0), 2, 2) Fit <- LossMatrix(L, p.theta) ### Point-estimated loss and samples of state probabilities L <- matrix(c(-500,1000,-300,-300), 2, 2) rownames(L) <- c("s[1]: Defaults","s[2]: !Defaults") colnames(L) <- c("a[1]: Buy ZZZ", "a[2]: Buy XXX") L p.theta <- array(runif(4000), dim=c(2,2,1000)) #Random probabilities, #just for a quick example. And, since they must sum to one: for (i in 1:1000) { p.theta[,,i] <- p.theta[,,i] / matrix(colSums(p.theta[,,i]), dim(p.theta)[1], dim(p.theta)[2], byrow=TRUE)} Fit <- LossMatrix(L, p.theta) Fit ### Point-estimates of loss may be replaced with samples as well. } \keyword{Decision Theory} \keyword{Utility} LaplacesDemon/man/dist.Matrix.Normal.Rd0000755000176200001440000000646515144316355017505 0ustar liggesusers\name{dist.Matrix.Normal} \alias{dmatrixnorm} \alias{rmatrixnorm} \title{Matrix Normal Distribution} \description{ These functions provide the density and random number generation for the matrix normal distribution. } \usage{ dmatrixnorm(X, M, U, V, log=FALSE) rmatrixnorm(M, U, V) } \arguments{ \item{X}{This is data or parameters in the form of a matrix with \eqn{n} rows and \eqn{k} columns.} \item{M}{This is mean matrix with \eqn{n} rows and \eqn{k} columns.} \item{U}{This is a \eqn{n \times n}{n x n} positive-definite scale matrix.} \item{V}{This is a \eqn{k \times k}{k x k} positive-definite scale matrix.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate Matrix \item Density: \eqn{p(\theta) = \frac{\exp(-0.5tr[V^{-1}(X-M)'U^{-1}(X-M)])}{(2\pi)^{nk/2}|V|^{n/2}|U|^{k/2}}}{p(theta) = exp(-0.5tr[V^(-1)(X-M)'U^(-1)(X-M)])/[(2*pi)^(nk/2)|V|^(n/2)|U|(k/2)]} \item Inventors: Unknown \item Notation 1: \eqn{\theta \sim \mathcal{MN}_{n \times k}(M, U, V)}{theta ~ MN[n x k](M, U, V)} \item Notation 2: \eqn{p(\theta) = \mathcal{MN}_{n \times k}(\theta | M, U, V)}{p(theta) = MN[n x k](theta | M, U, V)} \item Parameter 1: location \eqn{n \times k}{n x k} matrix \eqn{M} \item Parameter 2: positive-definite \eqn{n \times n}{n x n} scale matrix \eqn{U} \item Parameter 3: positive-definite \eqn{k \times k}{k x k} scale matrix \eqn{V} \item Mean: \eqn{E(\theta) = M}{E(theta) = M} \item Variance: Unknown \item Mode: Unknown } The matrix normal distribution is also called the matrix Gaussian, matrix-variate normal, or matrix-variate Gaussian distribution. It is a generalization of the multivariate normal distribution to matrix-valued random variables. An example of the use of a matrix normal distribution is multivariate regression, in which there is a \eqn{j \times k}{j x k} matrix of regression effects of \eqn{j} predictors for \eqn{k} dependent variables. For univariate regression, having only one dependent variable, the \eqn{j} regression effects may be multivariate normally distributed. For multivariate regression, this multivariate normal distribution may be extended to a matrix normal distribution to account for relationships of the regression effects across \eqn{k} dependent variables. In this example, the matrix normal distribution is the conjugate prior distribution for these regression effects. The matrix normal distribution has two covariance matrices, one for the rows and one for the columns. When \eqn{U} is diagonal, the rows are independent. When \eqn{V} is diagonal, the columns are independent. } \value{ \code{dmatrixnorm} gives the density and \code{rmatrixnorm} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dinvmatrixgamma}}, \code{\link{dmatrixgamma}}, and \code{\link{dmvn}}. } \examples{ library(LaplacesDemon) N <- 10 K <- 4 U <- as.positive.definite(matrix(rnorm(N*N),N,N)) V <- as.positive.definite(matrix(rnorm(K*K),K,K)) x <- dmatrixnorm(matrix(0,N,K), matrix(0,N,K), U, V) X <- rmatrixnorm(matrix(0,N,K), U, V) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/KS.Diagnostic.Rd0000755000176200001440000000462215144316355016441 0ustar liggesusers\name{KS.Diagnostic} \alias{KS.Diagnostic} \title{Kolmogorov-Smirnov Convergence Diagnostic} \description{ The Kolmogorov-Smirnov test is a nonparametric test of stationarity that has been applied as an MCMC diagnostic (Brooks et al, 2003), such as to the posterior samples from the \code{\link{LaplacesDemon}} function. The first and last halves of the chain are compared. This test assumes IID, which is violated in the presence of autocorrelation. The \code{KS.Diagnostic} is a univariate diagnostic that is usually applied to each marginal posterior distribution. A multivariate form is not included. By chance alone due to multiple independent tests, 5\% of the marginal posterior distributions should appear non-stationary when stationarity exists. Assessing multivariate convergence is difficult. } \usage{ KS.Diagnostic(x) } \arguments{ \item{x}{This is a vector of posterior samples for which a Kolmogorov-Smirnov test will be applied that compares the first and last halves for stationarity.} } \details{ There are two main approaches to using the Kolmogorov-Smirnov test as an MCMC diagnostic. There is a version of the test that has been adapted to account for autocorrelation (and is not included here). Otherwise, the chain is thinned enough that autocorrelation is not present or is minimized, in which case the two-sample Kolmogorov-Smirnov test is applied. The CDFs of both samples are compared. The \code{ks.test} function in base R is used. The advantage of the Kolmogorov-Smirnov test is that it is easier and faster to calculate. The disadvantages are that autocorrelation biases results, and the test is generally biased on the conservative side (indicating stationarity when it should not). } \value{ The \code{KS.Diagnostic} function returns a frequentist p-value, and stationarity is indicated when p > 0.05. } \references{ Brooks, S.P., Giudici, P., and Philippe, A. (2003). "Nonparametric Convergence Assessment for MCMC Model Selection". \emph{Journal of Computational and Graphical Statistics}. 12(1), p. 1--22. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{is.stationary}}, \code{\link{ks.test}}, and \code{\link{LaplacesDemon}}. } \examples{ library(LaplacesDemon) x <- rnorm(1000) KS.Diagnostic(x) } \keyword{Diagnostic} \keyword{MCMC} LaplacesDemon/man/summary.vb.ppc.Rd0000755000176200001440000004035615144316355016731 0ustar liggesusers\name{summary.vb.ppc} \alias{summary.vb.ppc} \title{Posterior Predictive Check Summary} \description{ This may be used to summarize either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}). Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is summarized, depending on \code{\link{predict.vb}}. } \usage{\method{summary}{vb.ppc}(object, Categorical, Rows, Discrep, d, Quiet, \dots)} \arguments{ \item{object}{An object of class \code{vb.ppc} is required.} \item{Categorical}{Logical. If \code{TRUE}, then \code{y} and \code{yhat} are considered to be categorical (such as y=0 or y=1), rather than continuous.} \item{Rows}{An optional vector of row numbers, for example \code{c(1:10)}. All rows will be estimated, but only these rows will appear in the summary.} \item{Discrep}{A character string indicating a discrepancy test. \code{Discrep} defaults to \code{NULL}. Valid character strings when \code{y} is continuous are: \code{"Chi-Square"}, \code{"Chi-Square2"}, \code{"Kurtosis"}, \code{"L-criterion"}, \code{"MASE"}, \code{"MSE"}, \code{"PPL"}, \code{"Quadratic Loss"}, \code{"Quadratic Utility"}, \code{"RMSE"}, \code{"Skewness"}, \code{"max(yhat[i,]) > max(y)"}, \code{"mean(yhat[i,]) > mean(y)"}, \code{"mean(yhat[i,] > d)"}, \code{"mean(yhat[i,] > mean(y))"}, \code{"min(yhat[i,]) < min(y)"}, \code{"round(yhat[i,]) = d"}, and \code{"sd(yhat[i,]) > sd(y)"}. Valid character strings when \code{y} is categorical are: \code{"p(yhat[i,] != y[i])"}. Kurtosis and skewness are not discrepancies, but are included here for convenience.} \item{d}{This is an optional integer to be used with the \code{Discrep} argument above, and it defaults to \code{d=0}.} \item{Quiet}{This logical argument defaults to \code{FALSE} and will print results to the console. When \code{TRUE}, results are not printed.} \item{\dots}{Additional arguments are unused.} } \details{ This function summarizes an object of class \code{vb.ppc}, which consists of posterior predictive checks on either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]}, depending respectively on whether unobserved instances of \eqn{\textbf{y}}{y} or the model sample of \eqn{\textbf{y}}{y} was used in the \code{\link{predict.vb}} function. The deviance and monitored variables are also summarized. The purpose of a posterior predictive check is to assess how well (or poorly) the model fits the data, or to assess discrepancies between the model and the data. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. When \eqn{\textbf{y}}{y} is continuous and known, this function estimates the predictive concordance between \eqn{\textbf{y}}{y} and \eqn{\textbf{y}^{rep}}{y[rep]} as per Gelfand (1996), and the predictive quantile (PQ), which is for record-level outlier detection used to calculate Gelfand's predictive concordance. When \eqn{\textbf{y}}{y} is categorical and known, this function estimates the record-level lift, which is \code{p(yhat[i,] = y[i]) / [p(y = j) / n]}, or the number of correctly predicted samples over the rate of that category of \eqn{\textbf{y}}{y} in vector \eqn{\textbf{y}}{y}. A discrepancy measure is an approach to studying discrepancies between the model and data (Gelman et al., 1996). Below is a list of discrepancy measures, followed by a brief introduction to discrepancy analysis: \itemize{ \item The \code{"Chi-Square"} discrepancy measure is the chi-square goodness-of-fit test that is recommended by Gelman. For each record i=1:N, this returns (y[i] - E(y[i]))^2 / var(yhat[i,]). \item The \code{"Chi-Square2"} discrepancy measure returns the following for each record: Pr(chisq.rep[i,] > chisq.obs[i,]), where chisq.obs[i,] <- (y[i] - E(y[i]))^2 / E(y[i]), and chisq.rep[i,] <- (yhat[i,] - E(yhat[i,]))^2 / E(yhat[i,]), and the overall discrepancy is the percent of records that were outside of the 95\% quantile-based probability interval (see \code{\link{p.interval}}). \item The \code{"Kurtosis"} discrepancy measure returns the kurtosis of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding kurtotic replicate distributions. \item The \code{"L-criterion"} discrepancy measure of Laud and Ibrahim (1995) provides the record-level combination of two components (see below), and the discrepancy statistic is the sum, \code{L}, as well as a calibration number, \code{S.L}. For more information on the L-criterion, see the accompanying vignette entitled "Bayesian Inference". \item The \code{"MASE"} (Mean Absolute Scaled Error) is a discrepancy measure for the accuracy of time-series forecasts, estimated as \code{(|y - yhat|) / mean(abs(diff(y)))}. The discrepancy statistic is the mean of the record-level values. \item The \code{"MSE"} (Mean Squared Error) discrepancy measure provides the MSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level MSEs. MSE and quadratic loss are identical. \item The \code{"PPL"} (Posterior Predictive Loss) discrepancy measure of Gelfand and Ghosh (1998) provides the record-level combination of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The \code{d=0} argument applies the following weight to the accuracy component, which is then added to the variance component: \eqn{d/(d+1)}. For \eqn{\textbf{y}^{new}}{y[new]}, use \eqn{d=0}. For \eqn{\textbf{y}^{rep}}{y[rep]} and model comparison, \eqn{d} is commonly set to 1, 10, or 100000. Larger values of \eqn{d} put more stress on fit and downgrade the precision of the estimates. \item The \code{"Quadratic Loss"} discrepancy measure provides the mean quadratic loss for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic losses. Quadratic loss and MSE are identical, and quadratic loss is the negative of quadratic utility. \item The \code{"Quadratic Utility"} discrepancy measure provides the mean quadratic utility for each record across all replicates, and the discrepancy statistic is the mean of the record-level mean quadratic utilities. Quadratic utility is the negative of quadratic loss. \item The \code{"RMSE"} (Root Mean Squared Error) discrepancy measure provides the RMSE for each record across all replicates, and the discrepancy statistic is the mean of the record-level RMSEs. \item The \code{"Skewness"} discrepancy measure returns the skewness of \eqn{\textbf{y}^{rep}}{y[rep]} for each record, and the discrepancy statistic is the mean for all records. This does not measure discrepancies between the model and data, and is useful for finding skewed replicate distributions. \item The \code{"max(yhat[i,]) > max(y)"} discrepancy measure returns a record-level indicator when a record's maximum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} exceeds the maximum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications that exceed the maximum of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,]) > mean(y)"} discrepancy measure returns a record-level indicator when the mean of a record's \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is greater than the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with mean replications that exceed the mean of \eqn{\textbf{y}}{y}. \item The \code{"mean(yhat[i,] > d)"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds a specified value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"mean(yhat[i,] > mean(y))"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that exceeds the mean of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"min(yhat[i,]) < min(y)"} discrepancy measure returns a record-level indicator when a record's minimum \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is less than the minimum of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with replications less than the minimum of \eqn{\textbf{y}}{y}. \item The \code{"round(yhat[i,]) = d"} discrepancy measure returns a record-level proportion of \eqn{\textbf{y}^{rep}_i}{y[rep][i]} that, when rounded, is equal to a specified discrete value, \code{d}. The discrepancy statistic is the mean of the record-level proportions. \item The \code{"sd(yhat[i,]) > sd(y)"} discrepancy measure returns a record-level indicator when the standard deviation of replicates is larger than the standard deviation of all of \eqn{\textbf{y}}{y}. The discrepancy statistic is the mean of the record-level indicators, reporting the proportion of records with larger standard deviations than \eqn{\textbf{y}}{y}. \item The \code{"p(yhat[i,] != y[i])"} discrepancy measure returns the record-level probability that \eqn{\textbf{y}^{rep}_i}{y[rep][i]} is not equal to \eqn{\textbf{y}}{y}. This is valid when \eqn{\textbf{y}}{y} is categorical and \code{yhat} is the predicted category. The probability is the proportion of replicates. } After observing a discrepancy statistic, the user attempts to improve the model by revising the model to account for discrepancies between data and the current model. This approach to model revision relies on an analysis of the discrepancy statistic. Given a discrepancy measure that is based on model fit, such as the L-criterion, the user may correlate the record-level discrepancy statistics with the dependent variable, independent variables, and interactions of independent variables. The discrepancy statistic should not correlate with the dependent and independent variables. Interaction variables may be useful for exploring new relationships that are not in the current model. Alternatively, a decision tree may be applied to the record-level discrepancy statistics, given the independent variables, in an effort to find relationships in the data that may be helpful in the model. Model revision may involve the addition of a finite mixture component to account for outliers in discrepancy, or specifying the model with a distribution that is more robust to outliers. There are too many suggestions to include here, and discrepancy analysis varies by model. } \value{ This function returns a list with the following components: \item{BPIC}{The Bayesian Predictive Information Criterion (BPIC) was introduced by Ando (2007). BPIC is a variation of the Deviance Information Criterion (DIC) that has been modified for predictive distributions. For more information on DIC (Spiegelhalter et al., 2002), see the accompanying vignette entitled "Bayesian Inference". \eqn{BPIC = Dbar + 2pD}. The goal is to minimize BPIC.} \item{Concordance}{This is the percentage of the records of y that are within the 95\% quantile-based probability interval (see \code{\link{p.interval}}) of \eqn{\textbf{y}^{rep}}{y[rep]}. Gelfand's suggested goal is to achieve 95\% predictive concordance. Lower percentages indicate too many outliers and a poor fit of the model to the data, and higher percentages may suggest overfitting. Concordance occurs only when \eqn{\textbf{y}}{y} is continuous.} \item{Mean Lift}{This is the mean of the record-level lifts, and occurs only when \eqn{\textbf{y}}{y} is specified as categorical with \code{Categorical=TRUE}.} \item{Discrepancy.Statistic}{This is only reported if the \code{Discrep} argument receives a valid discrepancy measure as listed above. The \code{Discrep} applies to each record of \eqn{\textbf{y}}{y}, and the \code{Discrepancy.Statistic} reports the results of the discrepancy measure on the entire data set. For example, if \code{Discrep="min(yhat[i,]) < min(y)"}, then the overall result is the proportion of records in which the minimum sample of yhat was less than the overall minimum \eqn{\textbf{y}}{y}. This is \code{Pr(min(yhat[i,]) < min(y) | y, Theta)}, where \code{Theta} is the parameter set.} \item{L-criterion}{The L-criterion (Laud and Ibrahim, 1995) was developed for model and variable selection. It is a sum of two components: one involves the predictive variance and the other includes the accuracy of the means of the predictive distribution. The L-criterion measures model performance with a combination of how close its predictions are to the observed data and variability of the predictions. Better models have smaller values of \code{L}. \code{L} is measured in the same units as the response variable, and measures how close the data vector \eqn{\textbf{y}}{y} is to the predictive distribution. In addition to the value of \code{L}, there is a value for \code{S.L}, which is the calibration number of \code{L}, and is useful in determining how much of a decrease is necessary between models to be noteworthy.} \item{Monitor}{This is a \eqn{N \times 5}{N x 5} matrix, where \eqn{N} is the number of monitored variables and there are 5 columns, as follows: Mean, SD, LB (the 2.5\% quantile), Median, and UB (the 97.5\% quantile).} \item{Summary}{When \eqn{\textbf{y}}{y} is continuous, this is a \eqn{N \times 8}{N x 8} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and there are 8 columns, as follows: y, Mean, SD, LB (the 2.5\% quantile), Median, UB (the 97.5\% quantile), PQ (the predictive quantile, which is \eqn{Pr(\textbf{y}^{rep} \ge \textbf{y})}{Pr(y[rep] >= y)}), and Test, which shows the record-level result of a test, if specified. When \eqn{\textbf{y}}{y} is categorical, this matrix has a number of columns equal to the number of categories of \eqn{\textbf{y}}{y} plus 3, also including \code{y}, \code{Lift}, and \code{Discrep}.} } \references{ Ando, T. (2007). "Bayesian Predictive Information Criterion for the Evaluation of Hierarchical Bayesian and Empirical Bayes Models". \emph{Biometrika}, 94(2), p. 443--458. Gelfand, A. (1996). "Model Determination Using Sampling Based Methods". In Gilks, W., Richardson, S., Spiegehalter, D., Chapter 9 in Markov Chain Monte Carlo in Practice. Chapman and Hall: Boca Raton, FL. Gelfand, A. and Ghosh, S. (1998). "Model Choice: A Minimum Posterior Predictive Loss Approach". \emph{Biometrika}, 85, p. 1--11. Gelman, A., Meng, X.L., and Stern H. (1996). "Posterior Predictive Assessment of Model Fitness via Realized Discrepancies". \emph{Statistica Sinica}, 6, p. 733--807. Laud, P.W. and Ibrahim, J.G. (1995). "Predictive Model Selection". \emph{Journal of the Royal Statistical Society}, B 57, p. 247--262. Spiegelhalter, D.J., Best, N.G., Carlin, B.P., and van der Linde, A. (2002). "Bayesian Measures of Model Complexity and Fit (with Discussion)". \emph{Journal of the Royal Statistical Society}, B 64, p. 583--639. } \author{Statisticat, LLC.} \seealso{ \code{\link{predict.vb}}, \code{\link{p.interval}}, and \code{\link{VariationalBayes}}. } \examples{### See the VariationalBayes function for an example.} \keyword{BPIC} \keyword{Chi-Square} \keyword{Kurtosis} \keyword{L-criterion} \keyword{MASE} \keyword{MSE} \keyword{Posterior Predictive Checks} \keyword{Posterior Predictive Loss} \keyword{Quadratic Loss} \keyword{Quadratic Utility} \keyword{RMSE} \keyword{Skewness} \keyword{summary} LaplacesDemon/man/dist.Zellner.Rd0000755000176200001440000001435315144316355016420 0ustar liggesusers\name{dist.Zellner} \alias{dhyperg} \alias{dzellner} \alias{rzellner} \title{Hyperprior-g Prior and Zellner's g-Prior} \description{ These functions provide the density of the hyper-g prior (Liang et al., 2008), and both the density and random generation of Zellner's g-prior (Zellner, 1986). } \usage{ dhyperg(g, alpha=3, log=FALSE) dzellner(beta, g, sigma, X, log=FALSE) rzellner(n, g, sigma, X) } \arguments{ \item{alpha}{This is a positive scale hyperhyperparameter that is proper when \eqn{\alpha > 2}{alpha > 2}. The default is \code{alpha=3}.} \item{beta}{This is regression effects \eqn{\beta}{beta}, a vector of length \eqn{J}.} \item{g}{This is hyperparameter \eqn{g}, a positive scalar.} \item{n}{This is the number of random deviates to generate.} \item{sigma}{This is the residual standard deviation \eqn{\sigma}{sigma}, a positive scalar.} \item{X}{This is a full-rank \eqn{N \times J}{N x J} design matrix \eqn{\textbf{X}}{X} for \eqn{N} records and \eqn{J} predictors, where \eqn{J+1 < N}. Zellner's g-prior has been extended (elsewhere) via singular value decomposition (SVD) to the case where \eqn{J > N}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = \frac{1}{(2\pi)^{J/2}|(g \sigma^2(\textbf{X}^T \textbf{X})^{-1})^{-1}|^{1/2}} \exp(-\frac{1}{2}(\theta - \mu)'(g \sigma^2(\textbf{X}^T \textbf{X})^{-1})^{-1}(\theta - \mu))}{p(theta) = (1/((2*pi)^(J/2)*|Sigma|^(1/2))) * exp(-(1/2)*(theta-mu)'*Sigma^(-1)*(theta-mu))} \item Inventor: Zellner, A. (1986) \item Notation 1: \eqn{\theta \sim \mathrm{N}_J(0, g \sigma^2(\textbf{X}^T \textbf{X})^{-1})}{theta ~ N[J](0, g sigma^2 (X^T X)^(-1))} \item Notation 2: \eqn{p(\theta) = \mathrm{N}_J(\theta | g, \sigma^2, \textbf{X})}{p(theta) = N[J](theta, g, sigma^2, X)} \item Parameter 1: location parameter \eqn{\beta}{beta} \item Parameter 2: scale parameter \eqn{g > 0} \item Parameter 3: scale parameter \eqn{\sigma^2 > 0}{sigma^2 > 0} \item Mean: \item Variance: \item Mode: } Zellner's g-prior is a popular, data-dependent, elliptical, improper, least-informative prior distribution on regression effects \eqn{\beta}{beta} in a Gaussian regression model. It is a particular form in the conjugate Normal-Gamma family. Zellner's g-prior is also used for estimating Bayes factors (for hypothesis testing) with a simpler form, as well as in model selection and variable selection. The marginal posterior distribution of regression effects \eqn{\beta}{beta} is multivariate t. One of many nice properties of Zellner's g-prior is that it adapts automatically to near-collinearity between different predictors. Zellner's g-prior puts most of its prior mass in the direction that causes the regression coefficients of correlated predictors to be smoothed away from each other. When coupled with model selection, Zellner's g-prior discourages highly collinear predictors from entering the models simultaneously by inducing a negative correlation between the coefficients. However, when it is desirable for collinear predictors to enter simultaneously, a modification has been proposed (though not included here) in which \eqn{(\textbf{X}^T \textbf{X})^{-1}}{(X^T X)^(-1)} is replaced with \eqn{(\textbf{X}^T \textbf{X})^\lambda}{(X^T X)^lambda}. For more information, see Krishna et al. (2009). For variable selection, large values of \eqn{g}, with a prior mean of zero for \eqn{\beta}{beta}, encourage models with few, large coefficients. Conversely, small values of \eqn{g} encourage saturated models with many, small coefficients. The design matrix \eqn{\textbf{X}}{X} is converted to Fisher's information matrix, which is used as a covariance matrix for \eqn{\beta}{beta}. This is computationally efficient, because each element of the covariance matrix does not need to be estimated as a parameter. When \eqn{\textbf{X}}{X} is nearly singular, regression effects \eqn{\beta}{beta} may be poorly estimated. Hyperparameter \eqn{g} acts as an inverse relative prior sample size, or as a dimensionality penalty. Zellner (1986) recommended that a hyperprior distribution is assigned to \eqn{g} so that it is estimated from the data, although in practice \eqn{g} has often been fixed, usually to \eqn{N} when no information is available, since it has the interpretation of adding prior information equivalent to one observation. A variety of hyperpriors have been suggested for \eqn{g}, such as in Bove and Held (2011), Liang et al. (2008), and Maruyama and George (2011). \eqn{g} becomes diffuse as it approaches infinity, and the Bayes factor approaches zero. The hyper-g prior of Liang et al. (2008) is proper when \eqn{\alpha > 2}{alpha > 2}, and any value in the interval \eqn{(2,4]} may be reasonable. } \value{ \code{dhyperg} gives the density of the hyper-g prior of Liang et al. (2008), \code{dzellner} gives the density of Zellner's g-prior, and \code{rzellner} generates random deviates. } \references{ Bove, D.S. and Held, L. (2011). "Hyper-g Priors for Generalized Linear Models". \emph{Bayesian Analysis}, 6(3), p. 387--410. Krishna, A., Bondell, H.D., and Ghosh, S.K. (2009). "Bayesian Variable Selection Using an Adaptive Powered Correlation Prior". \emph{Journal of Statistical Planning Inference}, 139(8), p. 2665-2674.. Liang, F., Paulo, R., Molina, G., Clyde, M.A., and Berger, J.O. (2008). "Mixtures of g Priors for Bayesian Variable Selection". \emph{Journal of the American Statistical Association}, 103, p. 410--423. Maruyama, Y. and George, E.I. (2011). "Fully Bayes Factors with a Generalised g-Prior". \emph{Annals of Statistics}, 39, p. 2740--2765. Zellner, A. (1986). "On Assessing Prior Distributions and Bayesian Regression Analysis with g-Prior Distributions". In \emph{Bayesian Inference and Decision Techniques: Essays in Honor of Bruno de Finetti}, p. 233--243. Elsevier: Amsterdam, North Holland. } \seealso{ \code{\link{BayesFactor}} and \code{\link{dmvt}} } \examples{ library(LaplacesDemon) set.seed(667) beta <- rnorm(10) g <- 100 sigma <- 2 X <- cbind(1,matrix(rnorm(100*9),100,9)) dhyperg(g, alpha=3) dzellner(beta, g, sigma, X) rzellner(1, g, sigma, X) } \keyword{Distribution} LaplacesDemon/man/plotMatrix.Rd0000755000176200001440000001025715144316355016205 0ustar liggesusers\name{plotMatrix} \alias{plotMatrix} \title{Plot a Numerical Matrix} \description{ This function plots a numerical matrix, and is often used to plot the following matrices: correlation, covariance, distance, and precision. } \usage{ plotMatrix(x, col=colorRampPalette(c("red","black","green"))(100), cex=1, circle=TRUE, order=FALSE, zlim=NULL, title="", PDF=FALSE, \dots) } \arguments{ \item{x}{This required argument is a numerical matrix, or an object of class \code{bayesfactor}, \code{demonoid}, \code{iterquad}, \code{laplace}, \code{pmc}, \code{posteriorchecks}, or \code{vb}. See more information below regarding these classes. One component of a blocked proposal covariance matrix must be pointed to explicitly, rather than to the object of class \code{demonoid}.} \item{col}{This argument specifies the colors of the circles. By default, the \code{colorRampPalette} function colors strong positive correlation as \code{green}, zero correlation as \code{black}, and strong negative correlation as \code{red}, and provides 100 color gradations.} \item{cex}{When \code{circle=TRUE}, this argument specifies the size of the marginal text, the names of the parameters or variables, and defaults to 1.} \item{circle}{Logical. When \code{TRUE}, each element in the numeric matrix is represented with a circle, and a larger circle is assigned to elements that are farther from zero. Also, when \code{TRUE}, the gradation scale does not appear to the right of the plot.} \item{order}{Logical. This argument defaults to \code{FALSE}, and presents the parameters or variables in the same order as in the numeric matrix. When \code{TRUE}, the parameters or variables are ordered using principal components analysis.} \item{zlim}{When \code{circle=FALSE}, the gradation scale may be constrained to an interval by \code{zlim}, such as \code{zlim=c(-1,1)}, and only values within the interval are plotted.} \item{title}{This argument specifies the title of the plot, and the default does not include a title. When \code{x} is of class \code{posteriorchecks}, the title is changed to \code{Posterior Correlation}.} \item{PDF}{Logical. When \code{TRUE}, the plot is saved as a .pdf file.} \item{\dots}{Additional arguments are unused.} } \details{ The \code{plotMatrix} function produces one of two styles of plots, depending on the \code{circle} argument. A \eqn{K \times K}{K x K} numeric matrix of \eqn{K} parameters or variables is plotted. The plot is a matrix of the same dimensions, in which each element is colored (and sized, when \code{circle=TRUE}) according to its value. Although \code{plotMatrix} does not provide the same detail as a numeric matrix, it is easier to discover elements of interest according to color (and size when \code{circle=TRUE}). The \code{plotMatrix} function is not inherently Bayesian, and does not include uncertainty in matrices. Nonetheless, it is included because it is a useful graphical presentation of a numeric matrices, and is recommended to be used with the posterior correlation matrix in an object of class \code{posteriorchecks}. When \code{x} is an object of class \code{bayesfactor}, matrix \code{B} is plotted. When \code{x} is an object of class \code{demonoid} (if it is a matrix), \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}, the covariance matrix \code{Covar} is plotted. When \code{x} is an object of class \code{posteriorchecks}, the posterior correlation matrix is plotted. This is a modified version of the \code{circle.corr} function of Taiyun Wei. } \author{Taiyun Wei} \seealso{\code{\link{PosteriorChecks}}} \examples{ library(LaplacesDemon) ### Although it is most commonly used with an object of class ### posteriorchecks, it is applied here to a different correlation matrix. data(mtcars) plotMatrix(cor(mtcars), col=colorRampPalette(c("green","gray10","red"))(100), cex=1, circle=FALSE, order=TRUE) plotMatrix(cor(mtcars), col=colorRampPalette(c("green","gray10","red"))(100), cex=1, circle=TRUE, order=TRUE)} \keyword{Plot}LaplacesDemon/man/data.demonsessions.Rd0000755000176200001440000000200515144316355017633 0ustar liggesusers\name{data.demonsessions} \alias{demonsessions} \title{Demon Sessions Data Set} \usage{data(demonsessions)} \description{ These are the monthly number of user sessions at \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index} by continent. Additional data may be added in the future. } \format{ This data frame contains 26 rows (with row names) and 6 columns. The following data dictionary describes each variable or column. \describe{ \item{\code{Africa}}{This is the African continent.} \item{\code{Americas}}{This is North and South America.} \item{\code{Asia}}{This is the Asian continent.} \item{\code{Europe}}{This is Europe as a continent.} \item{\code{Oceania}}{This is Oceania, such as Australia.} \item{\code{Not.Set}}{This includes sessions in which the continent was not set, or is unknown.} } } \source{\url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index}} \keyword{datasets} LaplacesDemon/man/joint.density.plot.Rd0000755000176200001440000000575115144316355017623 0ustar liggesusers\name{joint.density.plot} \alias{joint.density.plot} \title{Joint Density Plot} \description{ This function plots the joint kernel density from samples of two marginal posterior distributions. } \usage{ joint.density.plot(x, y, Title=NULL, contour=TRUE, color=FALSE, Trace=NULL) } \arguments{ \item{x,y}{These are vectors consisting of samples from two marginal posterior distributions, such as those output by \code{\link{LaplacesDemon}} in components \code{Posterior1} (all samples) or \code{Posterior2} (stationary samples).} \item{Title}{This is the title of the joint posterior density plot.} \item{contour}{This logical argument indicates whether or not contour lines will be added to the plot. \code{contour} defaults to \code{TRUE}.} \item{color}{This logical argument indicates whether or not color will be added to the plot. \code{color} defaults to \code{FALSE}.} \item{Trace}{This argument defaults to \code{NULL}, in which case it does not trace the exploration of the joint density. To trace the exploration of the joint density, specify \code{Trace} with the beginning and ending iteration or sample. For example, to view the trace of the first ten iterations or samples, specify \code{Trace=c(1,10)}.} } \details{ This function produces either a bivariate scatterplot that may have kernel density contour lines added, or a bivariate plot with kernel density-influenced colors, which may also have kernel density contour lines added. A joint density plot may be more informative than two univariate density plots. The \code{Trace} argument allows the user to view the exploration of the joint density, such as from MCMC chain output. An efficient algorithm jumps to random points of the joint density, and an inefficient algorithm explores more slowly. The initial point of the trace (which is the first element passed to \code{Trace}) is plotted with a green dot. The user should consider plotting the joint density of the two marginal posterior distributions with the highest \code{\link{IAT}}, as identified with the \code{\link{PosteriorChecks}} function, since these are the two least efficient MCMC chains. Different sequences of iterations may be plotted. This `joint trace plot' may show behavior of the MCMC algorithm to the user. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{IAT}}, \code{\link{LaplacesDemon}}, and \code{\link{PosteriorChecks}} } \examples{ library(LaplacesDemon) X <- rmvn(1000, runif(2), diag(2)) joint.density.plot(X[,1], X[,2], Title="Joint Density Plot", contour=TRUE, color=FALSE) joint.density.plot(X[,1], X[,2], Title="Joint Density Plot", contour=FALSE, color=TRUE) joint.density.plot(X[,1], X[,2], Title="Joint Density Plot", contour=TRUE, color=TRUE) joint.density.plot(X[,1], X[,2], Title="Joint Trace Plot", contour=FALSE, color=TRUE, Trace=c(1,10)) } \keyword{Plot}LaplacesDemon/man/dist.Laplace.Rd0000755000176200001440000001123515144316355016342 0ustar liggesusers\name{dist.Laplace} \alias{dlaplace} \alias{plaplace} \alias{qlaplace} \alias{rlaplace} \title{Laplace Distribution: Univariate Symmetric} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate, symmetric, Laplace distribution with location parameter \eqn{\mu}{mu} and scale parameter \eqn{\lambda}{\lambda}. } \usage{ dlaplace(x, location=0, scale=1, log=FALSE) plaplace(q, location=0, scale=1) qlaplace(p, location=0, scale=1) rlaplace(n, location=0, scale=1) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{location}{This is the location parameter \eqn{\mu}{mu}.} \item{scale}{This is the scale parameter \eqn{\lambda}{lambda}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{1}{2 \lambda} \exp(-\frac{|\theta - \mu|}{\lambda})}{p(theta) = (1 / (2*lambda)) * exp(-(abs(theta - mu) / lambda))} \item Inventor: Pierre-Simon Laplace (1774) \item Notation 1: \eqn{\theta \sim \mathrm{Laplace}(\mu,\lambda)}{theta ~ Laplace(mu, lambda)} \item Notation 2: \eqn{\theta \sim \mathcal{L}(\mu, \lambda)}{theta ~ L(mu, lambda)} \item Notation 3: \eqn{p(\theta) = \mathrm{Laplace}(\theta | \mu, \lambda)}{p(theta) = Laplace(theta | mu, lambda)} \item Notation 4: \eqn{p(\theta) = \mathcal{L}(\theta | \mu, \lambda)}{p(theta) = L(theta | mu, lambda)} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: scale parameter \eqn{\lambda > 0}{lambda > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = 2 \lambda^2}{var(theta) = 2*lambda^2} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The Laplace distribution (Laplace, 1774) is also called the double exponential distribution, because it looks like two exponential distributions back to back with respect to location \eqn{\mu}{mu}. It is also called the ``First Law of Laplace'', just as the normal distribution is referred to as the ``Second Law of Laplace''. The Laplace distribution is symmetric with respect to \eqn{\mu}{mu}, though there are asymmetric versions of the Laplace distribution. The PDF of the Laplace distribution is reminiscent of the normal distribution; however, whereas the normal distribution is expressed in terms of the squared difference from the mean \eqn{\mu}{mu}, the Laplace density is expressed in terms of the absolute difference from the mean, \eqn{\mu}{mu}. Consequently, the Laplace distribution has fatter tails than the normal distribution. It has been argued that the Laplace distribution fits most things in nature better than the normal distribution. There are many extensions to the Laplace distribution, such as the asymmetric Laplace, asymmetric log-Laplace, Laplace (re-parameterized for precision), log-Laplace, multivariate Laplace, and skew-Laplace, among many more. These functions are similar to those in the \code{VGAM} package. } \value{ \code{dlaplace} gives the density, \code{plaplace} gives the distribution function, \code{qlaplace} gives the quantile function, and \code{rlaplace} generates random deviates. } \references{ Laplace, P. (1774). "Memoire sur la Probabilite des Causes par les Evenements." l'Academie Royale des Sciences, 6, 621--656. English translation by S.M. Stigler in 1986 as "Memoir on the Probability of the Causes of Events" in \emph{Statistical Science}, 1(3), p. 359--378. } \seealso{ \code{\link{dalaplace}}, \code{\link{dallaplace}}, \code{\link{dexp}}, \code{\link{dlaplacep}}, \code{\link{dllaplace}}, \code{\link{dmvl}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, \code{\link{dsdlaplace}}, and \code{\link{dslaplace}}. } \examples{ library(LaplacesDemon) x <- dlaplace(1,0,1) x <- plaplace(1,0,1) x <- qlaplace(0.5,0,1) x <- rlaplace(100,0,1) #Plot Probability Functions x <- seq(from=-5, to=5, by=0.1) plot(x, dlaplace(x,0,0.5), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dlaplace(x,0,1), type="l", col="green") lines(x, dlaplace(x,0,2), type="l", col="blue") legend(2, 0.9, expression(paste(mu==0, ", ", lambda==0.5), paste(mu==0, ", ", lambda==1), paste(mu==0, ", ", lambda==2)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/LML.Rd0000755000176200001440000002251415144337635014471 0ustar liggesusers\name{LML} \alias{LML} \title{Logarithm of the Marginal Likelihood} \description{ This function approximates the logarithm of the marginal likelihood (LML), where the marginal likelihood is also called the integrated likelihood or the prior predictive distribution of \eqn{\textbf{y}}{y} in Bayesian inference. The marginal likelihood is \deqn{p(\textbf{y}) = \int p(\textbf{y} | \Theta)p(\Theta) d\Theta}{p(y) = integral p(y | Theta)p(Theta) d Theta} The prior predictive distribution indicates what \eqn{\textbf{y}}{y} should look like, given the model, before \eqn{\textbf{y}}{y} has been observed. The presence of the marginal likelihood of \eqn{\textbf{y}}{y} normalizes the joint posterior distribution, \eqn{p(\Theta|\textbf{y})}{p(Theta|y)}, ensuring it is a proper distribution and integrates to one (see \code{\link{is.proper}}). The marginal likelihood is the denominator of Bayes' theorem, and is often omitted, serving as a constant of proportionality. Several methods of approximation are available. } \usage{ LML(Model=NULL, Data=NULL, Modes=NULL, theta=NULL, LL=NULL, Covar=NULL, method="NSIS") } \arguments{ \item{Model}{This is the model specification for the model that was updated either in \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, or \code{\link{VariationalBayes}}. This argument is used only with the \code{LME} method.} \item{Data}{This is the list of data passed to the model specification. This argument is used only with the \code{LME} method.} \item{Modes}{This is a vector of the posterior modes (or medians, in the case of MCMC). This argument is used only with the \code{GD} or \code{LME} methods.} \item{theta}{This is a matrix of posterior samples (parameters only), and is specified only with the \code{GD}, \code{HME}, or \code{NSIS} methods.} \item{LL}{This is a vector of MCMC samples of the log-likelihood, and is specified only with the \code{GD}, \code{HME}, or \code{NSIS} methods.} \item{Covar}{This argument accepts the covariance matrix of the posterior modes, and is used only with the \code{GD} or \code{LME} methods.} \item{method}{The method may be \code{"GD"}, \code{"HME"}, \code{"LME"}, or \code{"NSIS"}, and defaults to \code{"NSIS"}. \code{"GD"} uses the Gelfand-Dey estimator, \code{"HME"} uses the Harmonic Mean Estimator, \code{"LME"} uses the Laplace-Metropolis Estimator, and \code{"NSIS"} uses nonparametric self-normalized importance sampling (NSIS).} } \details{ Generally, a user of \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}} does not need to use the \code{LML} function, because these methods already include it. However, \code{LML} may be called by the user, should the user desire to estimate the logarithm of the marginal likelihood with a different method, or with non-stationary chains. The \code{\link{LaplacesDemon}} and \code{\link{LaplacesDemon.hpc}} functions only call \code{LML} when all parameters are stationary, and only with non-adaptive algorithms. The \code{GD} method, where GD stands for Gelfand-Dey (1994), is a modification of the harmonic mean estimator (HME) that results in a more stable estimator of the logarithm of the marginal likelihood. This method is unbiased, simulation-consistent, and usually satisfies the Gaussian central limit theorem. The \code{HME} method, where HME stands for harmonic mean estimator, of Newton-Raftery (1994) is the easiest, and therefore fastest, estimation of the logarithm of the marginal likelihood. However, it is an unreliable estimator and should be avoided, because small likelihood values can overly influence the estimator, variance is often infinite, and the Gaussian central limit theorem is usually not satisfied. It is included here for completeness. There is not a function in this package that uses this method by default. Given \eqn{N} samples, the estimator is \eqn{1/[\frac{1}{N} \sum_N \exp(-LL)]}{1 / [1/N sum_N exp(-LL)]}. The \code{LME} method uses the Laplace-Metropolis Estimator (LME), in which the estimation of the Hessian matrix is approximated numerically. It is the slowest method here, though it returns an estimate in more cases than the other methods. The supplied \code{Model} specification must be executed a number of times equal to \eqn{k^2 \times 4}{k^2 x 2}, where \eqn{k} is the number of parameters. In large dimensions, this is very slow. The Laplace-Metropolis Estimator is inappropriate with hierarchical models. The \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, and \code{\link{VariationalBayes}} functions use \code{LME} when it has converged and \code{sir=FALSE}, in which case it uses the posterior means or modes, and is itself Laplace Approximation. The Laplace-Metropolis Estimator (LME) is the logarithmic form of equation 4 in Lewis and Raftery (1997). In a non-hierarchical model, the marginal likelihood may easily be approximated with the Laplace-Metropolis Estimator for model \eqn{m} as \deqn{p(\textbf{y}|m) = (2\pi)^{d_m/2}|\Sigma_m|^{1/2}p(\textbf{y}|\Theta_m,m)p(\Theta_m|m)}{p(y|m) = (2*pi)^(d_m/2) |Sigma_m|^(1/2) p(y|Theta_m, m)p(Theta_m|m)} where \eqn{d} is the number of parameters and \eqn{\Sigma}{Sigma} is the inverse of the negative of the approximated Hessian matrix of second derivatives. As a rough estimate of Kass and Raftery (1995), LME is worrisome when the sample size of the data is less than five times the number of parameters, and LME should be adequate in most problems when the sample size of the data exceeds twenty times the number of parameters (p. 778). The \code{NSIS} method is essentially the \code{MarginalLikelihood} function in the \code{MargLikArrogance} package. After \code{HME}, this is the fastest method available here. The \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, and \code{\link{VariationalBayes}} functions use \code{NSIS} when converged and \code{sir=TRUE}. The \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, and \code{\link{PMC}} functions use \code{NSIS}. At least 301 stationary samples are required, and the number of parameters cannot exceed half the number of stationary samples. } \value{ \code{LML} returns a list with two components: \item{LML}{ This is an approximation of the logarithm of the marginal likelihood (LML), which is notoriously difficult to estimate. For this reason, several methods are provided. The marginal likelihood is useful when comparing models, such as with Bayes factors in the \code{\link{BayesFactor}} function. When the method fails, \code{NA} is returned, and it is most likely that the joint posterior is improper (see \code{\link{is.proper}}).} \item{VarCov}{ This is a variance-covariance matrix, and is the negative inverse of the Hessian matrix, if estimated. The \code{GD}, \code{HME}, and \code{NSIS} methods do not estimate \code{VarCov}, and return \code{NA}.} } \references{ Gelfand, A.E. and Dey, D.K. (1994). "Bayesian Model Choice: Asymptotics and Exact Calculations". \emph{Journal of the Royal Statistical Society}, Series B 56, p. 501--514. Kass, R.E. and Raftery, A.E. (1995). "Bayes Factors". \emph{Journal of the American Statistical Association}, 90(430), p. 773--795. Lewis, S.M. and Raftery, A.E. (1997). "Estimating Bayes Factors via Posterior Simulation with the Laplace-Metropolis Estimator". \emph{Journal of the American Statistical Association}, 92, p. 648--655. Newton, M.A. and Raftery, A.E. (1994). "Approximate Bayesian Inference by the Weighted Likelihood Bootstrap". \emph{Journal of the Royal Statistical Society}, Series B 3, p. 3--48. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{BayesFactor}}, \code{\link{is.proper}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{ ### If a model object were created and called Fit, then: # ### Applying HME to an object of class demonoid or pmc: #LML(LL=Fit$Deviance*(-1/2), method="HME") # ### Applying LME to an object of class demonoid: #LML(Model, MyData, Modes=apply(Fit$Posterior1, 2, median), method="LME") # ### Applying NSIS to an object of class demonoid #LML(theta=Fit$Posterior1, LL=Fit$Deviance*-(1/2), method="NSIS") # ### Applying LME to an object of class iterquad: #LML(Model, MyData, Modes=Fit$Summary1[,1], method="LME") # ### Applying LME to an object of class laplace: #LML(Model, MyData, Modes=Fit$Summary1[,1], method="LME") # ### Applying LME to an object of class vb: #LML(Model, MyData, Modes=Fit$Summary1[,1], method="LME") } \keyword{Harmonic Mean Estimator} \keyword{Integrated Likelihood} \keyword{Laplace-Metropolis Estimator} \keyword{Marginal Likelihood} \keyword{Nonparametric Self-Normalized Importance Sampling} \keyword{Prior Predictive Distribution} LaplacesDemon/man/ESS.Rd0000755000176200001440000001304315144316355014470 0ustar liggesusers\name{ESS} \alias{ESS} \title{Effective Sample Size due to Autocorrelation} \description{ This function may be used to estimate the effective sample size (ESS) (not to be confused with Elliptical Slice Sampling) of a continuous target distribution, where the sample size is reduced by autocorrelation. ESS is a measure of how well each continuous chain is mixing. ESS is a univariate function that is often applied to each continuous, marginal posterior distribution. A multivariate form is not included. By chance alone due to multiple independent tests, 5\% of the continuous parameters may indicate that ESS is below a user threshold of acceptability, such as 100, even when above the threshold. Assessing convergence is difficult. } \usage{ESS(x)} \arguments{ \item{x}{This required argument is a vector or matrix of posterior samples.} } \details{ Effective Sample Size (ESS) was recommended by Radford Neal in the panel discussion of Kass et al. (1998). When a continuous, marginal posterior distribution is sampled with a Markov chain Monte Carlo (MCMC) algorithm, there is usually autocorrelation present in the samples. More autocorrelation is associated with less posterior sampled information, because the information in the samples is autocorrelated, or put another way, successive samples are not independent from earlier samples. This reduces the effective sample size of, and precision in representing, the continuous, marginal posterior distribution. \code{ESS} is one of the criteria in the \code{\link{Consort}} function, where stopping the MCMC updates is not recommended until \code{ESS} \eqn{\ge 100}. Although the need for precision of each modeler differs with each model, it is often a good goal to obtain \code{ESS} \eqn{= 1000}. \code{ESS} is related to the integrated autocorrelation time (see \code{\link{IAT}} for more information). ESS is usually defined as \deqn{\mathrm{ESS}(\theta) = \frac{S}{1 + 2 \sum^{\infty}_{k=1} \rho_k (\theta)},}{ESS(theta) = S / (1 + 2 sum[k] rho[k] (theta)),} where \eqn{S}{S} is the number of posterior samples, \eqn{\rho_k}{rho[k]} is the autocorrelation at lag \eqn{k}{k}, and \eqn{\theta}{theta} is the vector of marginal posterior samples. The infinite sum is often truncated at lag \eqn{k}{k} when \eqn{\rho_k (\theta) < 0.05}{rho[k](theta) < 0.05}. Just as with the \code{effectiveSize} function in the \code{coda} package, the \code{AIC} argument in the \code{ar} function is used to estimate the order. ESS is a measure of how well each continuous chain is mixing, and a continuous chain mixes better when in the target distribution. This does not imply that a poorly mixing chain still searching for its target distribution will suddenly mix well after finding it, though mixing should improve. A poorly mixing continuous chain does not necessarily indicate problems. A smaller ESS is often due to correlated parameters, and is commonly found with scale parameters. Posterior correlation may be obtained from the \code{\link{PosteriorChecks}} function, and plotted with the \code{\link{plotMatrix}} function. Common remedies for poor mixing include re-parameterizing the model or trying a different MCMC algorithm that better handles correlated parameters. Slow mixing is indicative of an inefficiency in which a continuous chain takes longer to find its target distribution, and once found, takes longer to explore it. Therefore, slow mixing results in a longer required run-time to find and adequately represent the continuous target distribution, and increases the chance that the user may make inferences from a less than adequate representation of the continuous target distribution. There are many methods of re-parameterization to improve mixing. It is helpful when predictors are centered and scaled, such as with the \code{\link{CenterScale}} function. Parameters for predictors are often assigned prior distributions that are independent per parameter, in which case an exchangeable prior distribution or a multivariate prior distribution may help. If a parameter with poor mixing is bounded with the \code{\link{interval}} function, then transforming it to the real line (such as with a log transformation for a scale parameter) is often helpful, since constraining a parameter to an interval often reduces ESS. Another method is to re-parameterize so that one or more latent variables represent the process that results in slow mixing. Such re-parameterization uses data augmentation. This is numerically the same as the \code{effectiveSize} function in the \code{coda} package, but programmed to accept a simple vector or matrix so it does not require an \code{mcmc} or \code{mcmc.list} object, and the result is bound to be less than or equal to the original number of samples. } \value{ A vector is returned, and each element is the effective sample size (ESS) for a corresponding column of \code{x}, after autocorrelation has been taken into account. } \references{ Kass, R.E., Carlin, B.P., Gelman, A., and Neal, R. (1998). "Markov Chain Monte Carlo in Practice: A Roundtable Discussion". \emph{The American Statistician}, 52, p. 93--100. } \seealso{ \code{\link{CenterScale}}, \code{\link{Consort}}, \code{\link{IAT}}, \code{\link{interval}}, \code{\link{LaplacesDemon}}, \code{\link{plotMatrix}}, and \code{\link{PosteriorChecks}}. } \keyword{Diagnostic} \keyword{MCMC}LaplacesDemon/man/dist.Normal.Variance.Rd0000755000176200001440000001076515144316355017767 0ustar liggesusers\name{dist.Normal.Variance} \alias{dnormv} \alias{pnormv} \alias{qnormv} \alias{rnormv} \title{Normal Distribution: Variance Parameterization} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate normal distribution with mean \eqn{\mu}{mu} and variance \eqn{\sigma^2}{sigma^2}. } \usage{ dnormv(x, mean=0, var=1, log=FALSE) pnormv(q, mean=0, var=1, lower.tail=TRUE, log.p=FALSE) qnormv(p, mean=0, var=1, lower.tail=TRUE, log.p=FALSE) rnormv(n, mean=0, var=1) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mean}{This is the mean parameter \eqn{\mu}{mu}.} \item{var}{This is the variance parameter \eqn{\sigma^2}{sigma^2}, which must be positive.} \item{log, log.p}{Logical. If \code{TRUE}, then probabilities \eqn{p} are given as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{Logical. If \code{TRUE} (default), then probabilities are \eqn{Pr[X \le x]}{Pr[X <= x]}, otherwise, \eqn{Pr[X > x]}{Pr[X > x]}.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{1}{\sqrt{2\pi\sigma^2}} \exp(-\frac{(\theta-\mu)^2}{2\sigma^2})}{p(theta) = (1/(sqrt(2*pi*sigma^2))) * exp(-((theta-mu)^2/(2*sigma^2)))} \item Inventor: Carl Friedrich Gauss or Abraham De Moivre \item Notation 1: \eqn{\theta \sim \mathcal{N}(\mu, \sigma^2)}{theta ~ N(mu, sigma^2)} \item Notation 2: \eqn{p(\theta) = \mathcal{N}(\theta | \mu, \sigma^2)}{p(theta) = N(theta | mu, sigma^2)} \item Parameter 1: mean parameter \eqn{\mu}{mu} \item Parameter 2: variance parameter \eqn{\sigma^2 > 0}{sigma^2 > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = \sigma^2}{var(theta) = sigma^2} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The normal distribution, also called the Gaussian distribution and the Second Law of Laplace, is usually parameterized with mean and variance. \code{Base R} uses the mean and standard deviation. These functions provide the variance parameterization for convenience and familiarity. For example, it is easier to code \code{dnormv(1,1,1000)} than \code{dnorm(1,1,sqrt(1000))}. Some authors attribute credit for the normal distribution to Abraham de Moivre in 1738. In 1809, Carl Friedrich Gauss published his monograph ``Theoria motus corporum coelestium in sectionibus conicis solem ambientium'', in which he introduced the method of least squares, method of maximum likelihood, and normal distribution, among many other innovations. Gauss, himself, characterized this distribution according to mean and precision, though his definition of precision differed from the modern one. Although the normal distribution is very common, it often does not fit data as well as more robust alternatives with fatter tails, such as the Laplace or Student t distribution. A flat distribution is obtained in the limit as \eqn{\sigma^2 \rightarrow \infty}{sigma^2 -> infinity}. For models where the dependent variable, y, is specified to be normally distributed given the model, the Jarque-Bera test (see \code{\link{plot.demonoid.ppc}} or \code{\link{plot.laplace.ppc}}) may be used to test the residuals. These functions are similar to those in \code{base R}. } \value{ \code{dnormv} gives the density, \code{pnormv} gives the distribution function, \code{qnormv} gives the quantile function, and \code{rnormv} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dlaplace}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dst}}, \code{\link{dt}}, \code{\link{plot.demonoid.ppc}}, and \code{\link{plot.laplace.ppc}}. } \examples{ library(LaplacesDemon) x <- dnormv(1,0,1) x <- pnormv(1,0,1) x <- qnormv(0.5,0,1) x <- rnormv(100,0,1) #Plot Probability Functions x <- seq(from=-5, to=5, by=0.1) plot(x, dnormv(x,0,0.5), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dnormv(x,0,1), type="l", col="green") lines(x, dnormv(x,0,5), type="l", col="blue") legend(2, 0.9, expression(paste(mu==0, ", ", sigma^2==0.5), paste(mu==0, ", ", sigma^2==1), paste(mu==0, ", ", sigma^2==5)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/print.vb.Rd0000755000176200001440000000105115144337635015600 0ustar liggesusers\name{print.vb} \alias{print.vb} \title{Print an object of class \code{vb} to the screen} \description{ This may be used to print the contents of an object of class \code{vb} to the screen. } \usage{\method{print}{vb}(x, \dots)} \arguments{ \item{x}{An object of class \code{vb} is required.} \item{\dots}{Additional arguments are unused.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{VariationalBayes}}} \examples{### See the VariationalBayes function for an example.} \keyword{print}LaplacesDemon/man/dist.Truncated.Rd0000755000176200001440000000615115144316355016733 0ustar liggesusers\name{dist.Truncated} \alias{dtrunc} \alias{extrunc} \alias{ptrunc} \alias{qtrunc} \alias{rtrunc} \alias{vartrunc} \title{Truncated Distributions} \description{ Density, distribution function, quantile function and random generation for truncated distributions. } \usage{ dtrunc(x, spec, a=-Inf, b=Inf, log=FALSE, ...) extrunc(spec, a=-Inf, b=Inf, ...) ptrunc(x, spec, a=-Inf, b=Inf, ...) qtrunc(p, spec, a=-Inf, b=Inf, ...) rtrunc(n, spec, a=-Inf, b=Inf, ...) vartrunc(spec, a=-Inf, b=Inf, ...) } \arguments{ \item{n}{This is a the number of random draws for \code{rtrunc}.} \item{p}{This is a vector of probabilities.} \item{x}{This is a vector to be evaluated.} \item{spec}{The base name of a probability distribution is specified here. For example, to estimate the density of a truncated normal distribution, enter \code{norm}.} \item{a}{This is the lower bound of truncation, which defaults to negative infinity.} \item{b}{This is the upper bound of truncation, which defaults to infinity.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} \item{\dots}{Additional arguments pertain to the probability distribution specified in the \code{spec} argument.} } \details{ A truncated distribution is a conditional distribution that results from a priori restricting the domain of some other probability distribution. More than merely preventing values outside of truncated bounds, a proper truncated distribution integrates to one within the truncated bounds. For more information on propriety, see \code{\link{is.proper}}. In contrast to a truncated distribution, a censored distribution occurs when the probability distribution is still allowed outside of a pre-specified range. Here, distributions are truncated to the interval \eqn{[a,b]}, such as \eqn{p(\theta) \in [a,b]}{p(theta) in [a,b]}. The \code{dtrunc} function is often used in conjunction with the \code{\link{interval}} function to truncate prior probability distributions in the model specification function for use with these numerical approximation functions: \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, and \code{\link{PMC}}. The R code of Nadarajah and Kotz (2006) has been modified to work with log-densities. } \value{ \code{dtrunc} gives the density, \code{extrunc} gives the expectation, \code{ptrunc} gives the distribution function, \code{qtrunc} gives the quantile function, \code{rtrunc} generates random deviates, and \code{vartrunc} gives the variance of the truncated distribution. } \references{ Nadarajah, S. and Kotz, S. (2006). "R Programs for Computing Truncated Distributions". \emph{Journal of Statistical Software}, 16, Code Snippet 2, p. 1--8. } \seealso{ \code{\link{interval}}, \code{\link{is.proper}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, and \code{\link{PMC}}. } \examples{ library(LaplacesDemon) x <- seq(-0.5, 0.5, by = 0.1) y <- dtrunc(x, "norm", a=-0.5, b=0.5, mean=0, sd=2) } \keyword{Distribution} LaplacesDemon/man/dist.Horseshoe.Rd0000755000176200001440000000673015144316355016744 0ustar liggesusers\name{dist.Horseshoe} \alias{dhs} \alias{rhs} \title{Horseshoe Distribution} \description{ This is the density function and random generation from the horseshoe distribution. } \usage{ dhs(x, lambda, tau, log=FALSE) rhs(n, lambda, tau) } \arguments{ \item{n}{This is the number of draws from the distribution.} \item{x}{This is a location vector at which to evaluate density.} \item{lambda}{This vector is a positive-only local parameter \eqn{\lambda}{lambda}.} \item{tau}{This scalar is a positive-only global parameter \eqn{\tau}{tau}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Multivariate Scale Mixture \item Density: (see below) \item Inventor: Carvalho et al. (2008) \item Notation 1: \eqn{\theta \sim \mathcal{HS}(\lambda, \tau)}{theta ~ HS(lambda, tau)} \item Notation 2: \eqn{p(\theta) = \mathcal{HS}(\theta | \lambda, \tau)}{p(theta) = HS(theta | lambda, tau)} \item Parameter 1: local scale \eqn{\lambda > 0}{lambda > 0} \item Parameter 2: global scale \eqn{\tau > 0}{tau > 0} \item Mean: \eqn{E(\theta)}{E(theta)} \item Variance: \eqn{var(\theta)}{var(theta)} \item Mode: \eqn{mode(\theta)}{mode(theta)} } The horseshoe distribution (Carvalho et al., 2008) is a heavy-tailed mixture distribution that can be considered a variance mixture, and it is in the family of multivariate scale mixtures of normals. The horseshoe distribution was proposed as a prior distribution, and recommended as a default choice for shrinkage priors in the presence of sparsity. Horseshoe priors are most appropriate in large-p models where dimension reduction is necessary to avoid overly complex models that predict poorly, and also perform well in estimating a sparse covariance matrix via Cholesky decomposition (Carvalho et al., 2009). When the number of parameters in variable selection is assumed to be sparse, meaning that most elements are zero or nearly zero, a horseshoe prior is a desirable alternative to the Laplace-distributed parameters in the LASSO, or the parameterization in ridge regression. When the true value is far from zero, the horseshoe prior leaves the parameter unshrunk. Yet, the horseshoe prior is accurate in shrinking parameters that are truly zero or near-zero. Parameters near zero are shrunk more than parameters far from zero. Therefore, parameters far from zero experience less shrinkage and are closer to their true values. The horseshoe prior is valuable in discriminating signal from noise. By replacing the Laplace-distributed parameters in LASSO with horseshoe-distributed parameters and including a global scale, the result is called horseshoe regression. } \value{ \code{dhs} gives the density and \code{rhs} generates random deviates. } \references{ Carvalho, C.M., Polson, N.G., and Scott, J.G. (2008). "The Horseshoe Estimator for Sparse Signals". \emph{Discussion Paper 2008-31}. Duke University Department of Statistical Science. Carvalho, C.M., Polson, N.G., and Scott, J.G. (2009). "Handling Sparsity via the Horseshoe". \emph{Journal of Machine Learning Research}, 5, p. 73--80. } \seealso{ \code{\link{dlaplace}} } \examples{ library(LaplacesDemon) x <- rnorm(100) lambda <- rhalfcauchy(100, 5) tau <- 5 x <- dhs(x, lambda, tau, log=TRUE) x <- rhs(100, lambda=lambda, tau=tau) plot(density(x)) } \keyword{Distribution} LaplacesDemon/man/plot.miss.Rd0000755000176200001440000000475515144316355016000 0ustar liggesusers\name{plot.miss} \alias{plot.miss} \title{Plot samples from the output of MISS} \description{ This may be used to plot, or save plots of, samples in an object of class \code{miss}. Plots include a trace plot, density plot, and autocorrelation or ACF plot. } \usage{ \method{plot}{miss}(x, PDF=FALSE, \dots) } \arguments{ \item{x}{ This required argument is an object of class \code{miss}.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{\dots}{Additional arguments are unused.} } \details{ The plots are arranged in a \eqn{3 \times 3}{3 x 3} matrix. Each row represents the predictive distribution of a missing value. The left column displays trace plots, the middle column displays kernel density plots, and the right column displays autocorrelation (ACF) plots. Trace plots show the thinned history of the predictive distribution, with its value in the y-axis moving by iteration across the x-axis. Simulations of a predictive distribution with good properties do not suggest a trend upward or downward as it progresses across the x-axis (it should appear stationary), and it should mix well, meaning it should appear as though random samples are being taken each time from the same target distribution. Visual inspection of a trace plot cannot verify convergence, but apparent non-stationarity or poor mixing can certainly suggest non-convergence. A red, smoothed line also appears to aid visual inspection. Kernel density plots depict the marginal posterior distribution. There is no distributional assumption about this density. Autocorrelation plots show the autocorrelation or serial correlation between sampled values at nearby iterations. Samples with autocorrelation do not violate any assumption, but are inefficient because they reduce the effective sample size (\code{\link{ESS}}), and indicate that the chain is not mixing well, since each value is influenced by values that are previous and nearby. The x-axis indicates lags with respect to samples by iteration, and the y-axis represents autocorrelation. The ideal autocorrelation plot shows perfect correlation at zero lag, and quickly falls to zero autocorrelation for all other lags. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{MISS}}.} \examples{### See the MISS function for an example.} \keyword{Plot}LaplacesDemon/man/Matrices.Rd0000755000176200001440000004520315144337635015614 0ustar liggesusers\name{Matrices} \alias{as.indicator.matrix} \alias{as.inverse} \alias{as.parm.matrix} \alias{as.positive.definite} \alias{as.positive.semidefinite} \alias{as.symmetric.matrix} \alias{Cov2Cor} \alias{CovEstim} \alias{GaussHermiteCubeRule} \alias{Hessian} \alias{is.positive.definite} \alias{is.positive.semidefinite} \alias{is.square.matrix} \alias{is.symmetric.matrix} \alias{Jacobian} \alias{logdet} \alias{lower.triangle} \alias{read.matrix} \alias{SparseGrid} \alias{TransitionMatrix} \alias{tr} \alias{upper.triangle} \title{Matrix Utility Functions} \description{ These are utility functions for working with matrices. } \usage{ as.indicator.matrix(x) as.inverse(x) as.parm.matrix(x, k, parm, Data, a=-Inf, b=Inf, restrict=FALSE, chol=FALSE) as.positive.definite(x) as.positive.semidefinite(x) as.symmetric.matrix(x, k=NULL) is.positive.definite(x) is.positive.semidefinite(x) is.square.matrix(x) is.symmetric.matrix(x) Cov2Cor(Sigma) CovEstim(Model, parm, Data, Method="Hessian") GaussHermiteCubeRule(N, dims, rule) Hessian(Model, parm, Data, Interval=1e-6, Method="Richardson") Jacobian(Model, parm, Data, Interval=1e-6, Method="simple") logdet(x) lower.triangle(x, diag=FALSE) read.matrix(file, header=FALSE, sep=",", nrow=0, samples=0, size=0, na.rm=FALSE) SparseGrid(J, K) TransitionMatrix(theta.y=NULL, y.theta=NULL, p.theta=NULL) tr(x) upper.triangle(x, diag=FALSE) } \arguments{ \item{N}{This required argument accepts a positive integer that indicates the number of nodes.} \item{x}{This is a matrix (though \code{as.symmetric.matrix} also accepts vectors).} \item{J}{This required argument indicates the dimension of the integral and accepts a positive integer.} \item{k}{For \code{as.parm.matrix}, this is a required argument, indicating the dimension of the matrix. For \code{as.symmetric.matrix}, this is an optional argument that specifies the dimension of the symmetric matrix. This applies only when \code{x} is a vector. It defaults to \code{NULL}, in which case it calculates \code{k <- (-1 + sqrt(1 + 8 * length(x)))/ 2}.} \item{K}{This required argument indicates the accuracy and accepts a positive integer. Larger values result in many more integration nodes.} \item{diag}{Logical. If \code{TRUE}, then the elements in the main diagonal are also returned.} \item{dims}{This required argument indicates the dimension of the integral and accepts a positive integer.} \item{Sigma}{This is a covariance matrix, \eqn{\Sigma}{Sigma}, and may be entered either as a matrix or vector.} \item{Model}{This is a model specification function. For more information, see \code{\link{LaplacesDemon}}.} \item{parm}{This is a vector of parameters passed to the model specification.} \item{Data}{This is the list of data passed to the model specification. For more information, see \code{\link{LaplacesDemon}}.} \item{a,b}{These optional arguments allow the elements of \code{x} to be bound to the interval \eqn{[a,b]}. For example, elements of a correlation matrix are in the interval \eqn{[-1,1]}.} \item{restrict}{Logical. If \code{TRUE}, then \code{x[1,1]} is restricted to 1. This is useful in multinomial probit, for example. The variable, \code{LaplacesDemonMatrix}, is created in a new environment, \code{LDEnv} so \code{as.parm.matrix} can keep track of changes from iteration to iteration.} \item{rule}{This is an optional argument that accepts a univariate Gauss-Hermite quadrature rule. Usually, this argument is left empty. A rule may be supplied that differs from the traditional rule, such as when constraints have been observed, and one or more nodes and weights were adjusted.} \item{chol}{Logical. If \code{TRUE}, then x is an upper-triangular matrix.} \item{file}{This is the name of the file from which the numeric data matrix will be imported or read.} \item{header}{Logical. When \code{TRUE}, the first row of the file must contain names of the columns, and will be converted to the column names of the numeric matrix. When \code{FALSE}, the first row of the file contains data, not column names.} \item{Interval}{This accepts a small scalar number for precision.} \item{Method}{This accepts a quoted string. For \code{Hessian}, it defaults to \code{Method="Richardson"}, which uses Richardson extrapolation. For \code{Jacobian}, it defaults to \code{Method="simple"}, which uses finite-differencing. Richardson Richardson extrapolation is more accurate, but slower to calculate. Since error due to finite-differencing propagates through to higher derivatives, finite-differencing should not be used when approximating a Hessian matrix. Another method called automatic differentiation is not currently available here, but should be more accurate, though even slower to calculate. Another popular alternative is to use the \code{\link{BayesianBootstrap}} on the data. For \code{CovEstim}, this accepts \code{Method="Hessian"}, \code{Method="Identity"} (which simply assigns an identity matrix), \code{Method="OPG"} (which calculates the sum of outer products of record-level gradients), or \code{Method="Sandwich"}, which is the sandwich estimator and combines the Hessian and OPG estimates.} \item{nrow}{This is the number of rows of the numeric matrix, and defaults to \code{nrow=0}. If the number is known, the function will perform noticeably faster when it does not have to check.} \item{p.theta}{This accepts a matrix of prior probabilities for a transition matrix, and defaults to \code{NULL}. If used, each row must sum to 1.} \item{samples}{This is the number of samples to take from the numeric matrix. When \code{samples=0}, sampling is not performed and the entire matrix is returned.} \item{sep}{This argument indicates a character with which it will separate fields when creating column vectors. For example, a read a comma-separated file (.csv), use \code{sep=","}.} \item{size}{This is the batch size to be used only when reading a numeric matrix that is larger than the available computer memory (RAM), and only when \code{samples} is greater than zero. Sampling of a big data matrix is performed by first determining the records to keep, and then reading batches, one by one, and keeping the matching records.} \item{theta.y}{This accepts a vector of posterior samples of a discrete Markov chain, and defaults to \code{NULL}. If used, the order of the samples affects the transition probability.} \item{na.rm}{Logical. When \code{TRUE}, rows with missing values are removed from the matrix after it is read. Rather than removing missing values, the user may consider imputing missing values inside the model, or before the model with the \code{\link{MISS}} function. Examples of within-model imputation may be found in the accompanying "Examples" vignette.} \item{y.theta}{This accepts a vector of data that are samples of a discrete distribution, and defaults to \code{NULL}. If used, the order of the samples affects the transition probability.} } \details{ The \code{as.indicator.matrix} function creates an indicator matrix from a vector. This function is useful for converting a discrete vector into a matrix in which each column represents one of the discrete values, and each occurence of that value in the related column is indicated by a one, and is otherwise filled with zeroes. This function is similar to the \code{class.ind} function in the nnet package. The \code{as.inverse} function returns the matrix inverse of \code{x}. The \code{solve} function in base R also returns the matrix inverse, but \code{solve} can return a matrix that is not symmetric, and can fail due to singularities. The \code{as.inverse} function tries to use the \code{solve} function to return a matrix inverse, and when it fails due to a singularity, \code{as.inverse} uses eigenvalue decomposition (in which eigenvalues below a tolerance are replaced with the tolerance), and coerces the result to a symmetric matrix. This is similar to the \code{solvcov} function in the fpc package. The \code{as.parm.matrix} function prepares a correlation, covariance, or precision matrix in two important ways. First, \code{as.parm.matrix} obtains the parameters for the matrix specified in the \code{x} argument by matching the name of the matrix in the \code{x} argument with any parameters in \code{parm}, given the parameter names in the \code{Data} listed in \code{parm.names}. These obtained parameters are organized into a matrix as the elements of the upper-triangular, including the diagonal. A copy is made, without the diagonal, and the lower-triangular is filled in, completing the matrix. Second, \code{as.parm.matrix} checks for positive-definiteness. If matrix \code{x} is positive-definite, then the matrix is stored as a variable called \code{LaplacesDemonMatrix} in a new environment called \code{LDEnv}. If matrix \code{x} is not positive-definite, then \code{LaplacesDemonMatrix} in \code{LDEnv} is sought as a replacement. If this variable exists, then it is used to replace the matrix. If not, then the matrix is replaced with an identity matrix. Back in the model specification, after using \code{as.parm.matrix}, it is recommended that the user also pass the resulting matrix back into the \code{parm} vector, so the sampler or algorithm knows that the elements of the matrix have changed. The \code{as.positive.definite} function returns the nearest positive-definite matrix for a matrix that is square and symmetric (Higham, 2002). This version is intended only for covariance and precision matrices, and has been optimized for speed. A more extensible function is \code{nearPD} in the matrixcalc package, which is also able to work with correlation matrices, and matrices that are asymmetric. The \code{as.positive.semidefinite} function iteratively seeks to return a square, symmetric matrix that is at least positive-semidefinite, by replacing each negative eigenvalue and calculating its projection. This is intended only for covariance and precision matrices. A similar function is \code{makePsd} in the RTAQ package, though it is not iterative, and returns matrices that fail a logical check with \code{is.positive.semidefinite}. The \code{as.symmetric.matrix} function accepts either a vector or matrix, and returns a symmetric matrix. In the case of a vector, it can be either all elements of the matrix, or the lower triangular. In the case of a \code{x} being entered as a matrix, this function tolerates non-finite values in one triangle (say, the lower), as long as the corresponding element is finite in the other (say, the upper) triangle. The \code{Cov2Cor} function converts a covariance matrix into a correlation matrix, and accepts the covariance matrix either in matrix or vector form. This function may be useful inside a model specification and also with converting posterior draws of the elements of a covariance matrix to a correlation matrix. \code{Cov2Cor} is an expanded form of the \code{cov2cor} function in the \code{stats} package, where \code{Cov2Cor} is also able to accept and return a vectorized matrix. The \code{CovEstim} function estimates a covariance matrix with one of several methods. This is mainly used by \code{\link{LaplaceApproximation}}, where the \code{parm} argument receives the posterior modes. See the \code{CovEst} argument for more details. The \code{GaussHermiteCubeRule} function returns a matrix of nodes and a vector of weights for a \code{dims}-dimensional integral given \eqn{N} univariate nodes. The number of multivariate nodes will differ from the number of univariate nodes. This function is for use with multivariate quadrature, often called cubature. This has been adapted from the \code{multiquad} function in the NominalLogisticBiplot package. The \code{\link{GaussHermiteQuadRule}} function is a univariate version. A customized univariate \code{rule} may be supplied when constraints necessitate that one or more nodes and weights had to be altered. The \code{Hessian} returns a symmetric, Hessian matrix, which is a matrix of second partial derivatives. The estimation of the Hessian matrix is approximated numerically using Richardson extrapolation by default. This is a slow function. This function is not intended to be called by the user, but is made available here. This is essentially the \code{hessian} function from the numDeriv package, adapted to Laplace's Demon. The \code{is.positive.definite} function is a logical test of whether or not a matrix is positive-definite. A \eqn{k \times k}{k x k} symmetric matrix \eqn{\textbf{X}}{X} is positive-definite if all of its eigenvalues are positive (\eqn{\lambda_i > 0, i \in k}{lambda[i] > 0, i in k}). All main-diagonal elements must be positive. The determinant of a positive-definite matrix is always positive, so a positive-definite matrix is always nonsingular. Non-symmetric, positive-definite matrices exist, but are not considered here. The \code{is.positive.semidefinite} function is a logical test of whether or not a matrix is positive-semidefinite. A \eqn{k x k} symmetric matrix \eqn{\textbf{X}}{X} is positive-semidefinite if all of its eigenvalues are non-negative (\eqn{\lambda_i \ge 0, i \in k}{lambda[i] >= 0, i ink}). The \code{is.square.matrix} function is a logical test of whether or not a matrix is square. A square matrix is a matrix with the same number of rows and columns, and is usually represented as a \eqn{k \times k}{k x k} matrix \eqn{\textbf{X}}{X}. The \code{is.symmetric.matrix} function is a logical test of whether or not a matrix is symmetric. A symmetric matrix is a square matrix that is equal to its transpose, \eqn{\textbf{X} = \textbf{X}^T}{X = t(X)}. For example, where \eqn{i} indexes rows and \eqn{j} indexes columns, \eqn{\textbf{X}_{i,j} = \textbf{X}_{j,i}}{X[i,j] = X[j,i]}. This differs from the \code{isSymmetric} function in base R that is inexact, using \code{all.equal}. The \code{Jacobian} function estimates the Jacobian matrix, which is a matrix of all first-order partial derivatives of the \code{Model}. The Jacobian matrix is estimated by default with forward finite-differencing, or optionally with Richardson extrapolation. This function is not intended to be called by the user, but is made available here. This is essentially the \code{jacobian} function from the numDeriv package, adapted to LaplacesDemon. The \code{logdet} function returns the logarithm of the determinant of a positive-definite matrix via the Cholesky decomposition. The determinant is a value associated with a square matrix, and was used historically to \emph{determine} if a system of linear equations has a unique solution. The term \emph{determinant} was introduced by Gauss, where Laplace referred to it as the resultant. When the determinant is zero, the matrix is singular and non-invertible; there are either no solutions or many solutions. A unique solution exists when the determinant is non-zero. The \code{det} function in base R works well for small matrices, but can return erroneously return zero in larger matrices. It is better to work with the log-determinant. The \code{lower.triangle} function returns a vector of the lower triangular elements of a matrix, and the diagonal is included when \code{diag=TRUE}. The \code{read.matrix} function is provided here as one of many convenient ways to read a numeric matrix into R. The most common method of storing data in R is the data frame, because it is versatile. For example, a data frame may contain character, factor, and numeric variables together. For iterative estimation, common in Bayesian inference, the data frame is much slower than the numeric matrix. For this reason, the LaplacesDemon package does not use data frames, and has not traditionally accepted character or factor data. The \code{read.matrix} function returns either an entire numeric matrix, or row-wise samples from a numeric matrix. Samples may be taken from a matrix that is too large for available computer memory (RAM), such as with big data. The \code{SparseGrid} function returns a sparse grid for a \eqn{J}-dimensional integral with accuracy \eqn{K}, given Gauss-Hermite quadrature rules. A grid of order \eqn{K} provides an exact result for a polynomial of total order of \eqn{2K - 1} or less. \code{SparseGrid} returns a matrix of nodes and a vector of weights. A sparse grid is more efficient than the full grid in the \code{GaussHermiteCubeRule} function. This has been adapted from the SparseGrid package. The \code{TransitionMatrix} function has several uses. A user may supply a vector of marginal posterior samples of a discrete Markov chain as \code{theta.y}, and an observed posterior transition matrix is returned. Otherwise, a user may supply data (\code{y.theta}) and/or a prior (\code{p.theta}), in which case a posterior transition matrix is returned. A common row-wise prior is the dirichlet distribution. Transition probabilities are from row element to column element. The \code{tr} function returns the trace of a matrix. The trace of a matrix is the sum of the elements in the main diagonal of a square matrix. For example, the trace of a \eqn{k \times k}{k x k} matrix \eqn{\textbf{X}}{X}, is \eqn{\sum_{k=1} \textbf{X}_{k,k}}{sum(k=1) X[k,k]}. The \code{upper.triangle} function returns a vector of the lower triangular elements of a matrix, and the diagonal is included when \code{diag=TRUE}. } \references{ Higham, N.J. (2002). "Computing the Nearest Correlation Matrix - a Problem from Finance". \emph{IMA Journal of Numerical Analysis}, 22, p. 329--343. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{BayesianBootstrap}}, \code{\link{Cov2Prec}}, \code{\link{cov2cor}}, \code{\link{ddirichlet}}, \code{\link{GaussHermiteQuadRule}}, \code{\link{isSymmetric}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{lower.tri}}, \code{\link{MISS}}, \code{\link{Prec2Cov}}, \code{\link{solve}}, and \code{\link{upper.tri}}. } \keyword{Array} \keyword{High Performance Computing} \keyword{Math} \keyword{Matrix} \keyword{Utility}LaplacesDemon/man/LaplacesDemon.RAM.Rd0000755000176200001440000001461215144316355017166 0ustar liggesusers\name{LaplacesDemon.RAM} \alias{LaplacesDemon.RAM} \title{LaplacesDemon RAM Estimate} \description{ This function estimates the random-access memory (RAM) required to update a given model and data with the \code{\link{LaplacesDemon}} function. \emph{Warning:} Unwise use of this function may crash a computer, so please read the details below. } \usage{ LaplacesDemon.RAM(Model, Data, Iterations, Thinning, Algorithm="RWM") } \arguments{ \item{Model}{This is a model specification function. For more information, see \code{\link{LaplacesDemon}}.} \item{Data}{This is a list of Data. For more information, see \code{\link{LaplacesDemon}}.} \item{Iterations}{This is the number of iterations for which \code{\link{LaplacesDemon}} would update. For more information, see \code{\link{LaplacesDemon}}.} \item{Thinning}{This is the amount of thinning applied to the chains in \code{\link{LaplacesDemon}}.For more information, see \code{\link{LaplacesDemon}}.} \item{Algorithm}{This argument accepts the name of the algorithm as a string, as entered in \code{\link{LaplacesDemon}}.For more information, see \code{\link{LaplacesDemon}}.} } \details{ The \code{LaplacesDemon.RAM} function uses the \code{\link{object.size}} function to estimate the size in MB of RAM required to update one chain in \code{\link{LaplacesDemon}} for a given model and data, and for a number of iterations and specified thinning. When RAM is exceeded, the computer will crash. This function can be useful when trying to estimate how many iterations to update a model without crashing the computer. However, when estimating the required RAM, \code{LaplacesDemon.RAM} actually creates several large objects, such as \code{post} (see below). If too many iterations are given as an argument to \code{LaplacesDemon.RAM}, for example, then it will crash the computer while trying to estimate the required RAM. The best way to use this function is as follows. First, prepare the model specification and list of data. Second, observe how much RAM the computer is using at the moment, as well as the maximum available RAM. The majority of the difference of these two is the amount of RAM the computer may dedicate to updating the model. Next, use this function with a small number of iterations (important in some algorithms), and with few thinned samples (important in all algorithms). Note the estimated RAM. Increase the number of iterations and thinned samples, and again note the RAM. Continue to increase the number of iterations and thinned samples until, say, arbitrarily within 90\% of the above-mentioned difference in RAM. The computer operating system uses RAM, as does any other software running at the moment. R is currently using RAM, and other functions in the \code{LaplacesDemon} package, and any other package that is currently activated, are using RAM. There are numerous small objects that are not included in the returned list, that use RAM. For example, there may be a scalar called \code{alpha} for the acceptance probability, etc. One potentially larger object that is not included, and depends on the algorithm, is a matrix used for estimating \code{\link{LML}}. Its use occurs with non-adaptive MCMC algorithms, only with enough globally stationary samples, and only when the ratio of parameters to samples is not excessive. If used, then the user should create a matrix of the appropriate dimensions and use the \code{\link{object.size}} function to estimate the RAM. If the data is too large for RAM, then consider using either the \code{\link{BigData}} function or the SGLD algorithm in \code{\link{LaplacesDemon}}. } \value{ \code{LaplacesDemon.RAM} returns a list with several components. Each component is an estimate in MB for an object. The list has the following components: \item{Covar}{This is the estimated size in MB of RAM required for the covariance matrix, variance vector, or both (some algorithms store both internally, creating one from the other). Blocked covariance matrices are not considered at this time.} \item{Data}{This is the estimated size in MB of RAM required for the list of data.} \item{Deviance}{This is the estimated size in MB of RAM required for the deviance vector.} \item{Initial.Values}{This is the estimated size in MB of RAM required for the vector of initial values.} \item{Model}{This is the estimated size in MB of RAM required for the model specification function.} \item{Monitor}{This is the estimated size in MB of RAM required for the \eqn{N \times J}{N x J} matrix \code{Monitor}, where \eqn{N} is the number of thinned samples and J is the number of monitored variables.} \item{post}{This is the estimated size in MB of RAM required for a matrix of posterior samples. This matrix is used in some algorithms, and is not returned by \code{\link{LaplacesDemon}}.} \item{Posterior1}{This is the estimated size in MB of RAM required for the \eqn{N \times J}{N x J} matrix \code{Posterior1}, where \eqn{N} is the number of thinned samples and \eqn{J} is the number of initial values or parameters.} \item{Posterior2}{This is the estimated size in MB of RAM required for the \eqn{N \times J}{N x J} matrix \code{Posterior2}, where \eqn{N} is the number of globally stationary thinned samples and \eqn{J} is the number of initial values or parameters. Maximum RAM use is assumed here, so the same \eqn{N} is used, as in \code{Posterior1}.} \item{Summary1}{This is the estimated size in MB of RAM required for the summary table of all thinned posterior samples of parameters, deviance, and monitored variables.} \item{Summary2}{This is the estimated size in MB of RAM required for the summary table of all globally stationary thinned posterior samples of parameters, deviance, and monitored variables.} \item{Total}{This is the estimated size in MB of RAM required in total to update one chain in \code{\link{LaplacesDemon}} for a given model and data, and for a number of iterations and specified thinning.} } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{BigData}}, \code{\link{LaplacesDemon}}, \code{\link{LML}}, and \code{\link{object.size}}. } \keyword{Memory} LaplacesDemon/man/plot.laplace.ppc.Rd0000755000176200001440000004102215144316355017173 0ustar liggesusers\name{plot.laplace.ppc} \alias{plot.laplace.ppc} \title{Plots of Posterior Predictive Checks} \description{ This may be used to plot, or save plots of, samples in an object of class \code{laplace.ppc}. A variety of plots is provided. } \usage{\method{plot}{laplace.ppc}(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, \dots)} \arguments{ \item{x}{ This required argument is an object of class \code{laplace.ppc}.} \item{Style}{ This optional argument specifies one of several styles of plots, and defaults to \code{NULL} (which is the same as \code{"Density"}). Styles of plots are indicated in quotes. Optional styles include \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"Density"}, \code{"DW"}, \code{"DW, Multivariate, C"}, \code{"ECDF"}, \code{"Fitted"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Predictive Quantiles"}, \code{"Residual Density"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}. Details are given below.} \item{Data}{ This optional argument accepts the data set used when updating the model. Data is required only with certain plot styles, including \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"DW, Multivariate, C"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}.} \item{Rows}{ This optional argument is for a vector of row numbers that specify the records associated by row in the object of class \code{laplace.ppc}. Only these rows are plotted. The default is to plot all rows. Some plots do not allow rows to be specified.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{\dots}{Additional arguments are unused.} } \details{ This function can be used to produce a variety of posterior predictive plots, and the style of plot is selected with the \code{Style} argument. Below are some notes on the styles of plots. \code{Covariates} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is not categorical. \code{Covariates, Categorical DV} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is categorical. \code{Density} plots show the kernel density of the posterior predictive distribution for each selected row of y (all are selected by default). A vertical red line indicates the position of the observed y along the x-axis. When the vertical red line is close to the middle of a normal posterior predictive distribution, then there is little discrepancy between y and the posterior predictive distribution. When the vertical red line is in the tail of the distribution, or outside of the kernel density altogether, then there is a large discrepancy between y and the posterior predictive distribution. Large discrepancies may be considered outliers, and moreover suggest that an improvement in model fit should be considered. \code{DW} plots the distributions of the Durbin-Watson (DW) test statistics (Durbin and Watson, 1950), both observed (\eqn{d^{obs}}{d.obs} as a transparent, black density) and replicated (\eqn{d^{rep}}{d.rep} as a transparent, red density). The distribution of \eqn{d^{obs}}{d.obs} is estimated from the model, and \eqn{d^{rep}}{d.rep} is simulated from normal residuals without autocorrelation, where the number of simulations are the same as the observed number. This DW test may be applied to the residuals of univariate time-series models (or otherwise ordered residuals) to detect first-order autocorrelation. Autocorrelated residuals are not independent. The DW test is applicable only when the residuals are normally-distributed, higher-order autocorrelation is not present, and y is not used also as a lagged predictor. The DW test statistic, \eqn{d^{obs}}{d[obs]}, occurs in the interval (0,4), where 0 is perfect positive autocorrelation, 2 is no autocorrelation, and 4 is perfect negative autocorrelation. The following summary is reported on the plot: the mean of \eqn{d^{obs}}{d[obs]} (and its 95\% probability interval), the probability that \eqn{d^{obs} > d^{rep}}{d[obs] > d[rep]}, and whether or not autocorrelation is found. Positive autocorrelation is reported when the observed process is greater than the replicated process in 2.5\% of the samples, and negative autocorrelation is reported when the observed process is greater than the replicated process in 97.5\% of the samples. \code{DW, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Durbin-Watson test, as in \code{DW} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for first-order autocorrelation. \code{ECDF} (Empirical Cumulative Distribution Function) plots compare the ECDF of y with three ECDFs of yhat based on the 2.5\%, 50\% (median), and 97.5\% of its distribution. The ECDF(y) is defined as the proportion of values less than or equal to y. This plot is appropriate when y is univariate and at least ordinal. \code{Fitted} plots compare y with the probability interval of its replicate, and provide loess smoothing. This plot is appropriate when y is univariate and not categorical. \code{Fitted, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each column-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen column-wise. \code{Fitted, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each row-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen row-wise. \code{Jarque-Bera} plots the distributions of the Jarque-Bera (JB) test statistics (Jarque and Bera, 1980), both observed (\eqn{JB^{obs}}{JB.obs} as a transparent black density) and replicated (\eqn{JB^{rep}}{JB.rep} as a transparent red density). The distribution of \eqn{JB^{obs}}{JB.obs} is estimated from the model, and \eqn{JB^{rep}}{JB.rep} is simulated from normal residuals, where the number of simulations are the same as the observed number. This Jarque-Bera test may be applied to the residuals of univariate models to test for normality. The Jarque-Bera test does not test normality per se, but whether or not the distribution has kurtosis and skewness that match a normal distribution, and is therefore a test of the moments of a normal distribution. The following summary is reported on the plot: the mean of \eqn{JB^{obs}}{JB[obs]} (and its 95\% probability interval), the probability that \eqn{JB^{obs} > JB^{rep}}{JB[obs] > JB[rep]}, and whether or not normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Jarque-Bera, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Jarque-Bera test, as in \code{Jarque-Bera} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for normality. \code{Mardia} plots the distributions of the skewness (K3) and kurtosis (K4) test statistics (Mardia, 1970), both observed (\eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} as transparent black density) and replicated (\eqn{K3^{rep}}{K3.rep} and \eqn{K4^{rep}}{K4.rep} as transparent red density). The distributions of \eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} are estimated from the model, and both \eqn{K3^{rep}}{K3.rep} \eqn{K4^{rep}}{K4.rep} are simulated from multivariate normal residuals, where the number of simulations are the same as the observed number. This Mardia's test may be applied to the residuals of multivariate models to test for multivariate normality. Mardia's test does not test for multivariate normality per se, but whether or not the distribution has kurtosis and skewness that match a multivariate normal distribution, and is therefore a test of the moments of a multivariate normal distribution. The following summary is reported on the plots: the means of \eqn{K3^{obs}}{K3[obs]} and \eqn{K4^{obs}}{K4[obs]} (and the associated 95\% probability intervals), the probabilities that \eqn{K3^{obs} > K3^{rep}}{K3[obs] > K3[rep]} and \eqn{K4^{obs} > K4^{rep}}{K4[obs] > K4[rep]}, and whether or not multivariate normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Mardia} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. \code{Y} must be a \eqn{N \times P}{N x P} matrix of \eqn{N}{N} records and \eqn{P}{P} variables. Source code was modified from the deprecated package QRMlib. \code{Predictive Quantiles} plots compare y with the predictive quantile (PQ) of its replicate. This may be useful in looking for patterns with outliers. Instances outside of the gray lines are considered outliers. \code{Residual Density} plots the residual density of the median of the samples. A vertical red line occurs at zero. This plot may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when y is univariate and continuous. \code{Residual Density, Multivariate C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are column-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen column-wise. \code{Residual Density, Multivariate R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are row-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen row-wise. \code{Residuals} plots compare y with its residuals. The probability interval is plotted as a line. This plot is appropriate when y is univariate. \code{Residuals, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each column-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen column-wise. \code{Residuals, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each row-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen row-wise. \code{Space-Time by Space} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one time-series plot per point s in space, for a total of S plots. Therefore, these are time-series plots for each point s in space across T time-periods. See \code{Time-Series} plots below. \code{Space-Time by Time} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one spatial plot per time-period, and T plots will be produced. See \code{Spatial} plots below. \code{Spatial} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows yrep plotted according to its coordinates, and is color-coded so that higher values of yrep become more red, and lower values become more yellow. \code{Spatial Uncertainty} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows the probability interval of yrep plotted according to its coordinates, and is color-coded so that wider probability intervals become more red, and lower values become more yellow. \code{Time-Series} plots compare y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is univariate and ordered by time. \code{Time-Series, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by column in Y. \code{Time-Series, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each row-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by row in Y, such as is typically true in panel models. } \references{ Durbin, J., and Watson, G.S. (1950). "Testing for Serial Correlation in Least Squares Regression, I." \emph{Biometrika}, 37, p. 409--428. Jarque, C.M. and Bera, A.K. (1980). "Efficient Tests for Normality, Homoscedasticity and Serial Independence of Regression Residuals". \emph{Economics Letters}, 6(3), p. 255--259. Mardia, K.V. (1970). "Measures of Multivariate Skewness and Kurtosis with Applications". \emph{Biometrika}, 57(3), p. 519--530. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplaceApproximation}} and \code{\link{predict.laplace}}. } \examples{### See the LaplaceApproximation function for an example.} \keyword{Plot}LaplacesDemon/man/dist.Multivariate.t.Cholesky.Rd0000755000176200001440000001113015144316355021463 0ustar liggesusers\name{dist.Multivariate.t.Cholesky} \alias{dmvtc} \alias{rmvtc} \title{Multivariate t Distribution: Cholesky Parameterization} \description{ These functions provide the density and random number generation for the multivariate t distribution, otherwise called the multivariate Student distribution, given the Cholesky parameterization. } \usage{ dmvtc(x, mu, U, df=Inf, log=FALSE) rmvtc(n=1, mu, U, df=Inf) } \arguments{ \item{x}{This is either a vector of length \eqn{k} or a matrix with a number of columns, \eqn{k}, equal to the number of columns in scale matrix \eqn{\textbf{S}}{S}.} \item{n}{This is the number of random draws.} \item{mu}{This is a numeric vector or matrix representing the location parameter,\eqn{\mu}{mu} (the mean vector), of the multivariate distribution (equal to the expected value when \code{df > 1}, otherwise represented as \eqn{\nu > 1}{nu > 1}). When a vector, it must be of length \eqn{k}, or must have \eqn{k} columns as a matrix, as defined above.} \item{U}{This is the \eqn{k \times k}{k x k} upper-triangular matrix that is Cholesky factor \eqn{\textbf{U}}{U} of scale matrix \eqn{\textbf{S}}{S}, such that \code{S*df/(df-2)} is the variance-covariance matrix when \code{df > 2}.} \item{df}{This is the degrees of freedom, and is often represented with \eqn{\nu}{nu}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{\Gamma[(\nu+k)/2]}{\Gamma(\nu/2)\nu^{k/2}\pi^{k/2}|\Sigma|^{1/2}[1 + (1/\nu)(\theta-\mu)^{\mathrm{T}} \Sigma^{-1} (\theta-\mu)]^{(\nu+k)/2}}}{p(theta) = Gamma[(nu+k)/2] / {Gamma(nu/2)nu^(k/2)pi^(k/2)|Sigma|^(1/2)[1 + (1/nu)(theta-mu)^T*Sigma^(-1)(theta-mu)]^[(nu+k)/2]}} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathrm{t}_k(\mu, \Sigma, \nu)}{theta ~ t[k](mu, Sigma, nu)} \item Notation 2: \eqn{p(\theta) = \mathrm{t}_k(\theta | \mu, \Sigma, \nu)}{p(theta) = t[k](theta | mu, Sigma, nu)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} scale matrix \eqn{\Sigma}{Sigma} \item Parameter 3: degrees of freedom \eqn{\nu > 0}{nu > 0} (df in the functions) \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu}, for \eqn{\nu > 1}{nu > 1}, otherwise undefined \item Variance: \eqn{var(\theta) = \frac{\nu}{\nu - 2} \Sigma}{var(theta) = (nu / (nu - 2))*Sigma}, for \eqn{\nu > 2}{nu > 2} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate t distribution, also called the multivariate Student or multivariate Student t distribution, is a multidimensional extension of the one-dimensional or univariate Student t distribution. A random vector is considered to be multivariate t-distributed if every linear combination of its components has a univariate Student t-distribution. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k}, and an upper-triangular \eqn{k \times k}{k x k} matrix that is Cholesky factor \eqn{\textbf{U}}{U}, as per the \code{\link{chol}} function for Cholesky decomposition. When degrees of freedom \eqn{\nu=1}{nu=1}, this is the multivariate Cauchy distribution. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, the Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dmvt}, \code{dmvtc} must additionally matrix-multiply the Cholesky back to the scale matrix, but it does not have to check for or correct the scale matrix to positive-definiteness, which overall is slower. The same is true when comparing \code{rmvt} and \code{rmvtc}. } \value{ \code{dmvtc} gives the density and \code{rmvtc} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{chol}}, \code{\link{dinvwishartc}}, \code{\link{dmvc}}, \code{\link{dmvcp}}, \code{\link{dmvtp}}, \code{\link{dst}}, \code{\link{dstp}}, and \code{\link{dt}}. } \examples{ library(LaplacesDemon) x <- seq(-2,4,length=21) y <- 2*x+10 z <- x+cos(y) mu <- c(1,12,2) S <- matrix(c(1,2,0,2,5,0.5,0,0.5,3), 3, 3) U <- chol(S) df <- 4 f <- dmvtc(cbind(x,y,z), mu, U, df) X <- rmvtc(1000, c(0,1,2), U, 5) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution} LaplacesDemon/man/is.stationary.Rd0000755000176200001440000000346115144316355016650 0ustar liggesusers\name{is.stationary} \alias{is.stationary} \title{Logical Check of Stationarity} \description{ This function returns \code{TRUE} if the object is stationary according to the \code{\link{Geweke.Diagnostic}} function, and \code{FALSE} otherwise. } \usage{ is.stationary(x) } \arguments{ \item{x}{This is a vector, matrix, or object of class \code{demonoid}.} } \details{ Stationarity, here, refers to the limiting distribution in a Markov chain. A series of samples from a Markov chain, in which each sample is the result of an iteration of a Markov chain Monte Carlo (MCMC) algorithm, is analyzed for stationarity, meaning whether or not the samples trend or its moments change across iterations. A stationary posterior distribution is an equilibrium distribution, and assessing stationarity is an important diagnostic toward inferring Markov chain convergence. In the cases of a matrix or an object of class \code{demonoid}, all Markov chains (as column vectors) must be stationary for \code{is.stationary} to return \code{TRUE}. Alternative ways to assess stationarity of chains are to use the \code{\link{BMK.Diagnostic}} or \code{\link{Heidelberger.Diagnostic}} functions. } \value{ \code{is.stationary} returns a logical value indicating whether or not the supplied object is stationary according to the \code{\link{Geweke.Diagnostic}} function. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{BMK.Diagnostic}}, \code{\link{Geweke.Diagnostic}}, \code{\link{Heidelberger.Diagnostic}}, and \code{\link{LaplacesDemon}}. } \examples{ library(LaplacesDemon) is.stationary(rnorm(100)) is.stationary(matrix(rnorm(100),10,10)) } \keyword{Diagnostic} \keyword{Stationarity} \keyword{Utility}LaplacesDemon/man/dist.Inverse.Wishart.Cholesky.Rd0000755000176200001440000001157015144316355021616 0ustar liggesusers\name{dist.Inverse.Wishart.Cholesky} \alias{dinvwishartc} \alias{rinvwishartc} \title{Inverse Wishart Distribution: Cholesky Parameterization} \description{ These functions provide the density and random number generation for the inverse Wishart distribution with the Cholesky parameterization. } \usage{ dinvwishartc(U, nu, S, log=FALSE) rinvwishartc(nu, S) } \arguments{ \item{U}{This is the upper-triangular \eqn{k \times k}{k x k} matrix for the Cholesky factor \eqn{\textbf{U}}{U} of covariance matrix \eqn{\Sigma}{Sigma}.} \item{nu}{This is the scalar degrees of freedom, \eqn{\nu}{nu}.} \item{S}{This is the symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = (2^{\nu k/2} \pi^{k(k-1)/4} \prod^k_{i=1} \Gamma(\frac{\nu+1-i}{2}))^{-1} |\textbf{S}|^{\nu/2} |\Sigma|^{-(\nu+k+1)/2} \exp(-\frac{1}{2} tr(\textbf{S} \Sigma^{-1}))}{p(theta) = (2^(nu*k/2) * pi^(k(k-1)/4) * [Gamma((nu+1-i)/2) * ... * Gamma((nu+1-k)/2)])^(-1) * |S|^(nu/2) * |Sigma|^(-(nu+k+1)/2) * exp(-(1/2) * tr(S Sigma^(-1)))} \item Inventor: John Wishart (1928) \item Notation 1: \eqn{\Sigma \sim \mathcal{W}^{-1}_{\nu}(\textbf{S}^{-1})}{Sigma ~ W^(-1)[nu](S^(-1))} \item Notation 2: \eqn{p(\Sigma) = \mathcal{W}^{-1}_{\nu}(\Sigma | \textbf{S}^{-1})}{p(Sigma) = W^-1[nu](Sigma | S^(-1))} \item Parameter 1: degrees of freedom \eqn{\nu}{nu} \item Parameter 2: symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S} \item Mean: \eqn{E(\Sigma) = \frac{\textbf{S}}{\nu - k - 1}}{E(Sigma) = S / (nu - k - 1)} \item Variance: \item Mode: \eqn{mode(\Sigma) = \frac{\textbf{S}}{\nu + k + 1}}{mode(Sigma) = S / (nu + k + 1)} } The inverse Wishart distribution is a probability distribution defined on real-valued, symmetric, positive-definite matrices, and is used as the conjugate prior for the covariance matrix, \eqn{\Sigma}{Sigma}, of a multivariate normal distribution. In this parameterization, \eqn{\Sigma}{Sigma} has been decomposed to the upper-triangular Cholesky factor \eqn{\textbf{U}}{U}, as per \code{\link{chol}}. The inverse-Wishart density is always finite, and the integral is always finite. A degenerate form occurs when \eqn{\nu < k}{nu < k}. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, the Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dinvwishart}, \code{dinvwishartc} must additionally matrix-multiply the Cholesky back to the covariance matrix, but it does not have to check for or correct the covariance matrix to positive-semidefiniteness, which overall is slower. Compared with \code{rinvwishart}, \code{rinvwishartc} must additionally calculate a Cholesky decomposition, and is therefore slower. The inverse Wishart prior lacks flexibility, having only one parameter, \eqn{\nu}{nu}, to control the variability for all \eqn{k(k + 1)/2} elements. Popular choices for the scale matrix \eqn{\textbf{S}}{S} include an identity matrix or sample covariance matrix. When the model sample size is small, the specification of the scale matrix can be influential. The inverse Wishart distribution has a dependency between variance and correlation, although its relative for a precision matrix (inverse covariance matrix), the Wishart distribution, does not have this dependency. This relationship becomes weaker with more degrees of freedom. Due to these limitations (lack of flexibility, and dependence between variance and correlation), alternative distributions have been developed. Alternative distributions that are available here include the inverse matrix gamma (\code{\link{dinvmatrixgamma}}), Scaled Inverse Wishart (\code{\link{dsiw}}) and Huang-Wand (\code{\link{dhuangwand}}). Huang-Wand is recommended. } \value{ \code{dinvwishartc} gives the density and \code{rinvwishartc} generates random deviates. } \references{ Wishart, J. (1928). "The Generalised Product Moment Distribution in Samples from a Normal Multivariate Population". \emph{Biometrika}, 20A(1-2), p. 32--52. } \seealso{ \code{\link{chol}}, \code{\link{Cov2Prec}}, \code{\link{dhuangwand}}, \code{\link{dinvmatrixgamma}}, \code{\link{dmvn}}, \code{\link{dmvnc}}, \code{\link{dmvtc}}, \code{\link{dsiw}}, \code{\link{dwishart}}, \code{\link{dwishartc}}, and \code{\link{dyangbergerc}}. } \examples{ library(LaplacesDemon) Sigma <- matrix(c(2,-.3,-.3,4),2,2) U <- chol(Sigma) x <- dinvwishartc(U, 3, matrix(c(1,.1,.1,1),2,2)) x <- rinvwishartc(3, matrix(c(1,.1,.1,1),2,2)) } \keyword{Distribution} LaplacesDemon/man/BayesianBootstrap.Rd0000755000176200001440000001447115144316355017475 0ustar liggesusers\name{BayesianBootstrap} \alias{BayesianBootstrap} \title{The Bayesian Bootstrap} \description{ This function performs the Bayesian bootstrap of Rubin (1981), returning either bootstrapped weights or statistics. } \usage{ BayesianBootstrap(X, n=1000, Method="weights", Status=NULL) } \arguments{ \item{X}{This is a vector or matrix of data. When a matrix is supplied, sampling is based on the first column.} \item{n}{This is the number of bootstrapped replications.} \item{Method}{When \code{Method="weights"} (which is the default), a matrix of row weights is returned. Otherwise, a function is accepted. The function specifies the statistic to be bootstrapped. The first argument of the function should be a matrix of data, and the second argument should be a vector of weights.} \item{Status}{This determines the periodicity of status messages. When \code{Status=100}, for example, a status message is displayed every 100 replications. Otherwise, \code{Status} defaults to \code{NULL}, and status messages are not displayed.} } \details{ The term, `bootstrap', comes from the German novel \emph{Adventures of Baron Munchausen} by Rudolph Raspe, in which the hero saves himself from drowning by pulling on his own bootstraps. The idea of the statistical bootstrap is to evaluate properties of an estimator through the empirical, rather than theoretical, CDF. Rubin (1981) introduced the Bayesian bootstrap. In contrast to the frequentist bootstrap which simulates the sampling distribution of a statistic estimating a parameter, the Bayesian bootstrap simulates the posterior distribution. The data, \eqn{\textbf{X}}{X}, are assumed to be independent and identically distributed (IID), and to be a representative sample of the larger (bootstrapped) population. Given that the data has \eqn{N} rows in one bootstrap replication, the row weights are sampled from a Dirichlet distribution with all \eqn{N} concentration parameters equal to \eqn{1} (a uniform distribution over an open standard \eqn{N-1} simplex). The distributions of a parameter inferred from considering many samples of weights are interpretable as posterior distributions on that parameter. The Bayesian bootstrap is useful for estimating marginal posterior covariance and standard deviations for the posterior modes of \code{\link{LaplaceApproximation}}, especially when the model dimension (the number of parameters) is large enough that estimating the \code{\link{Hessian}} matrix of second partial derivatives is too computationally demanding. Just as with the frequentist bootstrap, inappropriate use of the Bayesian bootstrap can lead to inappropriate inferences. The Bayesian bootstrap violates the likelihood principle, because the evaluation of a statistic of interest depends on data sets other than the observed data set. For more information on the likelihood principle, see \url{https://web.archive.org/web/20150213002158/http://www.bayesian-inference.com/likelihood#likelihoodprinciple}. The \code{BayesianBootstrap} function has many uses, including creating test statistics on the population data given the observed data (supported here), imputation (with this variation: \code{\link{ABB}}), validation, and more. } \value{ When \code{Method="weights"}, this function returns a \eqn{N \times n}{S x J} matrix of weights, where the number of rows \eqn{N} is equal to the number of rows in \code{X}. For statistics, a matrix or array is returned, depending on the number of dimensions. The replicates are indexed by row in a matrix or in the first dimension of the array. } \references{ Rubin, D.B. (1981). "The Bayesian Bootstrap". \emph{The Annals of Statistics}, 9(1), p. 130--134. } \author{Bogumil Kaminski, \email{bkamins@sgh.waw.pl} and Statisticat, LLC.} \seealso{ \code{\link{ABB}}, \code{\link{Hessian}}, \code{\link{LaplaceApproximation}}, and \code{\link{LaplacesDemon}}. } \examples{ library(LaplacesDemon) #Example 1: Samples x <- 1:2 BB <- BayesianBootstrap(X=x, n=100, Method="weights"); BB #Example 2: Mean, Univariate x <- 1:2 BB <- BayesianBootstrap(X=x, n=100, Method=weighted.mean); BB #Example 3: Mean, Multivariate data(demonsnacks) BB <- BayesianBootstrap(X=demonsnacks, n=100, Method=function(x,w) apply(x, 2, weighted.mean, w=w)); BB #Example 4: Correlation dye <- c(1.15, 1.70, 1.42, 1.38, 2.80, 4.70, 4.80, 1.41, 3.90) efp <- c(1.38, 1.72, 1.59, 1.47, 1.66, 3.45, 3.87, 1.31, 3.75) X <- matrix(c(dye,efp), length(dye), 2) colnames(X) <- c("dye","efp") BB <- BayesianBootstrap(X=X, n=100, Method=function(x,w) cov.wt(x, w, cor=TRUE)$cor); BB #Example 5: Marginal Posterior Covariance #The following example is commented out due to package build time. #To run the following example, use the code from the examples in #the LaplaceApproximation function for the data, model specification #function, and initial values. Then perform the Laplace #Approximation as below (with CovEst="Identity" and sir=FALSE) until #convergence, set the latest initial values, then use the Bayesian #bootstrap on the data, run the Laplace Approximation again to #convergence, save the posterior modes, and repeat until S samples #of the posterior modes are collected. Finally, calculate the #parameter covariance or standard deviation. #Fit <- LaplaceApproximation(Model, Initial.Values, Data=MyData, # Iterations=1000, Method="SPG", CovEst="Identity", sir=FALSE) #Initial.Values <- as.initial.values(Fit) #S <- 100 #Number of bootstrapped sets of posterior modes (parameters) #Z <- rbind(Fit$Summary1[,1]) #Bootstrapped parameters collected here #N <- nrow(MyData$X) #Number of records #MyData.B <- MyData #for (s in 1:S) { # cat("\nIter:", s, "\n") # BB <- BayesianBootstrap(MyData$y, n=N) # z <- apply(BB, 2, function(x) sample.int(N, size=1, prob=x)) # MyData.B$y <- MyData$y[z] # MyData.B$X <- MyData$X[z,] # Fit <- LaplaceApproximation(Model, Initial.Values, Data=MyData.B, # Iterations=1000, Method="SPG", CovEst="Identity", sir=FALSE) # Z <- rbind(Z, Fit$Summary1[,1])} #cov(Z) #Bootstrapped marginal posterior covariance #sqrt(diag(cov(Z))) #Bootstrapped marginal posterior standard deviations } \keyword{Utility} LaplacesDemon/man/LaplacesDemon.Rd0000755000176200001440000016163415145052534016554 0ustar liggesusers\name{LaplacesDemon} \alias{LaplacesDemon} \alias{LaplacesDemon.hpc} \title{Laplace's Demon} \description{ The \code{LaplacesDemon} function is the main function of Laplace's Demon. Given data, a model specification, and initial values, \code{LaplacesDemon} maximizes the logarithm of the unnormalized joint posterior density with MCMC and provides samples of the marginal posterior distributions, deviance, and other monitored variables. The \code{LaplacesDemon.hpc} function extends \code{LaplacesDemon} to parallel chains for multicore or cluster high performance computing. } \usage{ LaplacesDemon(Model, Data, Initial.Values, Covar=NULL, Iterations=10000, Status=100, Thinning=10, Algorithm="MWG", Specs=list(B=NULL), Debug=list(DB.chol=FALSE, DB.eigen=FALSE, DB.MCSE=FALSE, DB.Model=TRUE), LogFile="", ...) LaplacesDemon.hpc(Model, Data, Initial.Values, Covar=NULL, Iterations=10000, Status=100, Thinning=10, Algorithm="MWG", Specs=list(B=NULL), Debug=list(DB.chol=FALSE, DB.eigen=FALSE, DB.MCSE=FALSE, DB.Model=TRUE), LogFile="", Chains=2, CPUs=2, Type="PSOCK", Packages=NULL, Dyn.libs=NULL) } \arguments{ \item{Model}{This required argument receives the model from a user-defined function that must be named Model. The user-defined function is where the model is specified. \code{LaplacesDemon} passes two arguments to the model function, \code{parms} and \code{Data}, and receives five arguments from the model function: \code{LP} (the logarithm of the unnormalized joint posterior), \code{Dev} (the deviance), \code{Monitor} (the monitored variables), \code{yhat} (the variables for posterior predictive checks), and \code{parm}, the vector of parameters, which may be constrained in the model function. More information on the Model specification function may be found in the "LaplacesDemon Tutorial" vignette, and the \code{\link{is.model}} function. Many examples of model specification functions may be found in the "Examples" vignette.} \item{Data}{This required argument accepts a list of data. The list of data must contain \code{mon.names} which contains monitored variable names, and must contain \code{parm.names} which contains parameter names. The \code{\link{as.parm.names}} function may be helpful for preparing the data, and the \code{\link{is.data}} function may be helpful for checking data.} \item{Initial.Values}{For \code{LaplacesDemon}, this argument requires a vector of initial values equal in length to the number of parameters. For \code{LaplacesDemon.hpc}, this argument also accepts a vector, in which case the same initial values will be applied to all parallel chains, or the argument accepts a matrix in which each row is a parallel chain and the number of columns is equal in length to the number of parameters. When a matrix is supplied for \code{LaplacesDemon.hpc}, each parallel chain begins with its own initial values that are preferably dispersed. For both \code{LaplacesDemon} and \code{LaplacesDemon.hpc}, each initial value will be the starting point for an adaptive chain or a non-adaptive Markov chain of a parameter. Parameters are assumed to be continuous, unless specified to be discrete (see \code{dparm} below), which is not accepted by all algorithms (see \code{\link{dcrmrf}} for an alternative). If all initial values are set to zero, then Laplace's Demon will attempt to optimize the initial values with the \code{\link{LaplaceApproximation}} function. After Laplace's Demon finishes updating, it may be desired to continue updating from where it left off. To continue, this argument should receive the last iteration of the previous update. For example, if the output object is called Fit, then \code{Initial.Values=as.initial.values(Fit)}. Initial values may be generated randomly with the \code{\link{GIV}} function.} \item{Covar}{This argument defaults to \code{NULL}, but may otherwise accept a \eqn{K \times K}{K x K} proposal covariance matrix (where \eqn{K} is the number of dimensions or parameters), a variance vector, or a list of covariance matrices (for blockwise sampling in some algorithms). When the model is updated for the first time and prior variance or covariance is unknown, then \code{Covar=NULL} should be used. Some algorithms require covariance, some only require variance, and some require neither. Laplace's Demon automatically converts the user input to the required form. Once Laplace's Demon has finished updating, it may be desired to continue updating where it left off, in which case the proposal covariance matrix from the last run can be input into the next run. The covariance matrix may also be input from the \code{\link{LaplaceApproximation}} function, if used.} \item{Iterations}{This required argument accepts integers larger than 10, and determines the number of iterations that Laplace's Demon will update the parameters while searching for target distributions. The required amount of computer memory will increase with \code{Iterations}. If computer memory is exceeded, then all will be lost. The \code{\link{Combine}} function can be used later to combine multiple updates.} \item{Status}{This argument accepts an integer between 1 and the number of iterations, and indicates how often, in iterations, the user would like the status printed to the screen or log file. Usually, the following is reported: the number of iterations, the proposal type (for example, multivariate or componentwise, or mixture, or subset), and LP. For example, if a model is updated for 1,000 iterations and \code{Status=200}, then a status message will be printed at the following iterations: 200, 400, 600, 800, and 1,000.} \item{Thinning}{This argument accepts integers between 1 and the number of iterations, and indicates that every nth iteration will be retained, while the other iterations are discarded. If \code{Thinning=5}, then every 5th iteration will be retained. Thinning is performed to reduce autocorrelation and the number of marginal posterior samples.} \item{Algorithm}{This argument accepts the abbreviated name of the MCMC algorithm, which must appear in quotes. A list of MCMC algorithms appears below in the Details section, and the abbreviated name is in parenthesis.} \item{Specs}{This argument defaults to \code{NULL}, and accepts a list of specifications for the MCMC algorithm declared in the \code{Algorithm} argument. The specifications associated with each algorithm may be seen below in the examples, must appear in the order shown, and are described in the details section below.} \item{Debug}{This argument accepts a list of logical scalars that control whether or not errors or warnings are reported due to a \code{try} function or non-finite values. List components include \code{DB.chol} regarding \code{chol}, \code{DB.eigen} regarding \code{eigen}, \code{DB.MCSE} regarding \code{\link{MCSE}}, and \code{DB.Model} regarding the Model specification function. Errors and warnings should be investigated, but do not necessarily indicate a faulty Model specification function or a bug in the software. For example, a sampler may make a proposal that would result in a matrix that is not positive definite, when it should be. This kind of error or warning is acceptable, provided the sampler handles it correctly by rejecting the proposal, and provided the Model specification function is not causing the issue. Oftentimes, blockwise sampling with carefully chosen blocks will mostly or completely eliminate errors or warnings that occur otherwise in larger, multivariate proposals. Similarly, debugged componentwise algorithms tend to provide more information than multivariate algorithms, since usually the parameter and both its current and proposed values may be reported. If confident in the Model specification function, and errors or warnings are produced frequently that are acceptable, then consider setting \code{DB.Model=FALSE} for cleaner output and faster sampling. If the Model specification function is not faulty and there is a bug in \code{LaplacesDemon}, then please report it with a bug description and reproducible code on \url{https://github.com/LaplacesDemonR/LaplacesDemon/issues}.} \item{LogFile}{This argument is used to specify a log file name in quotes in the working directory as a destination, rather than the console, for the output messages of \code{cat} and \code{stop} commands. It is helpful to assign a log file name when using multiple cores, such as with \code{LaplacesDemon.hpc}. Doing so allows the user to check the progress in the log. A number of log files are created, one for each chain, and one for the overall process.} \item{Chains}{This argument is required only for \code{LaplacesDemon.hpc}, and indicates the number of parallel chains.} \item{CPUs}{This argument is required for parallel independent or interactive chains in \code{LaplacesDemon} or \code{LaplacesDemon.hpc}, and indicates the number of central processing units (CPUs) of the computer or cluster. For example, when a user has a quad-core computer, \code{CPUs=4}.} \item{Type}{This argument defaults to \code{"PSOCK"} and uses the Simple Network of Workstations (SNOW) for parallelization. Alternatively, \code{Type="MPI"} may be specified to use Message Passing Interface (MPI) for parallelization.} \item{Packages}{This optional argument is for use with parallel independent or interacting chains, and defaults to \code{NULL}. This argument accepts a vector of package names to load into each parallel chain. If the \code{Model} specification depends on any packages, then these package names need to be in this vector.} \item{Dyn.libs}{This optional argument is for use with parallel independent or interacting chain, and defaults to \code{NULL}. This argument accepts a vector of the names of dynamic link libraries (shared objects) to load into each parallel chain. The libraries must be located in the working directory.} \item{...}{Additional arguments are unused.} } \details{ \code{LaplacesDemon} offers numerous MCMC algorithms for numerical approximation in Bayesian inference. The algorithms are \itemize{ \item Adaptive Directional Metropolis-within-Gibbs (ADMG) \item Adaptive Griddy-Gibbs (AGG) \item Adaptive Hamiltonian Monte Carlo (AHMC) \item Adaptive Metropolis (AM) \item Adaptive Metropolis-within-Gibbs (AMWG) \item Adaptive-Mixture Metropolis (AMM) \item Affine-Invariant Ensemble Sampler (AIES) \item Componentwise Hit-And-Run Metropolis (CHARM) \item Delayed Rejection Adaptive Metropolis (DRAM) \item Delayed Rejection Metropolis (DRM) \item Differential Evolution Markov Chain (DEMC) \item Elliptical Slice Sampler (ESS) \item Gibbs Sampler (Gibbs) \item Griddy-Gibbs (GG) \item Hamiltonian Monte Carlo (HMC) \item Hamiltonian Monte Carlo with Dual-Averaging (HMCDA) \item Hit-And-Run Metropolis (HARM) \item Independence Metropolis (IM) \item Interchain Adaptation (INCA) \item Metropolis-Adjusted Langevin Algorithm (MALA) \item Metropolis-Coupled Markov Chain Monte Carlo (MCMCMC) \item Metropolis-within-Gibbs (MWG) \item Multiple-Try Metropolis (MTM) \item No-U-Turn Sampler (NUTS) \item Oblique Hyperrectangle Slice Sampler (OHSS) \item Preconditioned Crank-Nicolson (pCN) \item Random Dive Metropolis-Hastings (RDMH) \item Random-Walk Metropolis (RWM) \item Reflective Slice Sampler (RSS) \item Refractive Sampler (Refractive) \item Reversible-Jump (RJ) \item Robust Adaptive Metropolis (RAM) \item Sequential Adaptive Metropolis-within-Gibbs (SAMWG) \item Sequential Metropolis-within-Gibbs (SMWG) \item Slice Sampler (Slice) \item Stochastic Gradient Langevin Dynamics (SGLD) \item Tempered Hamiltonian Monte Carlo (THMC) \item t-walk (twalk) \item Univariate Eigenvector Slice Sampler (UESS) \item Updating Sequential Adaptive Metropolis-within-Gibbs (USAMWG) \item Updating Sequential Metropolis-within-Gibbs (USMWG) } It is a goal for the documentation in the \pkg{LaplacesDemon} to be extensive. However, details of MCMC algorithms are best explored online at \url{https://web.archive.org/web/20150206014000/http://www.bayesian-inference.com/mcmc}, as well as in the "LaplacesDemon Tutorial" vignette, and the "Bayesian Inference" vignette. Algorithm specifications (\code{Specs}) are listed below: \itemize{ \item \code{A} is used in AFSS, HMCDA, MALA, NUTS, OHSS, and UESS. In MALA, it is the maximum acceptable value of the Euclidean norm of the adaptive parameters mu and sigma, and the Frobenius norm of the covariance matrix. In AFSS, HMCDA, NUTS, OHSS, and UESS, it is the number of initial, adaptive iterations to be discarded as burn-in. \item \code{Adaptive} is the iteration in which adaptation begins, and is used in AM, AMM, DRAM, INCA, and Refractive. Most of these algorithms adapt according to an observed covariance matrix, and should sample before beginning to adapt. \item \code{alpha.star} is the target acceptance rate in MALA and RAM, and is optional in CHARM and HARM. The recommended value for multivariate proposals is \code{alpha.star=0.234}, for componentwise proposals is \code{alpha.star=0.44}, and for MALA is \code{alpha.star=0.574}. \item \code{at} affects the traverse move in twalk. \code{at=6} is recommended. It helps when some parameters are highly correlated, and the correlation structure may change through the state-space. The traverse move is associated with an acceptance rate that decreases as the number of parameters increases, and is the reason that \code{n1} is used to select a subset of parameters each iteration. If adjusted, it is recommended to stay in the interval [2,10]. \item \code{aw} affects the walk move in twalk, and \code{aw=1.5} is recommended. If adjusted, it is recommended to stay in the interval [0.3,2]. \item \code{beta} is a scale parameter for AIES, and defaults to 2, or an autoregressive parameter for pCN. \item \code{bin.n} is the scalar size parameter for a binomial prior distribution of model size for the RJ algorithm. \item \code{bin.p} is the scalar probability parameter for a binomial prior distribution of model size for the RJ algorithm. \item \code{B} is a list of blocked parameters. Each component of the list represents a block of parameters, and contains a vector in which each element is the position of the associated parameter in parm.names. This function is optional in the AFSS, AMM, AMWG, ESS, HARM, MWG, RAM, RWM, Slice, and UESS algorithms. For more information on blockwise sampling, see the \code{\link{Blocks}} function. \item \code{Begin} indicates the time-period in which to begin updating (filtering or predicting) in the USAMWG and USMWG algorithms. \item \code{Bounds} is used in the Slice algorithm. It is a vector of length two with the lower and upper boundary of the slice. For continuous parameters, it is often set to negative and positive infinity, while for discrete parameters it is set to the minimum and maximum discrete values to be sampled. When blocks are used, this must be supplied as a list with the same number of list components as the number of blocks. \item \code{delta} is used in HMCDA, MALA, and NUTS. In HMCDA and NUTS, it is the target acceptance rate, and the recommended value is 0.65 in HMCDA and 0.6 in NUTS. In MALA, it is a constant in the bounded drift function, may be in the interval [1e-10,1000], and 1 is the default. \item \code{Dist} is the proposal distribution in RAM, and may either be \code{Dist="t"} for t-distributed or \code{Dist="N"} for normally-distributed. \item \code{dparm} accepts a vector of integers that indicate discrete parameters. This argument is for use with the AGG or GG algorithm. \item \code{Dyn} is a \eqn{T \times K}{T x K} matrix of dynamic parameters, where \eqn{T} is the number of time-periods and \eqn{K} is the number of dynamic parameters. \code{Dyn} is used by SAMWG, SMWG, USAMWG, and USMWG. Non-dynamic parameters are updated first in each sampler iteration, then dynamic parameters are updated in a random order in each time-period, and sequentially by time-period. \item \code{epsilon} is used in AHMC, HMC, HMCDA, MALA, NUTS, SGLD, and THMC. It is the step-size in all algorithms except MALA. It is a vector equal in length to the number of parameters in AHMC, HMC, and THMC. It is a scalar in HMCDA and NUTS. It is either a scalar or a vector equal in length to the number of iterations in SGLD. When \code{epsilon=NULL} in HMCDA or NUTS (only), a reasonable initial value is found. In MALA, it is a vector of length two. The first element is the acceptable minimum of adaptive scale sigma, and the second element is added to the diagonal of the covariance matrix for regularization. \item \code{FC} is used in Gibbs and accepts a function that receives two arguments: the vector of all parameters and the list of data (similar to the Model specification function). FC must return the updated vector of all parameters. The user specifies FC to calculate the full conditional distribution of one or more parameters. \item \code{file} is the quoted name of a numeric matrix of data, without headers, for SGLD. The big data set must be a .csv file. This matrix has \code{Nr} rows and \code{Nc} columns. Each iteration, SGLD will randomly select a block of rows, where the number of rows is specified by the \code{size} argument. \item \code{Fit} is an object of class \code{demonoid} in the USAMWG and USMWG algorithms. Posterior samples before the time-period specified in the \code{Begin} argument are not updated, and are used instead from \code{Fit}. \item \code{gamma} controls the step size in DEMC or the decay of adaptation in MALA and RAM. In DEMC, it is positive and defaults to \eqn{2.38 / \sqrt{2J}}{2.38/sqrt(2J)} when \code{NULL}, where \eqn{J} is the length of initial values. For RAM, it is in the interval (0.5,1], and 0.66 is recommended. For MALA, it is in the interval (1,\code{Iterations}), and defaults to 1. \item \code{Grid} accepts either a vector or a list of vectors of evenly-spaced points on a grid for the AGG or GG algorithm. When the argument is a vector, the same grid is applied to all parameters. When the argument is a list, each component in the list has a grid that is applied to the corresponding parameter. The algorithm will evaluate each continuous parameter at the latest value plus each point in the grid, or each discrete parameter (see \code{dparm}) at each grid point (which should be each discrete value). \item \code{K} is a scalar number of proposals in MTM. \item \code{L} is a scalar number of leapfrog steps in AHMC, HMC, and THMC. When \code{L=1}, the algorithm reduces to Langevin Monte Carlo (LMC). \item \code{lambda} is used in HMCDA and MCMCMC. In HMCDA, it is a scalar trajectory length. In MCMCMC, it is either a scalar that controls temperature spacing, or a vector of temperature spacings. \item \code{Lmax} is a scalar maximum for \code{L} (see above) in HMCDA and NUTS. \item \code{m} is used in the AFSS, AHMC, HMC, Refractive, RSS, Slice, THMC, and UESS algorithms. In AHMC, HMC, and THMC, it is a \eqn{J \times J}{J x J} mass matrix for \eqn{J} initial values. In AFSS and UESS, it is a scalar, and is the maximum number of steps for creating the slice interval. In Refractive and RSS, it is a scalar, and is the number of steps to take per iteration. In Slice, it is either a scalar or a list with as many list components as blocks. It must be an integer in [1,Inf], and indicates the maximum number of steps for creating the slice interval. \item \code{mu} is a vector that is equal in length to the initial values. This vector will be used as the mean of the proposal distribution, and is usually the posterior mode of a previously-updated \code{\link{LaplaceApproximation}}. \item \code{MWG} is used in Gibbs to specify a vector of parameters that are to receive Metropolis-within-Gibbs updates. Each element is an integer that indicates the parameter. \item \code{Nc} is either the number of (un-parallelized) parallel chains in DEMC (and must be at least 3) or the number of columns of big data in SGLD. \item \code{Nr} is the number of rows of big data in SGLD. \item \code{n} is the number of previous iterations in ADMG, AFSS, AMM, AMWG, OHSS, RAM, and UESS. \item \code{n1} affects the size of the subset of each set of points to adjust, and is used in twalk. It relates to the number of parameters, and \code{n1=4} is recommended. If adjusted, it is recommended to stay in the interval [2,20]. \item \code{parm.p} is a vector of probabilities for parameter selection in the RJ algorithm, and must be equal in length to the number of initial values. \item \code{r} is a scalar used in the Refractive algorithm to indicate the ratio between r1 and r2. \item \code{Periodicity} specifies how often in iterations the adaptive algorithm should adapt, and is used by AHMC, AM, AMM, AMWG, DRAM, INCA, SAMWG, and USAMWG. If \code{Periodicity=10}, then the algorithm adapts every 10th iteration. A higher \code{Periodicity} is associated with an algorithm that runs faster, because it does not have to calculate adaptation as often, though the algorithm adapts less often to the target distributions, so it is a trade-off. It is recommended to use the lowest value that runs fast enough to suit the user, or provide sufficient adaptation. \item \code{selectable} is a vector of indicators of whether or not a parameter is selectable for variable selection in the RJ algorithm. Non-selectable parameters are assigned a zero, and are always in the model. Selectable parameters are assigned a one. This vector must be equal in length to the number of initial values. \item \code{selected} is a vector of indicators of whether or not each parameter is selected when the RJ algorithm begins, and must be equal in length to the number of initial values. \item \code{SIV} stands for secondary initial values and is used by twalk. \code{SIV} must be the same length as \code{Initial.Values}, and each element of these two vectors must be unique from each other, both before and after being passed to the \code{Model} function. \code{SIV} defaults to \code{NULL}, in which case values are generated with \code{\link{GIV}}. \item \code{size} is the number of rows of big data to be read into SGLD each iteration. \item \code{smax} is the maximum allowable tuning parameter sigma, the standard deviation of the conditional distribution, in the AGG algorithm. \item \code{Temperature} is used in the THMC algorithm to heat up the momentum in the first half of the leapfrog steps, and then cool down the momentum in the last half. \code{Temperature} must be positive. When greater than 1, THMC should explore more diffuse distributions, and may be helpful with multimodal distributions. \item \code{Type} is used in the Slice algorithm. It is either a scalar or a list with the same number of list components as blocks. This accepts \code{"Continuous"} for continuous parameters, \code{"Nominal"} for discrete parameters that are unordered, and \code{"Ordinal"} for discrete parameters that are ordered. \item \code{w} is used in AFSS, AMM, DEMC, Refractive, RSS, and Slice. It is a mixture weight for both the AMM and DEMC algorithms, and in these algorithms it is in the interval (0,1]. For AMM, it is recommended to use \code{w=0.05}, as per Roberts and Rosenthal (2009). The two mixture components in AMM are adaptive multivariate and static/symmetric univariate proposals. The mixture is determined at each iteration with mixture weight \code{w}. In the AMM algorithm, a higher value of \code{w} is associated with more static/symmetric univariate proposals, and a lower \code{w} is associated with more adaptive multivariate proposals. AMM will be unable to include the multivariate mixture component until it has accumulated some history, and models with more parameters will take longer to be able to use adaptive multivariate proposals. In DEMC, it indicates the probability that each iteration uses a snooker update, rather than a projection update, and the recommended default is \code{w=0.1}. In the Refractive algorithm, \code{w} is a scalar step size parameter. In AFSS, RSS, and the Slice algorithms, this is a step size interval for creating the slice interval. In AFSS and RSS, a scalar or vector equal in length the number of initial values is accepted. In Slice, a scalar or a list with a number of list components equal to the number of blocks is accepted. \item \code{Z} accepts a \eqn{T \times J}{T x J} matrix or \eqn{T \times J \times Nc}{T x J x Nc} array of thinned samples for \eqn{T} thinned iterations, \eqn{J} parameters, and \eqn{Nc} chains for DEMC. \code{Z} defaults to \code{NULL}. The matrix of thinned posterior samples from a previous run may be used, in which case the samples are copied across the chains. } } \value{ \code{LaplacesDemon} returns an object of class \code{demonoid}, and \code{LaplacesDemon.hpc} returns an object of class \code{demonoid.hpc} that is a list of objects of class \code{demonoid}, where the number of components in the list is the number of parallel chains. Each object of class \code{demonoid} is a list with the following components: \item{Acceptance.Rate}{This is the acceptance rate of the MCMC algorithm, indicating the percentage of iterations in which the proposals were accepted. For more information on acceptance rates, see the \code{\link{AcceptanceRate}} function.} \item{Algorithm}{This reports the specific algorithm used.} \item{Call}{This is the matched call of \code{LaplacesDemon}.} \item{Covar}{This stores the \eqn{K \times K}{K x K} proposal covariance matrix (where \eqn{K} is the dimension or number of parameters), variance vector, or list of covariance matrices. If variance or covariance is used for adaptation, then this covariance is returned. Otherwise, the variance of the samples of each parameter is returned. If the model is updated in the future, then this vector, matrix, or list can be used to start the next update where the last update left off. Only the diagonal of this matrix is reported in the associated \code{print} function.} \item{CovarDHis}{This \eqn{N \times K}{N x K} matrix stores the diagonal of the proposal covariance matrix of each adaptation in each of \eqn{N} rows for \eqn{K} dimensions, where the dimension is the number of parameters or length of the initial values vector. The proposal covariance matrix should change less over time. An exception is that the AHMC algorithm stores an algorithm specification here, which is not the diagonal of the proposal covariance matrix.} \item{Deviance}{This is a vector of the deviance of the model, with a length equal to the number of thinned samples that were retained. Deviance is useful for considering model fit, and is equal to the sum of the log-likelihood for all rows in the data set, which is then multiplied by negative two.} \item{DIC1}{This is a vector of three values: Dbar, pD, and DIC. Dbar is the mean deviance, pD is a measure of model complexity indicating the effective number of parameters, and DIC is the Deviance Information Criterion, which is a model fit statistic that is the sum of Dbar and pD. \code{DIC1} is calculated over all retained samples. Note that pD is calculated as \code{var(Deviance)/2} as in Gelman et al. (2004).} \item{DIC2}{This is identical to \code{DIC1} above, except that it is calculated over only the samples that were considered by the \code{BMK.Diagnostic} to be stationary for all parameters. If stationarity (or a lack of trend) is not estimated for all parameters, then \code{DIC2} is set to missing values.} \item{Initial.Values}{This is the vector of \code{Initial.Values}, which may have been optimized with the \code{\link{IterativeQuadrature}} or \code{\link{LaplaceApproximation}} function.} \item{Iterations}{This reports the number of \code{Iterations} for updating.} \item{LML}{This is an approximation of the logarithm of the marginal likelihood of the data (see the \code{\link{LML}} function for more information). \code{LML} is estimated only with stationary samples, and only with a non-adaptive algorithm, including Adaptive Griddy-Gibbs (AGG), Affine-Invariant Ensemble Sampler (AIES), Componentwise Hit-And-Run (CHARM), Delayed Rejection Metropolis (DRM), Elliptical Slice Sampling (ESS), Gibbs Sampler (Gibbs), Griddy-Gibbs (GG), Hamiltonian Monte Carlo (HMC), Hit-And-Run Metropolis (HARM), Independence Metropolis (IM), Metropolis-Coupled Markov Chain Monte Carlo (MCMCMC), Metropolis-within-Gibbs (MWG), Multiple-Try Metropolis, No-U-Turn Sampler (NUTS), Random Dive Metropolis-Hastings (RDMH), Random-Walk Metropolis (RWM), Reflective Slice Sampler (RSS), Refractive Sampler (Refractive), Reversible-Jump (RJ), Sequential Metropolis-within-Gibbs (SMWG), Slice Sampler (Slice), Stochastic Gradient Langevin Dynamics (SGLD), Tempered Hamiltonian Monte Carlo (THMC), or t-walk (twalk). \code{LML} is estimated with nonparametric self-normalized importance sampling (NSIS), given LL and the marginal posterior samples of the parameters. \code{LML} is useful for comparing multiple models with the \code{\link{BayesFactor}} function.} \item{Minutes}{This indicates the number of minutes that \code{LaplacesDemon} was running, and includes the initial checks as well as time it took the \code{\link{LaplaceApproximation}} function, assessing stationarity, effective sample size (ESS), and creating summaries.} \item{Model}{This contains the model specification \code{Model}.} \item{Monitor}{This is a vector or matrix of one or more monitored variables, which are variables that were specified in the \code{Model} function to be observed as chains (or Markov chains, if \code{Adaptive=0}), but that were not deviance or parameters.} \item{Parameters}{This reports the number of parameters.} \item{Posterior1}{This is a matrix of marginal posterior distributions composed of thinned samples, with a number of rows equal to the number of thinned samples and a number of columns equal to the number of parameters. This matrix includes all thinned samples.} \item{Posterior2}{This is a matrix equal to \code{Posterior1}, except that rows are included only if stationarity (a lack of trend) is indicated by the \code{\link{BMK.Diagnostic}} for all parameters. If stationarity did not occur, then this matrix is missing.} \item{Rec.BurnIn.Thinned}{This is the recommended burn-in for the thinned samples, where the value indicates the first row that was stationary across all parameters, and previous rows are discarded as burn-in. Samples considered as burn-in are discarded because they do not represent the target distribution and have not adequately forgotten the initial value of the chain (or Markov chain, if \code{Adaptive=0}).} \item{Rec.BurnIn.UnThinned}{This is the recommended burn-in for all samples, in case thinning will not be necessary.} \item{Rec.Thinning}{This is the recommended value for the \code{Thinning} argument according to the autocorrelation in the thinned samples, and it is limited to the interval [1,1000].} \item{Specs}{This is an optional list of algorithm specifications.} \item{Status}{This is the value in the \code{Status} argument.} \item{Summary1}{This is a matrix that summarizes the marginal posterior distributions of the parameters, deviance, and monitored variables over all samples in \code{Posterior1}. The following summary statistics are included: mean, standard deviation, MCSE (Monte Carlo Standard Error), ESS is the effective sample size due to autocorrelation, and finally the 2.5\%, 50\%, and 97.5\% quantiles are reported. MCSE is essentially a standard deviation around the marginal posterior mean that is due to uncertainty associated with using MCMC. The acceptable size of the MCSE depends on the acceptable uncertainty associated around the marginal posterior mean. Laplace's Demon prefers to continue updating until each MCSE is less than 6.27\% of each marginal posterior standard deviation (see the \code{\link{MCSE}} and \code{\link{Consort}} functions). The default \code{IMPS} method is used. Next, the desired precision of ESS depends on the user's goal, and Laplace's Demon prefers to continue until each ESS is at least 100, which should be enough to describe 95\% boundaries of an approximately Gaussian distribution (see the \code{\link{ESS}} for more information).} \item{Summary2}{This matrix is identical to the matrix in \code{Summary1}, except that it is calculated only on the stationary samples found in \code{Posterior2}. If universal stationarity was not estimated for the parameters, then this matrix is set to missing values.} \item{Thinned.Samples}{This is the number of thinned samples that were retained.} \item{Thinning}{This is the value of the \code{Thinning} argument.} } \references{ Atchade, Y.F. (2006). "An Adaptive Version for the Metropolis Adjusted Langevin Algorithm with a Truncated Drift". \emph{Methodology and Computing in Applied Probability}, 8, p. 235--254. Bai, Y. (2009). "An Adaptive Directional Metropolis-within-Gibbs Algorithm". Technical Report in Department of Statistics at the University of Toronto. Beskos, A., Roberts, G.O., Stuart, A.M., and Voss, J. (2008). "MCMC Methods for Diffusion Bridges". Stoch. Dyn., 8, p. 319--350. Boyles, L.B. and Welling, M. (2012). "Refractive Sampling". Craiu, R.V., Rosenthal, J., and Yang, C. (2009). "Learn From Thy Neighbor: Parallel-Chain and Regional Adaptive MCMC". \emph{Journal of the American Statistical Assocation}, 104(488), p. 1454--1466. Christen, J.A. and Fox, C. (2010). "A General Purpose Sampling Algorithm for Continuous Distributions (the t-walk)". \emph{Bayesian Analysis}, 5(2), p. 263--282. Dutta, S. (2012). "Multiplicative Random Walk Metropolis-Hastings on the Real Line". \emph{Sankhya B}, 74(2), p. 315--342. Duane, S., Kennedy, A.D., Pendleton, B.J., and Roweth, D. (1987). "Hybrid Monte Carlo". \emph{Physics Letters}, B, 195, p. 216--222. Gelman, A., Carlin, J., Stern, H., and Rubin, D. (2004). "Bayesian Data Analysis, Texts in Statistical Science, 2nd ed.". Chapman and Hall, London. Geman, S. and Geman, D. (1984). "Stochastic Relaxation, Gibbs Distributions, and the Bayesian Restoration of Images". \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, 6(6), p. 721--741. Geyer, C.J. (1991). "Markov Chain Monte Carlo Maximum Likelihood". In Keramidas, E.M. Computing Science and Statistics: Proceedings of the 23rd Symposium of the Interface. Fairfax Station VA: Interface Foundation. p. 156--163. Goodman J, and Weare, J. (2010). "Ensemble Samplers with Affine Invariance". \emph{Communications in Applied Mathematics and Computational Science}, 5(1), p. 65--80. Green, P.J. (1995). "Reversible Jump Markov Chain Monte Carlo Computation and Bayesian Model Determination". \emph{Biometrika}, 82, p. 711--732. Haario, H., Laine, M., Mira, A., and Saksman, E. (2006). "DRAM: Efficient Adaptive MCMC". \emph{Statistical Computing}, 16, p. 339--354. Haario, H., Saksman, E., and Tamminen, J. (2001). "An Adaptive Metropolis Algorithm". \emph{Bernoulli}, 7, p. 223--242. Hoffman, M.D. and Gelman. A. (2012). "The No-U-Turn Sampler: Adaptively Setting Path Lengths in Hamiltonian Monte Carlo". \emph{Journal of Machine Learning Research}, p. 1--30. Kass, R.E. and Raftery, A.E. (1995). "Bayes Factors". \emph{Journal of the American Statistical Association}, 90(430), p. 773--795. Lewis, S.M. and Raftery, A.E. (1997). "Estimating Bayes Factors via Posterior Simulation with the Laplace-Metropolis Estimator". \emph{Journal of the American Statistical Association}, 92, p. 648--655. Liu, J., Liang, F., and Wong, W. (2000). "The Multiple-Try Method and Local Optimization in Metropolis Sampling". \emph{Journal of the American Statistical Association}, 95, p. 121--134. Metropolis, N., Rosenbluth, A.W., Rosenbluth, M.N., and Teller, E. (1953). "Equation of State Calculations by Fast Computing Machines". \emph{Journal of Chemical Physics}, 21, p. 1087--1092. Mira, A. (2001). "On Metropolis-Hastings Algorithms with Delayed Rejection". \emph{Metron}, Vol. LIX, n. 3-4, p. 231--241. Murray, I., Adams, R.P., and MacKay, D.J. (2010). "Elliptical Slice Sampling". \emph{Journal of Machine Learning Research}, 9, p. 541--548. Neal, R.M. (2003). "Slice Sampling" (with discussion). \emph{Annals of Statistics}, 31(3), p. 705--767. Ritter, C. and Tanner, M. (1992), "Facilitating the Gibbs Sampler: the Gibbs Stopper and the Griddy-Gibbs Sampler", \emph{Journal of the American Statistical Association}, 87, p. 861--868. Roberts, G.O. and Rosenthal, J.S. (2009). "Examples of Adaptive MCMC". \emph{Computational Statistics and Data Analysis}, 18, p. 349--367. Roberts, G.O. and Tweedie, R.L. (1996). "Exponential Convergence of Langevin Distributions and Their Discrete Approximations". \emph{Bernoulli}, 2(4), p. 341--363. Rosenthal, J.S. (2007). "AMCMC: An R interface for adaptive MCMC". \emph{Computational Statistics and Data Analysis}, 51, p. 5467--5470. Smith, R.L. (1984). "Efficient Monte Carlo Procedures for Generating Points Uniformly Distributed Over Bounded Region". \emph{Operations Research}, 32, p. 1296--1308. Ter Braak, C.J.F. and Vrugt, J.A. (2008). "Differential Evolution Markov Chain with Snooker Updater and Fewer Chains", \emph{Statistics and Computing}, 18(4), p. 435--446. Tibbits, M., Groendyke, C., Haran, M., Liechty, J. (2014). "Automated Factor Slice Sampling". \emph{Journal of Computational and Graphical Statistics}, 23(2), p. 543--563. Thompson, M.D. (2011). "Slice Sampling with Multivariate Steps". \url{https://utoronto.scholaris.ca/items/161206c5-af25-41a8-99d8-8d622f950cb3} Vihola, M. (2011). "Robust Adaptive Metropolis Algorithm with Coerced Acceptance Rate". \emph{Statistics and Computing}. Springer, Netherlands. Welling, M. and Teh, Y.W. (2011). "Bayesian Learning via Stochastic Gradient Langevin Dynamics". \emph{Proceedings of the 28th International Conference on Machine Learning (ICML)}, p. 681--688. } \author{Statisticat, LLC., Silvere Vialet-Chabrand \email{silvere@vialet-chabrand.com}} \seealso{ \code{\link{AcceptanceRate}}, \code{\link{as.initial.values}}, \code{\link{as.parm.names}}, \code{\link{BayesFactor}}, \code{\link{Blocks}}, \code{\link{BMK.Diagnostic}}, \code{\link{Combine}}, \code{\link{Consort}}, \code{\link{dcrmrf}}, \code{\link{ESS}}, \code{\link{GIV}}, \code{\link{is.data}}, \code{\link{is.model}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon.RAM}}, \code{\link{LML}}, and \code{\link{MCSE}}. } \examples{ # The accompanying Examples vignette is a compendium of examples. #################### Load the LaplacesDemon Library ##################### library(LaplacesDemon) ############################## Demon Data ############################### data(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) J <- ncol(X) for (j in 2:J) X[,j] <- CenterScale(X[,j]) ######################### Data List Preparation ######################### mon.names <- "LP" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ########################## Model Specification ########################## Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(Data$X, t(beta)) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + beta.prior + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } #library(compiler) #Model <- cmpfun(Model) #Consider byte-compiling for more speed set.seed(666) ############################ Initial Values ############################# Initial.Values <- GIV(Model, MyData, PGF=TRUE) ########################################################################### # Examples of MCMC Algorithms # ########################################################################### #################### Automated Factor Slice Sampler ##################### Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, Covar=NULL, Iterations=1000, Status=100, Thinning=1, Algorithm="AFSS", Specs=list(A=Inf, B=NULL, m=100, n=0, w=1)) Fit print(Fit) #Consort(Fit) #plot(BMK.Diagnostic(Fit)) #PosteriorChecks(Fit) #caterpillar.plot(Fit, Parms="beta") #BurnIn <- Fit$Rec.BurnIn.Thinned #plot(Fit, BurnIn, MyData, PDF=FALSE) #Pred <- predict(Fit, Model, MyData, CPUs=1) #summary(Pred, Discrep="Chi-Square") #plot(Pred, Style="Covariates", Data=MyData) #plot(Pred, Style="Density", Rows=1:9) #plot(Pred, Style="ECDF") #plot(Pred, Style="Fitted") #plot(Pred, Style="Jarque-Bera") #plot(Pred, Style="Predictive Quantiles") #plot(Pred, Style="Residual Density") #plot(Pred, Style="Residuals") #Levene.Test(Pred) #Importance(Fit, Model, MyData, Discrep="Chi-Square") ############# Adaptive Directional Metropolis-within-Gibbs ############## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="ADMG", Specs=list(n=0, Periodicity=50)) ######################## Adaptive Griddy-Gibbs ########################## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="AGG", Specs=list(Grid=GaussHermiteQuadRule(3)$nodes, # dparm=NULL, smax=Inf, CPUs=1, Packages=NULL, Dyn.libs=NULL)) ################## Adaptive Hamiltonian Monte Carlo ##################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="AHMC", Specs=list(epsilon=0.02, L=2, m=NULL, # Periodicity=10)) ########################## Adaptive Metropolis ########################## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="AM", Specs=list(Adaptive=500, Periodicity=10)) ################### Adaptive Metropolis-within-Gibbs #################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="AMWG", Specs=list(B=NULL, n=0, Periodicity=50)) ###################### Adaptive-Mixture Metropolis ###################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="AMM", Specs=list(Adaptive=500, B=NULL, n=0, # Periodicity=10, w=0.05)) ################### Affine-Invariant Ensemble Sampler ################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="AIES", Specs=list(Nc=2*length(Initial.Values), Z=NULL, # beta=2, CPUs=1, Packages=NULL, Dyn.libs=NULL)) ################# Componentwise Hit-And-Run Metropolis ################## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="CHARM", Specs=NULL) ########### Componentwise Hit-And-Run (Adaptive) Metropolis ############# #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="CHARM", Specs=list(alpha.star=0.44)) ################# Delayed Rejection Adaptive Metropolis ################# #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="DRAM", Specs=list(Adaptive=500, Periodicity=10)) ##################### Delayed Rejection Metropolis ###################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="DRM", Specs=NULL) ################## Differential Evolution Markov Chain ################## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="DEMC", Specs=list(Nc=3, Z=NULL, gamma=NULL, w=0.1)) ####################### Elliptical Slice Sampler ######################## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="ESS", Specs=list(B=NULL)) ############################# Gibbs Sampler ############################# ### NOTE: Unlike the other samplers, Gibbs requires specifying a ### function (FC) that draws from full conditionals. #FC <- function(parm, Data) # { # ### Parameters # beta <- parm[Data$pos.beta] # sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) # sigma2 <- sigma*sigma # ### Hyperparameters # betamu <- rep(0,length(beta)) # betaprec <- diag(length(beta))/1000 # ### Update beta # XX <- crossprod(Data$X) # Xy <- crossprod(Data$X, Data$y) # IR <- backsolve(chol(XX/sigma2 + betaprec), diag(length(beta))) # btilde <- crossprod(t(IR)) %*% (Xy/sigma2 + betaprec %*% betamu) # beta <- btilde + IR %*% rnorm(length(beta)) # return(c(beta,sigma)) # } ##library(compiler) ##FC <- cmpfun(FC) #Consider byte-compiling for more speed #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="Gibbs", Specs=list(FC=FC, MWG=pos.sigma)) ############################# Griddy-Gibbs ############################## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="GG", Specs=list(Grid=seq(from=-0.1, to=0.1, len=5), # dparm=NULL, CPUs=1, Packages=NULL, Dyn.libs=NULL)) ####################### Hamiltonian Monte Carlo ######################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="HMC", Specs=list(epsilon=0.001, L=2, m=NULL)) ############# Hamiltonian Monte Carlo with Dual-Averaging ############### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=1, Thinning=1, # Algorithm="HMCDA", Specs=list(A=500, delta=0.65, epsilon=NULL, # Lmax=1000, lambda=0.1)) ####################### Hit-And-Run Metropolis ########################## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="HARM", Specs=NULL) ################## Hit-And-Run (Adaptive) Metropolis #################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="HARM", Specs=list(alpha.star=0.234, B=NULL)) ######################## Independence Metropolis ######################## ### Note: the mu and Covar arguments are populated from a previous Laplace ### Approximation. #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=Fit$Covar, Iterations=1000, Status=100, Thinning=1, # Algorithm="IM", # Specs=list(mu=Fit$Summary1[1:length(Initial.Values),1])) ######################### Interchain Adaptation ######################### #Initial.Values <- rbind(Initial.Values, GIV(Model, MyData, PGF=TRUE)) #Fit <- LaplacesDemon.hpc(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="INCA", Specs=list(Adaptive=500, Periodicity=10), # LogFile="MyLog", Chains=2, CPUs=2, Type="PSOCK", Packages=NULL, # Dyn.libs=NULL) ################ Metropolis-Adjusted Langevin Algorithm ################# #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="MALA", Specs=list(A=1e7, alpha.star=0.574, gamma=1, # delta=1, epsilon=c(1e-6,1e-7))) ############# Metropolis-Coupled Markov Chain Monte Carlo ############### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="MCMCMC", Specs=list(lambda=1, CPUs=2, Packages=NULL, # Dyn.libs=NULL)) ####################### Metropolis-within-Gibbs ######################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="MWG", Specs=list(B=NULL)) ######################## Multiple-Try Metropolis ######################## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="MTM", Specs=list(K=4, CPUs=1, Packages=NULL, Dyn.libs=NULL)) ########################## No-U-Turn Sampler ############################ #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=1, Thinning=1, # Algorithm="NUTS", Specs=list(A=500, delta=0.6, epsilon=NULL, # Lmax=Inf)) ################# Oblique Hyperrectangle Slice Sampler ################## #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="OHSS", Specs=list(A=Inf, n=0)) ##################### Preconditioned Crank-Nicolson ##################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="pCN", Specs=list(beta=0.1)) ###################### Robust Adaptive Metropolis ####################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="RAM", Specs=list(alpha.star=0.234, B=NULL, Dist="N", # gamma=0.66, n=0)) ################### Random Dive Metropolis-Hastings #################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="RDMH", Specs=NULL) ########################## Refractive Sampler ########################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="Refractive", Specs=list(Adaptive=1, m=2, w=0.1, r=1.3)) ########################### Reversible-Jump ############################# #bin.n <- J-1 #bin.p <- 0.2 #parm.p <- c(1, rep(1/(J-1),(J-1)), 1) #selectable <- c(0, rep(1,J-1), 0) #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="RJ", Specs=list(bin.n=bin.n, bin.p=bin.p, # parm.p=parm.p, selectable=selectable, # selected=c(0,rep(1,J-1),0))) ######################## Random-Walk Metropolis ######################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="RWM", Specs=NULL) ######################## Reflective Slice Sampler ####################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="RSS", Specs=list(m=5, w=1e-5)) ############## Sequential Adaptive Metropolis-within-Gibbs ############## #NOTE: The SAMWG algorithm is only for state-space models (SSMs) #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="SAMWG", Specs=list(Dyn=Dyn, Periodicity=50)) ################## Sequential Metropolis-within-Gibbs ################### #NOTE: The SMWG algorithm is only for state-space models (SSMs) #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="SMWG", Specs=list(Dyn=Dyn)) ############################# Slice Sampler ############################# #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=1, Thinning=1, # Algorithm="Slice", Specs=list(B=NULL, Bounds=c(-Inf,Inf), m=100, # Type="Continuous", w=1)) ################# Stochastic Gradient Langevin Dynamics ################# #NOTE: The Data and Model functions must be coded differently for SGLD. #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=10, Thinning=10, # Algorithm="SGLD", Specs=list(epsilon=1e-4, file="X.csv", Nr=1e4, # Nc=6, size=10)) ################### Tempered Hamiltonian Monte Carlo #################### #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="THMC", Specs=list(epsilon=0.001, L=2, m=NULL, # Temperature=2)) ############################### t-walk ################################# #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="twalk", Specs=list(SIV=NULL, n1=4, at=6, aw=1.5)) ################# Univariate Eigenvector Slice Sampler ################# #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=1000, Status=100, Thinning=1, # Algorithm="UESS", Specs=list(A=Inf, B=NULL, m=100, n=0)) ########## Updating Sequential Adaptive Metropolis-within-Gibbs ######### #NOTE: The USAMWG algorithm is only for state-space model updating #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=100000, Status=100, Thinning=100, # Algorithm="USAMWG", Specs=list(Dyn=Dyn, Periodicity=50, Fit=Fit, # Begin=T.m)) ############## Updating Sequential Metropolis-within-Gibbs ############## #NOTE: The USMWG algorithm is only for state-space model updating #Fit <- LaplacesDemon(Model, Data=MyData, Initial.Values, # Covar=NULL, Iterations=100000, Status=100, Thinning=100, # Algorithm="USMWG", Specs=list(Dyn=Dyn, Fit=Fit, Begin=T.m)) #End } \keyword{Adaptive} \keyword{Adaptive Directional Metropolis-within-Gibbs} \keyword{Adaptive Griddy-Gibbs} \keyword{Adaptive Hamiltonian Monte Carlo} \keyword{Adaptive Metropolis} \keyword{Adaptive-Mixture Metropolis} \keyword{Adaptive Metropolis-within-Gibbs} \keyword{Affine-Invariant Ensemble Sampler} \keyword{Bayesian Inference} \keyword{Delayed Rejection Adaptive Metropolis} \keyword{Delayed Rejection Metropolis} \keyword{Differential Evolution Markov Chain} \keyword{Elliptical Slice Sampler} \keyword{Gibbs Sampler} \keyword{Griddy-Gibbs} \keyword{Hamiltonian Monte Carlo} \keyword{High Performance Computing} \keyword{Hit-And-Run} \keyword{Independence Metropolis} \keyword{Interchain Adaptation} \keyword{MCMC} \keyword{Metropolis-Adjusted Langevin Algorithm} \keyword{Metropolis-Coupled Markov Chain Monte Carlo} \keyword{Metropolis-within-Gibbs} \keyword{Multiple-Try Metropolis} \keyword{Multiple Chains} \keyword{No-U-Turn Sampler} \keyword{Oblique Hyperrectangle Slice Sampler} \keyword{Optimization} \keyword{Parallel Chains} \keyword{Preconditioned Crank-Nicolson} \keyword{Reflective Slice Sampler} \keyword{Refractive Sampler} \keyword{Reversible-Jump} \keyword{Robust Adaptive Metropolis} \keyword{Random-Walk Metropolis} \keyword{Sequential Adaptive Metropolis-within-Gibbs} \keyword{Sequential Metropolis-within-Gibbs} \keyword{Slice Sampler} \keyword{Stochastic Gradient Langevin Dynamics} \keyword{Tempered Hamiltonian Monte Carlo} \keyword{t-walk} \keyword{Univariate Eigenvector Slice Sampler} \keyword{Updating Sequential Adaptive Metropolis-within-Gibbs} \keyword{Updating Sequential Metropolis-within-Gibbs} LaplacesDemon/man/print.raftery.Rd0000755000176200001440000000122715144337635016652 0ustar liggesusers\name{print.raftery} \alias{print.raftery} \title{Print an object of class \code{raftery} to the screen} \description{ This may be used to print the contents of an object of class \code{raftery} to the screen. } \usage{\method{print}{raftery}(x, digits=3, \dots)} \arguments{ \item{x}{An object of class \code{raftery} is required.} \item{digits}{This is the number of digits to print.} \item{\dots}{Additional arguments are unused.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{Raftery.Diagnostic}}. } \examples{### See the Raftery.Diagnostic function for an example.} \keyword{print} LaplacesDemon/man/dist.Multivariate.Cauchy.Precision.Rd0000755000176200001440000000756315144316355022625 0ustar liggesusers\name{dist.Multivariate.Cauchy.Precision} \alias{dmvcp} \alias{rmvcp} \title{Multivariate Cauchy Distribution: Precision Parameterization} \description{ These functions provide the density and random number generation for the multivariate Cauchy distribution. These functions use the precision parameterization. } \usage{ dmvcp(x, mu, Omega, log=FALSE) rmvcp(n=1, mu, Omega) } \arguments{ \item{x}{This is either a vector of length \eqn{k} or a matrix with a number of columns, \eqn{k}, equal to the number of columns in precision matrix \eqn{\Omega}{Omega}.} \item{n}{This is the number of random draws.} \item{mu}{This is a numeric vector representing the location parameter, \eqn{\mu}{mu} (the mean vector), of the multivariate distribution. It must be of length \eqn{k}, as defined above.} \item{Omega}{This is a \eqn{k \times k}{k x k} positive-definite precision matrix \eqn{\Omega}{Omega}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{\Gamma((1+k)/2)}{\Gamma(1/2)1^{k/2}\pi^{k/2}} |\Omega|^{1/2} (1 + (\theta-\mu)^T \Omega (\theta-\mu))^{-(1+k)/2}}{p(theta) = (Gamma((nu+k)/2) / (Gamma(1/2)*1^(k/2)*pi^(k/2))) * |Omega|^(1/2) * (1 + (theta-mu)^T Omega (theta-mu))^(-(1+k)/2)} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathcal{MC}_k(\mu, \Omega^{-1})}{theta ~ MC[k](mu, Omega^(-1))} \item Notation 2: \eqn{p(\theta) = \mathcal{MC}_k(\theta | \mu, \Omega^{-1})}{p(theta) = MC[k](theta | mu, Omega^(-1))} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = undefined}{var(theta) = undefined} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate Cauchy distribution is a multidimensional extension of the one-dimensional or univariate Cauchy distribution. A random vector is considered to be multivariate Cauchy-distributed if every linear combination of its components has a univariate Cauchy distribution. The multivariate Cauchy distribution is equivalent to a multivariate t distribution with 1 degree of freedom. The Cauchy distribution is known as a pathological distribution because its mean and variance are undefined, and it does not satisfy the central limit theorem. It is usually parameterized with mean and a covariance matrix, or in Bayesian inference, with mean and a precision matrix, where the precision matrix is the matrix inverse of the covariance matrix. These functions provide the precision parameterization for convenience and familiarity. It is easier to calculate a multivariate Cauchy density with the precision parameterization, because a matrix inversion can be avoided. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k}, and a \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega}, which must be positive-definite. } \value{ \code{dmvcp} gives the density and \code{rmvcp} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dcauchy}}, \code{\link{dmvc}}, \code{\link{dmvt}}, \code{\link{dmvtp}}, and \code{\link{dwishart}}. } \examples{ library(LaplacesDemon) x <- seq(-2,4,length=21) y <- 2*x+10 z <- x+cos(y) mu <- c(1,12,2) Omega <- matrix(c(1,2,0,2,5,0.5,0,0.5,3), 3, 3) f <- dmvcp(cbind(x,y,z), mu, Omega) X <- rmvcp(1000, rep(0,2), diag(2)) X <- X[rowSums((X >= quantile(X, probs=0.025)) & (X <= quantile(X, probs=0.975)))==2,] joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution} LaplacesDemon/man/Heidelberger.Diagnostic.Rd0000755000176200001440000001145615144316355020510 0ustar liggesusers\name{Heidelberger.Diagnostic} \alias{Heidelberger.Diagnostic} \title{Heidelberger and Welch's MCMC Convergence Diagnostic} \description{ Heidelberger and Welch (1981; 1983) proposed a two-part MCMC convergence diagnostic that calculates a test statistic (based on the Cramer-von Mises test statistic) to accept or reject the null hypothesis that the Markov chain is from a stationary distribution. } \usage{Heidelberger.Diagnostic(x, eps=0.1, pvalue=0.05)} \arguments{ \item{x}{This required argument accepts an object of class \code{demonoid}. It attempts to use \code{Posterior2}, but when this is missing it uses \code{Posterior1}.} \item{eps}{This argument specifies the target value for the ratio of halfwidth to sample mean.} \item{pvalue}{This argument specifies the level of statistical significance.} } \details{ The Heidelberg and Welch MCMC convergence diagnostic consists of two parts: First Part 1. Generate a chain of \eqn{N} iterations and define an alpha level. 2. Calculate the test statistic on the whole chain. Accept or reject the null hypothesis that the chain is from a stationary distribution. 3. If the null hypothesis is rejected, then discard the first 10\% of the chain. Calculate the test statistic and accept or reject the null hypothesis. 4. If the null hypothesis is rejected, then discard the next 10\% and calculate the test statistic. 5. Repeat until the null hypothesis is accepted or 50\% of the chain is discarded. If the test still rejects the null hypothesis, then the chain fails the test and needs to be run longer. Second Part If the chain passes the first part of the diagnostic, then the part of the chain that was not discarded from the first part is used to test the second part. The halfwidth test calculates half the width of the (1 - alpha)\% probability interval (credible interval) around the mean. If the ratio of the halfwidth and the mean is lower than \code{eps}, then the chain passes the halfwidth test. Otherwise, the chain fails the halfwidth test and must be updated for more iterations until sufficient accuracy is obtained. In order to avoid problems caused by sequential testing, the test should not be repeated too frequently. Heidelberger and Welch (1981) suggest increasing the run length by a factor I > 1.5, each time, so that estimate has the same, reasonably large, proportion of new data. The Heidelberger and Welch MCMC convergence diagnostic conducts multiple hypothesis tests. The number of potentially wrong results increases with the number of non-independent hypothesis tests conducted. The \code{Heidelberger.Diagnostic} is a univariate diagnostic that is usually applied to each marginal posterior distribution. A multivariate form is not included. By chance alone due to multiple independent tests, 5\% of the marginal posterior distributions should appear non-stationary when stationarity exists. Assessing multivariate convergence is difficult. } \note{ The \code{Heidelberger.Diagnostic} function was adapted from the \code{heidel.diag} function in the coda package. } \value{ The \code{Heidelberger.Diagnostic} function returns an object of class \code{heidelberger}. This object is a \eqn{J \times 6}{J x 6} matrix, and it is intended to be summarized with the \code{\link{print.heidelberger}} function. Nonetheless, this object of class \code{heidelberger} has \eqn{J} rows, each of which corresponds to a Markov chain. The column names are \code{stest}, \code{start}, \code{pvalue}, \code{htest}, \code{mean}, and \code{halfwidth}. The \code{stest} column indicates convergence with a one, and non-convergence with a zero, regarding the stationarity test. When non-convergence is indicated, the remaining columns have missing values. The \code{start} column indicates the starting iteration, and the \code{pvalue} column shows the p-value associated with the first test. The \code{htest} column indicates convergence for the halfwidth test. The \code{mean} and \code{halfwidth} columns report the mean and halfwidth. } \references{ Heidelberger, P. and Welch, P.D. (1981). "A Spectral Method for Confidence Interval Generation and Run Length Control in Simulations". \emph{Comm. ACM.}, 24, p. 233--245. Heidelberger, P. and Welch, P.D. (1983). "Simulation Run Length Control in the Presence of an Initial Transient". \emph{Opns Res.}, 31, p. 1109--1144. Schruben, L.W. (1982). "Detecting Initialization Bias in Simulation Experiments". \emph{Opns. Res.}, 30, p. 569--590. } \seealso{ \code{\link{burnin}}, \code{\link{is.stationary}}, \code{\link{LaplacesDemon}}, and \code{\link{print.heidelberger}}. } \examples{ #library(LaplacesDemon) ###After updating with LaplacesDemon, do: #hd <- Heidelberger.Diagnostic(Fit) #print(hd) } \keyword{Diagnostic} \keyword{MCMC} LaplacesDemon/man/plot.demonoid.Rd0000755000176200001440000001163115144316355016612 0ustar liggesusers\name{plot.demonoid} \alias{plot.demonoid} \alias{plot.demonoid.hpc} \title{Plot samples from the output of Laplace's Demon} \description{ This may be used to plot, or save plots of, samples in an object of class \code{demonoid} or \code{demonoid.hpc}. Plots include a trace plot, density plot, autocorrelation or ACF plot, and if an adaptive algorithm was used, the absolute difference in the proposal variance, or the value of epsilon, across adaptations. } \usage{ \method{plot}{demonoid}(x, BurnIn=0, Data, PDF=FALSE, Parms, FileName, \dots) \method{plot}{demonoid.hpc}(x, BurnIn=0, Data, PDF=FALSE, Parms, FileName, \dots) } \arguments{ \item{x}{ This required argument is an object of class \code{demonoid} or \code{demonoid.hpc}.} \item{BurnIn}{ This argument requires zero or a positive integer that indicates the number of thinned samples to discard as burn-in for the purposes of plotting. For more information on burn-in, see \code{\link{burnin}}.} \item{Data}{ This required argument must receive the list of data that was supplied to \code{\link{LaplacesDemon}} to create the object of class \code{demonoid}.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{Parms}{ This argument accepts a vector of quoted strings to be matched for selecting parameters for plotting. This argument defaults to \code{NULL} and selects every parameter for plotting. Each quoted string is matched to one or more parameter names with the \code{grep} function. For example, if the user specifies \code{Parms=c("eta", "tau")}, and if the parameter names are beta[1], beta[2], eta[1], eta[2], and tau, then all parameters will be selected, because the string \code{eta} is within \code{beta}. Since \code{grep} is used, string matching uses regular expressions, so beware of meta-characters, though these are acceptable: ".", "[", and "]".} \item{FileName}{ This argument accepts a string and save the plot under the specified name. If \code{PDF=FALSE} this argument in unused. By default, \code{FileName = paste0("laplacesDemon-plot_", format(Sys.time(), "yyyy-mm-dd_h:m:s"), ".pdf")} } \item{\dots}{Additional arguments are unused.} } \details{ The plots are arranged in a \eqn{3 \times 3}{3 x 3} matrix. Each row represents a parameter, the deviance, or a monitored variable. The left column displays trace plots, the middle column displays kernel density plots, and the right column displays autocorrelation (ACF) plots. Trace plots show the thinned history of the chain or Markov chain, with its value in the y-axis moving by thinned sample across the x-axis. A chain or Markov chain with good properties does not suggest a trend upward or downward as it progresses across the x-axis (it should appear stationary), and it should mix well, meaning it should appear as though random samples are being taken each time from the same target distribution. Visual inspection of a trace plot cannot verify convergence, but apparent non-stationarity or poor mixing can certainly suggest non-convergence. A red, smoothed line also appears to aid visual inspection. Kernel density plots depict the marginal posterior distribution. Although there is no distributional assumption about this density, kernel density estimation uses Gaussian basis functions. Autocorrelation plots show the autocorrelation or serial correlation between values of thinned samples at nearby thinned samples. Samples with autocorrelation do not violate any assumption, but are inefficient because they reduce the effective sample size (\code{\link{ESS}}), and indicate that the chain is not mixing well, since each value is influenced by values that are previous and nearby. The x-axis indicates lags with respect to thinned samples, and the y-axis represents autocorrelation. The ideal autocorrelation plot shows perfect correlation at zero lag, and quickly falls to zero autocorrelation for all other lags. If an adaptive algorithm was used, then the distribution of absolute differences in the proposal variances, or the value of epsilon, is plotted across adaptations. The proposal variance, or epsilon, should change less as the adaptive algorithm approaches the target distributions. The absolute differences in the proposal variance plot should approach zero. This is called the condition of diminishing adaptation. If it is not approaching zero, then consider using a different adaptive MCMC algorithm. The following quantiles are plotted for absolute changes proposal variance: 0.025, 0.500, and 0.975. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{burnin}}, \code{\link{ESS}}, \code{\link{LaplacesDemon}}, and \code{\link{LaplacesDemon.hpc}}.} \examples{### See the LaplacesDemon function for an example.} \keyword{Plot}LaplacesDemon/man/dist.Scaled.Inverse.Wishart.Rd0000755000176200001440000001012015144316355021216 0ustar liggesusers\name{dist.Scaled.Inverse.Wishart} \alias{dsiw} \alias{rsiw} \title{Scaled Inverse Wishart Distribution} \description{ These functions provide the density and random number generation for the scaled inverse Wishart distribution. } \usage{ dsiw(Q, nu, S, zeta, mu, delta, log=FALSE) rsiw(nu, S, mu, delta) } \arguments{ \item{Q}{This is the symmetric, positive-definite \eqn{k \times k}{k x k} matrix \eqn{\textbf{Q}}.} \item{nu}{This is the scalar degrees of freedom, \eqn{\nu}{nu} regarding \eqn{\textbf{Q}}. The default recommendation is \code{nu=k+1}.} \item{S}{This is the symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S} regarding \eqn{\textbf{Q}}. The default recommendation is \code{S=diag(k)}.} \item{zeta}{This is a positive-only vector of length \eqn{k} of auxiliary scale parameters \eqn{\zeta}{zeta}.} \item{mu}{This is a vector of length \eqn{k} of location hyperparameters \eqn{\mu}{mu} regarding \eqn{\zeta}{zeta}.} \item{delta}{This is a positive-only vector of length \eqn{k} of scale hyperparameters \eqn{\delta}{delta} regarding \eqn{\zeta}{zeta}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: (see below) \item Inventor: O'Malley and Zaslavsky (2005) \item Notation 1: \eqn{p(\Sigma) \sim \mathcal{SIW}(\textbf{Q}, \nu, \textbf{S}, \zeta, \mu, \delta)}{p(Sigma) ~ SIW(Q, nu, S, zeta, mu, delta)} \item Notation 2: \eqn{p(\Sigma) = \mathcal{SIW}(\Sigma | \textbf{Q}, \nu, \textbf{S}, \zeta, \mu, \delta}{p(Sigma) = SIW(Sigma | Q, nu, S, zeta, mu, delta)} \item Parameter 1: symmetric, positive-definite \eqn{k \times k}{k x k} matrix \eqn{\textbf{Q}}{Q} \item Parameter 2: degrees of freedom \eqn{\nu}{nu} \item Parameter 3: symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S} \item Parameter 4: Auxiliary scale parameter vector \eqn{\zeta}{zeta} \item Parameter 5: Hyperparameter location vector \eqn{\mu}{mu} \item Parameter 6: Hyperparameter scale vector \eqn{\delta}{delta} \item Mean: \item Variance: \item Mode: } The scaled inverse Wishart (SIW) distribution is a prior probability distribution for a covariance matrix, and is an alternative to the inverse Wishart distribution. While the inverse Wishart distribution is applied directly to covariance matrix \eqn{\Sigma}{Sigma}, the SIW distribution is applied to a decomposed matrix \eqn{\textbf{Q}} and diagonal scale matrix \eqn{\zeta}{zeta}. For information on how to apply it to \eqn{\textbf{Q}}, see the example below. SIW is more flexible than the inverse Wishart distribution because it has additional, and some say somewhat redundant, scale parameters. This makes up for one limitation of the inverse Wishart, namely that all uncertainty about posterior variances is represented in one parameter. The SIW prior may somewhat alleviate the dependency in the inverse Wishart between variances and correlations, though the SIW prior still retains some of this relationship. The Huang-Wand (\code{\link{dhuangwand}}) prior is a hierarchical alternative. } \value{ \code{dsiw} gives the density and \code{rsiw} generates random deviates. } \references{ O'Malley, A.J. and Zaslavsky, A.M. (2005), "Domain-Level Covariance Analysis for Survey Data with Structured Nonresponse". } \seealso{ \code{\link{dhuangwand}}, \code{\link{dinvwishartc}}, \code{\link{dmvn}}, and \code{\link{dwishart}}. } \examples{ library(LaplacesDemon) ### In the model specification function, input U and zeta, then: # Q <- t(U) %*% U # Zeta <- diag(zeta) # Sigma <- Zeta %*% Q %*% Zeta # Sigma.prior <- dsiw(Q, nu=Data$K+1, S=diag(Data$K), zeta, mu=0, delta=1) ### Examples x <- dsiw(diag(3), 4, diag(3), runif(3), rep(0,3), rep(1,3), log=TRUE) x <- rsiw(4, diag(3), rep(0,3), rep(1,3)) } \keyword{Distribution} LaplacesDemon/man/MISS.Rd0000755000176200001440000002066415144337635014624 0ustar liggesusers\name{MISS} \alias{MISS} \title{Multiple Imputation Sequential Sampling} \description{ This function performs multiple imputation (MI) on a numeric matrix by sequentially sampling variables with missing values, given all other variables in the data set. } \usage{ MISS(X, Iterations=100, Algorithm="GS", Fit=NULL, verbose=TRUE) } \arguments{ \item{X}{This required argument accepts a numeric matrix of data that contains both observed and missing values. Data set \eqn{\textbf{X}}{X} must not have any rows or columns that are completely missing. \eqn{\textbf{X}}{X} must not have any constants. The user must apply any data transformations appropriate for these models. Missing values are assumed to be Missing At Random (MAR).} \item{Iterations}{This is the number of iterations to perform sequential sampling via MCMC algorithms.} \item{Algorithm}{The MCMC algorithm defaults to the Gibbs Sampler (GS).} \item{Fit}{This optional argument accepts an object of class \code{miss}. When supplied, \code{MISS} will continue where it left off, provided the user does not change the algorithm (different methods are used with different algortihms, so model parameters will not match). In short, changing algorithms requires starting from scratch.} \item{verbose}{Logical. When \code{FALSE}, only the iteration prints to the console. When \code{TRUE}, which is the default, both the iteration and which variable is being imputed are printed to the console.} } \details{ Imputation is a family of statistical methods for replacing missing values with estimates. Introduced by Rubin and Schenker (1986) and Rubin (1987), Multiple Imputation (MI) is a family of imputation methods that includes multiple estimates, and therefore includes variability of the estimates. The Multiple Imputation Sequential Sampler (MISS) function performs MI by determining the type of variable and therefore the sampler for each variable, and then sequentially progresses through each variable in the data set that has missing values, updating its prediction of those missing values given all other variables in the data set each iteration. MI is best performed within a model, where it is called full-likelihood imputation. Examples may be found in the "Examples" vignette. However, sometimes it is impractical to impute within a model when there are numerous missing values and a large number of parameters are therefore added. As an alternative, MI may be performed on the data set before the data is passed to the model, such as in the \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, or \code{\link{VariationalBayes}} function. This is less desirable, but MISS is available for MCMC-based MI in this case. Missing values are initially set to column means for continuous variables, and are set to one for discrete variables. MISS uses the following methods and MCMC algorithms: Missing values of continuous variables are estimated with a ridge-stabilized linear regression Gibbs sampler. Missing values of binary variables that have only 0 or 1 for values are estimated either with a binary robit (t-link logistic regression model) Gibbs sampler of Albert and Chib (1993). Missing values of discrete variables with 3 or more (ordered or unordered) discrete values are considered continuous. In the presence of big data, it is suggested that the user sequentially read in batches of data that are small enough to be manageable, and then apply the MISS function to each batch. Each batch should be representative of the whole, of course. It is common for multiple imputation functions to handle variable transformations. MISS does not transform variables, but imputes what it gets. For example, if a user has a variable that should be positive only, then it is recommended here that the user log-transform the variable, pass the data set to MISS, and when finished, exponentiate both the observed and imputed values of that variable. The \code{CenterScale} function should also be considered to speed up convergence. It is hoped that MISS is helpful, though it is not without limitation and there are numerous alternatives outside of the \code{LaplacesDemon} package. If MISS does not fulfill the needs of the user, then the following packages are recommended: Amelia, mi, or mice. MISS emphasizes MCMC more than these alternatives, though MISS is not as extensive. When a data set does not have a simple structure, such as merely continuous or binary or unordered discrete, the \code{\link{LaplacesDemon}} function should be considered, where a user can easily specify complicated structures such as multilevel, spatial or temporal dependence, and more. Matrix inversions are required in the Gibbs sampler. Matrix inversions become more cumbersome as the number \eqn{J} of variables increases. If a large number of iterations is used, then the user may consider studying the imputations for approximate convergence with the \code{\link{BMK.Diagnostic}} function, by supplying the transpose of \code{Fit$Imp}. In the presence of numerous missing values, say more than 100, the user may consider iterating through the study of the imputations of 100 missing values at a time. } \value{ This function returns an object of class \code{miss} that is a list with five components: \item{Algorithm}{This indicates which algorithm was selected.} \item{Imp}{This is a \eqn{M \times T}{M x T} matrix of \eqn{M} missing values and \eqn{T} iterations that contains imputations.} \item{parm}{This is a list of length \eqn{J} for \eqn{J} variables, and each component of the list contains parameters associated with the prediction of missing values for that variable.} \item{PostMode}{This is a vector of posterior modes. If the user intends to replace missing values in a data set with only one estimate per missing values (single, not multiple imputation), then this vector contains these values.} \item{Type}{This is a vector of length \eqn{J} for \eqn{J} variables that indicates the type of each variable, as MISS will consider it. When \code{Type=1}, the variable is considered to be continuous. When \code{Type=2}, only two discrete values (0 and 1) were found.} } \references{ Albert, J.H. and Chib, S. (1993). "Bayesian Analysis of Binary and Polychotomous Response Data". \emph{Journal of the American Statistical Association}, 88(422), p. 669--679. Rubin, D.B. (1987). "Multiple Imputation for Nonresponse in Surveys". John Wiley and Sons: New York, NY. Rubin, D.B. and Schenker, N. (1986). "Multiple Imputation for Interval Estimation from Simple Random Samples with Ignorable Nonresponse". \emph{Journal of the American Statistical Association}, 81, p. 366--374. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{ABB}}, \code{\link{BMK.Diagnostic}}, \code{\link{CenterScale}}, \code{\link{IterativeQuadrature}} \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, and \code{\link{VariationalBayes}}. } \examples{ #library(LaplacesDemon) ### Create Data #N <- 20 #Number of Simulated Records #J <- 5 #Number of Simulated Variables #pM <- 0.25 #Percent Missing #Sigma <- as.positive.definite(matrix(runif(J*J),J,J)) #X <- rmvn(N, rep(0,J), Sigma) #m <- sample.int(N*J, round(pM*N*J)) #X[m] <- NA #head(X) ### Begin Multiple Imputation #Fit <- MISS(X, Iterations=100, Algorithm="GS", verbose=TRUE) #Fit #summary(Fit) #plot(Fit) #plot(BMK.Diagnostic(t(Fit$Imp))) ### Continue Updating if Necessary #Fit <- MISS(X, Iterations=100, Algorithm="GS", Fit, verbose=TRUE) #summary(Fit) #plot(Fit) #plot(BMK.Diagnostic(t(Fit$Imp))) ### Replace Missing Values in Data Set with Posterior Modes #Ximp <- X #Ximp[which(is.na(X))] <- Fit$PostMode ### Original and Imputed Data Sets #head(X) #head(Ximp) #summary(X) #summary(Ximp) ### or Multiple Data Sets, say 3 #Ximp <- array(X, dim=c(nrow(X), ncol(X), 3)) #for (i in 1:3) { # Xi <- X # Xi[which(is.na(X))] <- Fit$Imp[,sample.int(ncol(Fit$Imp), 1)] # Ximp[,,i] <- Xi} #head(X) #head(Ximp[,,1]) #head(Ximp[,,2]) #head(Ximp[,,3]) #End } \keyword{Gibbs Sampler} \keyword{Imputation} \keyword{Utility} LaplacesDemon/man/print.laplace.Rd0000755000176200001440000000111715144337635016575 0ustar liggesusers\name{print.laplace} \alias{print.laplace} \title{Print an object of class \code{laplace} to the screen} \description{ This may be used to print the contents of an object of class \code{laplace} to the screen. } \usage{\method{print}{laplace}(x, \dots)} \arguments{ \item{x}{An object of class \code{laplace} is required.} \item{\dots}{Additional arguments are unused.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{LaplaceApproximation}}} \examples{### See the LaplaceApproximation function for an example.} \keyword{print}LaplacesDemon/man/dist.Asymmetric.Log.Laplace.Rd0000755000176200001440000001035415144316355021177 0ustar liggesusers\name{dist.Asymmetric.Log.Laplace} \alias{dallaplace} \alias{pallaplace} \alias{qallaplace} \alias{rallaplace} \title{Asymmetric Log-Laplace Distribution} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate, asymmetric, log-Laplace distribution with location parameter \eqn{\mu}{mu}, scale parameter \eqn{\lambda}{\lambda}, and asymmetry or skewness parameter \eqn{\kappa}{kappa}. } \usage{ dallaplace(x, location=0, scale=1, kappa=1, log=FALSE) pallaplace(q, location=0, scale=1, kappa=1) qallaplace(p, location=0, scale=1, kappa=1) rallaplace(n, location=0, scale=1, kappa=1) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{location}{This is the location parameter \eqn{\mu}{mu}.} \item{scale}{This is the scale parameter \eqn{\lambda}{lambda}, which must be positive.} \item{kappa}{This is the asymmetry or skewness parameter \eqn{\kappa}{kappa}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density 1: \eqn{p(\theta) = \exp(-\mu)\frac{(\sqrt(2)\kappa / \lambda)(\sqrt(2) / \lambda\kappa)}{(\sqrt(2)\kappa / \lambda)+(\sqrt(2) / (\lambda\kappa))} \exp(-(\frac{\sqrt(2)\kappa}{\lambda})+1), \quad \theta \ge \exp(\mu)}{p(theta) = exp(-mu) * (sqrt(2)*kappa/lambda) * (sqrt(2)/(lambda*kappa)) / ((sqrt(2)*kappa/lambda)+(sqrt(2)/(lambda*kappa))) * exp(-((sqrt(2)*kappa/lambda)+1)), theta >= exp(mu)} \item Density 2: \eqn{p(\theta) = \exp(-\mu) \frac{(\sqrt(2)\kappa / \lambda) (\sqrt(2) / (\lambda\kappa))}{(\sqrt(2)\kappa / \lambda) + (\sqrt(2) / (\lambda\kappa))} \exp(\frac{\sqrt(2)(\log(\theta)-\mu)}{\lambda\kappa} - (\log(\theta)-\mu)), \quad \theta < \exp(\mu)}{p(theta) = exp(-mu) * (sqrt(2)*kappa/lambda) * (sqrt(2)/(lambda*kappa)) / ((sqrt(2)*kappa/lambda)+(sqrt(2)/(lambda*kappa))) * exp(((sqrt(2)*(log(theta)-mu)) / (lambda*kappa)) - (log(theta)-mu)), theta < exp(mu)} \item Inventor: Pierre-Simon Laplace \item Notation 1: \eqn{\theta \sim \mathcal{ALL}(\mu, \lambda, \kappa)}{theta ~ ALL(mu, lambda, kappa)} \item Notation 2: \eqn{p(\theta) = \mathcal{ALL}(\theta | \mu, \lambda, \kappa)}{p(theta) = ALL(theta | mu, lambda, kappa)} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: scale parameter \eqn{\lambda > 0}{lambda > 0} \item Mean: \eqn{E(\theta) = }{E(theta) = } \item Variance: \eqn{var(\theta) = }{var(theta) = } \item Mode: \eqn{mode(\theta) = }{mode(theta) = } } The univariate, asymmetric log-Laplace distribution is derived from the Laplace distribution. Multivariate and symmetric versions also exist. These functions are similar to those in the \code{VGAM} package. } \value{ \code{dallaplace} gives the density, \code{pallaplace} gives the distribution function, \code{qallaplace} gives the quantile function, and \code{rallaplace} generates random deviates. } \references{ Kozubowski, T. J. and Podgorski, K. (2003). "Log-Laplace Distributions". \emph{International Mathematical Journal}, 3, p. 467--495. } \seealso{ \code{\link{dalaplace}}, \code{\link{dexp}}, \code{\link{dlaplace}}, \code{\link{dlaplacep}}, \code{\link{dllaplace}}, \code{\link{dmvl}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}. } \examples{ library(LaplacesDemon) x <- dallaplace(1,0,1,1) x <- pallaplace(1,0,1,1) x <- qallaplace(0.5,0,1,1) x <- rallaplace(100,0,1,1) #Plot Probability Functions x <- seq(from=0.1, to=10, by=0.1) plot(x, dallaplace(x,0,1,0.5), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dallaplace(x,0,1,1), type="l", col="green") lines(x, dallaplace(x,0,1,5), type="l", col="blue") legend(5, 0.9, expression(paste(mu==0, ", ", lambda==1, ", ", kappa==0.5), paste(mu==0, ", ", lambda==1, ", ", kappa==1), paste(mu==0, ", ", lambda==1, ", ", kappa==5)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/KLD.Rd0000755000176200001440000001125115144316355014447 0ustar liggesusers\name{KLD} \alias{KLD} \title{Kullback-Leibler Divergence (KLD)} \description{ This function calculates the Kullback-Leibler divergence (KLD) between two probability distributions, and has many uses, such as in lowest posterior loss probability intervals, posterior predictive checks, prior elicitation, reference priors, and Variational Bayes. } \usage{ KLD(px, py, base) } \arguments{ \item{px}{This is a required vector of probability densities, considered as \eqn{p(\textbf{x})}{p(x)}. Log-densities are also accepted, in which case both \code{px} and \code{py} must be log-densities.} \item{py}{This is a required vector of probability densities, considered as \eqn{p(\textbf{y})}{p(y)}. Log-densities are also accepted, in which case both \code{px} and \code{py} must be log-densities.} \item{base}{This optional argument specifies the logarithmic base, which defaults to \code{base=exp(1)} (or \eqn{e}) and represents information in natural units (nats), where \code{base=2} represents information in binary units (bits).} } \details{ The Kullback-Leibler divergence (KLD) is known by many names, some of which are Kullback-Leibler distance, K-L, and logarithmic divergence. KLD is an asymmetric measure of the difference, distance, or direct divergence between two probability distributions \eqn{p(\textbf{y})}{p(y)} and \eqn{p(\textbf{x})}{p(x)} (Kullback and Leibler, 1951). Mathematically, however, KLD is not a distance, because of its asymmetry. Here, \eqn{p(\textbf{y})}{p(y)} represents the ``true'' distribution of data, observations, or theoretical distribution, and \eqn{p(\textbf{x})}{p(x)} represents a theory, model, or approximation of \eqn{p(\textbf{y})}{p(y)}. For probability distributions \eqn{p(\textbf{y})}{p(y)} and \eqn{p(\textbf{x})}{p(x)} that are discrete (whether the underlying distribution is continuous or discrete, the observations themselves are always discrete, such as from \eqn{i=1,\dots,N}{i=1,...,N}), \deqn{\mathrm{KLD}[p(\textbf{y}) || p(\textbf{x})] = \sum^N_i p(\textbf{y}_i) \log\frac{p(\textbf{y}_i)}{p(\textbf{x}_i)}}{KLD[p(y)||p(x)] = sum of p(y[i]) log(p(y[i]) / p(x[i]))} In Bayesian inference, KLD can be used as a measure of the information gain in moving from a prior distribution, \eqn{p(\theta)}{p(theta)}, to a posterior distribution, \eqn{p(\theta | \textbf{y})}{p(theta | y)}. As such, KLD is the basis of reference priors and lowest posterior loss intervals (\code{\link{LPL.interval}}), such as in Berger, Bernardo, and Sun (2009) and Bernardo (2005). The intrinsic discrepancy was introduced by Bernardo and Rueda (2002). For more information on the intrinsic discrepancy, see \code{\link{LPL.interval}}. } \value{ \code{KLD} returns a list with the following components: \item{KLD.px.py}{This is \eqn{\mathrm{KLD}_i[p(\textbf{x}_i) || p(\textbf{y}_i)]}{KLD[i](p(x[i]) || p(y[i]))}.} \item{KLD.py.px}{This is \eqn{\mathrm{KLD}_i[p(\textbf{y}_i) || p(\textbf{x}_i)]}{KLD[i](p(y[i]) || p(x[i]))}.} \item{mean.KLD}{This is the mean of the two components above. This is the expected posterior loss in \code{\link{LPL.interval}}.} \item{sum.KLD.px.py}{This is \eqn{\mathrm{KLD}[p(\textbf{x}) || p(\textbf{y})]}{KLD(p(x) || p(y))}. This is a directed divergence.} \item{sum.KLD.py.px}{This is \eqn{\mathrm{KLD}[p(\textbf{y}) || p(\textbf{x})]}{KLD(p(y) || p(x))}. This is a directed divergence.} \item{mean.sum.KLD}{This is the mean of the two components above.} \item{intrinsic.discrepancy}{This is minimum of the two directed divergences.} } \references{ Berger, J.O., Bernardo, J.M., and Sun, D. (2009). "The Formal Definition of Reference Priors". \emph{The Annals of Statistics}, 37(2), p. 905--938. Bernardo, J.M. and Rueda, R. (2002). "Bayesian Hypothesis Testing: A Reference Approach". \emph{International Statistical Review}, 70, p. 351--372. Bernardo, J.M. (2005). "Intrinsic Credible Regions: An Objective Bayesian Approach to Interval Estimation". \emph{Sociedad de Estadistica e Investigacion Operativa}, 14(2), p. 317--384. Kullback, S. and Leibler, R.A. (1951). "On Information and Sufficiency". \emph{The Annals of Mathematical Statistics}, 22(1), p. 79--86. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LPL.interval}} and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) px <- dnorm(runif(100),0,1) py <- dnorm(runif(100),0.1,0.9) KLD(px,py) } \keyword{Distribution} \keyword{Elicitation} \keyword{Reference Priors}LaplacesDemon/man/SensitivityAnalysis.Rd0000755000176200001440000001437715144316355020107 0ustar liggesusers\name{SensitivityAnalysis} \alias{SensitivityAnalysis} \title{Sensitivity Analysis} \description{ This function performs an elementary sensitivity analysis for two models regarding marginal posterior distributions and posterior inferences. } \usage{ SensitivityAnalysis(Fit1, Fit2, Pred1, Pred2) } \arguments{ \item{Fit1}{This argument accepts an object of class \code{demonoid}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}.} \item{Fit2}{This argument accepts an object of class \code{demonoid}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}.} \item{Pred1}{This argument accepts an object of class \code{demonoid.ppc}, \code{iterquad.ppc}, \code{laplace.ppc}, \code{pmc.ppc}, or \code{vb.ppc}.} \item{Pred2}{This argument accepts an object of class \code{demonoid.ppc}, \code{iterquad.ppc}, \code{laplace.ppc}, \code{pmc.ppc}, or \code{vb.ppc}.} } \details{ Sensitivity analysis is concerned with the influence from changes to the inputs of a model on the output. Comparing differences resulting from different prior distributions is the most common application of sensitivity analysis, though results from different likelihoods may be compared as well. The outputs of interest are the marginal posterior distributions and posterior inferences. There are many more methods of conducting a sensitivity analysis than exist in the \code{SensitivityAnalysis} function. For more information, see Oakley and O'Hagan (2004). The \code{\link{SIR}} function is useful for approximating changes in the posterior due to small changes in prior distributions. The \code{SensitivityAnalysis} function compares marginal posterior distributions and posterior predictive distributions. Specifically, it calculates the probability that each distribution in \code{Fit1} and \code{Pred1} is greater than the associated distribution in \code{Fit2} and \code{Pred2}, and returns a variance ratio of each pair of distributions. If the probability is \eqn{0.5} that a distribution is greater than another, or if the variance ratio is \eqn{1}, then no difference is found due to the inputs. Additional comparisons and methods are currently outside the scope of the \code{SensitivityAnalysis} function. The \code{\link{BayesFactor}} function may also be considered, as well as comparing posterior predictive checks resulting from \code{\link{summary.demonoid.ppc}}, \code{\link{summary.iterquad.ppc}}, \code{\link{summary.laplace.ppc}}, \code{\link{summary.pmc.ppc}}, or \code{\link{summary.vb.ppc}}. Regarding marginal posterior distributions, the \code{SensitivityAnalysis} function compares only distributions with identical parameter names. For example, suppose a statistician conducts a sensitivity analysis to study differences resulting from two prior distributions: a normal distribution and a Student t distribution. These distributions have two and three parameters, respectively. The statistician has named the parameters \code{beta} and \code{sigma} for the normal distribution, while for the Student t distribution, the parameters are named \code{beta}, \code{sigma}, and \code{nu}. In this case, the \code{SensitivityAnalysis} function compares the marginal posterior distributions for \code{beta} and \code{sigma}, though \code{nu} is ignored because it is not in both models. If the statistician does not want certain parameters compared, then differing parameter names should be assigned. Robust Bayesian analysis is a very similar topic, and often called simply Bayesian sensitivity analysis. In robust Bayesian analysis, the robustness of answers from a Bayesian analysis to uncertainty about the precise details of the analysis is studied. An answer is considered robust if it does not depend sensitively on the assumptions and inputs on which it is based. Robust Bayes methods acknowledge that it is sometimes very difficult to come up with precise distributions to be used as priors. Likewise the appropriate likelihood function that should be used for a particular problem may also be in doubt. In a robust Bayesian analysis, a standard Bayesian analysis is applied to all possible combinations of prior distributions and likelihood functions selected from classes of priors and likelihoods considered empirically plausible by the statistician. } \value{ This function returns a list with the following components: \item{Posterior}{This is a \eqn{J \times 2}{J x 2} matrix of \eqn{J} marginal posterior distributions. Column names are "p(Fit1 > Fit2)" and "var(Fit1) / var(Fit2)".} \item{Post.Pred.Dist}{This is a \eqn{N \times 2}{N x 2} matrix of \eqn{N} posterior predictive distributions. Column names are "p(Pred1 > Pred2)" and "var(Pred1) / var(Pred2)".} } \references{ Berger, J.O. (1984). "The Robust Bayesian Viewpoint (with discussion)". In J. B. Kadane, editor, Robustness of Bayesian Analyses, p. 63--144. North-Holland, Amsterdam. Berger, J.O. (1985). "Statistical Decision Theory and Bayesian Analysis". Springer-Verlag, New York. Berger, J.O. (1994). "An Overview of Robust Bayesian Analysis (with discussion)". Test, 3, p. 5--124. Oakley, J. and O'Hagan, A. (2004). "Probabilistic Sensitivity Analysis of Complex Models: a Bayesian Approach". \emph{Journal of the Royal Statistical Society, Series B}, 66, p. 751--769. Weiss, R. (1995). "An Approach to Bayesian Sensitivity Analysis". \emph{Journal of the Royal Statistical Society, Series B}, 58, p. 739--750. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{BayesFactor}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, \code{\link{predict.demonoid}}, \code{\link{predict.iterquad}}, \code{\link{predict.laplace}}, \code{\link{predict.pmc}}, \code{\link{SIR}}, \code{\link{summary.demonoid.ppc}}, \code{\link{summary.iterquad.ppc}}, \code{\link{summary.laplace.ppc}}, \code{\link{summary.pmc.ppc}}, and \code{\link{VariationalBayes}}. } \examples{ #sa <- SensitivityAnalysis(Fit1, Fit2, Pred1, Pred2) #sa } \keyword{Sensitivity} LaplacesDemon/man/dist.Asymmetric.Multivariate.Laplace.Rd0000755000176200001440000001024715144316355023125 0ustar liggesusers\name{dist.Asymmetric.Multivariate.Laplace} \alias{daml} \alias{raml} \title{Asymmetric Multivariate Laplace Distribution} \description{ These functions provide the density and random generation for the asymmetric multivariate Laplace distribution with location and skew parameter \eqn{\mu}{mu} and covariance \eqn{\Sigma}{Sigma}. } \usage{ daml(x, mu, Sigma, log=FALSE) raml(n, mu, Sigma) } \arguments{ \item{x}{This is a \eqn{N \times K}{N x K} matrix of data, or a vector of length \eqn{K}.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mu}{This is the location and skew parameter \eqn{\mu}{mu}. This may be a \eqn{N \times K}{N x K} matrix, or a vector of length \eqn{K}.} \item{Sigma}{This is the \eqn{K \times K}{K x K} positive-definite covariance matrix \eqn{\Sigma}{Sigma}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = \frac{2\exp(\theta\Omega\theta)}{(2\pi)^{k/2}|\Sigma|^0.5} \frac{\theta\Omega\theta}{2 + \mu\Omega\mu}^{(2-k)/4} K_{(2-k)/2}(\sqrt{(2 + \mu\Omega\mu)(\theta\Omega\theta)})}{ p(theta) = ((2exp(theta Omega theta)) / ((2pi)^(k/2)|Sigma|^(0.5))) ((theta Omega theta) / (2 + mu Omega mu))^((k-2)/4) K[(2-k)/2](sqrt((2 + mu Omega mu)(theta Omega theta)))} \item Inventor: Kotz, Kozubowski, and Podgorski (2003) \item Notation 1: \eqn{\theta \sim \mathcal{AL}_K(\mu, \Sigma)}{theta ~ AL[K](mu, Sigma)} \item Notation 2: \eqn{p(\theta) = \mathcal{AL}_K(\theta | \mu, \Sigma)}{p(theta) = AL[K](theta | mu, Sigma)} \item Parameter 1: location-skew parameter \eqn{\mu}{mu} \item Parameter 2: positive-definite covariance matrix \eqn{\Sigma}{Sigma} \item Mean: Unknown \item Variance: Unknown \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The asymmetric multivariate Laplace distribution of Kotz, Kozubowski, and Podgorski (2003) is a multivariate extension of the univariate, asymmetric Laplace distribution. It is parameterized according to two parameters: location-skew parameter \eqn{\mu}{mu} and positive-definite covariance matrix \eqn{\Sigma}{Sigma}. Location and skew occur in the same parameter. When \eqn{\mu=0}{mu=0}, the density is the (symmetric) multivariate Laplace of Anderson (1992). As each location deviates from zero, the marginal distribution becomes more skewed. Since location and skew are combined, it is appropriate for zero-centered variables, such as a matrix of centered and scaled dependent variables in cluster analysis, factor analysis, multivariate regression, or multivariate time-series. The asymmetric multivariate Laplace distribution is also discussed earlier in Kozubowski and Podgorski (2001), and is well-suited for financial modeling via multivariate regression, specifically with currency exchange rates. Cajigas and Urga (2005) fit residuals in a multivariate GARCH model with the asymmetric multivariate Laplace distribution, regarding stocks and bonds. They find that it "overwhelmingly outperforms" normality. } \value{ \code{daml} gives the density, and \code{raml} generates random deviates. } \references{ Anderson, D.N. (1992). "A Multivariate Linnik Distribution". \emph{Statistical Probability Letters}, 14, p. 333--336. Cajigas, J.P. and Urga, G. (2005) "Dynamic Conditional Correlation Models with Asymmetric Laplace Innovations". Centre for Economic Analysis: Cass Business School. Kotz, S., Kozubowski, T.J., and Podgorski, K. (2003). "An Asymmetric Multivariate Laplace Distribution". Working Paper. Kozubowski, T.J. and Podgorski, K. (2001). "Asymmetric Laplace Laws and Modeling Financial Data". \emph{Mathematical and Computer Modelling}, 34, p. 1003--1021. } \seealso{\code{\link{dalaplace}} and \code{\link{dmvl}} } \examples{ library(LaplacesDemon) x <- daml(c(1,2,3), c(0,1,2), diag(3)) X <- raml(1000, c(0,1,2), diag(3)) joint.density.plot(X[,1], X[,2], color=FALSE) } \keyword{Distribution}LaplacesDemon/man/plot.demonoid.ppc.Rd0000755000176200001440000004101115144316355017366 0ustar liggesusers\name{plot.demonoid.ppc} \alias{plot.demonoid.ppc} \title{Plots of Posterior Predictive Checks} \description{ This may be used to plot, or save plots of, samples in an object of class \code{demonoid.ppc}. A variety of plots is provided. } \usage{\method{plot}{demonoid.ppc}(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, \dots)} \arguments{ \item{x}{ This required argument is an object of class \code{demonoid.ppc}.} \item{Style}{ This optional argument specifies one of several styles of plots, and defaults to \code{NULL} (which is the same as \code{"Density"}). Styles of plots are indicated in quotes. Optional styles include \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"Density"}, \code{"DW"}, \code{"DW, Multivariate, C"}, \code{"ECDF"}, \code{"Fitted"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Predictive Quantiles"}, \code{"Residual Density"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}. Details are given below.} \item{Data}{ This optional argument accepts the data set used when updating the model. Data is required only with certain plot styles, including \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"DW, Multivariate, C"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}.} \item{Rows}{ This optional argument is for a vector of row numbers that specify the records associated by row in the object of class \code{demonoid.ppc}. Only these rows are plotted. The default is to plot all rows. Some plots do not allow rows to be specified.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{\dots}{Additional arguments are unused.} } \details{ This function can be used to produce a variety of posterior predictive plots, and the style of plot is selected with the \code{Style} argument. Below are some notes on the styles of plots. \code{Covariates} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is not categorical. \code{Covariates, Categorical DV} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is categorical. \code{Density} plots show the kernel density of the posterior predictive distribution for each selected row of y (all are selected by default). A vertical red line indicates the position of the observed y along the x-axis. When the vertical red line is close to the middle of a normal posterior predictive distribution, then there is little discrepancy between y and the posterior predictive distribution. When the vertical red line is in the tail of the distribution, or outside of the kernel density altogether, then there is a large discrepancy between y and the posterior predictive distribution. Large discrepancies may be considered outliers, and moreover suggest that an improvement in model fit should be considered. \code{DW} plots the distributions of the Durbin-Watson (DW) test statistics (Durbin and Watson, 1950), both observed (\eqn{d^{obs}}{d.obs} as a transparent, black density) and replicated (\eqn{d^{rep}}{d.rep} as a transparent, red density). The distribution of \eqn{d^{obs}}{d.obs} is estimated from the model, and \eqn{d^{rep}}{d.rep} is simulated from normal residuals without autocorrelation, where the number of simulations are the same as the observed number. This DW test may be applied to the residuals of univariate time-series models (or otherwise ordered residuals) to detect first-order autocorrelation. Autocorrelated residuals are not independent. The DW test is applicable only when the residuals are normally-distributed, higher-order autocorrelation is not present, and y is not used also as a lagged predictor. The DW test statistic, \eqn{d^{obs}}{d[obs]}, occurs in the interval (0,4), where 0 is perfect positive autocorrelation, 2 is no autocorrelation, and 4 is perfect negative autocorrelation. The following summary is reported on the plot: the mean of \eqn{d^{obs}}{d[obs]} (and its 95\% probability interval), the probability that \eqn{d^{obs} > d^{rep}}{d[obs] > d[rep]}, and whether or not autocorrelation is found. Positive autocorrelation is reported when the observed process is greater than the replicated process in 2.5\% of the samples, and negative autocorrelation is reported when the observed process is greater than the replicated process in 97.5\% of the samples. \code{DW, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Durbin-Watson test, as in \code{DW} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for first-order autocorrelation. \code{ECDF} (Empirical Cumulative Distribution Function) plots compare the ECDF of y with three ECDFs of yhat based on the 2.5\%, 50\% (median), and 97.5\% of its distribution. The ECDF(y) is defined as the proportion of values less than or equal to y. This plot is appropriate when y is univariate and at least ordinal. \code{Fitted} plots compare y with the probability interval of its replicate, and provide loess smoothing. This plot is appropriate when y is univariate and not categorical. \code{Fitted, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each column-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen column-wise. \code{Fitted, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each row-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen row-wise. \code{Jarque-Bera} plots the distributions of the Jarque-Bera (JB) test statistics (Jarque and Bera, 1980), both observed (\eqn{JB^{obs}}{JB.obs} as a transparent black density) and replicated (\eqn{JB^{rep}}{JB.rep} as a transparent red density). The distribution of \eqn{JB^{obs}}{JB.obs} is estimated from the model, and \eqn{JB^{rep}}{JB.rep} is simulated from normal residuals, where the number of simulations are the same as the observed number. This Jarque-Bera test may be applied to the residuals of univariate models to test for normality. The Jarque-Bera test does not test normality per se, but whether or not the distribution has kurtosis and skewness that match a normal distribution, and is therefore a test of the moments of a normal distribution. The following summary is reported on the plot: the mean of \eqn{JB^{obs}}{JB[obs]} (and its 95\% probability interval), the probability that \eqn{JB^{obs} > JB^{rep}}{JB[obs] > JB[rep]}, and whether or not normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Jarque-Bera, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Jarque-Bera test, as in \code{Jarque-Bera} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for normality. \code{Mardia} plots the distributions of the skewness (K3) and kurtosis (K4) test statistics (Mardia, 1970), both observed (\eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} as transparent black density) and replicated (\eqn{K3^{rep}}{K3.rep} and \eqn{K4^{rep}}{K4.rep} as transparent red density). The distributions of \eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} are estimated from the model, and both \eqn{K3^{rep}}{K3.rep} \eqn{K4^{rep}}{K4.rep} are simulated from multivariate normal residuals, where the number of simulations are the same as the observed number. This Mardia's test may be applied to the residuals of multivariate models to test for multivariate normality. Mardia's test does not test for multivariate normality per se, but whether or not the distribution has kurtosis and skewness that match a multivariate normal distribution, and is therefore a test of the moments of a multivariate normal distribution. The following summary is reported on the plots: the means of \eqn{K3^{obs}}{K3[obs]} and \eqn{K4^{obs}}{K4[obs]} (and the associated 95\% probability intervals), the probabilities that \eqn{K3^{obs} > K3^{rep}}{K3[obs] > K3[rep]} and \eqn{K4^{obs} > K4^{rep}}{K4[obs] > K4[rep]}, and whether or not multivariate normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Mardia} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. \code{Y} must be a \eqn{N \times P}{N x P} matrix of \eqn{N}{N} records and \eqn{P}{P} variables. Source code was modified from the deprecated package QRMlib. \code{Predictive Quantiles} plots compare y with the predictive quantile (PQ) of its replicate. This may be useful in looking for patterns with outliers. Instances outside of the gray lines are considered outliers. \code{Residual Density} plots the residual density of the median of the samples. A vertical red line occurs at zero. This plot may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when y is univariate and continuous. \code{Residual Density, Multivariate C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are column-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen column-wise. \code{Residual Density, Multivariate R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are row-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen row-wise. \code{Residuals} plots compare y with its residuals. The probability interval is plotted as a line. This plot is appropriate when y is univariate. \code{Residuals, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each column-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen column-wise. \code{Residuals, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each row-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen row-wise. \code{Space-Time by Space} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one time-series plot per point s in space, for a total of S plots. Therefore, these are time-series plots for each point s in space across T time-periods. See \code{Time-Series} plots below. \code{Space-Time by Time} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one spatial plot per time-period, and T plots will be produced. See \code{Spatial} plots below. \code{Spatial} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows yrep plotted according to its coordinates, and is color-coded so that higher values of yrep become more red, and lower values become more yellow. \code{Spatial Uncertainty} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows the probability interval of yrep plotted according to its coordinates, and is color-coded so that wider probability intervals become more red, and lower values become more yellow. \code{Time-Series} plots compare y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is univariate and ordered by time. \code{Time-Series, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by column in Y. \code{Time-Series, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each row-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by row in Y, such as is typically true in panel models. } \references{ Durbin, J., and Watson, G.S. (1950). "Testing for Serial Correlation in Least Squares Regression, I." \emph{Biometrika}, 37, p. 409--428. Jarque, C.M. and Bera, A.K. (1980). "Efficient Tests for Normality, Homoscedasticity and Serial Independence of Regression Residuals". \emph{Economics Letters}, 6(3), p. 255--259. Mardia, K.V. (1970). "Measures of Multivariate Skewness and Kurtosis with Applications". \emph{Biometrika}, 57(3), p. 519--530. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplacesDemon}} and \code{\link{predict.demonoid}}. } \examples{### See the LaplacesDemon function for an example.} \keyword{Plot}LaplacesDemon/man/dist.Normal.Mixture.Rd0000755000176200001440000000645215144316355017672 0ustar liggesusers\name{dist.Normal.Mixture} \alias{dnormm} \alias{pnormm} \alias{rnormm} \title{Mixture of Normal Distributions} \description{ These functions provide the density, cumulative, and random generation for the mixture of univariate normal distributions with probability \eqn{p}, mean \eqn{\mu}{mu} and standard deviation \eqn{\sigma}{sigma}. } \usage{ dnormm(x, p, mu, sigma, log=FALSE) pnormm(q, p, mu, sigma, lower.tail=TRUE, log.p=FALSE) rnormm(n, p, mu, sigma) } \arguments{ \item{x,q}{This is vector of values at which the density will be evaluated.} \item{p}{This is a vector of length \eqn{M} of probabilities for \eqn{M} components. The sum of the vector must be one.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mu}{This is a vector of length \eqn{M} that is the mean parameter \eqn{\mu}{mu}.} \item{sigma}{This is a vector of length \eqn{M} that is the standard deviation parameter \eqn{\sigma}{sigma}, which must be positive.} \item{lower.tail}{Logical. This defaults to \code{TRUE}.} \item{log,log.p}{Logical. If \code{TRUE}, then probabilities \eqn{p} are given as \eqn{\log(p)}{log(p)}.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \sum p_i \mathcal{N}(\mu_i, \sigma^2_i)}{p(theta) = sum p[i] N(mu[i], sigma[i]^2)} \item Inventor: Unknown \item Notation 1: \eqn{\theta \sim \mathcal{N}(\mu, \sigma^2)}{theta ~ N(mu, sigma^2)} \item Notation 2: \eqn{p(\theta) = \mathcal{N}(\theta | \mu, \sigma^2)}{p(theta) = N(theta | mu, sigma^2)} \item Parameter 1: mean parameters \eqn{\mu}{mu} \item Parameter 2: standard deviation parameters \eqn{\sigma > 0}{sigma > 0} \item Mean: \eqn{E(\theta) = \sum p_i \mu_i}{E(theta) = sum p[i] mu[i]} \item Variance: \eqn{var(\theta) = \sum p_i \sigma^{0.5}_i}{var(theta) = sum p[i] sigma[i]^(0.5)} \item Mode: } A mixture distribution is a probability distribution that is a combination of other probability distributions, and each distribution is called a mixture component, or component. A probability (or weight) exists for each component, and these probabilities sum to one. A mixture distribution (though not these functions here in particular) may contain mixture components in which each component is a different probability distribution. Mixture distributions are very flexible, and are often used to represent a complex distribution with an unknown form. When the number of mixture components is unknown, Bayesian inference is the only sensible approach to estimation. A normal mixture, or Gaussian mixture, distribution is a combination of normal probability distributions. } \value{ \code{dnormm} gives the density, \code{pnormm} returns the CDF, and \code{rnormm} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{ddirichlet}} and \code{\link{dnorm}}. } \examples{ library(LaplacesDemon) p <- c(0.3,0.3,0.4) mu <- c(-5, 1, 5) sigma <- c(1,2,1) x <- seq(from=-10, to=10, by=0.1) plot(x, dnormm(x, p, mu, sigma, log=FALSE), type="l") #Density plot(x, pnormm(x, p, mu, sigma), type="l") #CDF plot(density(rnormm(10000, p, mu, sigma))) #Random Deviates } \keyword{Distribution}LaplacesDemon/man/dist.Multivariate.Polya.Rd0000755000176200001440000000534215144316355020534 0ustar liggesusers\name{dist.Multivariate.Polya} \alias{dmvpolya} \alias{rmvpolya} \title{Multivariate Polya Distribution} \description{ These functions provide the density and random number generation for the multivariate Polya distribution. } \usage{ dmvpolya(x, alpha, log=FALSE) rmvpolya(n, alpha) } \arguments{ \item{x}{This is data or parameters in the form of a vector of length \eqn{k}.} \item{n}{This is the number of random draws to take from the distribution.} \item{alpha}{This is shape vector \eqn{\alpha}{alpha} with length \eqn{k}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Discrete Multivariate \item Density: \deqn{p(\theta) = \frac{N!}{\prod_k N_k!} \frac{(\sum_k \alpha_k - 1)!}{(\sum_k \theta_k + \sum_k \alpha_k - 1)!} \frac{\prod (\theta + \alpha - 1)!}{(\alpha - 1)!}}{p(theta) = (N! / prod(N[k]!)) * ((sum alpha[k] - 1)! / (sum theta[k] + sum alpha[k] - 1)!) * prod((theta + alpha - 1)! / (alpha - 1)!)} \item Inventor: George Polya (1887-1985) \item Notation 1: \eqn{\theta \sim \mathcal{MPO}(\alpha)}{theta ~ MPO(alpha)} \item Notation 3: \eqn{p(\theta) = \mathcal{MPO}(\theta | \alpha)}{p(theta) = MPO(theta | alpha)} \item Parameter 1: shape parameter vector \eqn{\alpha}{alpha} \item Mean: \eqn{E(\theta) = }{E(theta) = } \item Variance: \eqn{var(\theta) =}{var(theta) = } \item Mode: \eqn{mode(\theta) = }{mode(theta) = } } The multivariate Polya distribution is named after George Polya (1887-1985). It is also called the Dirichlet compound multinomial distribution or the Dirichlet-multinomial distribution. The multivariate Polya distribution is a compound probability distribution, where a probability vector \eqn{p} is drawn from a Dirichlet distribution with parameter vector \eqn{\alpha}{alpha}, and a set of \eqn{N} discrete samples is drawn from the categorical distribution with probability vector \eqn{p} and having \eqn{K} discrete categories. The compounding corresponds to a Polya urn scheme. In document classification, for example, the distribution is used to represent probabilities over word counts for different document types. The multivariate Polya distribution is a multivariate extension of the univariate Beta-binomial distribution. } \value{ \code{dmvpolya} gives the density and \code{rmvpolya} generates random deviates. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{dcat}}, \code{\link{ddirichlet}}, and \code{\link{dmultinom}}. } \examples{ library(LaplacesDemon) dmvpolya(x=1:3, alpha=1:3, log=TRUE) x <- rmvpolya(1000, c(0.1,0.3,0.6)) } \keyword{Distribution}LaplacesDemon/man/PosteriorChecks.Rd0000755000176200001440000001656515144316355017161 0ustar liggesusers\name{PosteriorChecks} \alias{PosteriorChecks} \title{Posterior Checks} \description{ Not to be confused with posterior predictive checks, this function provides additional information about the marginal posterior distributions of continuous parameters, such as the probability that each posterior coefficient of the parameters (referred to generically as \eqn{\theta}{theta}), is greater than zero [\eqn{p(\theta > 0)}{p(theta > 0)}], the estimated number of modes, the kurtosis and skewness of the posterior distributions, the burn-in of each chain (for MCMC only), integrated autocorrelation time, independent samples per minute, and acceptance rate. A posterior correlation matrix is provided only for objects of class \code{demonoid} or \code{pmc}. For discrete parameters, see the \code{\link{Hangartner.Diagnostic}}. } \usage{ PosteriorChecks(x, Parms) } \arguments{ \item{x}{This required argument accepts an object of class \code{demonoid}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}.} \item{Parms}{This argument accepts a vector of quoted strings to be matched for selecting parameters. This argument defaults to \code{NULL} and selects every parameter. Each quoted string is matched to one or more parameter names with the \code{grep} function. For example, if the user specifies \code{Parms=c("eta", "tau")}, and if the parameter names are beta[1], beta[2], eta[1], eta[2], and tau, then all parameters will be selected, because the string \code{eta} is within \code{beta}. Since \code{grep} is used, string matching uses regular expressions, so beware of meta-characters, though these are acceptable: ".", "[", and "]".} } \details{\code{PosteriorChecks} is a supplemental function that returns a list with two components. Following is a summary of popular uses of the \code{PosteriorChecks} function. First (and only for MCMC users), the user may be considering the current MCMC algorithm versus others. In this case, the \code{PosteriorChecks} function is often used to find the two MCMC chains with the highest \code{\link{IAT}}, and these chains are studied for non-randomness with a joint trace plot, via the \code{\link{joint.density.plot}} function. The best algorithm has the chains with the highest independent samples per minute (ISM). Posterior correlation may be studied between model updates as well as after a model seems to have converged. While frequentists consider multicollinear predictor variables, Bayesians tend to consider posterior correlation of the parameters. Models with multicollinear parameters take more iterations to converge. Hierarchical models often have high posterior correlations. Posterior correlation often contributes to a lower effective sample size (\code{\link{ESS}}). Common remedies include transforming the predictors, re-parameterization to reduce posterior correlation, using WIPs (Weakly-Informative Priors), or selecting a different numerical approximation algorithm. An example of re-parameterization is to constrain related parameters to sum to zero. Another approach is to specify the parameters according to a multivariate distribution that is assisted by estimating a covariance matrix. Some algorithms are more robust to posterior correlation than others. For example, posterior correlation should generally be less problematic for twalk than AMWG in \code{\link{LaplacesDemon}}. Posterior correlation may be plotted with the \code{\link{plotMatrix}} function, and may be useful for blocking parameters. For more information on blockwise sampling, see the \code{\link{Blocks}} function. After a user is convinced of the applicability of the current MCMC algorithm, and that the chains have converged, \code{PosteriorChecks} is often used to identify multimodal marginal posterior distributions for further study or model re-specification. Although many marginal posterior distributions appear normally distributed, there is no such assumption. Nonetheless, a marginal posterior distribution tends to be distributed the same as its prior distribution. If a parameter has a prior specified with a Laplace distribution, then the marginal posterior distribution tends also to be Laplace-distributed. In the common case of normality, kurtosis and skewness may be used to identify discrepancies between the prior and posterior, and perhaps this should be called a `prior-posterior check'. Lastly, parameter importance may be considered, in which case it is recommended to be considered simultaneously with variable importance from the \code{\link{Importance}} function. } \value{ \code{PosteriorChecks} returns an object of class \code{posteriorchecks} that is a list with the following components: \item{Posterior.Correlation}{ This is a correlation matrix of the parameters selected with the \code{Parms} argument. This component is returned as \code{NA} for objects of classes \code{"laplace"} or \code{"vb"}.} \item{Posterior.Summary}{This is a matrix in which each row is a parameter and there are eight columns: p(theta > 0), N.Modes, Kurtosis, Skewness, Burn-In, IAT, ISM, and AR. The first column, p(theta > 0), indicates parameter importance by reporting how much of the distribution is greater than zero. An important parameter distribution will have a result at least as extreme as 0.025 or 0.975, and an unimportant parameter distribution is centered at 0.5. This is not the importance of the associated variable relative to how well the model fits the data. For variable importance, see the \code{\link{Importance}} function. The second column, N.Modes, is the number of modes, estimated with the \code{\link{Modes}} function. Kurtosis and skewness are useful posterior checks that may suggest that a posterior distribution is non-normal or does not fit well with a distributional assumption, assuming a distributional assumption exists, which it may not. The burn-in is estimated for each chain (only for objects of class \code{demonoid} with the \code{\link{burnin}} function. The integrated autocorrelation time is estimated with \code{\link{IAT}}. The number of independent samples per minute (ISM) is calculated for objects of class \code{"demonoid"} as \code{\link{ESS}} divided by minutes. Lastly, the local acceptance rate of each MCMC chain is calculated with the \code{\link{AcceptanceRate}} function, and is set to 1 for objects of class \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{AcceptanceRate}}, \code{\link{Blocks}}, \code{\link{burnin}}, \code{\link{ESS}}, \code{\link{Hangartner.Diagnostic}}, \code{\link{joint.density.plot}}, \code{\link{IAT}}, \code{\link{Importance}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{Modes}}, \code{\link{plotMatrix}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \examples{### See the LaplacesDemon function for an example.} \keyword{Diagnostic} \keyword{MCMC} \keyword{Monte Carlo} \keyword{Multicollinearity} \keyword{Posterior Correlation} \keyword{Utility}LaplacesDemon/man/Precision.Rd0000755000176200001440000001045015144316355015770 0ustar liggesusers\name{Precision} \alias{Cov2Prec} \alias{Prec2Cov} \alias{prec2sd} \alias{prec2var} \alias{sd2prec} \alias{sd2var} \alias{var2prec} \alias{var2sd} \title{Precision} \description{ Bayesians often use precision rather than variance. These are elementary utility functions to facilitate conversions between precision, standard deviation, and variance regarding scalars, vectors, and matrices, and these functions are designed for those who are new to Bayesian inference. The names of these functions consist of two different scale parameters, separated by a `2', and capital letters refer to matrices while lower case letters refer to scalars and vectors. For example, the \code{Prec2Cov} function converts a precision matrix to a covariance matrix, while the \code{prec2sd} function converts a scalar or vector of precision parameters to standard deviation parameters. The modern Bayesian use of precision developed because it was more straightforward in a normal distribution to estimate precision \eqn{\tau}{tau} with a gamma distribution as a conjugate prior, than to estimate \eqn{\sigma^2}{sigma^2} with an inverse-gamma distribution as a conjugate prior. Today, conjugacy is usually considered to be merely a convenience, and in this example, a non-conjugate half-Cauchy prior distribution is recommended as a weakly informative prior distribution for scale parameters. } \usage{ Cov2Prec(Cov) Prec2Cov(Prec) prec2sd(prec=1) prec2var(prec=1) sd2prec(sd=1) sd2var(sd=1) var2prec(var=1) var2sd(var=1) } \arguments{ \item{Cov}{This is a covariance matrix, usually represented as \eqn{\Sigma}{Sigma}.} \item{Prec}{This is a precision matrix, usually represented as \eqn{\Omega}{Omega}.} \item{prec}{This is a precision scalar or vector, usually represented as \eqn{\tau}{tau}.} \item{sd}{This is a standard deviation scalar or vector, usually represented as \eqn{\sigma}{sigma}.} \item{var}{This is a variance scalar or vector, usually represented as \eqn{\sigma^2}{sigma^2}.} } \details{Bayesians often use precision rather than variance, where precision is the inverse of the variance. For example, a linear regression may be represented equivalently as \eqn{\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)}{y ~ N(mu, sigma^2)}, or \eqn{\textbf{y} \sim \mathcal{N}(\mu, \tau^{-1})}{y ~ N(mu, tau^(-1))}, where \eqn{\sigma^2}{sigma^2} is the variance, and \eqn{\tau}{tau} is the precision, which is the inverse of the variance.} \value{ \item{Cov2Prec}{ This returns a precision matrix, \eqn{\Omega}{Omega}, from a covariance matrix, \eqn{\Sigma}{Sigma}, where \eqn{\Omega = \Sigma^{-1}}{Omega = Sigma^(-1)}.} \item{Prec2Cov}{ This returns a covariance matrix, \eqn{\Sigma}{Sigma}, from a precision matrix, \eqn{\Omega}{Omega}, where \eqn{\Sigma = \Omega^{-1}}{Sigma = Omega^(-1)}.} \item{prec2sd}{ This returns a standard deviation, \eqn{\sigma}{sigma}, from a precision, \eqn{\tau}{tau}, where \eqn{\sigma = \sqrt{\tau^{-1}}}{sigma = sqrt(tau^(-1))}.} \item{prec2var}{ This returns a variance, \eqn{\sigma^2}{sigma^2}, from a precision, \eqn{\tau}{tau}, where \eqn{\sigma^2 = \tau^{-1}}{sigma^2 = tau^(-1)}.} \item{sd2prec}{ This returns a precision, \eqn{\tau}{tau}, from a standard deviation, \eqn{\sigma}{sigma}, where \eqn{\tau = \sigma^{-2}}{tau = sigma^(-2)}.} \item{sd2var}{ This returns a variance, \eqn{\sigma^2}{sigma^2}, from a standard deviation, \eqn{\sigma}{sigma}, where \eqn{\sigma^2 = \sigma \sigma}{sigma^2 = sigma x sigma}.} \item{var2prec}{ This returns a precision, \eqn{\tau}{tau}, from a variance, \eqn{\sigma^2}{sigma^2}, where \eqn{\tau = \frac{1}{\sigma^2}}{tau = 1 / sigma^2}.} \item{var2sd}{ This returns a standard deviation, \eqn{\sigma}{sigma}, from a variance, \eqn{\sigma^2}{sigma^2}, where \eqn{\sigma = \sqrt{\sigma^2}}{sigma = sqrt(sigma^2)}.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{Cov2Cor}}} \examples{ library(LaplacesDemon) Cov2Prec(matrix(c(1,0.1,0.1,1),2,2)) Prec2Cov(matrix(c(1,0.1,0.1,1),2,2)) prec2sd(0.5) prec2var(0.5) sd2prec(1.4142) sd2var(01.4142) var2prec(2) var2sd(2) } \keyword{Utility}LaplacesDemon/man/dist.Bernoulli.Rd0000755000176200001440000000471715144316355016743 0ustar liggesusers\name{dist.Bernoulli} \alias{dbern} \alias{pbern} \alias{qbern} \alias{rbern} \title{Bernoulli Distribution} \description{ These functions provide the density, distribution function, quantile function, and random generation for the Bernoulli distribution. } \usage{ dbern(x, prob, log=FALSE) pbern(q, prob, lower.tail=TRUE, log.p=FALSE) qbern(p, prob, lower.tail=TRUE, log.p=FALSE) rbern(n, prob) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations. If \code{length(n) > 1}, then the length is taken to be the number required.} \item{prob}{This is the probability of success on each trial.} \item{log, log.p}{Logical. if \code{TRUE}, probabilities \eqn{p} are given as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{Logical. if \code{TRUE} (default), probabilities are \eqn{Pr[X \le x]}{Pr[X <= x]}, otherwise, \eqn{Pr[X > x]}{Pr[X > x]}.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = {p}^{\theta} {(1-p)}^{1-\theta}}{p(theta) = p^theta (1-p)^(1-theta)}, \eqn{\theta = 0,1}{theta = 0,1} \item Inventor: Jacob Bernoulli \item Notation 1: \eqn{\theta \sim \mathcal{BERN}(p)}{theta ~ Bern(p)} \item Notation 2: \eqn{p(\theta) = \mathcal{BERN}(\theta | p)}{p(theta) = Bern(theta | p)} \item Parameter 1: probability parameter \eqn{0 \le p \le 1}{0 <= p <= 1} \item Mean: \eqn{E(\theta) = p}{E(theta) = p} \item Variance: \eqn{var(\theta) = \frac{p}{1-p}}{var(theta) = p / (1-p)} \item Mode: \eqn{mode(\theta) =}{mode(theta) =} } The Bernoulli distribution is a binomial distribution with \eqn{n=1}{n=1}, and one instance of a Bernoulli distribution is called a Bernoulli trial. One coin flip is a Bernoulli trial, for example. The categorical distribution is the generalization of the Bernoulli distribution for variables with more than two discrete values. The beta distribution is the conjugate prior distribution of the Bernoulli distribution. The geometric distribution is the number of Bernoulli trials needed to get one success. } \value{ \code{dbern} gives the density, \code{pbern} gives the distribution function, \code{qbern} gives the quantile function, and \code{rbern} generates random deviates. } \seealso{ \code{\link{dbinom}} } \examples{ library(LaplacesDemon) dbern(1, 0.7) rbern(10, 0.5) } \keyword{Distribution} LaplacesDemon/man/Math.Rd0000755000176200001440000000777615144316355014747 0ustar liggesusers\name{Math} \alias{GaussHermiteQuadRule} \alias{Hermite} \alias{logadd} \alias{partial} \title{Math Utility Functions} \description{ These are utility functions for math. } \usage{ GaussHermiteQuadRule(N) Hermite(x, N, prob=TRUE) logadd(x, add=TRUE) partial(Model, parm, Data, Interval=1e-6, Method="simple") } \arguments{ \item{N}{This required argument accepts a positive integer that indicates the number of nodes.} \item{x}{This is a numeric vector.} \item{add}{Logical. This defaults to \code{TRUE}, in which case \eqn{\log(x+y)}{log(x+y)} is performed. Otherwise, \eqn{\log(x-y)}{log(x-y)} is performed.} \item{Model}{This is a model specification function. For more information, see \code{\link{LaplacesDemon}}.} \item{parm}{This is a vector parameters.} \item{prob}{Logical. This defaults to \code{TRUE}, which uses the probabilist's kernel for the Hermite polynomial. Otherwise, \code{FALSE} uses the physicist's kernel.} \item{Data}{This is a list of data. For more information, see \code{\link{LaplacesDemon}}.} \item{Interval}{This is the interval of numeric differencing.} \item{Method}{This accepts a quoted string, and defaults to "simple", which is finite-differencing. Alternatively \code{Method="Richardson"} uses Richardson extrapolation, which is more accurate, but takes longer to calculate. Another method called automatic differentiation is currently unsupported, but is even more accurate, and takes even longer to calculate.} } \details{ The \code{GaussHermiteQuadRule} function returns nodes and weights for univariate Gauss-Hermite quadrature. The nodes and weights are obtained from a tridiagonal eigenvalue problem. Weights are calculated from the physicist's (rather than the probabilist's) kernel. This has been adapted from the GaussHermite function in the pracma package. The \code{\link{GaussHermiteCubeRule}} function is a multivariate version. This is used in the \code{\link{IterativeQuadrature}} function. The \code{Hermite} function evaluates a Hermite polynomial of degree \eqn{N} at \eqn{x}, using either the probabilist's (\code{prob=TRUE}) or physicist's (\code{prob=FALSE}) kernel. This function was adapted from the \code{hermite} function in package EQL. The \code{logadd} function performs addition (or subtraction) when the terms are logarithmic. The equations are: \deqn{\log(x+y) = \log(x) + \log(1 + \exp(\log(y) - \log(x)))}{log(x+y) = log(x) + log(1 + exp(log(y) - log(x)))} \deqn{\log(x-y) = \log(x) + \log(1 - \exp(\log(y) - \log(x)))}{log(x-y) = log(x) + log(1 - exp(log(y) - log(x)))} The \code{partial} function estimates partial derivatives of parameters in a model specification with data, using either forward finite-differencing or Richardson extrapolation. In calculus, a partial derivative of a function of several variables is its derivative with respect to one of those variables, with the others held constant. Related functions include \code{Jacobian} which returns a matrix of first-order partial derivatives, and \code{Hessian}, which returns a matrix of second-order partial derivatives of the model specification function with respect to its parameters. The \code{partial} function is not intended to be called by the user, but is used by other functions. This is essentially the \code{grad} function in the numDeriv package, but defaulting to forward finite-differencing with a smaller interval. } \value{ \code{logadd} returns the result of \eqn{\log(x+y)}{log(x+y)} or \eqn{\log(x-y)}{log(x-y)}. \code{partial} returns a vector of partial derivatives. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{GaussHermiteCubeRule}}, \code{\link{Hessian}}, \code{\link{IterativeQuadrature}}, \code{\link{Jacobian}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, and \code{\link{VariationalBayes}}. } \keyword{Math}LaplacesDemon/man/summary.miss.Rd0000755000176200001440000000161115144316355016503 0ustar liggesusers\name{summary.miss} \alias{summary.miss} \title{MISS Summary} \description{ This function summarizes posterior predictive distributions from an object of class \code{miss}. } \usage{\method{summary}{miss}(object, \dots)} \arguments{ \item{object}{An object of class \code{miss} is required.} \item{\dots}{Additional arguments are unused.} } \details{ This function summarizes the posterior predictive distributions from an object of class \code{miss}. } \value{ This function returns a \eqn{M \times 7}{M x 7} matrix, in which each row is the posterior predictive distribution of one of \eqn{M} missing values. Columns are Mean, SD, MCSE, ESS, LB, Median, and UB. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{MISS}}. } \examples{### See the MISS function for an example.} \keyword{Imputation} \keyword{summary} LaplacesDemon/man/dist.Asymmetric.Laplace.Rd0000755000176200001440000001165615144316355020465 0ustar liggesusers\name{dist.Asymmetric.Laplace} \alias{dalaplace} \alias{palaplace} \alias{qalaplace} \alias{ralaplace} \title{Asymmetric Laplace Distribution: Univariate} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate, asymmetric Laplace distribution with location parameter \code{location}, scale parameter \code{scale}, and asymmetry or skewness parameter \code{kappa}. } \usage{ dalaplace(x, location=0, scale=1, kappa=1, log=FALSE) palaplace(q, location=0, scale=1, kappa=1) qalaplace(p, location=0, scale=1, kappa=1) ralaplace(n, location=0, scale=1, kappa=1) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{location}{This is the location parameter \eqn{\mu}{mu}.} \item{scale}{This is the scale parameter \eqn{\lambda}{lambda}, which must be positive.} \item{kappa}{This is the asymmetry or skewness parameter \eqn{\kappa}{kappa}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{\kappa \sqrt{2}}{\lambda (1+\kappa^2)} \exp(-|\theta-\mu| \frac{\sqrt{2}}{\lambda} \kappa^{|\theta-\mu|} |\theta-\mu|)}{((kappa*sqrt(2)) / (lambda*(1+kappa^2))) * exp(-|x-mu| * (sqrt(2)/lambda) * kappa^(|x-mu|) * |x-mu|)} \item Inventor: Kotz, Kozubowski, and Podgorski (2001) \item Notation 1: \eqn{\theta \sim \mathcal{AL}(\mu, \lambda, \kappa)}{theta ~ AL(mu, lambda, kappa)} \item Notation 2: \eqn{p(\theta) = \mathcal{AL}(\theta | \mu, \lambda, \kappa)}{p(theta) = AL(theta | mu, lambda, kappa)} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: scale parameter \eqn{\lambda > 0}{lambda > 0} \item Parameter 3: skewness parameter \eqn{\kappa > 0}{kappa > 0} \item Mean: \eqn{E(\theta) = \mu + \lambda \frac{1/\kappa - \kappa}{\sqrt{2}}}{E(theta) = mu + lambda*(1/kappa - kappa) / sqrt(2)} \item Variance: \eqn{var(\theta) = \lambda^2 \frac{1 + \kappa^4}{2 \kappa^2}}{var(theta) = lambda^2 * (1 + kappa^4) / (2*kappa^2)} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The asymmetric Laplace of Kotz, Kozubowski, and Podgorski (2001), also referred to as AL, is an extension of the univariate, symmetric Laplace distribution to allow for skewness. It is parameterized according to three parameters: location parameter \eqn{\mu}{mu}, scale parameter \eqn{\lambda}{lambda}, and asymmetry or skewness parameter \eqn{\kappa}{kappa}. The special case of \eqn{\kappa=1}{kappa=1} is the symmetric Laplace distribution. Values of \eqn{\kappa}{kappa} in the intervals \eqn{(0, 1)}{(0,1)} and \eqn{(1, \infty)}{(1, Inf)}, correspond to positive (right) and negative (left) skewness, respectively. The AL distribution is leptokurtic, and its kurtosis ranges from 3 to 6 as \eqn{\kappa}{kappa} ranges from 1 to infinity. The skewness of the AL has been useful in engineering and finance. As an example, the AL distribution has been used as a replacement for Gaussian-distributed GARCH residuals. There is also an extension to the asymmetric multivariate Laplace distribution. The asymmetric Laplace distribution is demonstrated in Kozubowski and Podgorski (2001) to be well-suited for financial modeling, specifically with currency exchange rates. These functions are similar to those in the \code{VGAM} package. } \value{ \code{dalaplace} gives the density, \code{palaplace} gives the distribution function, \code{qalaplace} gives the quantile function, and \code{ralaplace} generates random deviates. } \references{ Kotz, S., Kozubowski, T.J., and Podgorski, K. (2001). "The Laplace Distribution and Generalizations: a Revisit with Applications to Communications, Economics, Engineering, and Finance". Boston: Birkhauser. Kozubowski, T.J. and Podgorski, K. (2001). "Asymmetric Laplace Laws and Modeling Financial Data". \emph{Mathematical and Computer Modelling}, 34, p. 1003-1021. } \seealso{\code{\link{dlaplace}} and \code{\link{dallaplace}} } \examples{ library(LaplacesDemon) x <- dalaplace(1,0,1,1) x <- palaplace(1,0,1,1) x <- qalaplace(0.5,0,1,1) x <- ralaplace(100,0,1,1) #Plot Probability Functions x <- seq(from=-5, to=5, by=0.1) plot(x, dalaplace(x,0,1,0.5), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dalaplace(x,0,1,1), type="l", col="green") lines(x, dalaplace(x,0,1,5), type="l", col="blue") legend(1, 0.9, expression(paste(mu==0, ", ", lambda==1, ", ", kappa==0.5), paste(mu==0, ", ", lambda==1, ", ", kappa==1), paste(mu==0, ", ", lambda==1, ", ", kappa==5)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/plot.pmc.ppc.Rd0000755000176200001440000004072115144316355016356 0ustar liggesusers\name{plot.pmc.ppc} \alias{plot.pmc.ppc} \title{Plots of Posterior Predictive Checks} \description{ This may be used to plot, or save plots of, samples in an object of class \code{pmc.ppc}. A variety of plots is provided. } \usage{\method{plot}{pmc.ppc}(x, Style=NULL, Data=NULL, Rows=NULL, PDF=FALSE, \dots)} \arguments{ \item{x}{ This required argument is an object of class \code{pmc.ppc}.} \item{Style}{ This optional argument specifies one of several styles of plots, and defaults to \code{NULL} (which is the same as \code{"Density"}). Styles of plots are indicated in quotes. Optional styles include \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"Density"}, \code{"DW"}, \code{"DW, Multivariate, C"}, \code{"ECDF"}, \code{"Fitted"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Predictive Quantiles"}, \code{"Residual Density"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}. Details are given below.} \item{Data}{ This optional argument accepts the data set used when updating the model. Data is required only with certain plot styles, including \code{"Covariates"}, \code{"Covariates, Categorical DV"}, \code{"DW, Multivariate, C"}, \code{"Fitted, Multivariate, C"}, \code{"Fitted, Multivariate, R"}, \code{"Jarque-Bera, Multivariate, C"}, \code{"Mardia"}, \code{"Residual Density, Multivariate, C"}, \code{"Residual Density, Multivariate, R"}, \code{"Residuals, Multivariate, C"}, \code{"Residuals, Multivariate, R"}, \code{"Space-Time by Space"}, \code{"Space-Time by Time"}, \code{"Spatial"}, \code{"Spatial Uncertainty"}, \code{"Time-Series, Multivariate, C"}, and \code{"Time-Series, Multivariate, R"}.} \item{Rows}{ This optional argument is for a vector of row numbers that specify the records associated by row in the object of class \code{pmc.ppc}. Only these rows are plotted. The default is to plot all rows. Some plots do not allow rows to be specified.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{\dots}{Additional arguments are unused.} } \details{ This function can be used to produce a variety of posterior predictive plots, and the style of plot is selected with the \code{Style} argument. Below are some notes on the styles of plots. \code{Covariates} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is not categorical. \code{Covariates, Categorical DV} requires \code{Data} to be specified, and also requires that the covariates are named \code{X} or \code{x}. A plot is produced for each covariate column vector against yhat, and is appropriate when y is categorical. \code{Density} plots show the kernel density of the posterior predictive distribution for each selected row of y (all are selected by default). A vertical red line indicates the position of the observed y along the x-axis. When the vertical red line is close to the middle of a normal posterior predictive distribution, then there is little discrepancy between y and the posterior predictive distribution. When the vertical red line is in the tail of the distribution, or outside of the kernel density altogether, then there is a large discrepancy between y and the posterior predictive distribution. Large discrepancies may be considered outliers, and moreover suggest that an improvement in model fit should be considered. \code{DW} plots the distributions of the Durbin-Watson (DW) test statistics (Durbin and Watson, 1950), both observed (\eqn{d^{obs}}{d.obs} as a transparent, black density) and replicated (\eqn{d^{rep}}{d.rep} as a transparent, red density). The distribution of \eqn{d^{obs}}{d.obs} is estimated from the model, and \eqn{d^{rep}}{d.rep} is simulated from normal residuals without autocorrelation, where the number of simulations are the same as the observed number. This DW test may be applied to the residuals of univariate time-series models (or otherwise ordered residuals) to detect first-order autocorrelation. Autocorrelated residuals are not independent. The DW test is applicable only when the residuals are normally-distributed, higher-order autocorrelation is not present, and y is not used also as a lagged predictor. The DW test statistic, \eqn{d^{obs}}{d[obs]}, occurs in the interval (0,4), where 0 is perfect positive autocorrelation, 2 is no autocorrelation, and 4 is perfect negative autocorrelation. The following summary is reported on the plot: the mean of \eqn{d^{obs}}{d[obs]} (and its 95\% probability interval), the probability that \eqn{d^{obs} > d^{rep}}{d[obs] > d[rep]}, and whether or not autocorrelation is found. Positive autocorrelation is reported when the observed process is greater than the replicated process in 2.5\% of the samples, and negative autocorrelation is reported when the observed process is greater than the replicated process in 97.5\% of the samples. \code{DW, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Durbin-Watson test, as in \code{DW} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for first-order autocorrelation. \code{ECDF} (Empirical Cumulative Distribution Function) plots compare the ECDF of y with three ECDFs of yhat based on the 2.5\%, 50\% (median), and 97.5\% of its distribution. The ECDF(y) is defined as the proportion of values less than or equal to y. This plot is appropriate when y is univariate and at least ordinal. \code{Fitted} plots compare y with the probability interval of its replicate, and provide loess smoothing. This plot is appropriate when y is univariate and not categorical. \code{Fitted, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each column-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen column-wise. \code{Fitted, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exists in the data set with exactly that name. These plots compare each row-wise vector of y in Y with its replicates and provide loess smoothing. This plot is appropriate when Y is multivariate, not categorical, and desired to be seen row-wise. \code{Jarque-Bera} plots the distributions of the Jarque-Bera (JB) test statistics (Jarque and Bera, 1980), both observed (\eqn{JB^{obs}}{JB.obs} as a transparent black density) and replicated (\eqn{JB^{rep}}{JB.rep} as a transparent red density). The distribution of \eqn{JB^{obs}}{JB.obs} is estimated from the model, and \eqn{JB^{rep}}{JB.rep} is simulated from normal residuals, where the number of simulations are the same as the observed number. This Jarque-Bera test may be applied to the residuals of univariate models to test for normality. The Jarque-Bera test does not test normality per se, but whether or not the distribution has kurtosis and skewness that match a normal distribution, and is therefore a test of the moments of a normal distribution. The following summary is reported on the plot: the mean of \eqn{JB^{obs}}{JB[obs]} (and its 95\% probability interval), the probability that \eqn{JB^{obs} > JB^{rep}}{JB[obs] > JB[rep]}, and whether or not normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Jarque-Bera, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise vector of residuals with a univariate Jarque-Bera test, as in \code{Jarque-Bera} above. This plot is appropriate when Y is multivariate, not categorical, and residuals are desired to be tested column-wise for normality. \code{Mardia} plots the distributions of the skewness (K3) and kurtosis (K4) test statistics (Mardia, 1970), both observed (\eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} as transparent black density) and replicated (\eqn{K3^{rep}}{K3.rep} and \eqn{K4^{rep}}{K4.rep} as transparent red density). The distributions of \eqn{K3^{obs}}{K3.obs} and \eqn{K4^{obs}}{K4.obs} are estimated from the model, and both \eqn{K3^{rep}}{K3.rep} \eqn{K4^{rep}}{K4.rep} are simulated from multivariate normal residuals, where the number of simulations are the same as the observed number. This Mardia's test may be applied to the residuals of multivariate models to test for multivariate normality. Mardia's test does not test for multivariate normality per se, but whether or not the distribution has kurtosis and skewness that match a multivariate normal distribution, and is therefore a test of the moments of a multivariate normal distribution. The following summary is reported on the plots: the means of \eqn{K3^{obs}}{K3[obs]} and \eqn{K4^{obs}}{K4[obs]} (and the associated 95\% probability intervals), the probabilities that \eqn{K3^{obs} > K3^{rep}}{K3[obs] > K3[rep]} and \eqn{K4^{obs} > K4^{rep}}{K4[obs] > K4[rep]}, and whether or not multivariate normality is indicated. Non-normality is reported when the observed process is greater than the replicated process in either 2.5\% or 97.5\% of the samples. \code{Mardia} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. \code{Y} must be a \eqn{N \times P}{N x P} matrix of \eqn{N}{N} records and \eqn{P}{P} variables. Source code was modified from the deprecated package QRMlib. \code{Predictive Quantiles} plots compare y with the predictive quantile (PQ) of its replicate. This may be useful in looking for patterns with outliers. Instances outside of the gray lines are considered outliers. \code{Residual Density} plots the residual density of the median of the samples. A vertical red line occurs at zero. This plot may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when y is univariate and continuous. \code{Residual Density, Multivariate C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are column-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen column-wise. \code{Residual Density, Multivariate R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are row-wise plots of residual density, given the median of the samples. These plots may be useful for inspecting a distributional assumption of residual variance. This plot is appropriate when Y is multivariate, continuous, and densities are desired to be seen row-wise. \code{Residuals} plots compare y with its residuals. The probability interval is plotted as a line. This plot is appropriate when y is univariate. \code{Residuals, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each column-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen column-wise. \code{Residuals, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These are plots of each row-wise vector of residuals. The probability interval is plotted as a line. This plot is appropriate when Y is multivariate, not categorical, and the residuals are desired to be seen row-wise. \code{Space-Time by Space} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one time-series plot per point s in space, for a total of S plots. Therefore, these are time-series plots for each point s in space across T time-periods. See \code{Time-Series} plots below. \code{Space-Time by Time} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude}, \code{longitude}, \code{S}, and \code{T}. These space-time plots compare the S x T matrix Y with the S x T matrix Yrep, producing one spatial plot per time-period, and T plots will be produced. See \code{Spatial} plots below. \code{Spatial} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows yrep plotted according to its coordinates, and is color-coded so that higher values of yrep become more red, and lower values become more yellow. \code{Spatial Uncertainty} requires \code{Data} to be specified, and also requires that the following variables exist in the data set with exactly these names: \code{latitude} and \code{longitude}. This spatial plot shows the probability interval of yrep plotted according to its coordinates, and is color-coded so that wider probability intervals become more red, and lower values become more yellow. \code{Time-Series} plots compare y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is univariate and ordered by time. \code{Time-Series, Multivariate, C} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each column-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by column in Y. \code{Time-Series, Multivariate, R} requires \code{Data} to be specified, and also requires that variable \code{Y} exist in the data set with exactly that name. These plots compare each row-wise time-series in Y with its replicate, including the median and probability interval quantiles. This plot is appropriate when y is multivariate and each time-series is indexed by row in Y, such as is typically true in panel models. } \references{ Durbin, J., and Watson, G.S. (1950). "Testing for Serial Correlation in Least Squares Regression, I." \emph{Biometrika}, 37, p. 409--428. Jarque, C.M. and Bera, A.K. (1980). "Efficient Tests for Normality, Homoscedasticity and Serial Independence of Regression Residuals". \emph{Economics Letters}, 6(3), p. 255--259. Mardia, K.V. (1970). "Measures of Multivariate Skewness and Kurtosis with Applications". \emph{Biometrika}, 57(3), p. 519--530. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{PMC}} and \code{\link{predict.pmc}}. } \examples{### See the PMC function for an example.} \keyword{Plot}LaplacesDemon/man/dist.Power.Exponential.Rd0000755000176200001440000001137315144316355020365 0ustar liggesusers\name{dist.Power.Exponential} \alias{dpe} \alias{ppe} \alias{qpe} \alias{rpe} \title{Power Exponential Distribution: Univariate Symmetric} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate, symmetric, power exponential distribution with location parameter \eqn{\mu}{mu}, scale parameter \eqn{\sigma}{sigma}, and kurtosis parameter \eqn{\kappa}{kappa}. } \usage{ dpe(x, mu=0, sigma=1, kappa=2, log=FALSE) ppe(q, mu=0, sigma=1, kappa=2, lower.tail=TRUE, log.p=FALSE) qpe(p, mu=0, sigma=1, kappa=2, lower.tail=TRUE, log.p=FALSE) rpe(n, mu=0, sigma=1, kappa=2) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mu}{This is the location parameter \eqn{\mu}{mu}.} \item{sigma}{This is the scale parameter \eqn{\sigma}{sigma}, which must be positive.} \item{kappa}{This is the kurtosis parameter \eqn{\kappa}{kappa}, which must be positive.} \item{log,log.p}{Logical. If \code{log=TRUE}, then the logarithm of the density or result is returned.} \item{lower.tail}{Logical. If \code{lower.tail=TRUE} (default), probabilities are \eqn{Pr[X \le x]}{Pr[X <= x]}, otherwise, \eqn{Pr[X > x]}{Pr[X > x]}.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{1}{2 \kappa^{1/\kappa} \Gamma(1+\frac{1}{\kappa}) \sigma} \exp(-\frac{|\theta-\mu|^{\kappa}}{\kappa \sigma^\kappa})}{p(theta) = 1/(2 kappa^(1/kappa) Gamma(1+1/kappa) sigma) * exp(-(|theta - mu|^kappa)/(kappa sigma^kappa))} \item Inventor: Subbotin, M.T. (1923) \item Notation 1: \eqn{\theta \sim \mathcal{PE}(\mu, \sigma, \kappa)}{theta ~ PE(mu, sigma, kappa)} \item Notation 2: \eqn{p(\theta) = \mathcal{PE}(\theta | \mu, \sigma, \kappa)}{p(theta) = PE(theta | mu, sigma, kappa)} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: scale parameter \eqn{\sigma > 0}{sigma > 0} \item Parameter 3: kurtosis parameter \eqn{\kappa > 0}{kappa > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = }{var(theta) = } \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The power exponential distribution is also called the exponential power distribution, generalized error distribution, generalized Gaussian distribution, and generalized normal distribution. The original form was introduced by Subbotin (1923) and re-parameterized by Lunetta (1963). These functions use the more recent parameterization by Lunetta (1963). A shape parameter, \eqn{\kappa > 0}{kappa > 0}, is added to the normal distribution. When \eqn{\kappa=1}{kappa=1}, the power exponential distribution is the same as the Laplace distribution. When \eqn{\kappa=2}{kappa=2}, the power exponential distribution is the same as the normal distribution. As \eqn{\kappa \rightarrow \infty}{kappa -> infinity}, this becomes a uniform distribution \eqn{\in (\mu-\sigma, \mu+\sigma)}{in (mu-sigma, mu+sigma)}. Tails that are heavier than normal occur when \eqn{\kappa < 2}{kappa < 2}, or lighter than normal when \eqn{\kappa > 2}{kappa > 2}. This distribution is univariate and symmetric, and there exist multivariate and asymmetric versions. These functions are similar to those in the \code{normalp} package. } \value{ \code{dpe} gives the density, \code{ppe} gives the distribution function, \code{qpe} gives the quantile function, and \code{rpe} generates random deviates. } \references{ Lunetta, G. (1963). "Di una Generalizzazione dello Schema della Curva Normale". \emph{Annali della Facolt`a di Economia e Commercio di Palermo}, 17, p. 237--244. Subbotin, M.T. (1923). "On the Law of Frequency of Errors". \emph{Matematicheskii Sbornik}, 31, p. 296--301. } \seealso{ \code{\link{dlaplace}}, \code{\link{dlaplacep}}, \code{\link{dmvpe}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, and \code{\link{dunif}}. } \examples{ library(LaplacesDemon) x <- dpe(1,0,1,2) x <- ppe(1,0,1,2) x <- qpe(0.5,0,1,2) x <- rpe(100,0,1,2) #Plot Probability Functions x <- seq(from=0.1, to=3, by=0.01) plot(x, dpe(x,0,1,0.1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dpe(x,0,1,2), type="l", col="green") lines(x, dpe(x,0,1,5), type="l", col="blue") legend(1.5, 0.9, expression(paste(mu==0, ", ", sigma==1, ", ", kappa==0.1), paste(mu==0, ", ", sigma==1, ", ", kappa==2), paste(mu==0, ", ", sigma==1, ", ", kappa==5)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/dist.Multivariate.Normal.Precision.Rd0000755000176200001440000001012015144316355022620 0ustar liggesusers\name{dist.Multivariate.Normal.Precision} \alias{dmvnp} \alias{rmvnp} \title{Multivariate Normal Distribution: Precision Parameterization} \description{ These functions provide the density and random number generation for the multivariate normal distribution, given the precision parameterization. } \usage{ dmvnp(x, mu, Omega, log=FALSE) rmvnp(n=1, mu, Omega) } \arguments{ \item{x}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{n}{This is the number of random draws.} \item{mu}{This is mean vector \eqn{\mu}{mu} with length \eqn{k} or matrix with \eqn{k} columns.} \item{Omega}{This is the \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = (2\pi)^{-p/2} |\Omega|^{1/2} \exp(-\frac{1}{2} (\theta-\mu)^T \Omega (\theta-\mu))}{p(theta) = (2*pi)^(-p/2) * |Omega|^(1/2) * exp(-(1/2)*(theta-mu)^t Omega (theta-mu))} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathcal{MVN}(\mu, \Omega^{-1})}{theta ~ MVN(mu, Omega^(-1))} \item Notation 2: \eqn{\theta \sim \mathcal{N}_k(\mu, \Omega^{-1})}{theta ~ N[k](mu, Omega^(-1))} \item Notation 3: \eqn{p(\theta) = \mathcal{MVN}(\theta | \mu, \Omega^{-1})}{p(theta) = MVN(theta | mu, Omega^(-1))} \item Notation 4: \eqn{p(\theta) = \mathcal{N}_k(\theta | \mu, \Omega^{-1})}{p(theta) = N[k](theta | mu, Omega^(-1))} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = \Omega^{-1}}{var(theta) = Omega^(-1)} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate normal distribution, or multivariate Gaussian distribution, is a multidimensional extension of the one-dimensional or univariate normal (or Gaussian) distribution. It is usually parameterized with mean and a covariance matrix, or in Bayesian inference, with mean and a precision matrix, where the precision matrix is the matrix inverse of the covariance matrix. These functions provide the precision parameterization for convenience and familiarity. It is easier to calculate a multivariate normal density with the precision parameterization, because a matrix inversion can be avoided. A random vector is considered to be multivariate normally distributed if every linear combination of its components has a univariate normal distribution. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k} and a \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega}, which must be positive-definite. The conjugate prior of the mean vector is another multivariate normal distribution. The conjugate prior of the precision matrix is the Wishart distribution (see \code{\link{dwishart}}). When applicable, the alternative Cholesky parameterization should be preferred. For more information, see \code{\link{dmvnpc}}. For models where the dependent variable, Y, is specified to be distributed multivariate normal given the model, the Mardia test (see \code{\link{plot.demonoid.ppc}}, \code{\link{plot.laplace.ppc}}, or \code{\link{plot.pmc.ppc}}) may be used to test the residuals. } \value{ \code{dmvnp} gives the density and \code{rmvnp} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dmvn}}, \code{\link{dmvnc}}, \code{\link{dmvnpc}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, \code{\link{dwishart}}, \code{\link{plot.demonoid.ppc}}, \code{\link{plot.laplace.ppc}}, and \code{\link{plot.pmc.ppc}}. } \examples{ library(LaplacesDemon) x <- dmvnp(c(1,2,3), c(0,1,2), diag(3)) X <- rmvnp(1000, c(0,1,2), diag(3)) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/ABB.Rd0000755000176200001440000001412615144316355014425 0ustar liggesusers\name{ABB} \alias{ABB} \title{Approximate Bayesian Bootstrap} \description{ This function performs multiple imputation (MI) with the Approximate Bayesian Bootstrap (ABB) of Rubin and Schenker (1986). } \usage{ ABB(X, K=1) } \arguments{ \item{X}{This is a vector or matrix of data that must include both observed and missing values. When \code{X} is a matrix, missing values must occur somewhere in the set, but are not required to occur in each variable.} \item{K}{This is the number of imputations.} } \details{ The Approximate Bayesian Bootstrap (ABB) is a modified form of the \code{\link{BayesianBootstrap}} (Rubin, 1981) that is used for multiple imputation (MI). Imputation is a family of statistical methods for replacing missing values with estimates. Introduced by Rubin and Schenker (1986) and Rubin (1987), MI is a family of imputation methods that includes multiple estimates, and therefore includes variability of the estimates. The data, \eqn{\textbf{X}}{X}, are assumed to be independent and identically distributed (IID), contain both observed and missing values, and its missing values are assumed to be ignorable (meaning enough information is available in the data that the missingness mechanism can be ignored, if the information is used properly) and Missing Completely At Random (MCAR). When \code{ABB} is used in conjunction with a propensity score (described below), missing values may be Missing At Random (MAR). \code{ABB} does not add auxiliary information, but performs imputation with two sampling (with replacement) steps. First, \eqn{\textbf{X}^\star_{obs}}{X_star_obs} is sampled from \eqn{\textbf{X}_{obs}}{X_obs}. Then, \eqn{\textbf{X}^\star_{mis}}{X_star_mis} is sampled from \eqn{\textbf{X}^\star_{obs}}{X_star_obs}. The result is a sample of the posterior predictive distribution of \eqn{(\textbf{X}_{mis}|\textbf{X}_{obs})}{(X_mis|X_obs)}. The first sampling step is also known as hotdeck imputation, and the second sampling step changes the variance. Since auxiliary information is not included, \code{ABB} is appropriate for missing values that are ignorable and MCAR. Auxiliary information may be included in the process of imputation by introducing a propensity score (Rosenbaum and Rubin, 1983; Rosenbaum and Rubin, 1984), which is an estimate of the probability of missingness. The propensity score is often the result of a binary logit model, where missingness is predicted as a function of other variables. The propensity scores are discretized into quantile-based groups, usually quintiles. Each quintile must have both observed and missing values. \code{ABB} is applied to each quintile. This is called within-class imputation. It is assumed that the missing mechanism depends only on the variables used to estimate the propensity score. With \eqn{K=1}, \code{ABB} may be used in MCMC, such as in \code{\link{LaplacesDemon}}, more commonly along with a propensity score for missingness. MI is performed, despite \eqn{K=1}, because imputation occurs at each MCMC iteration. The practical advantage of this form of imputation is the ease with which it may be implemented. For example, full-likelihood imputation should perform better, but requires a chain to be updated for each missing value. An example of a limitation of \code{ABB} with propensity scores is to consider imputing missing values of income from age in a context where age and income have a positive relationship, and where the highest incomes are missing systematically. \code{ABB} with propensity scores should impute these highest missing incomes given the highest observed ages, but is unable to infer beyond the observed data. ABB has been extended (Parzen et al., 2005) to reduce bias, by introducing a correction factor that is applied to the MI variance estimate. This correction may be applied to output from \code{ABB}. } \value{ This function returns a list with \eqn{K} components, one for each set of imputations. Each component contains a vector of imputations equal in length to the number of missing values in the data. \code{ABB} does not currently return the mean of the imputations, or the between-imputation variance or within-imputation variance. } \references{ Parzen, M., Lipsitz, S.R., and Fitzmaurice, G.M. (2005). "A Note on Reducing the Bias of the Approximate Bayesian Bootstrap Imputation Variance Estimator". \emph{Biometrika}, 92, 4, p. 971--974. Rosenbaum, P.R. and Rubin, D.B. (1983). "The Central Role of the Propensity Score in Observational Studies for Causal Effects". \emph{Biometrika}, 70, p. 41--55. Rosenbaum, P.R. and Rubin, D.B. (1984). "Reducing Bias in Observational Studies Using Subclassification in the Propensity Score". \emph{Journal of the American Statistical Association}, 79, p. 516--524. Rubin, D.B. (1981). "The Bayesian Bootstrap". \emph{Annals of Statistics}, 9, p. 130--134. Rubin, D.B. (1987). "Multiple Imputation for Nonresponse in Surveys". John Wiley and Sons: New York, NY. Rubin, D.B. and Schenker, N. (1986). "Multiple Imputation for Interval Estimation from Simple Random Samples with Ignorable Nonresponse". \emph{Journal of the American Statistical Association}, 81, p. 366--374. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{BayesianBootstrap}}, \code{\link{LaplacesDemon}}, and \code{\link{MISS}}. } \examples{ library(LaplacesDemon) ### Create Data J <- 10 #Number of variables m <- 20 #Number of missings N <- 50 #Number of records mu <- runif(J, 0, 100) sigma <- runif(J, 0, 100) X <- matrix(0, N, J) for (j in 1:J) X[,j] <- rnorm(N, mu[j], sigma[j]) ### Create Missing Values M1 <- rep(0, N*J) M2 <- sample(N*J, m) M1[M2] <- 1 M <- matrix(M1, N, J) X <- ifelse(M == 1, NA, X) ### Approximate Bayesian Bootstrap imp <- ABB(X, K=1) ### Replace Missing Values in X (when K=1) X.imp <- X X.imp[which(is.na(X.imp))] <- unlist(imp) X.imp } \keyword{Imputation} LaplacesDemon/man/Raftery.Diagnostic.Rd0000755000176200001440000001012715144316355017535 0ustar liggesusers\name{Raftery.Diagnostic} \alias{Raftery.Diagnostic} \title{Raftery and Lewis's diagnostic} \description{ Raftery and Lewis (1992) introduced an MCMC diagnostic that estimates the number of iterations needed for a given level of precision in posterior samples, as well as estimating burn-in, when quantiles are the posterior summaries of interest. } \usage{ Raftery.Diagnostic(x, q=0.025, r=0.005, s=0.95, eps=0.001) } \arguments{ \item{x}{This required argument accepts an object of class \code{demonoid}. It attempts to use \code{Posterior2}, but when this is missing it uses \code{Posterior1}.} \item{q}{This is the quantile to be estimated.} \item{r}{This is the desired margin of error of the estimate, also called the accuracy.} \item{s}{This is the probability of obtaining an estimate in the interval (q-r, q+r).} \item{eps}{This is the precision required for the estimate of time to convergence.} } \details{ In this MCMC diagnostic, a posterior quantile \eqn{q} of interest is specified. Next, an acceptable tolerance \eqn{r} is specified for \eqn{q}, which means that it is desired to measure \eqn{q} with an accuracy of +/- \eqn{r}. Finally, the user selects a probability \eqn{s}, which is the probability of being within the interval \eqn{(q-r, q+r)}. The \code{Raftery.Diagnostic} then estimates the number \eqn{N} of iterations and the number \eqn{M} of burn-in iterations that are necessary to satisfy the specified conditions regarding quantile \eqn{q}. The diagnostic was designed to test a short, initial update, in which the chains were called pilot chains, and the application was later suggested for iterative use after any update as a general method for pursuing convergence (Raftery and Lewis, 1996). Results of the \code{Raftery.Diagnostic} differ depending on the chosen quantile \eqn{q}. Estimates are conservative, so more iterations are suggested than necessary. } \note{ The \code{Raftery.Diagnostic} function was adapted from the \code{raftery.diag} function in the coda package, which was adapted from the FORTRAN program `gibbsit', written by Steven Lewis. } \value{ The \code{Raftery.Diagnostic} function returns an object of class \code{raftery} that is list. A print method is available for objects of this class. The list has the following components: \item{tspar}{These are the time-series parameters of the posterior samples in \code{x}.} \item{params}{This is a vector containing the parameters \code{q}, \code{r}, and \code{s}.} \item{Niters}{This is the number of iterations in the posterior samples in \code{x}.} \item{resmatrix}{This is a 3-dimensional array containing the results: \eqn{M} is the suggested burn-in, \eqn{N} is the suggested number of iterations, \eqn{Nmin} is the suggested number of iterations based on zero autocorrelation, and \eqn{I = (M+N)/Nmin} is the "dependence factor". The dependence factor is interpreted as the proportional increase in the number of iterations attributable to autocorrelation. Highly autocorrelated chains (> 5) are worrisome, and may be due to influential initial values, parameter correlations, or poor mixing.} } \references{ Raftery, A.E. and Lewis, S.M. (1992). "How Many Iterations in the Gibbs Sampler?" In \emph{Bayesian Statistics}, 4 (J.M. Bernardo, J.O. Berger, A.P. Dawid and A.F.M. Smith, eds.). Oxford, U.K.: Oxford University Press, p. 763--773. Raftery, A.E. and Lewis, S.M. (1992). "One Long Run with Diagnostics: Implementation Strategies for Markov chain Monte Carlo". \emph{Statistical Science}, 7, p. 493--497. Raftery, A.E. and Lewis, S.M. (1996). "Implementing MCMC". \emph{In} Practical Markov Chain Monte Carlo (W.R. Gilks, D.J. Spiegelhalter and S. Richardson, eds.). Chapman and Hall: Baton Rouge, FL. } \seealso{ \code{\link{burnin}}, \code{\link{LaplacesDemon}}, \code{\link{print.raftery}}, and \code{\link{Thin}}. } \examples{ #library(LaplacesDemon) ###After updating with LaplacesDemon, do: #rd <- Raftery.Diagnostic(Fit) #print(rd) } \keyword{Diagnostic} \keyword{Gibbsit} \keyword{MCMC} LaplacesDemon/man/dist.Inverse.Beta.Rd0000755000176200001440000000555015144316355017271 0ustar liggesusers\name{dist.Inverse.Beta} \alias{dinvbeta} \alias{rinvbeta} \title{Inverse Beta Distribution} \description{ This is the density function and random generation from the inverse beta distribution. } \usage{ dinvbeta(x, a, b, log=FALSE) rinvbeta(n, a, b) } \arguments{ \item{n}{This is the number of draws from the distribution.} \item{x}{This is a location vector at which to evaluate density.} \item{a}{This is the scalar shape parameter \eqn{\alpha}{alpha}.} \item{b}{This is the scalar shape parameter \eqn{\beta}{beta}} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{\theta^{\alpha - 1} (1 + \theta)^{-\alpha - \beta}}{\beta(\alpha, \beta)}}{(theta^(alpha - 1) * (1 + theta)^(-alpha - beta)) / beta(alpha, beta)} \item Inventor: Dubey (1970) \item Notation 1: \eqn{\theta \sim \mathcal{B}^{-1}(\alpha, \beta)}{theta ~ B^-1(alpha, beta)} \item Notation 2: \eqn{p(\theta) = \mathcal{B}^{-1}(\theta | \alpha, \beta)}{p(theta) = B^-1(theta | alpha, beta)} \item Parameter 1: shape \eqn{\alpha > 0}{alpha > 0} \item Parameter 2: shape \eqn{\beta > 0}{beta > 0} \item Mean: \eqn{E(\theta) = \frac{\alpha}{\beta - 1}}{E(theta) = alpha / (beta - 1)}, for \eqn{\beta > 1}{beta > 1} \item Variance: \eqn{var(\theta) = \frac{\alpha(\alpha + \beta - 1)}{(\beta - 1)^2 (\beta - 2)}}{var(theta) = (alpha * (alpha + beta - 1)) / ((beta - 1)^2 * (beta - 2))} \item Mode: \eqn{mode(\theta) = \frac{\alpha - 1}{\beta + 1}}{mode(theta) = (alpha - 1) / (beta + 1)} } The inverse-beta, also called the beta prime distribution, applies to variables that are continuous and positive. The inverse beta is the conjugate prior distribution of a parameter of a Bernoulli distribution expressed in odds. The inverse-beta distribution has also been extended to the generalized beta prime distribution, though it is not (yet) included here. } \value{ \code{dinvbeta} gives the density and \code{rinvbeta} generates random deviates. } \references{ Dubey, S.D. (1970). "Compound Gamma, Beta and F Distributions". \emph{Metrika}, 16, p. 27--31. } \seealso{ \code{\link{dbeta}} } \examples{ library(LaplacesDemon) x <- dinvbeta(5:10, 2, 3) x <- rinvbeta(10, 2, 3) #Plot Probability Functions x <- seq(from=0.1, to=20, by=0.1) plot(x, dinvbeta(x,2,2), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dinvbeta(x,2,3), type="l", col="green") lines(x, dinvbeta(x,3,2), type="l", col="blue") legend(2, 0.9, expression(paste(alpha==2, ", ", beta==2), paste(alpha==2, ", ", beta==3), paste(alpha==3, ", ", beta==2)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution} LaplacesDemon/man/plot.iterquad.Rd0000755000176200001440000000606715144316355016641 0ustar liggesusers\name{plot.iterquad} \alias{plot.iterquad} \title{Plot the output of \code{\link{IterativeQuadrature}}} \description{ This may be used to plot, or save plots of, the iterated history of the parameters and, if posterior samples were taken, density plots of parameters and monitors in an object of class \code{iterquad}. } \usage{\method{plot}{iterquad}(x, Data, PDF=FALSE, Parms, \dots)} \arguments{ \item{x}{ This required argument is an object of class \code{iterquad}.} \item{Data}{ This required argument must receive the list of data that was supplied to \code{\link{IterativeQuadrature}} to create the object of class \code{iterquad}.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{Parms}{ This argument accepts a vector of quoted strings to be matched for selecting parameters for plotting. This argument defaults to \code{NULL} and selects every parameter for plotting. Each quoted string is matched to one or more parameter names with the \code{grep} function. For example, if the user specifies \code{Parms=c("eta", "tau")}, and if the parameter names are beta[1], beta[2], eta[1], eta[2], and tau, then all parameters will be selected, because the string \code{eta} is within \code{beta}. Since \code{grep} is used, string matching uses regular expressions, so beware of meta-characters, though these are acceptable: ".", "[", and "]".} \item{\dots}{Additional arguments are unused.} } \details{ The plots are arranged in a \eqn{2 \times 2}{2 x 2} matrix. The purpose of the iterated history plots is to show how the value of each parameter and the deviance changed by iteration as the \code{\link{IterativeQuadrature}} attempted to fit a normal distribution to the marginal posterior distributions. The plots on the right show several densities, described below. \itemize{ \item The transparent black density is the normalized quadrature weights for non-standard normal distributions, \eqn{M}. For multivariate quadrature, there are often multiple weights at a given node, and the average \eqn{M} is shown. Vertical black lines indicate the nodes. \item The transparent red density is the normalized LP weights. For multivariate quadrature, there are often multiple weights at a given node, and the average normalized and weighted LP is shown. Vertical red lines indicate the nodes. \item The transparent green density is the normal density implied given the conditional mean and conditional variance. \item The transparent blue density is the kernel density estimate of posterior samples generated with Sampling Importance Resampling. This is plotted only if the algorithm converged, and if \code{sir=TRUE}. } } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{IterativeQuadrature}}} \examples{### See the IterativeQuadrature function for an example.} \keyword{Plot}LaplacesDemon/man/print.iterquad.Rd0000755000176200001440000000112315144337635017007 0ustar liggesusers\name{print.iterquad} \alias{print.iterquad} \title{Print an object of class \code{iterquad} to the screen} \description{ This may be used to print the contents of an object of class \code{iterquad} to the screen. } \usage{\method{print}{iterquad}(x, \dots)} \arguments{ \item{x}{An object of class \code{iterquad} is required.} \item{\dots}{Additional arguments are unused.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{IterativeQuadrature}}} \examples{### See the IterativeQuadrature function for an example.} \keyword{print}LaplacesDemon/man/dist.Multivariate.t.Rd0000755000176200001440000000755515144316355017723 0ustar liggesusers\name{dist.Multivariate.t} \alias{dmvt} \alias{rmvt} \title{Multivariate t Distribution} \description{ These functions provide the density and random number generation for the multivariate t distribution, otherwise called the multivariate Student distribution. } \usage{ dmvt(x, mu, S, df=Inf, log=FALSE) rmvt(n=1, mu, S, df=Inf) } \arguments{ \item{x}{This is either a vector of length \eqn{k} or a matrix with a number of columns, \eqn{k}, equal to the number of columns in scale matrix \eqn{\textbf{S}}{S}.} \item{n}{This is the number of random draws.} \item{mu}{This is a numeric vector or matrix representing the location parameter,\eqn{\mu}{mu} (the mean vector), of the multivariate distribution (equal to the expected value when \code{df > 1}, otherwise represented as \eqn{\nu > 1}{nu > 1}). When a vector, it must be of length \eqn{k}, or must have \eqn{k} columns as a matrix, as defined above.} \item{S}{This is a \eqn{k \times k}{k x k} positive-definite scale matrix \eqn{\textbf{S}}{S}, such that \code{S*df/(df-2)} is the variance-covariance matrix when \code{df > 2}. A vector of length 1 is also allowed (in this case, \eqn{k=1} is set).} \item{df}{This is the degrees of freedom, and is often represented with \eqn{\nu}{nu}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{\Gamma[(\nu+k)/2]}{\Gamma(\nu/2)\nu^{k/2}\pi^{k/2}|\Sigma|^{1/2}[1 + (1/\nu)(\theta-\mu)^{\mathrm{T}} \Sigma^{-1} (\theta-\mu)]^{(\nu+k)/2}}}{p(theta) = Gamma[(nu+k)/2] / {Gamma(nu/2)nu^(k/2)pi^(k/2)|Sigma|^(1/2)[1 + (1/nu)(theta-mu)^T*Sigma^(-1)(theta-mu)]^[(nu+k)/2]}} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathrm{t}_k(\mu, \Sigma, \nu)}{theta ~ t[k](mu, Sigma, nu)} \item Notation 2: \eqn{p(\theta) = \mathrm{t}_k(\theta | \mu, \Sigma, \nu)}{p(theta) = t[k](theta | mu, Sigma, nu)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} scale matrix \eqn{\Sigma}{Sigma} \item Parameter 3: degrees of freedom \eqn{\nu > 0}{nu > 0} (df in the functions) \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu}, for \eqn{\nu > 1}{nu > 1}, otherwise undefined \item Variance: \eqn{var(\theta) = \frac{\nu}{\nu - 2} \Sigma}{var(theta) = (nu / (nu - 2))*Sigma}, for \eqn{\nu > 2}{nu > 2} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate t distribution, also called the multivariate Student or multivariate Student t distribution, is a multidimensional extension of the one-dimensional or univariate Student t distribution. A random vector is considered to be multivariate t-distributed if every linear combination of its components has a univariate Student t-distribution. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k}, and a \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S}, which must be positive-definite. When degrees of freedom \eqn{\nu=1}{nu=1}, this is the multivariate Cauchy distribution. } \value{ \code{dmvt} gives the density and \code{rmvt} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dinvwishart}}, \code{\link{dmvc}}, \code{\link{dmvcp}}, \code{\link{dmvtp}}, \code{\link{dst}}, \code{\link{dstp}}, and \code{\link{dt}}. } \examples{ library(LaplacesDemon) x <- seq(-2,4,length=21) y <- 2*x+10 z <- x+cos(y) mu <- c(1,12,2) S <- matrix(c(1,2,0,2,5,0.5,0,0.5,3), 3, 3) df <- 4 f <- dmvt(cbind(x,y,z), mu, S, df) X <- rmvt(1000, c(0,1,2), S, 5) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution} LaplacesDemon/man/is.constrained.Rd0000755000176200001440000000325715144316355016767 0ustar liggesusers\name{is.constrained} \alias{is.constrained} \title{Logical Check of Constraints} \description{ This function provides a logical test of constraints for each initial value or parameter for a model specification, given data. } \usage{ is.constrained(Model, Initial.Values, Data) } \arguments{ \item{Model}{This is a model specification function. For more information, see the \code{\link{LaplacesDemon}} function.} \item{Initial.Values}{This is a vector of initial values, or current parameter values. For more information, see the \code{\link{LaplacesDemon}} function.} \item{Data}{This is a list of data. For more information, see the \code{\link{LaplacesDemon}} function.} } \details{ This function is useful for testing whether or not initial values changed due to constraints when being passed through a \code{Model} specification function. If any initial value changes, then the constrained values that are ouput in the fifth component of the \code{Model} specification are suitable as initial values, not the tested initial values. A parameter may be constrained and this function may not discover the constraint, since the discovery depends on the initial values and whether or not they change as they are passed through the model. } \value{ The \code{is.constrained} function returns a logical vector, equal in length to the number of initial values. Each element receives \code{TRUE} if the corresponding initial value changed due to a constraint, or \code{FALSE} if it did not. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplacesDemon}}. } \keyword{Utility}LaplacesDemon/man/Juxtapose.Rd0000755000176200001440000002116315144316355016022 0ustar liggesusers\name{Juxtapose} \alias{Juxtapose} \title{Juxtapose MCMC Algorithm Inefficiency} \description{ This function gives a side-by-side comparison of (or juxtaposes) the inefficiency of MCMC algorithms in \code{\link{LaplacesDemon}} for applied use, and is a valuable tool for selecting what is likely to be the least inefficient algorithm for the user's current model, prior to updating the final, intended model. } \usage{ Juxtapose(x) } \arguments{ \item{x}{This is a list of multiple components. Each component must be an object of class \code{demonoid}.} } \details{ Laplace's Demon recommends using the \code{Juxtapose} function on the user's model (or most likely a simplified version of it) with a smaller, simulated data set to select the least inefficient MCMC algorithm before using real data and updating the model for numerous iterations. The least inefficient MCMC algorithm differs for different models and data sets. Using \code{Juxtapose} in this way does not guarantee that the selected algorithm will remain the best choice with real data, but it should be better than otherwise selecting an algorithm. The user must make a decision regarding their model and data. The more similar the model and data is to the final, intended model and data, the more appropriate will be the results of the \code{Juxtapose} function. However, if the full model and data are used, then the user may as well instead skip using \code{Juxtapose} and proceed directly to \code{\link{LaplacesDemon}}. Replacing the actual data set with a smaller, simulated set is fairly straightforward, but the decision-making will most likely focus on what is the best way to reduce the full model specification. A simple approach may be to merely reduce the number of predictors. However, complicated models may have several components that slow down estimation time, and extend the amount of time until global stationarity is estimated. Laplace's Demon offers no guidance here, and leaves it in the realm of user discretion. First, the user should simulate a smaller data set, and if best, reduce the model specification. Next, the user must select candidate algorithms. Then, the user must update each algorithm with \code{\link{LaplacesDemon}} for numerous iterations, with the goal of achieving stationarity for all parameters early in the iterations. Each update should begin with the same model specification function, vector of initial values, and data. Each output object of class \code{demonoid} should be renamed. An example follows. Suppose a user considers three candidate algorithms for their model: AMWG, NUTS, and twalk. The user updates each model, saving the model that used the AMWG algorithm as, say, \code{Fit1}, the NUTS model as \code{Fit2}, and the twalk model as \code{Fit3}. Next, the output model objects are put in a list and passed to the \code{Juxtapose} function. See the example below. The \code{Juxtapose} function uses an internal version of the \code{\link{IAT}}, which is a slightly modified version of that found in the \code{SamplerCompare} package. The \code{Juxtapose} function returns an object of class \code{juxtapose}. It is a matrix in which each row is a result and each column is an algorithm. The rows are: \itemize{ \item \code{iter.min}: This is the iterations per minute. \item \code{t.iter.min}: This is the thinned iterations per minute. \item \code{prop.stat}: This is the proportion of iterations that were stationary. \item \code{IAT.025}: This is the 2.5\% quantile of the integrated autocorrelation time of the worst parameter, estimated only on samples when all parameters are estimated to be globally stationary. \item \code{IAT.500}: This is the median integrated autocorrelation time of the worst parameter, estimated only on samples when all parameters are estimated to be globally stationary. \item \code{IAT.975}: This is the 97.5\% quantile of the integrated autocorrelation time of the worst parameter, estimated only on samples when all parameters are estimated to be globally stationary. \item \code{ISM.025}: This is the 2.5\% quantile of the number of independent samples per minute. \item \code{ISM.500}: This is the median of the number of the independent samples per minute. The least inefficient MCMC algorithm has the highest \code{ISM.500}. \item \code{ISM.975}: This is the 97.5\% quantile of the number of the independent samples per minute. } As for calculating \eqn{ISM}, let \eqn{TIM} be the observed number of thinned iterations per minute, \eqn{PS} be the percent of iterations in which all parameters were estimated to be globally stationary, and \eqn{IAT_q}{IAT[q]} be a quantile from a simulated distribution of the integrated autocorrelation time among the parameters. \deqn{ISM = \frac{PS \times TIM}{IAT_q}}{ISM = (PS x TIM) / IAT[q]} There are various ways to measure the inefficiency of MCMC samplers. \code{\link{IAT}} is used perhaps most often. As with the \code{SamplerCompare} package, Laplace's Demon uses the worst parameter, in terms of \code{\link{IAT}}. Often, the number of evaluations or number of parameters is considered. The \code{Juxtapose} function, instead considers the final criterion of MCMC efficiency, in an applied context, to be \code{ISM}, or the number of Independent (thinned) Samples per Minute. The algorithm with the highest \code{ISM.500} is the best, or least inefficient, algorithm with respect to its worst \code{\link{IAT}}, the proportion of iterations required to seem to have global stationarity, and the number of (thinned) iterations per minute. A disadvantage of using time is that it will differ by computer, and is less likely to be reported in a journal. The advantage, though, is that it is more meaningful to a user. Increases in the number of evaluations, parameters, and time should all correlate well, but time may enlighten a user as to expected run-time given the model just studied, even though the real data set will most likely be larger than the simulated data used initially. NUTS is an example of a sampler in which the number of evaluations varies per iteration. For an alternative approach, see Thompson (2010). The \code{Juxtapose} function also adjusts \code{ISM} by \code{prop.stat}, the proportion of the iterations in which all chains were estimated to be stationary. This adjustment is weighted by burn-in iterations, penalizing an algorithm that took longer to achieve global stationarity. The goal, again, is to assist the user in selecting the least inefficient MCMC algorithm in an applied setting. The \code{Juxtapose} function has many other potential uses than those described above. One additional use of the \code{Juxtapose} function is to compare inefficiencies within a single algorithm in which algorithmic specifications varied with different model updates. Another use is to investigate parallel chains in an object of class \code{demonoid.hpc}, as returned from the \code{\link{LaplacesDemon.hpc}} function. Yet another use is to compare the effects of small changes to a model specification function, such as with priors, or due to an increase in the amount of simulated data. An object of class \code{juxtapose} may be plotted with the \code{\link{plot.juxtapose}} function, which displays \code{ISM} by default, or optionally \code{IAT}. For more information, see the \code{\link{plot.juxtapose}} function. Independent samples per minute, calculated as \code{\link{ESS}} divided by minutes of run-time, are also available by parameter in the \code{\link{PosteriorChecks}} function. } \value{ This function returns an object of class \code{juxtapose}. It is a \eqn{9 \times J}{9 x J} matrix with nine results for \eqn{J} MCMC algorithms. } \references{ Thompson, M. (2010). "Graphical Comparison of MCMC Performance". ArXiv e-prints, eprint 1011.4458. } \seealso{ \code{\link{IAT}}, \code{\link{is.juxtapose}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{plot.juxtapose}}, and \code{\link{PosteriorChecks}}. } \examples{ ### Update three demonoid objects, each from different MCMC algorithms. ### Suppose Fit1 was updated with AFSS, Fit2 with AMWG, and ### Fit3 with NUTS. Then, compare the inefficiencies: #Juxt <- Juxtapose(list(Fit1=Fit1, Fit2=Fit2, Fit3=Fit3)); Juxt #plot(Juxt, Style="ISM") } \keyword{Diagnostic} \keyword{Utilities} LaplacesDemon/man/dist.Multivariate.Normal.Precision.Cholesky.Rd0000755000176200001440000001137415144316355024414 0ustar liggesusers\name{dist.Multivariate.Normal.Precision.Cholesky} \alias{dmvnpc} \alias{rmvnpc} \title{Multivariate Normal Distribution: Precision-Cholesky Parameterization} \description{ These functions provide the density and random number generation for the multivariate normal distribution, given the precision-Cholesky parameterization. } \usage{ dmvnpc(x, mu, U, log=FALSE) rmvnpc(n=1, mu, U) } \arguments{ \item{x}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{n}{This is the number of random draws.} \item{mu}{This is mean vector \eqn{\mu}{mu} with length \eqn{k} or matrix with \eqn{k} columns.} \item{U}{This is the \eqn{k \times k}{k x k} upper-triangular of the precision matrix that is Cholesky factor \eqn{\textbf{U}}{U} of precision matrix \eqn{\Omega}{Omega}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = (2\pi)^{-p/2} |\Omega|^{1/2} \exp(-\frac{1}{2} (\theta-\mu)^T \Omega (\theta-\mu))}{p(theta) = (2*pi)^(-p/2) * |Omega|^(1/2) * exp(-(1/2)*(theta-mu)^t Omega (theta-mu))} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathcal{MVN}(\mu, \Omega^{-1})}{theta ~ MVN(mu, Omega^(-1))} \item Notation 2: \eqn{\theta \sim \mathcal{N}_k(\mu, \Omega^{-1})}{theta ~ N[k](mu, Omega^(-1))} \item Notation 3: \eqn{p(\theta) = \mathcal{MVN}(\theta | \mu, \Omega^{-1})}{p(theta) = MVN(theta | mu, Omega^(-1))} \item Notation 4: \eqn{p(\theta) = \mathcal{N}_k(\theta | \mu, \Omega^{-1})}{p(theta) = N[k](theta | mu, Omega^(-1))} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = \Omega^{-1}}{var(theta) = Omega^(-1)} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate normal distribution, or multivariate Gaussian distribution, is a multidimensional extension of the one-dimensional or univariate normal (or Gaussian) distribution. It is usually parameterized with mean and a covariance matrix, or in Bayesian inference, with mean and a precision matrix, where the precision matrix is the matrix inverse of the covariance matrix. These functions provide the precision-Cholesky parameterization for convenience and familiarity. It is easier to calculate a multivariate normal density with the precision parameterization, because a matrix inversion can be avoided. The precision matrix is replaced with an upper-triangular \eqn{k \times k}{k x k} matrix that is Cholesky factor \eqn{\textbf{U}}{U}, as per the \code{\link{chol}} function for Cholesky decomposition. A random vector is considered to be multivariate normally distributed if every linear combination of its components has a univariate normal distribution. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k} and a \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega}, which must be positive-definite. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dmvnp}, \code{dmvnpc} must additionally matrix-multiply the Cholesky back to the covariance matrix, but it does not have to check for or correct the precision matrix to positive-definiteness, which overall is slower. Compared with \code{rmvnp}, \code{rmvnpc} is faster because the Cholesky decomposition has already been performed. For models where the dependent variable, Y, is specified to be distributed multivariate normal given the model, the Mardia test (see \code{\link{plot.demonoid.ppc}}, \code{\link{plot.laplace.ppc}}, or \code{\link{plot.pmc.ppc}}) may be used to test the residuals. } \value{ \code{dmvnpc} gives the density and \code{rmvnpc} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{chol}}, \code{\link{dmvn}}, \code{\link{dmvnc}}, \code{\link{dmvnp}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, \code{\link{dwishartc}}, \code{\link{plot.demonoid.ppc}}, \code{\link{plot.laplace.ppc}}, and \code{\link{plot.pmc.ppc}}. } \examples{ library(LaplacesDemon) Omega <- diag(3) U <- chol(Omega) x <- dmvnpc(c(1,2,3), c(0,1,2), U) X <- rmvnpc(1000, c(0,1,2), U) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/dist.Wishart.Cholesky.Rd0000755000176200001440000001255515144316355020210 0ustar liggesusers\name{dist.Wishart.Cholesky} \alias{dwishartc} \alias{rwishartc} \title{Wishart Distribution: Cholesky Parameterization} \description{ These functions provide the density and random number generation for the Wishart distribution with the Cholesky parameterization. } \usage{ dwishartc(U, nu, S, log=FALSE) rwishartc(nu, S) } \arguments{ \item{U}{This is the upper-triangular \eqn{k \times k}{k x k} matrix for the Cholesky factor \eqn{\textbf{U}}{U} of precision matrix \eqn{\Omega}{Omega}.} \item{nu}{This is the scalar degrees of freedom \eqn{\nu}{nu}.} \item{S}{This is the symmetric, positive-semidefinite, \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = (2^{\nu k/2} \pi^{k(k-1)/4} \prod^k_{i=1} \Gamma(\frac{\nu+1-i}{2}))^{-1} |\textbf{S}|^{-nu/2} |\Omega|^{(nu-k-1)/2} \exp(-\frac{1}{2} tr(\textbf{S}^{-1} \Omega))}{p(theta) = (2^(nu*k/2) * pi^(k(k-1)/4) * [Gamma((nu+1-i)/2) * ... * Gamma((nu+1-k)/2)])^(-1) * |S|^(-nu/2) * |Omega|^((nu-k-1)/2) * exp(-(1/2) * tr(S^(-1) Omega))} \item Inventor: John Wishart (1928) \item Notation 1: \eqn{\Omega \sim \mathcal{W}_{\nu}(\textbf{S})}{Omega ~ W[nu](S)} \item Notation 2: \eqn{p(\Omega) = \mathcal{W}_{\nu}(\Omega | \textbf{S})}{p(Omega) = W[nu](Omega | S)} \item Parameter 1: degrees of freedom \eqn{\nu \ge k}{nu >= k} \item Parameter 2: symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S} \item Mean: \eqn{E(\Omega) = \nu \textbf{S}}{E(Omega) = nuS} \item Variance: \eqn{var(\Omega) = \nu (\textbf{S}^2_{i,j} + \textbf{S}_{i,i} \textbf{S}_{j,j})}{var(Omega) = nu(S[i,j]^2 + S[i,i]S[j,j])} \item Mode: \eqn{mode(\Omega) = (\nu - k - 1) \textbf{S}}{mode(Omega) = (nu-k-1)S}, for \eqn{\nu \ge k + 1}{nu >= k + 1} } The Wishart distribution is a generalization to multiple dimensions of the chi-square distribution, or, in the case of non-integer degrees of freedom, of the gamma distribution. However, the Wishart distribution is not called the multivariate chi-squared distribution because the marginal distribution of the off-diagonal elements is not chi-squared. The Wishart is the conjugate prior distribution for the precision matrix \eqn{\Omega}{Omega}, the inverse of which (covariance matrix \eqn{\Sigma}{Sigma}) is used in a multivariate normal distribution. In this parameterization, \eqn{\Omega}{Omega} has been decomposed to the upper-triangular Cholesky factor \eqn{\textbf{U}}{U}, as per \code{\link{chol}}. The integral is finite when \eqn{\nu \ge k}{nu >= k}, where \eqn{\nu}{nu} is the scalar degrees of freedom parameter, and \eqn{k} is the dimension of scale matrix \eqn{\textbf{S}}{S}. The density is finite when \eqn{\nu ge k + 1}{nu >= k + 1}, which is recommended. The degrees of freedom, \eqn{\nu}{nu}, is equivalent to specifying a prior sample size, indicating the confidence in \eqn{\textbf{S}}{S}, where \eqn{\textbf{S}}{S} is a prior guess at the order of covariance matrix \eqn{\Sigma}{Sigma}. A flat prior distribution is obtained as \eqn{\nu \rightarrow 0}{nu -> 0}. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, the Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dwishart}, \code{dwishartc} must additionally matrix-multiply the Cholesky back to the precision matrix, but it does not have to check for or correct the precision matrix to positive-semidefiniteness, which overall is slower. Compared with \code{rwishart}, \code{rwishartc} must additionally calculate a Cholesky decomposition, and is therefore slower. The Wishart prior lacks flexibility, having only one parameter, \eqn{\nu}{nu}, to control the variability for all \eqn{k(k + 1)/2} elements. Popular choices for the scale matrix \eqn{\textbf{S}}{S} include an identity matrix or sample covariance matrix. When the model sample size is small, the specification of the scale matrix can be influential. Although the related inverse Wishart distribution has a dependency between variance and correlation, the Wishart distribution does not have this dependency. The matrix gamma (\code{\link{dmatrixgamma}}) distribution is a more general version of the Wishart distribution, and the Yang-Berger (\code{\link{dyangberger}}) distribution is an alterative that is a least informative prior (LIP). } \value{ \code{dwishartc} gives the density and \code{rwishartc} generates random deviates. } \references{ Wishart, J. (1928). "The Generalised Product Moment Distribution in Samples from a Normal Multivariate Population". \emph{Biometrika}, 20A(1-2), p. 32--52. } \seealso{ \code{\link{chol}}, \code{\link{dchisq}}, \code{\link{dgamma}}, \code{\link{dinvwishart}}, \code{\link{dinvwishartc}}, \code{\link{dmatrixgamma}}, \code{\link{dmvnp}}, \code{\link{dmvnpc}}, \code{\link{Prec2Cov}}, and \code{\link{dyangbergerc}}. } \examples{ library(LaplacesDemon) Omega <- matrix(c(2,-.3,-.3,4),2,2) U <- chol(Omega) x <- dwishartc(U, 3, matrix(c(1,.1,.1,1),2,2)) x <- rwishartc(3, matrix(c(1,.1,.1,1),2,2)) } \keyword{Distribution} LaplacesDemon/man/dist.Log.Laplace.Rd0000755000176200001440000000712515144316355017065 0ustar liggesusers\name{dist.Log.Laplace} \alias{dllaplace} \alias{pllaplace} \alias{qllaplace} \alias{rllaplace} \title{Log-Laplace Distribution: Univariate Symmetric} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate, symmetric, log-Laplace distribution with location parameter \code{location} and scale parameter \code{scale}. } \usage{ dllaplace(x, location=0, scale=1, log=FALSE) pllaplace(q, location=0, scale=1) qllaplace(p, location=0, scale=1) rllaplace(n, location=0, scale=1) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{location}{This is the location parameter \eqn{\mu}{mu}.} \item{scale}{This is the scale parameter \eqn{\lambda}{lambda}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density 1: \eqn{p(\theta) = \frac{(\sqrt{2}/\lambda)^2}{2(\sqrt{2}/\lambda)} \exp(-(\sqrt{2}/\lambda)(\theta - \mu)), \theta \ge \exp(\mu)}{p(theta) = ((sqrt(2)/lambda)^2 / (2*(sqrt(2)/lambda))) * exp(-(sqrt(2)/lambda)*(theta - mu)), theta >= exp(mu)} \item Density 2: \eqn{p(\theta) = \frac{(\sqrt{2}/\lambda)^2}{2(\sqrt{2}/\lambda)} \exp((\sqrt{2}/\lambda)(\theta - \mu)), \theta < \exp(\mu)}{p(theta) = ((sqrt(2)/lambda)^2 / (2*(sqrt(2)/lambda))) * exp((sqrt(2)/lambda)*(theta - mu)),theta < exp(mu)} \item Inventor: Pierre-Simon Laplace \item Notation 1: \eqn{\theta \sim \mathcal{LL}(\mu, \lambda)}{theta ~ LL(mu, lambda)} \item Notation 2: \eqn{p(\theta) = \mathcal{LL}(\theta | \mu, \lambda)}{p(theta) = LL(theta | mu, lambda)} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: scale parameter \eqn{\lambda > 0}{lambda > 0} \item Mean: \eqn{E(\theta) = }{E(theta) = } \item Variance: \eqn{var(\theta) = }{var(theta) = } \item Mode: \eqn{mode(\theta) = }{mode(theta) = } } The univariate, symmetric log-Laplace distribution is derived from the Laplace distribution. Multivariate and asymmetric versions also exist. These functions are similar to those in the \code{VGAM} package. } \value{ \code{dllaplace} gives the density, \code{pllaplace} gives the distribution function, \code{qllaplace} gives the quantile function, and \code{rllaplace} generates random deviates. } \references{ Kozubowski, T. J. and Podgorski, K. (2003). "Log-Laplace Distributions". \emph{International Mathematical Journal}, 3, p. 467--495. } \seealso{ \code{\link{dalaplace}}, \code{\link{dallaplace}}, \code{\link{dexp}}, \code{\link{dlaplace}}, \code{\link{dlaplacep}}, \code{\link{dmvl}}, \code{\link{dnorm}}, \code{\link{dnormp}}, and \code{\link{dnormv}}. } \examples{ library(LaplacesDemon) x <- dllaplace(1,0,1) x <- pllaplace(1,0,1) x <- qllaplace(0.5,0,1) x <- rllaplace(100,0,1) #Plot Probability Functions x <- seq(from=0.1, to=20, by=0.1) plot(x, dllaplace(x,0,0.1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dllaplace(x,0,0.5), type="l", col="green") lines(x, dllaplace(x,0,1.5), type="l", col="blue") legend(2, 0.9, expression(paste(mu==0, ", ", lambda==0.1), paste(mu==0, ", ", lambda==0.5), paste(mu==0, ", ", lambda==1.5)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/dist.Categorical.Rd0000755000176200001440000000543315144316355017221 0ustar liggesusers\name{dist.Categorical} \alias{dcat} \alias{qcat} \alias{rcat} \title{Categorical Distribution} \description{ This is the density and random deviates function for the categorical distribution with probabilities parameter \eqn{p}. } \usage{ dcat(x, p, log=FALSE) qcat(pr, p, lower.tail=TRUE, log.pr=FALSE) rcat(n, p) } \arguments{ \item{x}{This is a vector of discrete data with \eqn{k} discrete categories, and is of length \eqn{n}. This function also accepts \eqn{x} after it has been converted to an \eqn{n \times k}{n x k} indicator matrix, such as with the \code{as.indicator.matrix} function.} \item{n}{This is the number of observations, which must be a positive integer that has length 1. When \code{p} is supplied to \code{rcat} as a matrix, \code{n} must equal the number of rows in \code{p}.} \item{p}{This is a vector of length \eqn{k} or \eqn{n \times k}{n x k} matrix of probabilities. The \code{qcat} function requires a vector.} \item{pr}{This is a vector of probabilities, or log-probabilities.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} \item{log.pr}{Logical. if \code{TRUE}, probabilities \eqn{pr} are given as \eqn{\log(pr)}{log(pr)}.} \item{lower.tail}{Logical. if \code{TRUE} (default), probabilities are \eqn{Pr[X \le x]}{Pr[X <= x]}, otherwise, \eqn{Pr[X > x]}{Pr[X > x]}.} } \details{ \itemize{ \item Application: Discrete Univariate \item Density: \eqn{p(\theta) = \sum \theta p}{p(theta) = Sum (theta * p)} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathcal{CAT}(p)}{theta ~ CAT(p)} \item Notation 2: \eqn{p(\theta) = \mathcal{CAT}(\theta | p)}{p(theta) = CAT(theta | p)} \item Parameter 1: probabilities \eqn{p} \item Mean: \eqn{E(\theta)}{E(theta)} = Unknown \item Variance: \eqn{var(\theta)}{var(theta)} = Unknown \item Mode: \eqn{mode(\theta)}{mode(theta)} = Unknown } Also called the discrete distribution, the categorical distribution describes the result of a random event that can take on one of \eqn{k} possible outcomes, with the probability \eqn{p} of each outcome separately specified. The vector \eqn{p} of probabilities for each event must sum to 1. The categorical distribution is often used, for example, in the multinomial logit model. The conjugate prior is the Dirichlet distribution. } \value{ \code{dcat} gives the density and \code{rcat} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{as.indicator.matrix}}, \code{\link{ddirichlet}}, and \code{\link{dmultinom}}. } \examples{ library(LaplacesDemon) dcat(x=1, p=c(0.3,0.3,0.4)) rcat(n=10, p=c(0.1,0.3,0.6)) } \keyword{Distribution} LaplacesDemon/man/predict.pmc.Rd0000755000176200001440000000762015144316355016252 0ustar liggesusers\name{predict.pmc} \alias{predict.pmc} \title{Posterior Predictive Checks} \description{ This may be used to predict either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}), and then perform posterior predictive checks. Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is predicted given an object of class \code{demonoid}, the model specification, and data. } \usage{\method{predict}{pmc}(object, Model, Data, CPUs=1, Type="PSOCK", \dots)} \arguments{ \item{object}{An object of class \code{pmc} is required.} \item{Model}{The model specification function is required.} \item{Data}{A data set in a list is required. The dependent variable is required to be named either \code{y} or \code{Y}.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} \item{\dots}{Additional arguments are unused.} } \details{ This function passes each iteration of marginal posterior samples along with data to \code{Model}, where the fourth component in the return list is labeled \code{yhat}, and is a vector of expectations of \eqn{\textbf{y}}{y}, given the samples, model specification, and data. Stationary samples are used if detected, otherwise non-stationary samples will be used. To predict \eqn{\textbf{y}^{rep}}{y[rep]}, simply supply the data set used to estimate the model. To predict \eqn{\textbf{y}^{new}}{y[new]}, supply a new data set instead (though for some model specifications, this cannot be done, and \eqn{\textbf{y}_{new}}{y[new]} must be specified in the \code{Model} function). If the new data set does not have \eqn{\textbf{y}}{y}, then create \code{y} in the list and set it equal to something sensible, such as \code{mean(y)} from the original data set. The variable \code{y} must be a vector. If instead it is matrix \code{Y}, then it will be converted to vector \code{y}. The vectorized length of \code{y} or \code{Y} must be equal to the vectorized length of \code{yhat}, the fourth component of the return list of the \code{Model} function. Parallel processing may be performed when the user specifies \code{CPUs} to be greater than one, implying that the specified number of CPUs exists and is available. Parallelization may be performed on a multicore computer or a computer cluster. Either a Simple Network of Workstations (SNOW) or Message Passing Interface is used (MPI). With small data sets and few samples, parallel processing may be slower, due to computer network communication. With larger data sets and more samples, the user should experience a faster run-time. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. } \value{ This function returns an object of class \code{pmc.ppc} (where ppc stands for posterior predictive checks). The returned object is a list with the following components: \item{y}{This stores the vectorized form of \eqn{\textbf{y}}{y}, the dependent variable.} \item{yhat}{This is a \eqn{N \times S}{N x S} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and \eqn{S} is the number of posterior samples.} \item{Deviance}{This is a vector of predictive deviance.} } \author{Statisticat, LLC.} \seealso{ \code{\link{PMC}} } \keyword{High Performance Computing} \keyword{Posterior Predictive Checks} \keyword{Predict} LaplacesDemon/man/logit.Rd0000755000176200001440000000575615144316355015170 0ustar liggesusers\name{logit} \alias{invlogit} \alias{logit} \title{The logit and inverse-logit functions} \description{ The logit and inverse-logit (also called the logistic function) are provided. } \usage{ invlogit(x) logit(p) } \arguments{ \item{x}{This object contains real values that will be transformed to the interval [0,1].} \item{p}{This object contains of probabilities p in the interval [0,1] that will be transformed to the real line.} } \details{ The \code{logit} function is the inverse of the sigmoid or logistic function, and transforms a continuous value (usually probability \eqn{p}) in the interval [0,1] to the real line (where it is usually the logarithm of the odds). The \code{logit} function is \eqn{\log(p / (1-p))}{log(p / (1 - p))}. The \code{invlogit} function (called either the inverse logit or the logistic function) transforms a real number (usually the logarithm of the odds) to a value (usually probability \eqn{p}) in the interval [0,1]. The \code{invlogit} function is \eqn{\frac{1}{1 + \exp(-x)}}{1 / (1 + exp(-x))}. If \eqn{p} is a probability, then \eqn{\frac{p}{1-p}}{p/(1-p)} is the corresponding odds, while the \code{logit} of \eqn{p} is the logarithm of the odds. The difference between the logits of two probabilities is the logarithm of the odds ratio. The derivative of probability \eqn{p} in a logistic function (such as \code{invlogit}) is: \eqn{\frac{d}{dx} = p(1-p)}{(d / dx) = p * (1 - p)}. In the LaplacesDemon package, it is common to re-parameterize a model so that a parameter that should be in an interval can be updated from the real line by using the \code{logit} and \code{invlogit} functions, though the \code{\link{interval}} function provides an alternative. For example, consider a parameter \eqn{\theta}{theta} that must be in the interval [0,1]. The algorithms in \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}} are unaware of the desired interval, and may attempt \eqn{\theta}{theta} outside of this interval. One solution is to have the algorithms update \code{logit(theta)} rather than \code{theta}. After \code{logit(theta)} is manipulated by the algorithm, it is transformed via \code{invlogit(theta)} in the model specification function, where \eqn{\theta \in [0,1]}{theta in [0,1]}. } \value{ \code{invlogit} returns probability \code{p}, and \code{logit} returns \code{x}. } \seealso{ \code{\link{interval}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{plogis}}, \code{\link{PMC}}, \code{\link{qlogis}}, and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) x <- -5:5 p <- invlogit(x) x <- logit(p) } \keyword{Inverse Logit} \keyword{Link Function} \keyword{Logistic Function} \keyword{Logit} \keyword{Transformation} LaplacesDemon/man/dist.Halft.Rd0000755000176200001440000000703215144316355016037 0ustar liggesusers\name{dist.Halft} \alias{dhalft} \alias{phalft} \alias{qhalft} \alias{rhalft} \title{Half-t Distribution} \description{ These functions provide the density, distribution function, quantile function, and random generation for the half-t distribution. } \usage{ dhalft(x, scale=25, nu=1, log=FALSE) phalft(q, scale=25, nu=1) qhalft(p, scale=25, nu=1) rhalft(n, scale=25, nu=1) } \arguments{ \item{x,q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{scale}{This is the scale parameter \eqn{\alpha}{alpha}, which must be positive.} \item{nu}{This is the scalar degrees of freedom parameter, which is usually represented as \eqn{\nu}{nu}.} \item{log}{Logical. If \code{log=TRUE} then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = (1 + \frac{1}{\nu} (\theta / \alpha)^2)^{-(\nu+1)/2}, \quad \theta \ge 0}{p(theta) = (1 + (1/nu)*(theta/alpha)^2)^(-(nu+1)/2), theta >= 0} \item Inventor: Derived from the Student t \item Notation 1: \eqn{\theta \sim \mathcal{HT}(\alpha, \nu)}{theta ~ HT(alpha,nu)} \item Notation 2: \eqn{p(\theta) = \mathcal{HT}(\theta | \alpha, \nu)}{p(theta) = HT(theta | alpha,nu)} \item Parameter 1: scale parameter \eqn{\alpha > 0}{alpha > 0} \item Parameter 2: degrees of freedom parameter \eqn{\nu}{nu} \item Mean: \eqn{E(\theta)}{E(theta)} = unknown \item Variance: \eqn{var(\theta)}{var(theta)} = unknown \item Mode: \eqn{mode(\theta) = 0}{mode(theta) = 0} } The half-t distribution is derived from the Student t distribution, and is useful as a weakly informative prior distribution for a scale parameter. It is more adaptable than the default recommended half-Cauchy, though it may also be more difficult to estimate due to its additional degrees of freedom parameter, \eqn{\nu}{nu}. When \eqn{\nu=1}{nu=1}, the density is proportional to a proper half-Cauchy distribution. When \eqn{\nu=-1}{nu=-1}, the density becomes an improper, uniform prior distribution. For more information on propriety, see \code{is.proper}. Wand et al. (2011) demonstrated that the half-t distribution may be represented as a scale mixture of inverse-gamma distributions. This representation is useful for conjugacy. } \value{ \code{dhalft} gives the density, \code{phalft} gives the distribution function, \code{qhalft} gives the quantile function, and \code{rhalft} generates random deviates. } \references{ Wand, M.P., Ormerod, J.T., Padoan, S.A., and Fruhwirth, R. (2011). "Mean Field Variational Bayes for Elaborate Distributions". \emph{Bayesian Analysis}, 6: p. 847--900. } \seealso{ \code{\link{dhalfcauchy}}, \code{\link{dst}}, \code{\link{dt}}, \code{\link{dunif}}, and \code{\link{is.proper}}. } \examples{ library(LaplacesDemon) x <- dhalft(1,25,1) x <- phalft(1,25,1) x <- qhalft(0.5,25,1) x <- rhalft(10,25,1) #Plot Probability Functions x <- seq(from=0.1, to=20, by=0.1) plot(x, dhalft(x,1,-1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dhalft(x,1,0.5), type="l", col="green") lines(x, dhalft(x,1,500), type="l", col="blue") legend(2, 0.9, expression(paste(alpha==1, ", ", nu==-1), paste(alpha==1, ", ", nu==0.5), paste(alpha==1, ", ", nu==500)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/is.constant.Rd0000755000176200001440000000140015144316355016273 0ustar liggesusers\name{is.constant} \alias{is.constant} \title{Logical Check of a Constant} \description{ This function provides a logical test of whether or not a vector is a constant. } \usage{ is.constant(x) } \arguments{ \item{x}{This is a vector.} } \details{ As opposed to a variable, a constant is a vector in which the elements contain less than or equal to one unique value. } \value{ The \code{is.constant} function returns a logical result, reporting \code{TRUE} when a vector is a constant, or \code{FALSE} otherwise. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{unique}} } \examples{ library(LaplacesDemon) is.constant(rep(1,10)) #TRUE is.constant(1:10) #FALSE } \keyword{Utility}LaplacesDemon/man/predict.laplace.Rd0000755000176200001440000001161615144316355017074 0ustar liggesusers\name{predict.laplace} \alias{predict.laplace} \title{Posterior Predictive Checks} \description{ This may be used to predict either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}), and then perform posterior predictive checks. Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is predicted given an object of class \code{laplace}, the model specification, and data. This function requires that posterior samples were produced with \code{\link{LaplaceApproximation}}. } \usage{\method{predict}{laplace}(object, Model, Data, CPUs=1, Type="PSOCK", \dots)} \arguments{ \item{object}{An object of class \code{laplace} is required.} \item{Model}{The model specification function is required.} \item{Data}{A data set in a list is required. The dependent variable is required to be named either \code{y} or \code{Y}.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} \item{\dots}{Additional arguments are unused.} } \details{ Since Laplace Approximation characterizes marginal posterior distributions with modes and variances, and posterior predictive checks involve samples, the \code{predict.laplace} function requires the use of independent samples of the marginal posterior distributions, provided by \code{\link{LaplaceApproximation}} when \code{sir=TRUE}. The samples of the marginal posterior distributions of the target distributions (the parameters) are passed along with the data to the \code{Model} specification and used to draw samples from the deviance and monitored variables. At the same time, the fourth component in the returned list, which is labeled \code{yhat}, is a vector of expectations of \eqn{\textbf{y}}{y}, given the samples, model specification, and data. To predict \eqn{\textbf{y}^{rep}}{y[rep]}, simply supply the data set used to estimate the model. To predict \eqn{\textbf{y}^{new}}{y[new]}, supply a new data set instead (though for some model specifications, this cannot be done, and \eqn{\textbf{y}_{new}}{y[new]} must be specified in the \code{Model} function). If the new data set does not have \eqn{\textbf{y}}{y}, then create \code{y} in the list and set it equal to something sensible, such as \code{mean(y)} from the original data set. The variable \code{y} must be a vector. If instead it is matrix \code{Y}, then it will be converted to vector \code{y}. The vectorized length of \code{y} or \code{Y} must be equal to the vectorized length of \code{yhat}, the fourth component of the returned list of the \code{Model} function. Parallel processing may be performed when the user specifies \code{CPUs} to be greater than one, implying that the specified number of CPUs exists and is available. Parallelization may be performed on a multicore computer or a computer cluster. Either a Simple Network of Workstations (SNOW) or Message Passing Interface is used (MPI). With small data sets and few samples, parallel processing may be slower, due to computer network communication. With larger data sets and more samples, the user should experience a faster run-time. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. } \value{ This function returns an object of class \code{laplace.ppc} (where ``ppc'' stands for posterior predictive checks). The returned object is a list with the following components: \item{y}{ This stores \eqn{\textbf{y}}{y}, the dependent variable.} \item{yhat}{ This is a \eqn{N \times S}{N x S} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and \eqn{S} is the number of posterior samples.} \item{Deviance}{ This is a vector of length \eqn{S}, where \eqn{S} is the number of independent posterior samples. Samples are obtained with the sampling importance resampling algorithm, \code{\link{SIR}}.} \item{monitor}{ This is a \eqn{N \times S}{N x S} matrix, where \eqn{N} is the number of monitored variables and \eqn{S} is the number of independent posterior samples. Samples are obtained with the sampling importance resampling algorithm, \code{\link{SIR}}.} } \author{Statisticat, LLC.} \seealso{ \code{\link{LaplaceApproximation}} and \code{\link{SIR}}. } \keyword{High Performance Computing} \keyword{Posterior Predictive Checks} \keyword{Predict} LaplacesDemon/man/dist.Multivariate.t.Precision.Cholesky.Rd0000755000176200001440000001224215144316355023422 0ustar liggesusers\name{dist.Multivariate.t.Precision.Cholesky} \alias{dmvtpc} \alias{rmvtpc} \title{Multivariate t Distribution: Precision-Cholesky Parameterization} \description{ These functions provide the density and random number generation for the multivariate t distribution, otherwise called the multivariate Student distribution. These functions use the precision and Cholesky parameterization. } \usage{ dmvtpc(x, mu, U, nu=Inf, log=FALSE) rmvtpc(n=1, mu, U, nu=Inf) } \arguments{ \item{x}{This is either a vector of length \eqn{k} or a matrix with a number of columns, \eqn{k}, equal to the number of columns in precision matrix \eqn{\Omega}{Omega}.} \item{n}{This is the number of random draws.} \item{mu}{This is a numeric vector representing the location parameter, \eqn{\mu}{mu} (the mean vector), of the multivariate distribution (equal to the expected value when \code{df > 1}, otherwise represented as \eqn{\nu > 1}{nu > 1}). It must be of length \eqn{k}, as defined above.} \item{U}{This is a \eqn{k \times k}{k x k} upper-triangular of the precision matrix that is Cholesky fator \eqn{\textbf{U}}{U} of precision matrix \eqn{\Omega}{Omega}.} \item{nu}{This is the degrees of freedom \eqn{\nu}{nu}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{\Gamma((\nu+k)/2)}{\Gamma(\nu/2)\nu^{k/2}\pi^{k/2}} |\Omega|^{1/2} (1 + \frac{1}{\nu} (\theta-\mu)^T \Omega (\theta-\mu))^{-(\nu+k)/2}}{p(theta) = (Gamma((nu+k)/2) / (Gamma(nu/2)*nu^(k/2)*pi^(k/2))) * |Omega|^(1/2) * (1 + (1/nu) (theta-mu)^T Omega (theta-mu))^(-(nu+k)/2)} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathrm{t}_k(\mu, \Omega^{-1}, \nu)}{theta ~ t[k](mu, Omega^(-1), nu)} \item Notation 2: \eqn{p(\theta) = \mathrm{t}_k(\theta | \mu, \Omega^{-1}, \nu)}{p(theta) = t[k](theta | mu, Omega^(-1), \nu)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega} \item Parameter 3: degrees of freedom \eqn{\nu > 0}{nu > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu}, for \eqn{\nu > 1}{nu > 1}, otherwise undefined \item Variance: \eqn{var(\theta) = \frac{\nu}{\nu - 2} \Omega^{-1}}{var(theta) = (nu / (nu - 2))*Omega^(-1)}, for \eqn{\nu > 2}{nu> 2} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate t distribution, also called the multivariate Student or multivariate Student t distribution, is a multidimensional extension of the one-dimensional or univariate Student t distribution. A random vector is considered to be multivariate t-distributed if every linear combination of its components has a univariate Student t-distribution. It is usually parameterized with mean and a covariance matrix, or in Bayesian inference, with mean and a precision matrix, where the precision matrix is the matrix inverse of the covariance matrix. These functions provide the precision parameterization for convenience and familiarity. It is easier to calculate a multivariate t density with the precision parameterization, because a matrix inversion can be avoided. The precision matrix is replaced with an upper-triangular \eqn{k \times k}{k x k} matrix that is Cholesky factor \eqn{\textbf{U}}{U}, as per the \code{\link{chol}} function for Cholesky decomposition. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k}, and a \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega}, which must be positive-definite. When degrees of freedom \eqn{\nu=1}{nu=1}, this is the multivariate Cauchy distribution. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, the Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dmvtp}, \code{dmvtpc} must additionally matrix-multiply the Cholesky back to the precision matrix, but it does not have to check for or correct the precision matrix to positive-definiteness, which overall is slower. Compared with \code{rmvtp}, \code{rmvtpc} is faster because the Cholesky decomposition has already been performed. } \value{ \code{dmvtpc} gives the density and \code{rmvtpc} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{chol}}, \code{\link{dwishartc}}, \code{\link{dmvc}}, \code{\link{dmvcp}}, \code{\link{dmvtc}}, \code{\link{dst}}, \code{\link{dstp}}, and \code{\link{dt}}. } \examples{ library(LaplacesDemon) x <- seq(-2,4,length=21) y <- 2*x+10 z <- x+cos(y) mu <- c(1,12,2) Omega <- matrix(c(1,2,0,2,5,0.5,0,0.5,3), 3, 3) U <- chol(Omega) nu <- 4 f <- dmvtpc(cbind(x,y,z), mu, U, nu) X <- rmvtpc(1000, c(0,1,2), U, 5) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution} LaplacesDemon/man/print.pmc.Rd0000755000176200001440000000103615144337635015753 0ustar liggesusers\name{print.pmc} \alias{print.pmc} \title{Print an object of class \code{pmc} to the screen} \description{ This may be used to print the contents of an object of class \code{pmc} to the screen. } \usage{\method{print}{pmc}(x, \dots)} \arguments{ \item{x}{An object of class \code{pmc} is required.} \item{\dots}{Additional arguments are unused.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{PMC}}. } \examples{### See the PMC function for an example.} \keyword{print} LaplacesDemon/man/dist.Generalized.Pareto.Rd0000755000176200001440000000646615144316355020475 0ustar liggesusers\name{dist.Generalized.Pareto} \alias{dgpd} \alias{rgpd} \title{Generalized Pareto Distribution} \description{ These are the density and random generation functions for the generalized Pareto distribution. } \usage{ dgpd(x, mu, sigma, xi, log=FALSE) rgpd(n, mu, sigma, xi) } \arguments{ \item{x}{This is a vector of data.} \item{n}{This is a positive scalar integer, and is the number of observations to generate randomly.} \item{mu}{This is a scalar or vector location parameter \eqn{\mu}{mu}. When \eqn{\xi}{xi} is non-negative, \eqn{\mu}{mu} must not be greater than \eqn{\textbf{x}}{x}. When \eqn{\xi}{xi} is negative, \eqn{\mu}{mu} must be less than \eqn{\textbf{x} + \sigma / \xi}{x + sigma/xi}.} \item{sigma}{This is a positive-only scalar or vector of scale parameters \eqn{\sigma}{sigma}.} \item{xi}{This is a scalar or vector of shape parameters \eqn{\xi}{xi}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{1}{\sigma}(1 + \xi\textbf{z})^(-1/\xi + 1)}{1/sigma (1 + xi z)^(-1/xi + 1)} where \eqn{\textbf{z} = \frac{\theta - \mu}{\sigma}}{z = (theta - mu)/sigma} \item Inventor: Pickands (1975) \item Notation 1: \eqn{\theta \sim \mathcal{GPD}(\mu, \sigma, \xi)}{theta ~ GPD(mu, sigma, xi)} \item Notation 2: \eqn{p(\theta) \sim \mathcal{GPD}(\theta | \mu, \sigma, \xi)}{p(theta) ~ GPD(theta | mu, sigma, xi)} \item Parameter 1: location \eqn{\mu}{mu}, where \eqn{\mu \le \theta}{mu <= theta} when \eqn{\xi \ge 0}{xi >= 0}, and \eqn{\mu \ge \theta + \sigma / \xi}{mu >= theta + sigma/xi} when \eqn{\xi < 0}{xi < 0} \item Parameter 2: scale \eqn{\sigma > 0}{sigma > 0} \item Parameter 3: shape \eqn{\xi}{xi} \item Mean: \eqn{\mu + \frac{\sigma}{1 - \xi}}{mu + sigma / (1 - xi)} when \eqn{\xi < 1}{xi < 1} \item Variance: \eqn{\frac{\sigma^2}{(1 - \xi)^2 (1 - 2\xi)}}{sigma^2 / [(1 - xi)^2 (1 - 2 xi)]} when \eqn{\xi < 0.5}{xi < 0.5} \item Mode: } The generalized Pareto distribution (GPD) is a more flexible extension of the Pareto (\code{\link{dpareto}}) distribution. It is equivalent to the exponential distribution when both \eqn{\mu = 0}{mu = 0} and \eqn{\xi = 0}{xi = 0}, and it is equivalent to the Pareto distribution when \eqn{\mu = \sigma / \xi}{mu = sigma / xi} and \eqn{\xi > 0}{xi > 0}. The GPD is often used to model the tails of another distribution, and the shape parameter \eqn{\xi}{xi} relates to tail-behavior. Distributions with tails that decrease exponentially are modeled with shape \eqn{\xi = 0}{xi = 0}. Distributions with tails that decrease as a polynomial are modeled with a positive shape parameter. Distributions with finite tails are modeled with a negative shape parameter. } \value{ \code{dgpd} gives the density, and \code{rgpd} generates random deviates. } \references{ Pickands J. (1975). "Statistical Inference Using Extreme Order Statistics". \emph{The Annals of Statistics}, 3, p. 119--131. } \seealso{ \code{\link{dpareto}} } \examples{ library(LaplacesDemon) x <- dgpd(0,0,1,0,log=TRUE) x <- rgpd(10,0,1,0) } \keyword{Distribution} LaplacesDemon/man/hpc_server.Rd0000755000176200001440000000303715144316355016200 0ustar liggesusers\name{hpc_server} \alias{server_Listening} \title{Server Listening} \description{ This function is not intended to be called directly by the user. It is an internal-only function to prevent cluster problems while using the \code{INCA} algorithm in the \code{LaplacesDemon.hpc} function. } \usage{ server_Listening(n=2, port=19009) } \arguments{ \item{n}{This is the number of CPUs. For more information, see \code{\link{LaplacesDemon.hpc}}.} \item{port}{This is a port for server listening, and defaults to port \code{19009}.} } \details{ For the \code{INCA} algorithm, a server has been built into the \code{LaplacesDemon.hpc} function. The server exchanges information between processes, and has been designed to be portable. The \code{server_Listening} function is run as a separate process via the \code{system} function, when \code{INCA} is selected in \code{LaplacesDemon.hpc}. Socket connections and the \code{serialize} function are used as per the \pkg{Snow} package to update a single proposal covariance matrix given all parallel chains. The sockets are opened/closed in each process with a small random sleep time to avoid collisions during connections to the internal server of \code{LaplacesDemon.hpc}. Blocking sockets are used to synchronize processes. } \author{Silvere Vialet-Chabrand \email{silvere@vialet-chabrand.com}} \seealso{ \code{\link{LaplacesDemon}} and \code{\link{LaplacesDemon.hpc}}. } \keyword{High Performance Computing} \keyword{Parallel Chains}LaplacesDemon/man/dist.Multivariate.Normal.Cholesky.Rd0000755000176200001440000001015415144316355022455 0ustar liggesusers\name{dist.Multivariate.Normal.Cholesky} \alias{dmvnc} \alias{rmvnc} \title{Multivariate Normal Distribution: Cholesky Parameterization} \description{ These functions provide the density and random number generation for the multivariate normal distribution, given the Cholesky parameterization. } \usage{ dmvnc(x, mu, U, log=FALSE) rmvnc(n=1, mu, U) } \arguments{ \item{x}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{n}{This is the number of random draws.} \item{mu}{This is mean vector \eqn{\mu}{mu} with length \eqn{k} or matrix with \eqn{k} columns.} \item{U}{This is the \eqn{k \times k}{k x k} upper-triangular matrix that is Cholesky factor \eqn{\textbf{U}}{U} of covariance matrix \eqn{\Sigma}{Sigma}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = \frac{1}{(2\pi)^{k/2}|\Sigma|^{1/2}} \exp(-\frac{1}{2}(\theta - \mu)'\Sigma^{-1}(\theta - \mu))}{p(theta) = (1/((2*pi)^(k/2)*|Sigma|^(1/2))) * exp(-(1/2)*(theta-mu)'*Sigma^(-1)*(theta-mu))} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathcal{MVN}(\mu, \Sigma)}{theta ~ MVN(mu, Sigma)} \item Notation 2: \eqn{\theta \sim \mathcal{N}_k(\mu, \Sigma)}{theta ~ N[k](mu, Sigma)} \item Notation 3: \eqn{p(\theta) = \mathcal{MVN}(\theta | \mu, \Sigma)}{p(theta) = MVN(theta | mu, Sigma)} \item Notation 4: \eqn{p(\theta) = \mathcal{N}_k(\theta | \mu, \Sigma)}{p(theta) = N[k](theta | mu, Sigma)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: \eqn{k \times k}{k x k} positive-definite matrix \eqn{\Sigma}{Sigma} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = \Sigma}{var(theta) = Sigma} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate normal distribution, or multivariate Gaussian distribution, is a multidimensional extension of the one-dimensional or univariate normal (or Gaussian) distribution. A random vector is considered to be multivariate normally distributed if every linear combination of its components has a univariate normal distribution. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k} and an upper-triangular \eqn{k \times k}{k x k} matrix that is Cholesky factor \eqn{\textbf{U}}{U}, as per the \code{\link{chol}} function for Cholesky decomposition. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, the Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dmvn}, \code{dmvnc} must additionally matrix-multiply the Cholesky back to the covariance matrix, but it does not have to check for or correct the covariance matrix to positive-definiteness, which overall is slower. Compared with \code{rmvn}, \code{rmvnc} is faster because the Cholesky decomposition has already been performed. For models where the dependent variable, Y, is specified to be distributed multivariate normal given the model, the Mardia test (see \code{\link{plot.demonoid.ppc}}, \code{\link{plot.laplace.ppc}}, or \code{\link{plot.pmc.ppc}}) may be used to test the residuals. } \value{ \code{dmvnc} gives the density and \code{rmvnc} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{chol}}, \code{\link{dinvwishartc}}, \code{\link{dmvn}}, \code{\link{dmvnp}}, \code{\link{dmvnpc}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, \code{\link{plot.demonoid.ppc}}, \code{\link{plot.laplace.ppc}}, and \code{\link{plot.pmc.ppc}}. } \examples{ library(LaplacesDemon) Sigma <- diag(3) U <- chol(Sigma) x <- dmvnc(c(1,2,3), c(0,1,2), U) X <- rmvnc(1000, c(0,1,2), U) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/LaplaceApproximation.Rd0000755000176200001440000010736515144337635020171 0ustar liggesusers\name{LaplaceApproximation} \alias{LaplaceApproximation} \title{Laplace Approximation} \description{ The \code{LaplaceApproximation} function deterministically maximizes the logarithm of the unnormalized joint posterior density with one of several optimization algorithms. The goal of Laplace Approximation is to estimate the posterior mode and variance of each parameter. This function is useful for optimizing initial values and estimating a covariance matrix to be input into the \code{\link{IterativeQuadrature}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}} function, or sometimes for model estimation in its own right. } \usage{ LaplaceApproximation(Model, parm, Data, Interval=1.0E-6, Iterations=100, Method="SPG", Samples=1000, CovEst="Hessian", sir=TRUE, Stop.Tolerance=1.0E-5, CPUs=1, Type="PSOCK") } \arguments{ \item{Model}{This required argument receives the model from a user-defined function. The user-defined function is where the model is specified. \code{LaplaceApproximation} passes two arguments to the model function, \code{parms} and \code{Data}. For more information, see the \code{\link{LaplacesDemon}} function and ``LaplacesDemon Tutorial'' vignette.} \item{parm}{This argument requires a vector of initial values equal in length to the number of parameters. \code{LaplaceApproximation} will attempt to optimize these initial values for the parameters, where the optimized values are the posterior modes, for later use with the \code{\link{IterativeQuadrature}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, or the \code{\link{VariationalBayes}} function. The \code{\link{GIV}} function may be used to randomly generate initial values. Parameters must be continuous.} \item{Data}{This required argument accepts a list of data. The list of data must include \code{mon.names} which contains monitored variable names, and \code{parm.names} which contains parameter names. \code{LaplaceApproximation} must be able to determine the sample size of the data, and will look for a scalar sample size variable \code{n} or \code{N}. If not found, it will look for variable \code{y} or \code{Y}, and attempt to take its number of rows as sample size. \code{LaplaceApproximation} needs to determine sample size due to the asymptotic nature of this method. Sample size should be at least \eqn{\sqrt{J}}{sqrt(J)} with \eqn{J} exchangeable parameters.} \item{Interval}{This argument receives an interval for estimating approximate gradients. The logarithm of the unnormalized joint posterior density of the Bayesian model is evaluated at the current parameter value, and again at the current parameter value plus this interval.} \item{Iterations}{This argument accepts an integer that determines the number of iterations that \code{LaplaceApproximation} will attempt to maximize the logarithm of the unnormalized joint posterior density. \code{Iterations} defaults to 100. \code{LaplaceApproximation} will stop before this number of iterations if the tolerance is less than or equal to the \code{Stop.Tolerance} criterion. The required amount of computer memory increases with \code{Iterations}. If computer memory is exceeded, then all will be lost.} \item{Method}{This optional argument accepts a quoted string that specifies the method used for Laplace Approximation. The default method is \code{Method="SPG"}. Options include \code{"AGA"} for adaptive gradient ascent, \code{"BFGS"} for the Broyden-Fletcher-Goldfarb-Shanno algorithm, \code{"BHHH"} for the algorithm of Berndt et al., \code{"CG"} for conjugate gradient, \code{"DFP"} for the Davidon-Fletcher-Powell algorithm, \code{"HAR"} for adaptive hit-and-run, \code{"HJ"} for Hooke-Jeeves, \code{"LBFGS"} for limited-memory BFGS, \code{"LM"} for Levenberg-Marquardt, \code{"NM"} for Nelder-Mead, \code{"NR"} for Newton-Raphson, \code{"PSO"} for Particle Swarm Optimization, \code{"Rprop"} for resilient backpropagation, \code{"SGD"} for Stochastic Gradient Descent, \code{"SOMA"} for the Self-Organizing Migration Algorithm, \code{"SPG"} for Spectral Projected Gradient, \code{"SR1"} for Symmetric Rank-One, and \code{"TR"} for Trust Region.} \item{Samples}{This argument indicates the number of posterior samples to be taken with sampling importance resampling via the \code{\link{SIR}} function, which occurs only when \code{sir=TRUE}. Note that the number of samples should increase with the number and intercorrelations of the parameters.} \item{CovEst}{This argument accepts a quoted string that indicates how the covariance matrix is estimated after the model finishes. This covariance matrix is used to obtain the standard deviation of each parameter, and may also be used for posterior sampling via Sampling Importance Resampling (SIR) (see the \code{sir} argument below), if converged. By default, the covariance matrix is approximated as the negative inverse of the \code{"Hessian"} matrix of second derivatives, estimated with Richardson extrapolation. Alternatives include \code{CovEst="Identity"}, \code{CovEst="OPG"}, or \code{CovEst="Sandwich"}. When \code{CovEst="Identity"}, the covariance matrix is not estimated, and is merely assigned an identity matrix. When \code{\link{LaplaceApproximation}} is performed internally by \code{\link{LaplacesDemon}}, an identity matrix is returned and scaled. When \code{CovEst="OPG"}, the covariance matrix is approximated with the inverse of the sum of the outer products of the gradient, which requires \code{X}, and either \code{y} or \code{Y} in the list of data. For OPG, a partial derivative is taken for each row in \code{X}, and each element in \code{y} or row in \code{Y}. Therefore, this requires \eqn{N + NJ} model evaluations for a data set with \eqn{N} records and \eqn{J} variables. The OPG method is an asymptotic approximation of the Hessian, and usually requires fewer calculations with a small data set, or more with large data sets. Both methods require a matrix inversion, which becomes costly as dimension grows. The Richardson-based Hessian method is more accurate, but requires more calculation in large dimensions. An alternative approach to obtaining covariance is to use the \code{\link{BayesianBootstrap}} on the data, or sample the posterior with iterative quadrature (\code{\link{IterativeQuadrature}}), MCMC (\code{\link{LaplacesDemon}}), or \code{\link{VariationalBayes}}.} \item{sir}{This logical argument indicates whether or not Sampling Importance Resampling (SIR) is conducted via the \code{\link{SIR}} function to draw independent posterior samples. This argument defaults to \code{TRUE}. Even when \code{TRUE}, posterior samples are drawn only when \code{LaplaceApproximation} has converged. Posterior samples are required for many other functions, including \code{plot.laplace} and \code{predict.laplace}. The only time that it is advantageous for \code{sir=FALSE} is when \code{LaplaceApproximation} is used to help the initial values for \code{\link{IterativeQuadrature}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}}, and it is unnecessary for time to be spent on sampling. Less time can be spent on sampling by increasing \code{CPUs}, which parallelizes the sampling.} \item{Stop.Tolerance}{This argument accepts any positive number and defaults to 1.0E-5. Tolerance is calculated each iteration, and the criteria varies by algorithm. The algorithm is considered to have converged to the user-specified \code{Stop.Tolerance} when the tolerance is less than or equal to the value of \code{Stop.Tolerance}, and the algorithm terminates at the end of the current iteration. Often, multiple criteria are used, in which case the maximum of all criteria becomes the tolerance. For example, when partial derivatives are taken, it is commonly required that the Euclidean norm of the partial derivatives is a criterion, and another common criterion is the Euclidean norm of the differences between the current and previous parameter values. Several algorithms have other, specific tolerances.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur. Parallelization occurs only for sampling with \code{\link{SIR}} when \code{sir=TRUE}.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} } \details{ The Laplace Approximation or Laplace Method is a family of asymptotic techniques used to approximate integrals. Laplace's method accurately approximates unimodal posterior moments and marginal posterior distributions in many cases. Since it is not applicable in all cases, it is recommended here that Laplace Approximation is used cautiously in its own right, or preferably, it is used before MCMC. After introducing the Laplace Approximation (Laplace, 1774, p. 366--367), a proof was published later (Laplace, 1814) as part of a mathematical system of inductive reasoning based on probability. Laplace used this method to approximate posterior moments. Since its introduction, the Laplace Approximation has been applied successfully in many disciplines. In the 1980s, the Laplace Approximation experienced renewed interest, especially in statistics, and some improvements in its implementation were introduced (Tierney et al., 1986; Tierney et al., 1989). Only since the 1980s has the Laplace Approximation been seriously considered by statisticians in practical applications. There are many variations of Laplace Approximation, with an effort toward replacing Markov chain Monte Carlo (MCMC) algorithms as the dominant form of numerical approximation in Bayesian inference. The run-time of Laplace Approximation is a little longer than Maximum Likelihood Estimation (MLE), usually shorter than variational Bayes, and much shorter than MCMC (Azevedo and Shachter, 1994). The speed of Laplace Approximation depends on the optimization algorithm selected, and typically involves many evaluations of the objective function per iteration (where an MCMC algorithm with a multivariate proposal usually evaluates once per iteration), making many MCMC algorithms faster per iteration. The attractiveness of Laplace Approximation is that it typically improves the objective function better than iterative quadrature, MCMC, and PMC when the parameters are in low-probability regions. Laplace Approximation is also typically faster than MCMC and PMC because it is seeking point-estimates, rather than attempting to represent the target distribution with enough simulation draws. Laplace Approximation extends MLE, but shares similar limitations, such as its asymptotic nature with respect to sample size and that marginal posterior distributions are Gaussian. Bernardo and Smith (2000) note that Laplace Approximation is an attractive family of numerical approximation algorithms, and will continue to develop. \code{LaplaceApproximation} seeks a global maximum of the logarithm of the unnormalized joint posterior density. The approach differs by \code{Method}. The \code{\link{LaplacesDemon}} function uses the \code{LaplaceApproximation} algorithm to optimize initial values and save time for the user. Most optimization algorithms assume that the logarithm of the unnormalized joint posterior density is defined and differentiable. Some methods calculate an approximate gradient for each initial value as the difference in the logarithm of the unnormalized joint posterior density due to a slight increase in the parameter. When \code{Method="AGA"}, the direction and distance for each parameter is proposed based on an approximate truncated gradient and an adaptive step size. The step size parameter, which is often plural and called rate parameters in other literature, is adapted each iteration with the univariate version of the Robbins-Monro stochastic approximation in Garthwaite (2010). The step size shrinks when a proposal is rejected and expands when a proposal is accepted. Gradient ascent is criticized for sometimes being relatively slow when close to the maximum, and its asymptotic rate of convergence is inferior to other methods. However, compared to other popular optimization algorithms such as Newton-Raphson, an advantage of the gradient ascent is that it works in infinite dimensions, requiring only sufficient computer memory. Although Newton-Raphson converges in fewer iterations, calculating the inverse of the negative Hessian matrix of second-derivatives is more computationally expensive and subject to singularities. Therefore, gradient ascent takes longer to converge, but is more generalizable. When \code{Method="BFGS"}, the BFGS algorithm is used, which was proposed by Broyden (1970), Fletcher (1970), Goldfarb (1970), and Shanno (1970), independently. BFGS may be the most efficient and popular quasi-Newton optimiziation algorithm. As a quasi-Newton algorithm, the Hessian matrix is approximated using rank-one updates specified by (approximate) gradient evaluations. Since BFGS is very popular, there are many variations of it. This is a version by Nash that has been adapted from the Rvmmin package, and is used in the \code{optim} function of base R. The approximate Hessian is not guaranteed to converge to the Hessian. When BFGS is used, the approximate Hessian is not used to calculate the final covariance matrix. When \code{Method="BHHH"}, the algorithm of Berndt et al. (1974) is used, which is commonly pronounced B-triple H. The BHHH algorithm is a quasi-Newton method that includes a step-size parameter, partial derivatives, and an approximation of a covariance matrix that is calculated as the inverse of the sum of the outer product of the gradient (OPG), calculated from each record. The OPG method becomes more costly with data sets with more records. Since partial derivatives must be calculated per record of data, the list of data has special requirements with this method, and must include design matrix \code{X}, and dependent variable \code{y} or \code{Y}. Records must be row-wise. An advantage of BHHH over NR (see below) is that the covariance matrix is necessarily positive definite, and gauranteed to provide an increase in LP each iteration (given a small enough step-size), even in convex areas. The covariance matrix is better approximated with larger data sample sizes, and when closer to the maximum of LP. Disadvantages of BHHH include that it can give small increases in LP, especially when far from the maximum or when LP is highly non-quadratic. When \code{Method="CG"}, a nonlinear conjugate gradient algorithm is used. CG uses partial derivatives, but does not use the Hessian matrix or any approximation of it. CG usually requires more iterations to reach convergence than other algorithms that use the Hessian or an approximation. However, since the Hessian becomes computationally expensive as the dimension of the model grows, CG is applicable to large dimensional models when \code{CovEst="Hessian"} is avoided. CG was originally developed by Hestenes and Stiefel (1952), though this version is adapted from the \code{Rcgminu} function in package Rcgmin. When \code{Method="DFP"}, the Davidon-Fletcher-Powell algorithm is used. DFP was the first popular, multidimensional, quasi-Newton optimization algorithm. The DFP update of an approximate Hessian matrix maintains symmetry and positive-definiteness. The approximate Hessian is not guaranteed to converge to the Hessian. When DFP is used, the approximate Hessian is not used to calculate the final covariance matrix. Although DFP is very effective, it was superseded by the BFGS algorithm. When \code{Method="HAR"}, a hit-and-run algorithm with a multivariate proposal and adaptive length is used. The length parameter is adapted each iteration with the univariate version of the Robbins-Monro stochastic approximation in Garthwaite (2010). The length shrinks when a proposal is rejected and expands when a proposal is accepted. This is the same algorithm as the HARM or Hit-And-Run Metropolis MCMC algorithm with adaptive length, except that a Metropolis step is not used. When \code{Method="HJ"}, the Hooke-Jeeves (1961) algorithm is used. This was adapted from the \code{HJK} algorithm in package dfoptim. Hooke-Jeeves is a derivative-free, direct search method. Each iteration involves two steps: an exploratory move and a pattern move. The exploratory move explores local behavior, and the pattern move takes advantage of pattern direction. It is sometimes described as a hill-climbing algorithm. If the solution improves, it accepts the move, and otherwise rejects it. Step size decreases with each iteration. The decreasing step size can trap it in local maxima, where it gets stuck and convergences erroneously. Users are encouraged to attempt again after what seems to be convergence, starting from the latest point. Although getting stuck at local maxima can be problematic, the Hooke-Jeeves algorithm is also attractive because it is simple, fast, does not depend on derivatives, and is otherwise relatively robust. When \code{Method="LBFGS"}, the limited-memory BFGS (Broyden-Fletcher-Goldfarb-Shanno) algorithm is called in \code{optim}, once per iteration. When \code{Method="LM"}, the Levenberg-Marquardt algorithm (Levenberg, 1944; Marquardt, 1963) is used. Also known as the Levenberg-Marquardt Algorithm (LMA) or the Damped Least-Squares (DLS) method, LM is a trust region (not to be confused with TR below) quasi-Newton optimization algorithm that provides minimizes nonlinear least squares, and has been adapted here to maximize LP. LM uses partial derivatives and approximates the Hessian with outer-products. It is suitable for nonlinear optimization up to a few hundred parameters, but loses its efficiency in larger problems due to matrix inversion. LM is considered between the Gauss-Newton algorithm and gradient descent. When far from the solution, LM moves slowly like gradient descent, but is guaranteed to converge. When LM is close to the solution, LM becomes a damped Gauss-Newton method. This was adapted from the \code{lsqnonlin} algorithm in package pracma. When \code{Method="NM"}, the Nelder-Mead (1965) algorithm is used. This was adapted from the \code{nelder_mead} function in package pracma. Nelder-Mead is a derivative-free, direct search method that is known to become inefficient in large-dimensional problems. As the dimension increases, the search direction becomes increasingly orthogonal to the steepest ascent (usually descent) direction. However, in smaller dimensions, it is a popular algorithm. At each iteration, three steps are taken to improve a simplex: reflection, extension, and contraction. When \code{Method="NR"}, the Newton-Raphson optimization algorithm, also known as Newton's Method, is used. Newton-Raphson uses derivatives and a Hessian matrix. The algorithm is included for its historical significance, but is known to be problematic when starting values are far from the targets, and calculating and inverting the Hessian matrix can be computationally expensive. As programmed here, when the Hessian is problematic, it tries to use only the derivatives, and when that fails, a jitter is applied. Newton-Raphson should not be the first choice of the user, and BFGS should always be preferred. When \code{Method="PSO"}, the Standard Particle Swarm Optimization 2007 algorithm is used. A swarm of particles is moved according to velocity, neighborhood, and the best previous solution. The neighborhood for each particle is a set of informing particles. PSO is derivative-free. PSO has been adapted from the \code{psoptim} function in package pso. When \code{Method="Rprop"}, the approximate gradient is taken for each parameter in each iteration, and its sign is compared to the approximate gradient in the previous iteration. A weight element in a weight vector is associated with each approximate gradient. A weight element is multiplied by 1.2 when the sign does not change, or by 0.5 if the sign changes. The weight vector is the step size, and is constrained to the interval [0.001, 50], and initial weights are 0.0125. This is the resilient backpropagation algorithm, which is often denoted as the ``Rprop-'' algorithm of Riedmiller (1994). When \code{Method="SGD"}, a stochastic gradient descent algorithm is used that is designed only for big data, and gained popularity after successful use in the NetFlix competition. This algorithm has special requirements for the \code{Model} specification function and the \code{Data} list. See the ``LaplacesDemon Tutorial'' vignette for more information. When \code{Method="SOMA"}, a population of ten particles or individuals moves in the direction of the best particle, the leader. The leader does not move in each iteration, and a line-search is used for each non-leader, up to three times the difference in parameter values between each non-leader and leader. This algorithm is derivative-free and often considered in the family of evolution algorithms. Numerous model evaluations are performed per non-leader per iteration. This algorithm was adapted from package soma. When \code{Method="SPG"}, a Spectral Projected Gradient algorithm is used. SPG is a non-monotone algorithm that is suitable for high-dimensional models. The approximate gradient is used, but the Hessian matrix is not. When used with large models, \code{CovEst="Hessian"} should be avoided. SPG has been adapted from the \code{spg} function in package BB. When \code{Method="SR1"}, the Symmetric Rank-One (SR1) algorithm is used. SR1 is a quasi-Newton algorithm, and the Hessian matrix is approximated, often without being positive-definite. At the posterior modes, the true Hessian is usually positive-definite, but this is often not the case during optimization when the parameters have not yet reached the posterior modes. Other restrictions, including constraints, often result in the true Hessian being indefinite at the solution. For these reasons, SR1 often outperforms BFGS. The approximate Hessian is not guaranteed to converge to the Hessian. When SR1 is used, the approximate Hessian is not used to calculate the final covariance matrix. When \code{Method="TR"}, the Trust Region algorithm of Nocedal and Wright (1999) is used. The TR algorithm attempts to reach its objective in the fewest number of iterations, is therefore very efficient, as well as safe. The efficiency of TR is attractive when model evaluations are expensive. The Hessian is approximated each iteration, making TR best suited to models with small to medium dimensions, say up to a few hundred parameters. TR has been adapted from the \code{trust} function in package trust. } \value{ \code{LaplaceApproximation} returns an object of class \code{laplace} that is a list with the following components: \item{Call}{This is the matched call of \code{LaplaceApproximation}.} \item{Converged}{This is a logical indicator of whether or not \code{LaplaceApproximation} converged within the specified \code{Iterations} according to the supplied \code{Stop.Tolerance} criterion. Convergence does not indicate that the global maximum has been found, but only that the tolerance was less than or equal to the \code{Stop.Tolerance} criterion.} \item{Covar}{This covariance matrix is estimated according to the \code{CovEst} argument. The \code{Covar} matrix may be scaled and input into the \code{Covar} argument of the \code{\link{LaplacesDemon}} or \code{\link{PMC}} function for further estimation, or the diagonal of this matrix may be used to represent the posterior variance of the parameters, provided the algorithm converged and matrix inversion was successful. To scale this matrix for use with Laplace's Demon or PMC, multiply it by \eqn{2.38^2/d}, where \eqn{d} is the number of initial values.} \item{Deviance}{This is a vector of the iterative history of the deviance in the \code{LaplaceApproximation} function, as it sought convergence.} \item{History}{This is a matrix of the iterative history of the parameters in the \code{LaplaceApproximation} function, as it sought convergence.} \item{Initial.Values}{This is the vector of initial values that was originally given to \code{LaplaceApproximation} in the \code{parm} argument.} \item{LML}{This is an approximation of the logarithm of the marginal likelihood of the data (see the \code{\link{LML}} function for more information). When the model has converged and \code{sir=TRUE}, the NSIS method is used. When the model has converged and \code{sir=FALSE}, the LME method is used. This is the logarithmic form of equation 4 in Lewis and Raftery (1997). As a rough estimate of Kass and Raftery (1995), the LME-based LML is worrisome when the sample size of the data is less than five times the number of parameters, and \code{LML} should be adequate in most problems when the sample size of the data exceeds twenty times the number of parameters (p. 778). The LME is inappropriate with hierarchical models. However \code{LML} is estimated, it is useful for comparing multiple models with the \code{BayesFactor} function.} \item{LP.Final}{This reports the final scalar value for the logarithm of the unnormalized joint posterior density.} \item{LP.Initial}{This reports the initial scalar value for the logarithm of the unnormalized joint posterior density.} \item{Minutes}{This is the number of minutes that \code{LaplaceApproximation} was running, and this includes the initial checks as well as drawing posterior samples and creating summaries.} \item{Monitor}{When \code{sir=TRUE}, a number of independent posterior samples equal to \code{Samples} is taken, and the draws are stored here as a matrix. The rows of the matrix are the samples, and the columns are the monitored variables.} \item{Posterior}{When \code{sir=TRUE}, a number of independent posterior samples equal to \code{Samples} is taken, and the draws are stored here as a matrix. The rows of the matrix are the samples, and the columns are the parameters.} \item{Step.Size.Final}{This is the final, scalar \code{Step.Size} value at the end of the \code{LaplaceApproximation} algorithm.} \item{Step.Size.Initial}{This is the initial, scalar \code{Step.Size}.} \item{Summary1}{This is a summary matrix that summarizes the point-estimated posterior modes. Uncertainty around the posterior modes is estimated from the covariance matrix. Rows are parameters. The following columns are included: Mode, SD (Standard Deviation), LB (Lower Bound), and UB (Upper Bound). The bounds constitute a 95\% probability interval.} \item{Summary2}{This is a summary matrix that summarizes the posterior samples drawn with sampling importance resampling (\code{\link{SIR}}) when \code{sir=TRUE}, given the point-estimated posterior modes and the covariance matrix. Rows are parameters. The following columns are included: Mode, SD (Standard Deviation), LB (Lower Bound), and UB (Upper Bound). The bounds constitute a 95\% probability interval.} \item{Tolerance.Final}{This is the last \code{Tolerance} of the \code{LaplaceApproximation} algorithm.} \item{Tolerance.Stop}{This is the \code{Stop.Tolerance} criterion.} } \references{ Azevedo-Filho, A. and Shachter, R. (1994). "Laplace's Method Approximations for Probabilistic Inference in Belief Networks with Continuous Variables". In "Uncertainty in Artificial Intelligence", Mantaras, R. and Poole, D., Morgan Kauffman, San Francisco, CA, p. 28--36. Bernardo, J.M. and Smith, A.F.M. (2000). "Bayesian Theory". John Wiley & Sons: West Sussex, England. Berndt, E., Hall, B., Hall, R., and Hausman, J. (1974), "Estimation and Inference in Nonlinear Structural Models". \emph{Annals of Economic and Social Measurement}, 3, p. 653--665. Broyden, C.G. (1970). "The Convergence of a Class of Double Rank Minimization Algorithms: 2. The New Algorithm". Journal of the Institute of Mathematics and its Applications, 6, p.76--90. Fletcher, R. (1970). "A New Approach to Variable Metric Algorithms". Computer Journal, 13(3), p. 317--322. Garthwaite, P., Fan, Y., and Sisson, S. (2010). "Adaptive Optimal Scaling of Metropolis-Hastings Algorithms Using the Robbins-Monro Process." Goldfarb, D. (1970). "A Family of Variable Metric Methods Derived by Variational Means". Mathematics of Computation, 24(109), p. 23--26. Hestenes, M.R. and Stiefel, E. (1952). "Methods of Conjugate Gradients for Solving Linear Systems". \emph{Journal of Research of the National Bureau of Standards}, 49(6), p. 409--436. Hooke, R. and Jeeves, T.A. (1961). "'Direct Search' Solution of Numerical and Statistical Problems". \emph{Journal of the Association for Computing Machinery}, 8(2), p. 212--229. Kass, R.E. and Raftery, A.E. (1995). "Bayes Factors". \emph{Journal of the American Statistical Association}, 90(430), p. 773--795. Laplace, P. (1774). "Memoire sur la Probabilite des Causes par les Evenements." l'Academie Royale des Sciences, 6, 621--656. English translation by S.M. Stigler in 1986 as "Memoir on the Probability of the Causes of Events" in Statistical Science, 1(3), 359--378. Laplace, P. (1814). "Essai Philosophique sur les Probabilites." English translation in Truscott, F.W. and Emory, F.L. (2007) from (1902) as "A Philosophical Essay on Probabilities". ISBN 1602063281, translated from the French 6th ed. (1840). Levenberg, K. (1944). "A Method for the Solution of Certain Non-Linear Problems in Least Squares". \emph{Quarterly of Applied Mathematics}, 2, p. 164--168. Lewis, S.M. and Raftery, A.E. (1997). "Estimating Bayes Factors via Posterior Simulation with the Laplace-Metropolis Estimator". \emph{Journal of the American Statistical Association}, 92, p. 648--655. Marquardt, D. (1963). "An Algorithm for Least-Squares Estimation of Nonlinear Parameters". \emph{SIAM Journal on Applied Mathematics}, 11(2), p. 431--441. Nelder, J.A. and Mead, R. (1965). "A Simplex Method for Function Minimization". \emph{The Computer Journal}, 7(4), p. 308--313. Nocedal, J. and Wright, S.J. (1999). "Numerical Optimization". Springer-Verlag. Riedmiller, M. (1994). "Advanced Supervised Learning in Multi-Layer Perceptrons - From Backpropagation to Adaptive Learning Algorithms". \emph{Computer Standards and Interfaces}, 16, p. 265--278. Shanno, D.F. (1970). "Conditioning of quasi-Newton Methods for Function Minimization". Mathematics of Computation, 24(111), p. 647--650. Tierney, L. and Kadane, J.B. (1986). "Accurate Approximations for Posterior Moments and Marginal Densities". \emph{Journal of the American Statistical Association}, 81(393), p. 82--86. Tierney, L., Kass. R., and Kadane, J.B. (1989). "Fully Exponential Laplace Approximations to Expectations and Variances of Nonpositive Functions". \emph{Journal of the American Statistical Association}, 84(407), p. 710--716. Zelinka, I. (2004). "SOMA - Self Organizing Migrating Algorithm". In: Onwubolu G.C. and Babu, B.V., editors. "New Optimization Techniques in Engineering". Springer: Berlin, Germany. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{BayesFactor}}, \code{\link{BayesianBootstrap}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplacesDemon}}, \code{\link{GIV}}, \code{\link{LML}}, \code{\link{optim}}, \code{\link{PMC}}, \code{\link{SIR}}, and \code{\link{VariationalBayes}}. } \examples{ # The accompanying Examples vignette is a compendium of examples. #################### Load the LaplacesDemon Library ##################### library(LaplacesDemon) ############################## Demon Data ############################### data(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,10]+1))) J <- ncol(X) for (j in 2:J) X[,j] <- CenterScale(X[,j]) ######################### Data List Preparation ######################### mon.names <- "mu[1]" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ########################## Model Specification ########################## Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(Data$X, t(beta)) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + beta.prior + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=mu[1], yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } ############################ Initial Values ############################# #Initial.Values <- GIV(Model, MyData, PGF=TRUE) Initial.Values <- rep(0,J+1) Fit <- LaplaceApproximation(Model, Initial.Values, Data=MyData, Iterations=100, Method="NM", CPUs=1) Fit print(Fit) #PosteriorChecks(Fit) #caterpillar.plot(Fit, Parms="beta") #plot(Fit, MyData, PDF=FALSE) #Pred <- predict(Fit, Model, MyData, CPUs=1) #summary(Pred, Discrep="Chi-Square") #plot(Pred, Style="Covariates", Data=MyData) #plot(Pred, Style="Density", Rows=1:9) #plot(Pred, Style="Fitted") #plot(Pred, Style="Jarque-Bera") #plot(Pred, Style="Predictive Quantiles") #plot(Pred, Style="Residual Density") #plot(Pred, Style="Residuals") #Levene.Test(Pred) #Importance(Fit, Model, MyData, Discrep="Chi-Square") #Fit$Covar is scaled (2.38^2/d) and submitted to LaplacesDemon as Covar. #Fit$Summary[,1] is submitted to LaplacesDemon as Initial.Values. #End } \keyword{Adaptive} \keyword{Bayesian Inference} \keyword{BFGS} \keyword{BHHH} \keyword{Conjugate Gradient} \keyword{DFP} \keyword{Gradient Ascent} \keyword{High Performance Computing} \keyword{Hit-And-Run} \keyword{Hooke-Jeeves} \keyword{Initial Values} \keyword{Limited-Memory BFGS} \keyword{Levenberg-Marquardt} \keyword{Nelder-Mead} \keyword{Newton-Raphson} \keyword{Optimization} \keyword{Particle Swarm Optimization} \keyword{Resilient Backpropagation} \keyword{Self-Organizing Migration Algorithm} \keyword{Spectral Projected Gradient} \keyword{Stochastic Gradient Descent} \keyword{Symmetric Rank-One} \keyword{Trust Region}LaplacesDemon/man/print.miss.Rd0000755000176200001440000000104615144337635016150 0ustar liggesusers\name{print.miss} \alias{print.miss} \title{Print an object of class \code{miss} to the screen} \description{ This may be used to print the contents of an object of class \code{miss} to the screen. } \usage{\method{print}{miss}(x, \dots)} \arguments{ \item{x}{An object of class \code{miss} is required.} \item{\dots}{Additional arguments are unused.} } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{MISS}}. } \examples{### See the MISS function for an example.} \keyword{print} LaplacesDemon/man/Consort.Rd0000755000176200001440000001614415144316355015472 0ustar liggesusers\name{Consort} \alias{Consort} \title{Consort with Laplace's Demon} \description{ This may be used to consort with Laplace's Demon regarding an object of class \code{demonoid}. Laplace's Demon will offer suggestions. } \usage{Consort(object)} \arguments{ \item{object}{This required argument is an object of class \code{demonoid}. For more information, see the \code{\link{LaplacesDemon}} function.} } \details{ First, \code{Consort} calls \code{print.demonoid}, which prints most of the components to the screen from the supplied object of class \code{demonoid}. Second, Laplace's Demon considers a combination of five conditions when making the largest part of its suggestion. These conditions are: the algorithm, acceptance rate, MCSE, ESS, and stationarity. Other things are considered as well, such as the recommended thinning value is used to suggest a new number of iterations, how fast the algorithm is expected to be, and if the condition of diminishing adaptation (also called the vanishing adaptation condition) was met (for an adaptive algorithm). Diminishing adaptation occurs only when the absolute value of the proposed variances trends downward (toward zero) over the course of all adaptations. When an algorithm is adaptive and it does not have diminishing adaptations, the \code{Consort} function will suggest a different adaptive algorithm. The \code{Periodicity} argument is suggested to be set equal to the value of \code{Rec.Thinning}. Appeasement applies only when all parameters are continuous.The \code{\link{Hangartner.Diagnostic}} should be considered for discrete parameters. Appeasement Conditions \itemize{ \item Algorithm: The final algorithm must be non-adaptive, so that the Markov property holds. This is conservative. A user may have an adaptive (non-final) algorithm in which adaptations in the latest update are stationary, or no longer diminishing. Laplace's Demon is unaware of previous updates, and conservatively interprets this as failing to meet the condition of diminishing adaptation, when the output may be satisfactory. On the other hand, if the adaptive algorithm has essentially stopped adapting, and if there is a non-adaptive version, then the user should consider switching to the non-adaptive algorithm. User discretion is advised. \item Acceptance Rate: The acceptance rate is considered satisfactory if it is within the interval [15\%,50\%] for most algorithms. Some algorithms have different recommended intervals. \item MCSE: The Monte Carlo Standard Error (MCSE) is considered satisfactory for each target distribution if it is less than 6.27\% of the standard deviation of the target distribution. This allows the true mean to be within 5\% of the area under a Gaussian distribution around the estimated mean. The \code{\link{MCSE}} function is used. Toft et al. (2007) propose a stricter criterion of 5\%. The criterion of 6.27\% for this stopping rule is arbitrary, and may be too lenient or strict, depending on the needs of the user. Nonetheless, it has performed well, and this type of stopping rule has been observed to perform better than MCMC convergence diagnostics (Flegal et al., 2008). \item ESS: The effective sample size (ESS) is considered satisfactory for each target distribution if it is at least 100, which is usually enough to describe 95\% probability intervals (see \code{\link{p.interval}} and \code{\link{LPL.interval}} for more information). The \code{\link{ESS}} function is used. When this criterion is unmet, the name of the worst mixing chain in Summary1 appears. \item Stationarity: Each target distribution is considered satisfactory if it is estimated to be stationary with the \code{\link{BMK.Diagnostic}} function. } Bear in mind that the MCSE, ESS, and stationarity criteria are all univariate measures applied to each marginal posterior distribution. Multivariate forms are not included. By chance alone due to multiple independent tests, 5\% of these diagnostics should indicate non-convergence when 'convergence' exists. In contrast, even one non-convergent nuisance parameter is associated with non-convergence in all other parameters. Assessing convergence is difficult. If all five conditions are satisfactory, then Laplace's Demon is appeased. Otherwise, Laplace's Demon will suggest and supply R code that is ready to be copy/pasted and executed. To visualize the MCSE-based stopping rule, run the following code: \code{x <- seq(from=-3, to=3, by=0.1);} \code{plot(x, dnorm(x,0,1), type="l");} \code{abline(v=-0.0627); abline(v=0.0627);} \code{abline(v=2*-0.0627, col="red"); abline(v=2*0.0627, col="red")} The black vertical lines show the standard error, and the red vertical lines show the 95\% interval. If the user has an object of class \code{demonoid.hpc}, then the \code{Consort} function may be still be applied, but a particular chain in the object must be specified as a component in a list. For example, with an object called \code{Fit} and a goal of consorting over the second chain, the code would be: \code{Consort(Fit[[2]])}. The Demonic Suggestion is usually very helpful, but should not be followed blindly. Do not let it replace critical thinking. For example, \code{Consort} may find that diminishing adaptation is unmet, and recommend a different algorithm. However, the user may be convinced that the current algorithm is best, and believe instead that MCMC found a local solution, and is leaving it to find the global solution, in which case adaptations may increase again. Diminishing adaptation may have occurred in a previous run, and is not found in the current run because adaptation is essentially finished. If either of these is true, then it may be best to ignore the newly suggested algorithm, and continue with the current algorithm. The suggested code may be helpful, but it is merely a suggestion. If achieving the appeasement of Laplace's Demon is difficult, consider ignoring the MCSE criterion and terminate when all other criteria have been met, placing special emphasis on ESS. } \references{ Flegal, J.M., Haran, M., and Jones, G.L. (2008). "Markov chain Monte Carlo: Can We Trust the Third Significant Figure?". \emph{Statistical Science}, 23, p. 250--260. Toft, N., Innocent, G., Gettinby, G., and Reid, S. (2007). "Assessing the Convergence of Markov Chain Monte Carlo Methods: An Example from Evaluation of Diagnostic Tests in Absence of a Gold Standard". \emph{Preventive Veterinary Medicine}, 79, p. 244--256. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{BMK.Diagnostic}}, \code{\link{ESS}}, \code{\link{Hangartner.Diagnostic}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{LPL.interval}}, \code{\link{MCSE}}, and \code{\link{p.interval}}. } \keyword{Diminishing Adaptation} \keyword{MCMC} LaplacesDemon/man/dist.Multivariate.Normal.Rd0000755000176200001440000000720315144316355020676 0ustar liggesusers\name{dist.Multivariate.Normal} \alias{dmvn} \alias{rmvn} \title{Multivariate Normal Distribution} \description{ These functions provide the density and random number generation for the multivariate normal distribution. } \usage{ dmvn(x, mu, Sigma, log=FALSE) rmvn(n=1, mu, Sigma) } \arguments{ \item{x}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{n}{This is the number of random draws.} \item{mu}{This is mean vector \eqn{\mu}{mu} with length \eqn{k} or matrix with \eqn{k} columns.} \item{Sigma}{This is the \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = \frac{1}{(2\pi)^{k/2}|\Sigma|^{1/2}} \exp(-\frac{1}{2}(\theta - \mu)'\Sigma^{-1}(\theta - \mu))}{p(theta) = (1/((2*pi)^(k/2)*|Sigma|^(1/2))) * exp(-(1/2)*(theta-mu)'*Sigma^(-1)*(theta-mu))} \item Inventors: Robert Adrain (1808), Pierre-Simon Laplace (1812), and Francis Galton (1885) \item Notation 1: \eqn{\theta \sim \mathcal{MVN}(\mu, \Sigma)}{theta ~ MVN(mu, Sigma)} \item Notation 2: \eqn{\theta \sim \mathcal{N}_k(\mu, \Sigma)}{theta ~ N[k](mu, Sigma)} \item Notation 3: \eqn{p(\theta) = \mathcal{MVN}(\theta | \mu, \Sigma)}{p(theta) = MVN(theta | mu, Sigma)} \item Notation 4: \eqn{p(\theta) = \mathcal{N}_k(\theta | \mu, \Sigma)}{p(theta) = N[k](theta | mu, Sigma)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = \Sigma}{var(theta) = Sigma} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate normal distribution, or multivariate Gaussian distribution, is a multidimensional extension of the one-dimensional or univariate normal (or Gaussian) distribution. A random vector is considered to be multivariate normally distributed if every linear combination of its components has a univariate normal distribution. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k} and a \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma}, which must be positive-definite. The conjugate prior of the mean vector is another multivariate normal distribution. The conjugate prior of the covariance matrix is the inverse Wishart distribution (see \code{\link{dinvwishart}}). When applicable, the alternative Cholesky parameterization should be preferred. For more information, see \code{\link{dmvnc}}. For models where the dependent variable, Y, is specified to be distributed multivariate normal given the model, the Mardia test (see \code{\link{plot.demonoid.ppc}}, \code{\link{plot.laplace.ppc}}, or \code{\link{plot.pmc.ppc}}) may be used to test the residuals. } \value{ \code{dmvn} gives the density and \code{rmvn} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dinvwishart}}, \code{\link{dmatrixnorm}}, \code{\link{dmvnc}}, \code{\link{dmvnp}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, \code{\link{plot.demonoid.ppc}}, \code{\link{plot.laplace.ppc}}, and \code{\link{plot.pmc.ppc}}. } \examples{ library(LaplacesDemon) x <- dmvn(c(1,2,3), c(0,1,2), diag(3)) X <- rmvn(1000, c(0,1,2), diag(3)) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/dist.Multivariate.Cauchy.Precision.Cholesky.Rd0000755000176200001440000001132615144316355024375 0ustar liggesusers\name{dist.Multivariate.Cauchy.Precision.Cholesky} \alias{dmvcpc} \alias{rmvcpc} \title{Multivariate Cauchy Distribution: Precision-Cholesky Parameterization} \description{ These functions provide the density and random number generation for the multivariate Cauchy distribution. These functions use the precision and Cholesky parameterization. } \usage{ dmvcpc(x, mu, U, log=FALSE) rmvcpc(n=1, mu, U) } \arguments{ \item{x}{This is either a vector of length \eqn{k} or a matrix with a number of columns, \eqn{k}, equal to the number of columns in precision matrix \eqn{\Omega}{Omega}.} \item{n}{This is the number of random draws.} \item{mu}{This is a numeric vector representing the location parameter, \eqn{\mu}{mu} (the mean vector), of the multivariate distribution. It must be of length \eqn{k}, as defined above.} \item{U}{This is the \eqn{k \times k}{k x k} upper-triangular matrix that is Cholesky factor \eqn{\textbf{U}}{U} of the positive-definite precision matrix \eqn{\Omega}{Omega}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{\Gamma((1+k)/2)}{\Gamma(1/2)1^{k/2}\pi^{k/2}} |\Omega|^{1/2} (1 + (\theta-\mu)^T \Omega (\theta-\mu))^{-(1+k)/2}}{p(theta) = (Gamma((nu+k)/2) / (Gamma(1/2)*1^(k/2)*pi^(k/2))) * |Omega|^(1/2) * (1 + (theta-mu)^T Omega (theta-mu))^(-(1+k)/2)} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathcal{MC}_k(\mu, \Omega^{-1})}{theta ~ MC[k](mu, Omega^(-1))} \item Notation 2: \eqn{p(\theta) = \mathcal{MC}_k(\theta | \mu, \Omega^{-1})}{p(theta) = MC[k](theta | mu, Omega^(-1))} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = }{var(theta) = } \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate Cauchy distribution is a multidimensional extension of the one-dimensional or univariate Cauchy distribution. A random vector is considered to be multivariate Cauchy-distributed if every linear combination of its components has a univariate Cauchy distribution. The multivariate Cauchy distribution is equivalent to a multivariate t distribution with 1 degree of freedom. The Cauchy distribution is known as a pathological distribution because its mean and variance are undefined, and it does not satisfy the central limit theorem. It is usually parameterized with mean and a covariance matrix, or in Bayesian inference, with mean and a precision matrix, where the precision matrix is the matrix inverse of the covariance matrix. These functions provide the precision parameterization for convenience and familiarity. It is easier to calculate a multivariate Cauchy density with the precision parameterization, because a matrix inversion can be avoided. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k}, and a \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega}, which must be positive-definite. The precision matrix is replaced with the upper-triangular Cholesky factor, as in \code{\link{chol}}. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dmvcp}, \code{dmvcpc} must additionally matrix-multiply the Cholesky back to the covariance matrix, but it does not have to check for or correct the precision matrix to positive-definiteness, which overall is slower. Compared with \code{rmvcp}, \code{rmvcpc} is faster because the Cholesky decomposition has already been performed. } \value{ \code{dmvcpc} gives the density and \code{rmvcpc} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{chol}}, \code{\link{dcauchy}}, \code{\link{dmvcc}}, \code{\link{dmvtc}}, \code{\link{dmvtpc}}, and \code{\link{dwishartc}}. } \examples{ library(LaplacesDemon) x <- seq(-2,4,length=21) y <- 2*x+10 z <- x+cos(y) mu <- c(1,12,2) Omega <- matrix(c(1,2,0,2,5,0.5,0,0.5,3), 3, 3) U <- chol(Omega) f <- dmvcpc(cbind(x,y,z), mu, U) X <- rmvcpc(1000, rep(0,2), diag(2)) X <- X[rowSums((X >= quantile(X, probs=0.025)) & (X <= quantile(X, probs=0.975)))==2,] joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution} LaplacesDemon/man/is.bayesian.Rd0000755000176200001440000000276415144316355016253 0ustar liggesusers\name{is.bayesian} \alias{is.bayesian} \title{Logical Check of a Bayesian Model} \description{ This function provides a logical test of whether or not a \code{Model} specification function is Bayesian. } \usage{ is.bayesian(Model, Initial.Values, Data) } \arguments{ \item{Model}{This is a model specification function. For more information, see the \code{\link{LaplacesDemon}} function.} \item{Initial.Values}{This is a vector of initial values, or current parameter values. For more information, see the \code{\link{LaplacesDemon}} function.} \item{Data}{This is a list of data. For more information, see the \code{\link{LaplacesDemon}} function.} } \details{ This function tests whether or not a model is Bayesian by comparing the first two returned arguments: the logarithm of the unnormalized joint posterior density (\code{LP}) and deviance (\code{Dev}). The deviance (D) is \deqn{\mathrm{D} = -2 \mathrm{LL}}{D = -2 LL}, where LL is the log-likelihood. Consequently, \deqn{\mathrm{LL} = \mathrm{D} / -2}{LL = D / -2}, and LP is the sum of LL and prior probability densities. If LP = LL, then the model is not Bayesian, because prior densities are absent. } \value{ The \code{is.bayesian} function returns a logical value of \code{TRUE} when the model is Bayesian, and \code{FALSE} otherwise. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{LaplacesDemon}}. } \keyword{Utility}LaplacesDemon/man/log-log.Rd0000755000176200001440000000330615144316355015377 0ustar liggesusers\name{log-log} \alias{cloglog} \alias{invcloglog} \alias{invloglog} \alias{loglog} \title{The log-log and complementary log-log functions} \description{ The log-log and complementary log-log functions, as well as the inverse functions, are provided. } \usage{ cloglog(p) invcloglog(x) invloglog(x) loglog(p) } \arguments{ \item{x}{This is a vector of real values that will be transformed to the interval [0,1].} \item{p}{This is a vector of probabilities p in the interval [0,1] that will be transformed to the real line.} } \details{ The logit and probit links are symmetric, because the probabilities approach zero or one at the same rate. The log-log and complementary log-log links are asymmetric. Complementary log-log links approach zero slowly and one quickly. Log-log links approach zero quickly and one slowly. Either the log-log or complementary log-log link will tend to fit better than logistic and probit, and are frequently used when the probability of an event is small or large. A mixture of the two links, the log-log and complementary log-log is often used, where each link is weighted. The reason that logit is so prevalent is because logistic parameters can be interpreted as odds ratios. } \value{ \code{cloglog} returns \code{x}, \code{invcloglog} and \code{invloglog} return probability \code{p}, and \code{loglog} returns \code{x}. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{LaplacesDemon}}} \examples{ library(LaplacesDemon) x <- -5:5 p <- invloglog(x) x <- loglog(p) } \keyword{Complementary log-log} \keyword{Link Function} \keyword{log-log} \keyword{Transformation} LaplacesDemon/man/PMC.Rd0000755000176200001440000004526615144337635014475 0ustar liggesusers\name{PMC} \alias{PMC} \title{Population Monte Carlo} \description{ The \code{PMC} function updates a model with Population Monte Carlo. Given a model specification, data, and initial values, \code{PMC} maximizes the logarithm of the unnormalized joint posterior density and provides samples of the marginal posterior distributions, deviance, and other monitored variables. } \usage{ PMC(Model, Data, Initial.Values, Covar=NULL, Iterations=10, Thinning=1, alpha=NULL, M=1, N=1000, nu=9, CPUs=1, Type="PSOCK") } \arguments{ \item{Model}{This is a model specification function. For more information, see \code{\link{LaplacesDemon}}.} \item{Initial.Values}{This is either a vector initial values, one for each of \eqn{K} parameters, or in the case of a mixture of \eqn{M} components, this is a \eqn{M \times K}{M x K} matrix of initial values. If all initial values are zero in this vector, or in the first row of a matrix, then \code{\link{LaplaceApproximation}} is used to optimize initial values, in which case all mixture components receive the same initial values and covariance matrix from the object of class \code{laplace}. Parameters must be continuous.} \item{Data}{This is a list of data. For more information, see \code{\link{LaplacesDemon}}.} \item{Covar}{This is a \eqn{K \times K}{K x K} covariance matrix for \eqn{K} parameters, or for multiple mixture components, this is a \eqn{K \times K \times M}{K x K x M} array of \eqn{M} covariance matrices, where \eqn{M} is the number of mixture components. \code{Covar} defaults to \code{NULL}, in which case a scaled identity matrix (with the same scale as in \code{\link{LaplacesDemon}}) is applied to all mixture components.} \item{Iterations}{This is the number of iterations during which PMC will update the model. Updating the model for only one iteration is the same as applying non-adaptive importance sampling.} \item{Thinning}{This is the number by which the posterior is thinned. To have 1,000 posterior samples with \code{M=3} mixture components and \code{N=10000} samples each, \code{Thinning=30}. For more information, see the \code{\link{Thin}} function.} \item{alpha}{This is a vector of length \eqn{M}, the number of mixture components. \eqn{\alpha}{alpha} is the probability of each mixture component. The default value is \code{NULL}, which assigns an equal probability to each component.} \item{M}{This is the number \eqn{M} of multivariate t distribution mixture components.} \item{N}{This is the number \eqn{N} of samples per mixture component. The required number of samples increases with the number \eqn{K} of parameters. These samples are also called walkers or particles.} \item{nu}{This is the degrees of freedom parameter \eqn{\nu}{nu} for the multivariate t distribution for each mixture component. If a multivariate normal distribution is preferred, then set \eqn{\nu > 1e4}{nu > 1e4}.} \item{CPUs}{This argument is required for parallel processing, and and indicates the number of central processing units (CPUs) of the computer or cluster. For example, when a user has a quad-core computer, \code{CPUs=4}.} \item{Type}{This argument defaults to \code{"PSOCK"} and uses the Simple Network of Workstations (SNOW) for parallelization. Alternatively, \code{Type="MPI"} may be specified to use Message Passing Interface (MPI) for parallelization.} } \details{ The \code{PMC} function uses the adaptive importance sampling algorithm of Wraith et al. (2009), also called Mixture PMC or M-PMC (Cappe et al., 2008). Iterative adaptive importance sampling was introduced in the 1980s. Modern PMC was introduced (Cappe et al., 2004), and extended to multivariate Gaussian or t-distributed mixtures (Cappe et al., 2008). This version uses a multivariate t distribution for each mixture component, and also allows a multivariate normal distribution when the degrees of freedom, \eqn{\nu > 1e4}{nu > 1e4}. At each iteration, a mixture distribution is sampled with importance sampling, and the samples (or populations) are adapted to improve the importance sampling. Adaptation is a variant of EM (Expectation-Maximization). The sample is self-normalized, and is an example of self-normalized importance sampling (SNIS), or self-importance sampling. The vector \eqn{\alpha}{alpha} contains the probability of each mixture component. These, as well as multivariate t distribution mixture parameters (except \eqn{\nu}{nu}), are adapted each iteration. Advantages of PMC over MCMC include: \itemize{ \item It is difficult to assess convergence of MCMC chains, and this is not necessary in PMC (Wraith et al., 2009). \item MCMC chains have autocorrelation that effectively reduces posterior samples. PMC produces independent samples that are not reduced with autocorrelation. \item PMC has been reported to produce samples with less variance than MCMC. \item It is difficult to parallelize MCMC. Posterior samples from parallel chains can be pooled when all chains have converged, but until this occurs, parallelization is unhelpful. PMC, on the other hand, can parallelize the independent, Monte Carlo samples during each iteration and reduce run-time as the number of processors increases. Currently, PMC is not parallelized here. \item The multivariate mixture in PMC can represent a multimodal posterior, where MCMC with parallel chains may be used to identify a multimodal posterior, but probably will not yield combined samples that proportionally represent it. } Disadvantages of PMC, compared to MCMC, include: \itemize{ \item In PMC, the required number of samples at each iteration increases quickly with respect to an increase in parameters. MCMC is more suitable for models with large numbers of parameters, and therefore, MCMC is more generalizable. \item PMC is more sensitive to initial values than MCMC, especially as the number of parameters increases. \item PMC is more sensitive to the initial covariance matrix (or matrices for mixture components) than adaptive MCMC. PMC requires more information about the target distributions before updating. The covariance matrix from a converged iterative quadrature algorithm, Laplace Approximation, or Variational Bayes may be required (see \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, or \code{\link{VariationalBayes}} for more information). } Since PMC requires better initial information than iterative quadrature, Laplace Approximation, MCMC, and Variational Bayes, it is not recommended to begin updating a model that has little prior information with PMC, especially when the model has more than a few parameters. Instead, iterative quadrature, Laplace Approximation, MCMC, or Variational Bayes should be used. However, once convergence is found or assumed, it is recommended to attempt to update the model with PMC, given the latest parameters and convariance matrix from iterative quadrature, Laplace Approximation, MCMC, or Variational Bayes. Used in this way, PMC may improve the model fit obtained with MCMC and should reduce the variance of the marginal posterior distributions, which is desirable for predictive modeling. Convergence is assessed by observing two outputs: normalized effective sample size (\code{ESSN}) and normalized perplexity (\code{Perplexity}). These are described below. PMC is considered to have converged when these diagnostics stabilize (Wraith et al., 2009), or when the normalized perplexity becomes sufficiently close to 1 (Cappe et al., 2008). If they do not stabilize, then it is suggested to begin PMC again with a larger number \code{N} of samples, and possibly with different initial values and covariance matrix or matrices. \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, or \code{\link{VariationalBayes}} may be helpful to provide better starting values for \code{PMC}. If a message appears that warns about `bad weights', then \code{PMC} is attempting to work with an iteration in which importance weights are problematic. If this occurs in the first iteration, then all importance weights are set to \eqn{1/N}. If this occurs in other iterations, then the information from the previous iteration is used instead and different draws are made from that importance distribution. This may allow \code{PMC} to eventually adapt successfully to the target. If not, the user is advised to begin again with a larger number \eqn{N} of samples, and possibly different initial values and covariance matrix or matrices, as above. PMC can experience difficulty when it begins with poor initial conditions. The user may combine samples from previous iterations with samples from the latest iteration for inference, if the algorithm converged before the last iteration. Currently, a function is not provided for combining previous samples. } \value{ The returned object is an object of class \code{pmc} with the following components: \item{alpha}{This is a \eqn{M \times T}{M x T} matrix of the probabilities of mixture components, where \eqn{M} is the number of mixture components and \eqn{T} is the number of iterations.} \item{Call}{This is the matched call of \code{PMC}.} \item{Covar}{This stores the \eqn{K \times K \times T \times M}{K x K x T x M} proposal covariance matrix in an array, where \eqn{K} is the dimension or number of parameters or initial values, \eqn{T} is the number of iterations, and \eqn{M} is the number of mixture components. If the model is updated in the future, then the latest covariance matrix for each mixture component can be extracted and used to start the next update where the last update left off.} \item{Deviance}{This is a vector of the deviance of the model, with a length equal to the number of thinned samples that were retained. Deviance is useful for considering model fit, and is equal to the sum of the log-likelihood for all rows in the data set, which is then multiplied by negative two.} \item{DIC}{This is a vector of three values: Dbar, pD, and DIC. Dbar is the mean deviance, pD is a measure of model complexity indicating the effective number of parameters, and DIC is the Deviance Information Criterion, which is a model fit statistic that is the sum of Dbar and pD. \code{DIC} is calculated over the thinned samples. Note that pD is calculated as \code{var(Deviance)/2} as in Gelman et al. (2004).} \item{ESSN}{This is a vector of length \eqn{T} that contains the normalized effective sample size (ESSN) per iteration across \eqn{T} iterations. ESSN is used as a convergence diagnostic. ESSN is normalized between zero and one, and can be interpreted as the proportion of samples with non-zero weight. Higher is better.} \item{Initial.Values}{This is the vector or matrix of \code{Initial.Values}.} \item{Iterations}{This reports the number of \code{Iterations} for updating.} \item{LML}{This is an approximation of the logarithm of the marginal likelihood of the data (see the \code{\link{LML}} function for more information). \code{LML} is estimated with nonparametric self-normalized importance sampling (NSIS), given LL and the marginal posterior samples of the parameters. \code{LML} is useful for comparing multiple models with the \code{\link{BayesFactor}} function.} \item{M}{This reports the number of mixture components.} \item{Minutes}{This indicates the number of minutes that \code{PMC} was running, and this includes the initial checks as well as time it took to perform final sampling and create summaries.} \item{Model}{This contains the model specification \code{Model}.} \item{N}{This is the number of un-thinned samples per mixture component.} \item{nu}{This is the degrees of freedom parameter \eqn{\nu}{nu} for each multivariate t distribution in each mixture component.} \item{Mu}{This is a \eqn{T \times K \times M}{T x K x M} array of means for the importance sampling distribution across \eqn{T} iterations, \eqn{K} parameters, and \eqn{M} mixture components.} \item{Monitor}{This is a \eqn{S \times J}{S x J} matrix of thinned samples of monitored variables, where \eqn{S} is the number of thinned samples and \eqn{J} is the number of monitored variables.} \item{Parameters}{This reports the number \eqn{K} of parameters.} \item{Perplexity}{This is a vector of length \eqn{T} that contains the normalized perplexity per iteration across \eqn{T} iterations, and is used as a convergence diagnostic. Perplexity is an approximation of the negative of the Kullback-Leibler divergence (see \code{\link{KLD}}) between the target and the importance function. Perplexity is normalized between zero and one, and a higher normalized perplexity relates to less divergence, so higher is better. A normalized perplexity that is close to one indicates good agreement between the target density and the importance function. This is based on the Shannon entropy of the normalized importance weights, which is used frequently to measure the quality of importance samples.} \item{Posterior1}{This is an \eqn{N \times K \times T \times M}{N x K x T x M} array of un-thinned posterior samples across \eqn{N} samples, \eqn{K} parameters, \eqn{T} iterations, and \eqn{M} mixture components.} \item{Posterior2}{This is a \eqn{S \times K}{S x K} matrix of thinned posterior samples, where \eqn{S} is the number of thinned samples and \eqn{K} is the number of parameters.} \item{Summary}{This is a matrix that summarizes the marginal posterior distributions of the parameters, deviance, and monitored variables from thinned samples. The following summary statistics are included: mean, standard deviation, MCSE (Monte Carlo Standard Error), ESS is the effective sample size due to autocorrelation, and finally the 2.5\%, 50\%, and 97.5\% quantiles are reported. MCSE is essentially a standard deviation around the marginal posterior mean that is due to uncertainty associated with using Monte Carlo sampling. The acceptable size of the MCSE depends on the acceptable uncertainty associated around the marginal posterior mean. The default \code{IMPS} method is used. Next, the desired precision of ESS depends on the user's goal.} \item{Thinned.Samples}{This is the number of thinned samples in \code{Posterior2}.} \item{Thinning}{This is the amount of thinning requested by the user.} \item{W}{This is a \eqn{N \times T}{N x T} matrix of normalized importance weights, where \eqn{N} is the number of un-thinned samples per mixture component and \eqn{T} is the number of iterations. Computationally, the algorithm uses the logarithm of the weights.} } \references{ Cappe, O., Douc, R., Guillin, A., Marin, J.M., and Robert, C. (2008). "Adaptive Importance Sampling in General Mixture Classes". \emph{Statistics and Computing}, 18, p. 587--600. Cappe, O., Guillin, A., Marin, J.M., and Robert, C. (2004). "Population Monte Carlo". \emph{Journal of Computational and Graphical Statistics}, 13, p. 907--929. Gelman, A., Carlin, J., Stern, H., and Rubin, D. (2004). "Bayesian Data Analysis, Texts in Statistical Science, 2nd ed.". Chapman and Hall, London. Wraith, D., Kilbinger, M., Benabed, K., Cappe, O., Cardoso, J.F., Fort, G., Prunet, S., and Robert, C.P. (2009). "Estimation of Cosmological Parameters Using Adaptive Importance Sampling". \emph{Physical Review D}, 80(2), p. 023507. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{BayesFactor}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LML}}, \code{\link{PMC.RAM}}, \code{\link{Thin}}, and \code{\link{VariationalBayes}}. } \examples{ # The accompanying Examples vignette is a compendium of examples. #################### Load the LaplacesDemon Library ##################### library(LaplacesDemon) ############################## Demon Data ############################### data(demonsnacks) y <- log(demonsnacks$Calories) X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) J <- ncol(X) for (j in 2:J) X[,j] <- CenterScale(X[,j]) ######################### Data List Preparation ######################### mon.names <- "LP" parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) pos.beta <- grep("beta", parm.names) pos.sigma <- grep("sigma", parm.names) PGF <- function(Data) { beta <- rnorm(Data$J) sigma <- runif(1) return(c(beta, sigma)) } MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) ########################## Model Specification ########################## Model <- function(parm, Data) { ### Parameters beta <- parm[Data$pos.beta] sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) parm[Data$pos.sigma] <- sigma ### Log-Prior beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood mu <- tcrossprod(Data$X, t(beta)) LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) ### Log-Posterior LP <- LL + beta.prior + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } set.seed(666) ############################ Initial Values ############################# Initial.Values <- GIV(Model, MyData, PGF=TRUE) ######################## Population Monte Carlo ######################### Fit <- PMC(Model, MyData, Initial.Values, Covar=NULL, Iterations=5, Thinning=1, alpha=NULL, M=1, N=100, CPUs=1) Fit print(Fit) PosteriorChecks(Fit) caterpillar.plot(Fit, Parms="beta") plot(Fit, BurnIn=0, MyData, PDF=FALSE) Pred <- predict(Fit, Model, MyData, CPUs=1) summary(Pred, Discrep="Chi-Square") plot(Pred, Style="Covariates", Data=MyData) plot(Pred, Style="Density", Rows=1:9) plot(Pred, Style="ECDF") plot(Pred, Style="Fitted") plot(Pred, Style="Jarque-Bera") plot(Pred, Style="Predictive Quantiles") plot(Pred, Style="Residual Density") plot(Pred, Style="Residuals") Levene.Test(Pred) Importance(Fit, Model, MyData, Discrep="Chi-Square") #End } \keyword{High Performance Computing} \keyword{Importance Sampling} \keyword{Monte Carlo}LaplacesDemon/man/dist.Pareto.Rd0000755000176200001440000000555415144316355016242 0ustar liggesusers\name{dist.Pareto} \alias{dpareto} \alias{ppareto} \alias{qpareto} \alias{rpareto} \title{Pareto Distribution} \description{ These functions provide the density, distribution function, quantile function, and random generation for the pareto distribution. } \usage{ dpareto(x, alpha, log=FALSE) ppareto(q, alpha) qpareto(p, alpha) rpareto(n, alpha) } \arguments{ \item{x,q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{alpha}{This is the shape parameter \eqn{\alpha}{alpha}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density or result is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{\alpha}{\theta^{\alpha+1}}, \theta \ge 1}{p(theta) = alpha / theta^(alpha + 1), theta >= 1} \item Inventor: Vilfredo Pareto (1848-1923) \item Notation 1: \eqn{\theta \sim \mathcal{PA}(\alpha)}{theta ~ PA(alpha)} \item Notation 2: \eqn{p(\theta) = \mathcal{PA}(\theta | \alpha)}{p(theta) = PA(theta | alpha)} \item Parameter 1: shape parameter \eqn{\alpha > 0}{alpha > 0} \item Mean: \eqn{E(\theta) = \frac{\alpha}{\alpha - 1}}{E(theta) = alpha / (alpha - 1)} \item Variance: \eqn{var(\theta) = \frac{\alpha}{(\alpha-1)^2(\alpha-2)}, \alpha > 2}{var(theta) = alpha / (alpha - 1)^2 (alpha - 2), alpha > 2} \item Mode: \eqn{mode(\theta) = 1}{mode(theta) = 1} } The Pareto distribution, sometimes called the Bradford distribution, is related to the exponential distribution. The gamma distribution is the conjugate prior distribution for the shape parameter \eqn{\alpha}{alpha} in the Pareto distribution. The Pareto distribution is the conjugate prior distribution for the range parameters of a uniform distribution. An extension, elsewhere, is the symmetric Pareto distribution. } \value{ \code{dpareto} gives the density, \code{ppareto} gives the distribution function, \code{qpareto} gives the quantile function, and \code{rpareto} generates random deviates. } \seealso{ \code{\link{dexp}}, \code{\link{dlnorm}}, \code{\link{dlnormp}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}. } \examples{ library(LaplacesDemon) x <- dpareto(1,1) x <- ppareto(0.5,1) x <- qpareto(0.5,1) x <- rpareto(10,1) #Plot Probability Functions x <- seq(from=1, to=5, by=0.01) plot(x, dpareto(x,0.1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dpareto(x,0.5), type="l", col="green") lines(x, dpareto(x,1), type="l", col="blue") legend(2, 0.9, expression(alpha==0.1, alpha==0.5, alpha==1), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/plot.vb.Rd0000755000176200001440000000434415144316355015426 0ustar liggesusers\name{plot.vb} \alias{plot.vb} \title{Plot the output of \code{\link{VariationalBayes}}} \description{ This may be used to plot, or save plots of, the iterated history of the parameters and variances, and if posterior samples were taken, density plots of parameters and monitors in an object of class \code{vb}. } \usage{\method{plot}{vb}(x, Data, PDF=FALSE, Parms, \dots)} \arguments{ \item{x}{ This required argument is an object of class \code{vb}.} \item{Data}{ This required argument must receive the list of data that was supplied to \code{\link{VariationalBayes}} to create the object of class \code{vb}.} \item{PDF}{ This logical argument indicates whether or not the user wants Laplace's Demon to save the plots as a .pdf file.} \item{Parms}{ This argument accepts a vector of quoted strings to be matched for selecting parameters for plotting. This argument defaults to \code{NULL} and selects every parameter for plotting. Each quoted string is matched to one or more parameter names with the \code{grep} function. For example, if the user specifies \code{Parms=c("eta", "tau")}, and if the parameter names are beta[1], beta[2], eta[1], eta[2], and tau, then all parameters will be selected, because the string \code{eta} is within \code{beta}. Since \code{grep} is used, string matching uses regular expressions, so beware of meta-characters, though these are acceptable: ".", "[", and "]".} \item{\dots}{Additional arguments are unused.} } \details{ The plots are arranged in a \eqn{3 \times 3}{3 x 3} matrix. The purpose of the iterated history plots is to show how the value of each parameter, variance, and the deviance changed by iteration as the \code{\link{VariationalBayes}} attempted to maximize the logarithm of the unnormalized joint posterior density. If the algorithm converged, and if \code{sir=TRUE} in \code{\link{VariationalBayes}}, then plots are produced of selected parameters and all monitored variables. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{VariationalBayes}}} \examples{### See the VariationalBayes function for an example.} \keyword{Plot}LaplacesDemon/man/predict.vb.Rd0000755000176200001440000001153315144316355016100 0ustar liggesusers\name{predict.vb} \alias{predict.vb} \title{Posterior Predictive Checks} \description{ This may be used to predict either new, unobserved instances of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{new}}{y[new]}) or replicates of \eqn{\textbf{y}}{y} (called \eqn{\textbf{y}^{rep}}{y[rep]}), and then perform posterior predictive checks. Either \eqn{\textbf{y}^{new}}{y[new]} or \eqn{\textbf{y}^{rep}}{y[rep]} is predicted given an object of class \code{vb}, the model specification, and data. This function requires that posterior samples were produced with \code{\link{VariationalBayes}}. } \usage{\method{predict}{vb}(object, Model, Data, CPUs=1, Type="PSOCK", \dots)} \arguments{ \item{object}{An object of class \code{vb} is required.} \item{Model}{The model specification function is required.} \item{Data}{A data set in a list is required. The dependent variable is required to be named either \code{y} or \code{Y}.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} \item{\dots}{Additional arguments are unused.} } \details{ Since Variational Bayes characterizes marginal posterior distributions with modes and variances, and posterior predictive checks involve samples, the \code{predict.vb} function requires the use of independent samples of the marginal posterior distributions, provided by \code{\link{VariationalBayes}} when \code{sir=TRUE}. The samples of the marginal posterior distributions of the target distributions (the parameters) are passed along with the data to the \code{Model} specification and used to draw samples from the deviance and monitored variables. At the same time, the fourth component in the returned list, which is labeled \code{yhat}, is a vector of expectations of \eqn{\textbf{y}}{y}, given the samples, model specification, and data. To predict \eqn{\textbf{y}^{rep}}{y[rep]}, simply supply the data set used to estimate the model. To predict \eqn{\textbf{y}^{new}}{y[new]}, supply a new data set instead (though for some model specifications, this cannot be done, and \eqn{\textbf{y}_{new}}{y[new]} must be specified in the \code{Model} function). If the new data set does not have \eqn{\textbf{y}}{y}, then create \code{y} in the list and set it equal to something sensible, such as \code{mean(y)} from the original data set. The variable \code{y} must be a vector. If instead it is matrix \code{Y}, then it will be converted to vector \code{y}. The vectorized length of \code{y} or \code{Y} must be equal to the vectorized length of \code{yhat}, the fourth component of the returned list of the \code{Model} function. Parallel processing may be performed when the user specifies \code{CPUs} to be greater than one, implying that the specified number of CPUs exists and is available. Parallelization may be performed on a multicore computer or a computer cluster. Either a Simple Network of Workstations (SNOW) or Message Passing Interface is used (MPI). With small data sets and few samples, parallel processing may be slower, due to computer network communication. With larger data sets and more samples, the user should experience a faster run-time. For more information on posterior predictive checks, see \url{https://web.archive.org/web/20150215050702/http://www.bayesian-inference.com/posteriorpredictivechecks}. } \value{ This function returns an object of class \code{vb.ppc} (where ``ppc'' stands for posterior predictive checks). The returned object is a list with the following components: \item{y}{ This stores \eqn{\textbf{y}}{y}, the dependent variable.} \item{yhat}{ This is a \eqn{N \times S}{N x S} matrix, where \eqn{N} is the number of records of \eqn{\textbf{y}}{y} and \eqn{S} is the number of posterior samples.} \item{Deviance}{ This is a vector of length \eqn{S}, where \eqn{S} is the number of independent posterior samples. Samples are obtained with the sampling importance resampling algorithm, \code{\link{SIR}}.} \item{monitor}{ This is a \eqn{N \times S}{N x S} matrix, where \eqn{N} is the number of monitored variables and \eqn{S} is the number of independent posterior samples. Samples are obtained with the sampling importance resampling algorithm, \code{\link{SIR}}.} } \author{Statisticat, LLC.} \seealso{ \code{\link{SIR}} and \code{\link{VariationalBayes}}. } \keyword{High Performance Computing} \keyword{Posterior Predictive Checks} \keyword{Predict} LaplacesDemon/man/plot.bmk.Rd0000755000176200001440000000440515144316355015566 0ustar liggesusers\name{plot.bmk} \alias{plot.bmk} \title{Plot Hellinger Distances} \description{ This function plots Hellinger distances in an object of class \code{bmk}. } \usage{ \method{plot}{bmk}(x, col=colorRampPalette(c("black","red"))(100), title="", PDF=FALSE, Parms=NULL, \dots) } \arguments{ \item{x}{This required argument is an object of class \code{bmk}. See the \code{\link{BMK.Diagnostic}} function for more information.} \item{col}{This argument specifies the colors of the cells. By default, the \code{colorRampPalette} function colors large Hellinger distances as \code{red}, small as \code{black}, and provides 100 color gradations.} \item{title}{This argument specifies the title of the plot, and the default does not include a title.} \item{PDF}{Logical. When \code{TRUE}, the plot is saved as a .pdf file.} \item{Parms}{ This argument accepts a vector of quoted strings to be matched for selecting parameters for plotting. This argument defaults to \code{NULL} and selects every parameter for plotting. Each quoted string is matched to one or more parameter names with the \code{grep} function. For example, if the user specifies \code{Parms=c("eta", "tau")}, and if the parameter names are beta[1], beta[2], eta[1], eta[2], and tau, then all parameters will be selected, because the string \code{eta} is within \code{beta}. Since \code{grep} is used, string matching uses regular expressions, so beware of meta-characters, though these are acceptable: ".", "[", and "]".} \item{\dots}{Additional arguments are unused.} } \details{ The \code{plot.bmk} function plots the Hellinger distances in an object of class \code{bmk}. This is useful for quickly finding portions of chains with large Hellinger distances, which indicates non-stationarity and non-convergence. } \seealso{\code{\link{BMK.Diagnostic}}} \examples{ library(LaplacesDemon) N <- 1000 #Number of posterior samples J <- 10 #Number of parameters Theta <- matrix(runif(N*J),N,J) colnames(Theta) <- paste("beta[", 1:J, "]", sep="") for (i in 2:N) {Theta[i,1] <- Theta[i-1,1] + rnorm(1)} HD <- BMK.Diagnostic(Theta, batches=10) plot(HD, title="Hellinger distance between batches") } \keyword{Plot}LaplacesDemon/man/LPL.interval.Rd0000755000176200001440000001563215144316355016316 0ustar liggesusers\name{LPL.interval} \alias{LPL.interval} \title{Lowest Posterior Loss Interval} \description{ This function returns the Lowest Posterior Loss (LPL) interval for one parameter, given samples from the density of its prior distribution and samples of the posterior distribution. } \usage{ LPL.interval(Prior, Posterior, prob=0.95, plot=FALSE, PDF=FALSE) } \arguments{ \item{Prior}{This is a vector of samples of the prior density.} \item{Posterior}{This is a vector of posterior samples.} \item{prob}{This is a numeric scalar in the interval (0,1) giving the Lowest Posterior Loss (LPL) interval, and defaults to 0.95, representing a 95\% LPL interval.} \item{plot}{Logical. When \code{plot=TRUE}, two plots are produced. The top plot shows the expected posterior loss. The LPL region is shaded black, and the area outside the region is gray. The bottom plot shows LPL interval of \eqn{\theta}{theta} on the kernel density of \eqn{\theta}{theta}. Again, the LPL region is shaded black, and the outside area is gray. A vertical, red, dotted line is added at zero for both plots. The \code{plot} argument defaults to \code{FALSE}. The plot treats the distribution as if it were unimodal; disjoint regions are not estimated here. If multimodality should result in disjoint regions, then consider using HPD intervals in the \code{\link{p.interval}} function.} \item{PDF}{Logical. When \code{PDF=TRUE}, and only when \code{plot=TRUE}, plots are saved as a .pdf file in the working directory.} } \details{ The Lowest Posterior Loss (LPL) interval (Bernardo, 2005), or LPLI, is a probability interval based on intrinsic discrepancy loss between prior and posterior distributions. The expected posterior loss is the loss associated with using a particular value \eqn{\theta_i \in \theta}{theta[i] in theta} of the parameter as the unknown true value of \eqn{\theta}{theta} (Bernardo, 2005). Parameter values with smaller expected posterior loss should always be preferred. The LPL interval includes a region in which all parameter values have smaller expected posterior loss than those outside the region. Although any loss function could be used, the loss function should be invariant under reparameterization. Any intrinsic loss function is invariant under reparameterization, but not necessarily invariant under one-to-one transformations of data \eqn{\textbf{x}}{x}. When a loss function is also invariant under one-to-one transformations, it is usually also invariant when reduced to a sufficient statistic. Only an intrinsic loss function that is invariant when reduced to a sufficient statistic should be considered. The intrinsic discrepancy loss is easily a superior loss function to the overused quadratic loss function, and is more appropriate than other popular measures, such as Hellinger distance, Kullback-Leibler divergence (\code{\link{KLD}}), and Jeffreys logarithmic divergence. The intrinsic discrepancy loss is also an information-theory related divergence measure. Intrinsic discrepancy loss is a symmetric, non-negative loss function, and is a continuous, convex function. Intrinsic discrepancy loss was introduced by Bernardo and Rueda (2002) in a different context: hypothesis testing. Formally, it is: \deqn{\delta f(p_2,p_1) = min[\kappa(p_2 | p_1), \kappa(p_1 | p_2)]}{delta f(p[2],p[1]) = min[kappa(p[2] | p[1]), kappa(p[1] | p[2])]} where \eqn{\delta}{delta} is the discrepancy, \eqn{\kappa}{kappa} is the \code{\link{KLD}}, and \eqn{p_1}{p[1]} and \eqn{p_2}{p[2]} are the probability distributions. The intrinsic discrepancy loss is the loss function, and the expected posterior loss is the mean of the directed divergences. The LPL interval is also called an intrinsic credible interval or intrinsic probability interval, and the area inside the interval is often called an intrinsic credible region or intrinsic probability region. In practice, whether a reference prior or weakly informative prior (WIP) is used, the LPL interval is usually very close to the HPD interval, though the posterior losses may be noticeably different. If LPL used a zero-one loss function, then the HPD interval would be produced. An advantage of the LPL interval over HPD interval (see \code{\link{p.interval}}) is that the LPL interval is invariant to reparameterization. This is due to the invariant reparameterization property of reference priors. The quantile-based probability interval is also invariant to reparameterization. The LPL interval enjoys the same advantage as the HPD interval does over the quantile-based probability interval: it does not produce equal tails when inappropriate. Compared with probability intervals, the LPL interval is slightly less convenient to calculate. Although the prior distribution is specified within the \code{Model} specification function, the user must specify it for the \code{LPL.interval} function as well. A comparison of the quantile-based probability interval, HPD interval, and LPL interval is available here: \url{https://web.archive.org/web/20150214090353/http://www.bayesian-inference.com/credible}. } \value{ A matrix is returned with one row and two columns. The row represents the parameter and the column names are \code{"Lower"} and \code{"Upper"}. The elements of the matrix are the lower and upper bounds of the LPL interval. } \references{ Bernardo, J.M. (2005). "Intrinsic Credible Regions: An Objective Bayesian Approach to Interval Estimation". \emph{Sociedad de Estadistica e Investigacion Operativa}, 14(2), p. 317--384. Bernardo, J.M. and Rueda, R. (2002). "Bayesian Hypothesis Testing: A Reference Approach". \emph{International Statistical Review}, 70, p. 351--372. } \author{Statisticat, LLC.} \seealso{ \code{\link{KLD}}, \code{\link{p.interval}}, \code{\link{LaplacesDemon}}, and \code{\link{PMC}}.} \examples{ library(LaplacesDemon) #Although LPL is intended to be applied to output from LaplacesDemon or #PMC, here is an example in which p(theta) ~ N(0,100), and #p(theta | y) ~ N(1,10), given 1000 samples. theta <- rnorm(1000,1,10) LPL.interval(Prior=dnorm(theta,0,100^2), Posterior=theta, prob=0.95, plot=TRUE) #A more practical example follows, but it assumes a model has been #updated with LaplacesDemon or PMC, the output object is called Fit, and #that the prior for the third parameter is normally distributed with #mean 0 and variance 100: #temp <- Fit$Posterior2[,3] #names(temp) <- colnames(Fit$Posterior2)[3] #LPL.interval(Prior=dnorm(temp,0,100^2), Posterior=temp, prob=0.95, # plot=TRUE, PDF=FALSE) } \keyword{Credible Interval} \keyword{Credible Region} \keyword{Credible Set} \keyword{LPL} \keyword{LPLI} \keyword{Probability Interval} \keyword{Probability Region} \keyword{Probability Set} LaplacesDemon/man/dist.Stick.Rd0000755000176200001440000000567415144316355016070 0ustar liggesusers\name{dist.Stick} \alias{dStick} \alias{rStick} \title{Truncated Stick-Breaking Prior Distribution} \description{ These functions provide the density and random number generation of the original, truncated stick-breaking (TSB) prior distribution given \eqn{\theta}{theta} and \eqn{\gamma}{gamma}, as per Ishwaran and James (2001). } \usage{ dStick(theta, gamma, log=FALSE) rStick(M, gamma) } \arguments{ \item{M}{This accepts an integer that is equal to one less than the number of truncated number of possible mixture components (\eqn{M=1}). Unlike most random deviate functions, this is not the number of random deviates to return.} \item{theta}{This is \eqn{\theta}{theta}, a vector of length \eqn{M-1}, where \eqn{M} is the truncated number of possible mixture components.} \item{gamma}{This is \eqn{\gamma}{gamma}, a scalar, and is usually gamma-distributed.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Discrete Multivariate \item Density: \eqn{p(\pi) = \frac{(1-\theta)^{\beta-1}}{\mathrm{B}(1,\beta)}}{p(pi) = ((1-theta)^(beta-1))/(B(1,\beta))} \item Inventor: Sethuraman, J. (1994) \item Notation 1: \eqn{\pi \sim \mathrm{Stick}(\theta,\gamma)}{pi ~ Stick(theta, gamma)} \item Notation 2: \eqn{\pi \sim \mathrm{GEM}(\theta,\gamma)}{pi ~ Stick(theta, gamma)} \item Notation 3: \eqn{p(\pi) = \mathrm{Stick}(\pi | \theta, \gamma)}{p(pi) = Stick(pi | theta, gamma)} \item Notation 4: \eqn{p(\pi) = \mathrm{GEM}(\pi | \theta, \gamma)}{p(pi) = GEM(pi | theta, gamma)} \item Parameter 1: shape parameter \eqn{\theta \in (0,1)}{theta in (0,1)} \item Parameter 2: shape parameter \eqn{\gamma > 0}{gamma > 0} \item Mean: \eqn{E(\pi) = \frac{1}{1+\gamma}}{E(pi) = 1/(1+gamma)} \item Variance: \eqn{var(\pi) = \frac{\gamma}{(1+\gamma)^2 (\gamma+2)}}{var(pi) = gamma / ((1+gamma)^2 (gamma+2))} \item Mode: \eqn{mode(\pi) = 0}{mode(pi) = 0} } The original truncated stick-breaking (TSB) prior distribution assigns each \eqn{\theta}{theta} to be beta-distributed with parameters \eqn{\alpha=1}{alpha=1} and \eqn{\beta=\gamma}{beta=gamma} (Ishwaran and James, 2001). This distribution is commonly used in truncated Dirichlet processes (TDPs). } \value{ \code{dStick} gives the density and \code{rStick} generates a random deviate vector of length \eqn{M}. } \references{ Ishwaran, H. and James, L. (2001). "Gibbs Sampling Methods for Stick Breaking Priors". \emph{Journal of the American Statistical Association}, 96(453), p. 161--173. Sethuraman, J. (1994). "A Constructive Definition of Dirichlet Priors". \emph{Statistica Sinica}, 4, p. 639--650. } \seealso{ \code{\link{ddirichlet}}, \code{\link{dmvpolya}}, and \code{\link{Stick}}. } \examples{ library(LaplacesDemon) dStick(runif(4), 0.1) rStick(4, 0.1) } \keyword{Distribution} LaplacesDemon/man/Combine.Rd0000755000176200001440000001533415144316355015417 0ustar liggesusers\name{Combine} \alias{Combine} \title{Combine Demonoid Objects} \description{ This function combines objects of class \code{demonoid}. } \usage{ Combine(x, Data, Thinning=1) } \arguments{ \item{x}{This is a list of objects of class \code{demonoid}, and this list may be an object of class \code{demonoid.hpc}.} \item{Data}{This is the data, and must be identical to the data used to create the \code{demonoid} objects with \code{\link{LaplacesDemon}}.} \item{Thinning}{This is the amount of thinning to apply to the posterior samples after appending them together. \code{Thinning} defaults to 1, in which case all samples are retained. For example, in the case of, say, \code{Thinning=10}, then only every 10th sample would be retained. When combining parallel chains, \code{Thinning} is often left to its default. When combining consecutive updates, \code{Thinning} is usually applied, with the value equal to the number of objects of class \code{demonoid}. For more information on thinning, see the \code{Thin} function.} } \details{ The purpose of the \code{Combine} function is to enable a user to combine objects of class \code{demonoid} for one of three reasons. First, parallel chains from \code{\link{LaplacesDemon.hpc}} may be combined after convergence is assessed with \code{\link{Gelman.Diagnostic}}. Second, consecutive updates of single chains from \code{\link{LaplacesDemon}} or parallel chains from \code{\link{LaplacesDemon.hpc}} may be combined when the computer has insufficient random-access memory (RAM) for the user to update once with enough iterations. Third, consecutive single-chain or parallel-chain updates may be combined when it seems that the logarithm of the joint posterior distribution, \code{LP}, seems to be oscillating up and down, which is described in more detail below. The most common use regards the combination of parallel chains output from \code{\link{LaplacesDemon.hpc}}. Typically, a user with parallel chains examines them graphically with the \code{\link{caterpillar.plot}} and \code{plot} (actually, \code{\link{plot.demonoid}}) functions, and assesses convergence with the \code{\link{Gelman.Diagnostic}} function. Thereafter, the parallel chain output in the object of class \code{demonoid.hpc} should be combined into a single object of class \code{demonoid}, before doing posterior predictive checks and making inferences. In this case, the \code{Thinning} argument usually is recommended to remain at its default. It is also common with a high-dimensional model (a model with a large number of parameters) to need more posterior samples than allowed by the random-access memory (RAM) of the computer. In this case, it is best to use the \code{\link{LaplacesDemon.RAM}} function to estimate the amount of RAM that a given model will require with a given number of iterations, and then update \code{\link{LaplacesDemon}} almost as much as RAM allows, and save the output object of class \code{demonoid}. Then, the user is advised to continue onward with a consecutive update (after using \code{\link{as.initial.values}} and anything else appropriate to prepare for the consecutive update). Suppose a user desires to update a gigantic model with thousands of parameters, and with the aid of \code{\link{LaplacesDemon.RAM}}, estimates that they can safely update only 100,000 iterations, and that 150,000 iterations would exceed RAM and crash the computer. The patient user can update several consecutive models, each with retaining only 1,000 thinned posterior samples, and combine them later with the \code{Combine} function, by placing multiple objects into a list, as described below. In this way, it is possible for a user to update models that otherwise far exceed computer RAM. Less commonly, multiple updates of single-chain objects should be combined into a single object of class \code{demonoid}. This is most useful in complicated models that are run for large numbers of iterations, where it may be suspected that stationarity has been achieved, but that thinning is insufficient, and the samples may be combined and thinned. If followed, then these suggestions may continue seemingly to infinity, and the unnormalized logarithm of the joint posterior density, \code{LP}, may seem to oscillate, sometimes improving and getting higher, and getting lower during other updates. For this purpose, the prior covariance matrix of the last model is retained (rather than combining them). This may be an unpleasant surprise for combining parallel updates, so be aware of it. In these cases, which usually involve complicated models with high autocorrelation in the chains, the user may opt to use parallel processing with the \code{\link{LaplacesDemon.hpc}} function, or may use the \code{\link{LaplacesDemon}} function as follows. The user should save (meaning, not overwrite) each object of class \code{demonoid}, place multiple objects into a list, and use the \code{Combine} function to combine these objects. For example, suppose a user names the object Fit, as in the \code{\link{LaplacesDemon}} example. Now, rather than overwriting object Fit, object Fit is renamed, after updating a million iterations, to Fit1. As suggested by \code{\link{Consort}}, another million iterations are used, but now to create object Fit2. Further suppose this user specified \code{Thinning=1000} in \code{\link{LaplacesDemon}}, meaning that the million iterations are thinned by 1,000, so only 1,000 iterations are retained in each object, Fit1 and Fit2. In this case, \code{Combine} combines the information in Fit1 and Fit2, and returns an object the user names Fit3. Fit3 has only 1,000 iterations, which is the result of appending the iterations in Fit1 and Fit2, and thinning by 2. If 2,000,000 iterations were updated from the beginning, and were thinned by 2,000, then the same information exists now in Fit3. The \code{\link{Consort}} function can now be applied to Fit3, to see if stationarity is found. If not, then more objects of class \code{demonoid} can be collected and combined. } \value{ This function returns an object of class \code{demonoid}. For more information on an object of class \code{demonoid}, see the \code{LaplacesDemon} function. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{\code{\link{caterpillar.plot}}, \code{\link{Gelman.Diagnostic}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, and \code{\link{Thin}}.} \keyword{MCMC} \keyword{Multiple Chains} \keyword{Parallel Chains} \keyword{Utility}LaplacesDemon/man/dist.Multivariate.t.Precision.Rd0000755000176200001440000001032015144316355021635 0ustar liggesusers\name{dist.Multivariate.t.Precision} \alias{dmvtp} \alias{rmvtp} \title{Multivariate t Distribution: Precision Parameterization} \description{ These functions provide the density and random number generation for the multivariate t distribution, otherwise called the multivariate Student distribution. These functions use the precision parameterization. } \usage{ dmvtp(x, mu, Omega, nu=Inf, log=FALSE) rmvtp(n=1, mu, Omega, nu=Inf) } \arguments{ \item{x}{This is either a vector of length \eqn{k} or a matrix with a number of columns, \eqn{k}, equal to the number of columns in precision matrix \eqn{\Omega}{Omega}.} \item{n}{This is the number of random draws.} \item{mu}{This is a numeric vector representing the location parameter, \eqn{\mu}{mu} (the mean vector), of the multivariate distribution (equal to the expected value when \code{df > 1}, otherwise represented as \eqn{\nu > 1}{nu > 1}). It must be of length \eqn{k}, as defined above.} \item{Omega}{This is a \eqn{k \times k}{k x k} positive-definite precision matrix \eqn{\Omega}{Omega}.} \item{nu}{This is the degrees of freedom \eqn{\nu}{nu}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{\Gamma((\nu+k)/2)}{\Gamma(\nu/2)\nu^{k/2}\pi^{k/2}} |\Omega|^{1/2} (1 + \frac{1}{\nu} (\theta-\mu)^T \Omega (\theta-\mu))^{-(\nu+k)/2}}{p(theta) = (Gamma((nu+k)/2) / (Gamma(nu/2)*nu^(k/2)*pi^(k/2))) * |Omega|^(1/2) * (1 + (1/nu) (theta-mu)^T Omega (theta-mu))^(-(nu+k)/2)} \item Inventor: Unknown (to me, anyway) \item Notation 1: \eqn{\theta \sim \mathrm{t}_k(\mu, \Omega^{-1}, \nu)}{theta ~ t[k](mu, Omega^(-1), nu)} \item Notation 2: \eqn{p(\theta) = \mathrm{t}_k(\theta | \mu, \Omega^{-1}, \nu)}{p(theta) = t[k](theta | mu, Omega^(-1), \nu)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega} \item Parameter 3: degrees of freedom \eqn{\nu > 0}{nu > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu}, for \eqn{\nu > 1}{nu > 1}, otherwise undefined \item Variance: \eqn{var(\theta) = \frac{\nu}{\nu - 2} \Omega^{-1}}{var(theta) = (nu / (nu - 2))*Omega^(-1)}, for \eqn{\nu > 2}{nu> 2} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate t distribution, also called the multivariate Student or multivariate Student t distribution, is a multidimensional extension of the one-dimensional or univariate Student t distribution. A random vector is considered to be multivariate t-distributed if every linear combination of its components has a univariate Student t-distribution. It is usually parameterized with mean and a covariance matrix, or in Bayesian inference, with mean and a precision matrix, where the precision matrix is the matrix inverse of the covariance matrix. These functions provide the precision parameterization for convenience and familiarity. It is easier to calculate a multivariate t density with the precision parameterization, because a matrix inversion can be avoided. This distribution has a mean parameter vector \eqn{\mu}{mu} of length \eqn{k}, and a \eqn{k \times k}{k x k} precision matrix \eqn{\Omega}{Omega}, which must be positive-definite. When degrees of freedom \eqn{\nu=1}{nu=1}, this is the multivariate Cauchy distribution. } \value{ \code{dmvtp} gives the density and \code{rmvtp} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dwishart}}, \code{\link{dmvc}}, \code{\link{dmvcp}}, \code{\link{dmvt}}, \code{\link{dst}}, \code{\link{dstp}}, and \code{\link{dt}}. } \examples{ library(LaplacesDemon) x <- seq(-2,4,length=21) y <- 2*x+10 z <- x+cos(y) mu <- c(1,12,2) Omega <- matrix(c(1,2,0,2,5,0.5,0,0.5,3), 3, 3) nu <- 4 f <- dmvtp(cbind(x,y,z), mu, Omega, nu) X <- rmvtp(1000, c(0,1,2), diag(3), 5) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution} LaplacesDemon/man/dist.Inverse.ChiSquare.Rd0000755000176200001440000000551415144316355020302 0ustar liggesusers\name{dist.Inverse.ChiSquare} \alias{dinvchisq} \alias{rinvchisq} \title{(Scaled) Inverse Chi-Squared Distribution} \description{ This is the density function and random generation for the (scaled) inverse chi-squared distribution. } \usage{ dinvchisq(x, df, scale, log=FALSE) rinvchisq(n, df, scale=1/df) } \arguments{ \item{x}{This is a vector of quantiles.} \item{n}{This is the number of observations. If \code{length(n) > 1}, then the length is taken to be the number required.} \item{df}{This is the degrees of freedom parameter, usually represented as \eqn{\nu}{nu}.} \item{scale}{This is the scale parameter, usually represented as \eqn{\lambda}{lambda}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \deqn{p(\theta) = \frac{{\nu/2}^{\nu/2}}{\Gamma(\nu/2)} \lambda^\nu \frac{1}{\theta}^{\nu/2+1} \exp(-\frac{\nu \lambda^2}{2\theta}), \theta \ge 0}{p(theta) = ((nu/2)^(nu/2))/(\Gamma(nu/2)) lambda^nu (1/theta)^((nu/2)+1) exp(-(nu lambda^2)/(2*theta)), theta >= 0} \item Inventor: Derived from the chi-squared distribution \item Notation 1: \eqn{\theta \sim \chi^{-2}(\nu, \lambda)}{theta ~ chi^(-2)(nu, lambda)} \item Notation 2: \eqn{p(\theta) = \chi^{-2}(\theta | \nu, \lambda)}{p(theta) = chi^(-2)(theta | nu, lambda)} \item Parameter 1: degrees of freedom parameter \eqn{\nu > 0}{nu > 0} \item Parameter 2: scale parameter \eqn{\lambda}{lambda} \item Mean: \eqn{E(\theta)}{E(theta)} = unknown \item Variance: \eqn{var(\theta)}{var(theta)} = unknown \item Mode: \eqn{mode(\theta) = }{mode(theta) = } } The inverse chi-squared distribution, also called the inverted chi-square distribution, is the multiplicate inverse of the chi-squared distribution. If \eqn{x} has the chi-squared distribution with \eqn{\nu}{nu} degrees of freedom, then \eqn{1 / x} has the inverse chi-squared distribution with \eqn{\nu}{nu} degrees of freedom, and \eqn{\nu / x}{nu / x} has the inverse chi-squared distribution with \eqn{\nu}{nu} degrees of freedom. These functions are similar to those in the GeoR package. } \value{ \code{dinvchisq} gives the density and \code{rinvchisq} generates random deviates. } \seealso{ \code{\link{dchisq}} } \examples{ library(LaplacesDemon) x <- dinvchisq(1,1,1) x <- rinvchisq(10,1) #Plot Probability Functions x <- seq(from=0.1, to=5, by=0.01) plot(x, dinvchisq(x,0.5,1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dinvchisq(x,1,1), type="l", col="green") lines(x, dinvchisq(x,5,1), type="l", col="blue") legend(3, 0.9, expression(paste(nu==0.5, ", ", lambda==1), paste(nu==1, ", ", lambda==1), paste(nu==5, ", ", lambda==1)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution} LaplacesDemon/man/caterpillar.plot.Rd0000755000176200001440000000715215144337635017325 0ustar liggesusers\name{caterpillar.plot} \alias{caterpillar.plot} \title{Caterpillar Plot} \description{ A caterpillar plot is a horizontal plot of 3 quantiles of selected distributions. This may be used to produce a caterpillar plot of posterior samples (parameters and monitored variables) from an object either of class \code{demonoid}, \code{demonoid.hpc}, \code{iterquad}, \code{laplace}, \code{pmc}, \code{vb}, or a matrix. } \usage{caterpillar.plot(x, Parms=NULL, Title=NULL)} \arguments{ \item{x}{ This required argument is an object of class \code{demonoid}, \code{demonoid.hpc}, \code{iterquad}, \code{laplace}, \code{pmc}, \code{vb}, or a \eqn{S \times J}{S x J} matrix of \eqn{S} samples and \eqn{J} variables. For an object of class \code{demonoid}, the distributions of the stationary posterior summary (\code{Summary2}) will be attempted first, and if missing, then the parameters of all posterior samples (\code{Summary1}) will be plotted. For an object of class \code{demonoid.hpc}, stationarity may differ by chain, so all posterior samples (\code{Summary1}) are used. For an object of class \code{laplace} or \code{vb}, the distributions in the posterior summary, \code{Summary}, are plotted according to the posterior draws, sampled with sampling importance resampling in the \code{\link{SIR}} function. When a generic matrix is supplied, unimodal 95\% HPD intervals are estimated with the \code{\link{p.interval}} function.} \item{Parms}{ This argument accepts a vector of quoted strings to be matched for selecting parameters and monitored variables for plotting (though all parameters are selected when a generic matrix is supplied). This argument defaults to \code{NULL} and selects every parameter for plotting. Each quoted string is matched to one or more parameter names with the \code{grep} function. For example, if the user specifies \code{Parms=c("eta", "tau")}, and if the parameter names are beta[1], beta[2], eta[1], eta[2], and tau, then all parameters will be selected, because the string \code{eta} is within \code{beta}. Since \code{grep} is used, string matching uses regular expressions, so beware of meta-characters, though these are acceptable: ".", "[", and "]".} \item{Title}{ This argument accepts a title for the plot.} } \details{ Caterpillar plots are popular plots in Bayesian inference for summarizing the quantiles of posterior samples. A caterpillar plot is similar to a horizontal boxplot, though without quartiles, making it easier for the user to study more distributions in a single plot. The following quantiles are plotted as a line for each parameter: 0.025 and 0.975, with the exception of a generic matrix, where unimodal 95\% HPD intervals are estimated (for more information, see \code{\link{p.interval}}). A vertical, gray line is included at zero. For all but class \code{demonoid.hpc}, the median appears as a black dot, and the quantile line is black. For class \code{demonoid.hpc}, the color of the median and quantile line differs by chain; the first chain is black and additional chains appear beneath. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{PMC}}, \code{\link{p.interval}}, \code{\link{SIR}}, and \code{\link{VariationalBayes}}. } \examples{#An example is provided in the LaplacesDemon function.} \keyword{Plot} LaplacesDemon/man/dist.Normal.Inverse.Wishart.Rd0000755000176200001440000000577115144316355021273 0ustar liggesusers\name{dist.Normal.Inverse.Wishart} \alias{dnorminvwishart} \alias{rnorminvwishart} \title{Normal-Inverse-Wishart Distribution} \description{ These functions provide the density and random number generation for the normal-inverse-Wishart distribution. } \usage{ dnorminvwishart(mu, mu0, lambda, Sigma, S, nu, log=FALSE) rnorminvwishart(n=1, mu0, lambda, S, nu) } \arguments{ \item{mu}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{mu0}{This is mean vector \eqn{\mu_0}{mu[0]} with length \eqn{k} or matrix with \eqn{k} columns.} \item{lambda}{This is a positive-only scalar.} \item{n}{This is the number of random draws.} \item{nu}{This is the scalar degrees of freedom \eqn{\nu}{nu}.} \item{Sigma}{This is a \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma}.} \item{S}{This is the symmetric, positive-semidefinite, \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\mu, \Sigma) = \mathcal{N}(\mu | \mu_0, \frac{1}{\lambda}\Sigma) \mathcal{W}^{-1}(\Sigma | \nu, \textbf{S})}{p(mu, Sigma) = N(mu | mu[0], (1/lambda) Sigma) W^(-1)(Sigma | nu, S)} \item Inventors: Unknown \item Notation 1: \eqn{(\mu, \Sigma) \sim \mathcal{NIW}(\mu_0, \lambda, \textbf{S}, \nu)}{(mu, Sigmaa) ~ NIW(mu[0], lambda, S, nu)} \item Notation 2: \eqn{p(\mu, \Sigma) = \mathcal{NIW}(\mu, \Sigma | \mu_0, \lambda, \textbf{S}, \nu)}{p(mu, Sigma) = NIW(mu, Sigma | mu[0], lambda, S, nu)} \item Parameter 1: location vector \eqn{\mu_0}{mu[0]} \item Parameter 2: \eqn{\lambda > 0}{lambda > 0} \item Parameter 3: symmetric, positive-semidefinite \eqn{k \times k}{k x k} scale matrix \eqn{\textbf{S}}{S} \item Parameter 4: degrees of freedom \eqn{\nu \ge k}{nu >= k} \item Mean: Unknown \item Variance: Unknown \item Mode: Unknown } The normal-inverse-Wishart distribution, or Gaussian-inverse-Wishart distribution, is a multivariate four-parameter continuous probability distribution. It is the conjugate prior of a multivariate normal distribution with unknown mean and covariance matrix. } \value{ \code{dnorminvwishart} gives the density and \code{rnorminvwishart} generates random deviates and returns a list with two components. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dmvn}} and \code{\link{dinvwishart}}. } \examples{ library(LaplacesDemon) K <- 3 mu <- rnorm(K) mu0 <- rnorm(K) nu <- K + 1 S <- diag(K) lambda <- runif(1) #Real scalar Sigma <- as.positive.definite(matrix(rnorm(K^2),K,K)) x <- dnorminvwishart(mu, mu0, lambda, Sigma, S, nu, log=TRUE) out <- rnorminvwishart(n=10, mu0, lambda, S, nu) joint.density.plot(out$mu[,1], out$mu[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/cond.plot.Rd0000755000176200001440000000271015144316355015735 0ustar liggesusers\name{cond.plot} \alias{cond.plot} \title{Conditional Plots} \description{ This function provides several styles of conditional plots with base graphics. } \usage{ cond.plot(x, y, z, Style="smoothscatter") } \arguments{ \item{x}{This required argument accepts a numeric vector.} \item{y}{This argument accepts a numeric vector, and is only used with some styles.} \item{z}{This required argument accepts a discrete vector.} \item{Style}{This argument specifies the style of plot, and accepts "boxplot", "densover" (density overlay), "hist", "scatter", or "smoothscatter".} } \details{ The \code{cond.plot} function provides simple conditional plots with base graphics. All plot styles are conditional upon \code{z}. Up to nine conditional plots are produced in a panel. Plots include: boxplot: y ~ x | z densover: f(x | z) hist: x | z scatter: x, y | z smoothscatter: x, y | z The \code{cond.plot} function is not intended to try to compete with some of the better graphics packages, but merely to provide simple functionality. } \value{ Conditional plots are returned. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{joint.density.plot}} and \code{\link{joint.pr.plot}}. } \examples{ library(LaplacesDemon) x <- rnorm(1000) y <- runif(1000) z <- rcat(1000, rep(1/4,4)) cond.plot(x, y, z, Style="smoothscatter") } \keyword{Plot}LaplacesDemon/man/interval.Rd0000755000176200001440000001106715144316355015666 0ustar liggesusers\name{interval} \alias{interval} \title{Constrain to Interval} \description{ This function constrains the value(s) of a scalar, vector, matrix, or array to a specified interval, \eqn{[a,b]}. In Bayesian inference, it is often used both to truncate a parameter to an interval, such as \eqn{p(\theta) \in [a,b]}{p(theta) in [a,b]}. The \code{interval} function is often used in conjunction with the \code{\link{dtrunc}} function to truncate the prior probability distribution associated with the constrained parameter. While \code{\link{dtrunc}} prevents assigning density outside of its interval and re-estimates density within the interval, the \code{interval} function is used to prevent the parameter from moving outside of the interval in the first place. After the parameter is constrained to an interval in \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}}, the constrained parameter should be updated back into the \code{parm} vector, so the algorithm knows it has been constrained. This is unrelated to the probability interval (see \code{\link{p.interval}} and \code{\link{LPL.interval}}). } \usage{ interval(x, a=-Inf, b=Inf, reflect=TRUE) } \arguments{ \item{x}{This required argument is a scalar, vector, matrix or array, and its elements will be constrained to the interval [\code{a},\code{b}].} \item{a}{This optional argument allows the specification of the lower bound of the interval, and defaults to \code{-Inf}.} \item{b}{This optional argument allows the specification of the upper bound of the interval, and defaults to \code{Inf}.} \item{reflect}{Logical. When \code{TRUE}, a value outside of the constrained interval is reflected or bounced back into the interval. When \code{FALSE}, a value outside of the interval is assigned the nearest boundary of the interval. This argument defaults to \code{TRUE}.} } \details{ It is common for a parameter to be constrained to an interval. The \code{interval} function provides two methods of constraining proposals. The default is to reflect an out-of-bounds proposal off of the boundaries until the proposal is within the specified interval. This is rare in the literature but works very well in practice. The other method does not reflect off of boundaries, but sets the value equal to the violated boundary. This is also rare in the literature and is not generally recommended. If the \code{interval} function is unacceptable, then there are several alternatives. It is common to re-parameterize by transforming the constrained parameter to the real line. For example, a positive-only scale parameter may be log-transformed. A parameter that is re-parameterized to the real line often mixes better in MCMC, exhibiting a higher effective sample size (\code{\link{ESS}}), and each evaluation of the model specification function is faster as well. However, without a hard constraint, it remains possible for the transformed parameter still become problematic, such as a log-transformed scale parameter that reaches negative infinity. This is much more common in the literature. Another method is to allow the parameters to move outside of the desired, constrained interval in MCMC during the model update, and when the model update is finished, to discard any samples outside of the constraint boundaries. This is a method of rejecting unacceptable proposals in regions of zero probability. However, it is possible for parameters to remain outside of acceptable bounds long enough to be problematic. In \code{\link{LaplacesDemon}}, the Gibbs sampler allows more control in the FC function, where a user can customize how constraints are handled. } \value{ The \code{interval} function returns a scalar, vector, matrix, or array in accord with its argument, \code{x}. Each element is constrained to the interval [\code{a},\code{b}]. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dtrunc}}, \code{\link{ESS}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LPL.interval}}, \code{\link{PMC}}, \code{\link{p.interval}}, \code{\link{VariationalBayes}}. } \examples{ #See the Examples vignette for numerous examples. library(LaplacesDemon) x <- 2 interval(x,0,1) X <- matrix(runif(25,-2,2),5,5) interval(X,-1,1) } \keyword{Utility}LaplacesDemon/man/Mode.Rd0000755000176200001440000001154315144316355014725 0ustar liggesusers\name{Mode} \alias{is.amodal} \alias{is.bimodal} \alias{is.multimodal} \alias{is.trimodal} \alias{is.unimodal} \alias{Mode} \alias{Modes} \title{The Mode(s) of a Vector} \description{ The mode is a measure of central tendency. It is the value that occurs most frequently, or in a continuous probability distribution, it is the value with the most density. A distribution may have no modes (such as with a constant, or in a uniform distribution when no value occurs more frequently than any other), or one or more modes. } \usage{ is.amodal(x, min.size=0.1) is.bimodal(x, min.size=0.1) is.multimodal(x, min.size=0.1) is.trimodal(x, min.size=0.1) is.unimodal(x, min.size=0.1) Mode(x) Modes(x, min.size=0.1) } \arguments{ \item{x}{This is a vector in which a mode (or modes) will be sought.} \item{min.size}{This is the minimum size that can be considered a mode, where size means the proportion of the distribution between areas of increasing kernel density estimates.} } \details{ The \code{is.amodal} function is a logical test of whether or not \code{x} has a mode. If \code{x} has a mode, then \code{TRUE} is returned, otherwise \code{FALSE}. The \code{is.bimodal} function is a logical test of whether or not \code{x} has two modes. If \code{x} has two modes, then \code{TRUE} is returned, otherwise \code{FALSE}. The \code{is.multimodal} function is a logical test of whether or not \code{x} has multiple modes. If \code{x} has multiple modes, then \code{TRUE} is returned, otherwise \code{FALSE}. The \code{is.trimodal} function is a logical test of whether or not \code{x} has three modes. If \code{x} has three modes, then \code{TRUE} is returned, otherwise \code{FALSE}. The \code{is.unimodal} function is a logical test of whether or not \code{x} has one mode. If \code{x} has one mode, then \code{TRUE} is returned, otherwise \code{FALSE}. The \code{Mode} function returns the most frequent value when \code{x} is discrete. If \code{x} is a constant, then it is considered amodal, and \code{NA} is returned. If multiple modes exist, this function returns only the mode with the highest density, or if two or more modes have the same density, then it returns the first mode found. Otherwise, the \code{Mode} function returns the value of \code{x} associated with the highest kernel density estimate, or the first one found if multiple modes have the same density. The \code{Modes} function is a simple, deterministic function that differences the kernel density of \code{x} and reports a number of modes equal to half the number of changes in direction, although the \code{min.size} function can be used to reduce the number of modes returned, and defaults to 0.1, eliminating modes that do not have at least 10\% of the distributional area. The \code{Modes} function returns a list with three components: \code{modes}, \code{modes.dens}, and \code{size}. The elements in each component are ordered according to the decreasing density of the modes. The \code{modes} component is a vector of the values of \code{x} associated with the modes. The \code{modes.dens} component is a vector of the kernel density estimates at the modes. The \code{size} component is a vector of the proportion of area underneath each mode. The \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, and \code{\link{VariationalBayes}} functions characterize the marginal posterior distributions by posterior modes (means) and variance. A related topic is MAP or maximum \emph{a posteriori} estimation. Otherwise, the results of Bayesian inference tend to report the posterior mean or median, along with probability intervals (see \code{\link{p.interval}} and \code{\link{LPL.interval}}), rather than posterior modes. In many types of models, such as mixture models, the posterior may be multimodal. In such a case, the usual recommendation is to choose the highest mode if feasible and possible. However, the highest mode may be uncharacteristic of the majority of the posterior. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LPL.interval}}, \code{\link{p.interval}}, and \code{\link{VariationalBayes}}. } \examples{ library(LaplacesDemon) ### Below are distributions with different numbers of modes. x <- c(1,1) #Amodal x <- c(1,2,2,2,3) #Unimodal x <- c(1,2) #Bimodal x <- c(1,3,3,3,3,4,4,4,4,4) #min.size affects the answer x <- c(1,1,3,3,3,3,4,4,4,4,4) #Trimodal ### And for each of the above, the functions below may be applied. Mode(x) Modes(x) is.amodal(x) is.bimodal(x) is.multimodal(x) is.trimodal(x) is.unimodal(x) } \keyword{Mode} \keyword{Utility}LaplacesDemon/man/dist.YangBerger.Rd0000755000176200001440000000454615144316355017035 0ustar liggesusers\name{dist.YangBerger} \alias{dyangberger} \alias{dyangbergerc} \title{Yang-Berger Distribution} \description{ This is the density function for the Yang-Berger prior distribution for a covariance matrix or precision matrix. } \usage{ dyangberger(x, log=FALSE) dyangbergerc(x, log=FALSE) } \arguments{ \item{x}{This is the \eqn{k \times k}{k x k} positive-definite covariance matrix or precision matrix for \code{dyangberger} or the Cholesky factor \eqn{\textbf{U}}{U} of the covariance matrix or precision matrix for \code{dyangbergerc}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = \frac{1}{|\theta|^{\prod (d_j - d_{j-1})}}}{p(theta) = 1 / |theta|^(prod (d[j] - d[j-1]))}, where \eqn{d} are increasing eigenvalues. See equation 13 in Yang and Berger (1994). \item Inventor: Yang and Berger (1994) \item Notation 1: \eqn{\theta \sim \mathcal{YB}}{p(theta) ~ YB} \item Mean: \item Variance: \item Mode: } Yang and Berger (1994) derived a least informative prior (LIP) for a covariance matrix or precision matrix. The Yang-Berger (YB) distribution does not have any parameters. It is a reference prior for objective Bayesian inference. The Cholesky parameterization is also provided here. The YB prior distribution results in a proper posterior. It involves an eigendecomposition of the covariance matrix or precision matrix. It is difficult to interpret a model that uses the YB prior, due to a lack of intuition regarding the relationship between eigenvalues and correlations. Compared to Jeffreys prior for a covariance matrix, this reference prior encourages equal eigenvalues, and therefore results in a covariance matrix or precision matrix with a better shrinkage of its eigenstructure. } \value{ \code{dyangberger} and \code{dyangbergerc} give the density. } \references{ Yang, R. and Berger, J.O. (1994). "Estimation of a Covariance Matrix using the Reference Prior". \emph{Annals of Statistics}, 2, p. 1195-1211. } \seealso{ \code{\link{dinvwishart}} and \code{\link{dwishart}} } \examples{ library(LaplacesDemon) X <- matrix(c(1,0.8,0.8,1), 2, 2) dyangberger(X, log=TRUE) } \keyword{Distribution} LaplacesDemon/man/dist.HuangWand.Rd0000755000176200001440000000770715144316355016666 0ustar liggesusers\name{dist.HuangWand} \alias{dhuangwand} \alias{dhuangwandc} \alias{rhuangwand} \alias{rhuangwandc} \title{Huang-Wand Distribution} \description{ These are the density and random generation functions for the Huang-Wand prior distribution for a covariance matrix. } \usage{ dhuangwand(x, nu=2, a, A, log=FALSE) dhuangwandc(x, nu=2, a, A, log=FALSE) rhuangwand(nu=2, a, A) rhuangwandc(nu=2, a, A) } \arguments{ \item{x}{This is a \eqn{k \times k}{k x k} positive-definite covariance matrix \eqn{\Sigma}{Sigma} for \code{dhuangwand}, or the Cholesky factor \eqn{\textbf{U}}{U} of the covariance matrix for \code{dhuangwandc}.} \item{nu}{This is a scalar degrees of freedom parameter \eqn{\nu}{nu}. The default is \code{nu=2}, which is an uninformative prior, resulting in marginal uniform distributions on the correlation matrix.} \item{a}{This is a positive-only vector of scale parameters \eqn{a} of length \eqn{k}.} \item{A}{This is a positive-only vector of of scale hyperparameters \eqn{A} of length \eqn{k}. Larger values result in a more uninformative prior. A default, uninformative prior is \code{A=rep(1e6,k)}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \eqn{p(\theta) = \mathcal{W}^{-1}_{\nu+k-1}(2 \nu diag(1/a)) \mathcal{G}^{-1}(1/2, 1/A^2)}{p(theta) = W^(-1)[nu+k-1](2*nu*diag(1/a)) G^(-1)(1/2, 1/A^2)} \item Inventor: Huang and Wand (2013) \item Notation 1: \eqn{\theta \sim \mathcal{HW}_\nu(\textbf{a}, \textbf{A})}{theta ~ HW[nu](a, A)} \item Notation 2: \eqn{p(\theta) \sim \mathcal{HW}_\nu(\theta | \textbf{a}, \textbf{A})}{p(theta) ~ HW[nu](theta | a, A)} \item Parameter 1: degrees of freedom \eqn{\nu}{nu} \item Parameter 2: scale \eqn{a > 0} \item Parameter 3: scale \eqn{A > 0} \item Mean: \item Variance: \item Mode: } Huang and Wand (2013) proposed a prior distribution for a covariance matrix that uses a hierarchical inverse Wishart. This is a more flexible alternative to the inverse Wishart distribution, and the Huang-Wand prior retains conjugacy. The Cholesky parameterization is also provided here. The Huang-Wand prior distribution alleviates two main limitations of an inverse Wishart distribution. First, the uncertainty in the diagonal variances of a covariance matrix that is inverse Wishart distributed is represented with only one degrees of freedom parameter, which may be too restrictive. The Huang-Wand prior overcomes this limitation. Second, the inverse Wishart distribution imposes a dependency between variance and correlation. The Huang-Wand prior lessens, but does not fully remove, this dependency. The standard deviations of a Huang-Wand distributed covariance matrix are half-t distributed, as \eqn{\mathcal{HT}(\nu, \textbf{A})}{HT(nu, A)}. This is in accord with modern assumptions about distributions of scale parameters, and is also useful for sparse covariance matrices. The \code{rhuangwand} function allows either \code{a} or \code{A} to be missing. When \code{a} is missing, the covariance matrix is generated from the hyperparameters. When \code{A} is missing, the covariance matrix is generated from the parameters. } \value{ \code{dhuangwand} and \code{dhuangwandc} give the density, and \code{rhuangwand} and \code{rhuangwandc} generate random deviates. } \references{ Huang, A., Wand, M., et al. (2013), "Simple Marginally Noninformative Prior Distributions for Covariance Matrices". \emph{Bayesian Analysis}, 8, p. 439--452. } \seealso{ \code{\link{dhalft}} and \code{\link{dinvwishart}} } \examples{ library(LaplacesDemon) dhuangwand(diag(3), nu=2, a=runif(3), A=rep(1e6,3), log=TRUE) rhuangwand(nu=2, A=rep(1e6, 3)) #Missing a rhuangwand(nu=2, a=runif(3)) #Missing A } \keyword{Distribution} LaplacesDemon/man/dist.Student.t.Precision.Rd0000755000176200001440000001127415144316355020626 0ustar liggesusers\name{dist.Student.t.Precision} \alias{dstp} \alias{pstp} \alias{qstp} \alias{rstp} \title{Student t Distribution: Precision Parameterization} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate Student t distribution with location parameter \eqn{\mu}{mu}, precision parameter \eqn{\tau}{tau}, and degrees of freedom parameter \eqn{\nu}{nu}. } \usage{ dstp(x, mu=0, tau=1, nu=10, log=FALSE) pstp(q, mu=0, tau=1, nu=10, lower.tail=TRUE, log.p=FALSE) qstp(p, mu=0, tau=1, nu=10, lower.tail=TRUE, log.p=FALSE) rstp(n, mu=0, tau=1, nu=10) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mu}{This is the location parameter \eqn{\mu}{mu}.} \item{tau}{This is the precision parameter \eqn{\tau}{tau}, which must be positive.} \item{nu}{This is the degrees of freedom parameter \eqn{\nu}{nu}, which must be positive.} \item{lower.tail}{Logical. If \code{lower.tail=TRUE}, then probabilities are \eqn{Pr[X \le x]}{Pr[X <= x]}, otherwise, \eqn{Pr[X > x]}{Pr[X > x]}.} \item{log, log.p}{Logical. If \code{log=TRUE}, then the logarithm of the density or probability is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{\Gamma((\nu+1)/2)}{\Gamma(\nu/2)} \sqrt{\frac{\tau}{\nu\pi}} (1 + \frac{\tau}{\nu} (\theta-\mu)^2)^{-(\nu+1)/2}}{p(theta) = (Gamma((nu+1)/2) / Gamma(nu/2)) * sqrt(tau/(nu*pi)) * (1 + (tau/nu)*(theta-mu)^2)^(-(nu+1)/2)} \item Inventor: William Sealy Gosset (1908) \item Notation 1: \eqn{\theta \sim \mathrm{t}(\mu, \sqrt{\tau^{-1}}, \nu)}{theta ~ t(mu, sqrt(tau^(-1)),nu)} \item Notation 2: \eqn{p(\theta) = \mathrm{t}(\theta | \mu, \sqrt{\tau^{-1}}, \nu)}{p(theta) = t(theta | mu, sqrt(tau^(-1)), nu)} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: precision parameter \eqn{\tau > 0}{tau > 0} \item Parameter 3: degrees of freedom \eqn{\nu > 0}{nu > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu}, for \eqn{\nu > 1}{nu > 1}, otherwise undefined \item Variance: \eqn{var(\theta) = \frac{1}{\tau}\frac{\nu}{\nu - 2}}{var(theta) = (1/tau)[nu / (nu - 2)]}, for \eqn{\nu > 2}{nu > 2} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The Student t-distribution is often used as an alternative to the normal distribution as a model for data. It is frequently the case that real data have heavier tails than the normal distribution allows for. The classical approach was to identify outliers and exclude or downweight them in some way. However, it is not always easy to identify outliers (especially in high dimensions), and the Student t-distribution is a natural choice of model-form for such data. It provides a parametric approach to robust statistics. The degrees of freedom parameter, \eqn{\nu}{nu}, controls the kurtosis of the distribution, and is correlated with the precision parameter \eqn{\tau}{tau}. The likelihood can have multiple local maxima and, as such, it is often necessary to fix \eqn{\nu}{nu} at a fairly low value and estimate the other parameters taking this as given. Some authors report that values between 3 and 9 are often good choices, and some authors suggest 5 is often a good choice. In the limit \eqn{\nu \rightarrow \infty}{nu -> infinity}, the Student t-distribution approaches \eqn{\mathcal{N}(\mu, \sigma^2)}{N(mu, sigma^2)}. The case of \eqn{\nu = 1}{nu = 1} is the Cauchy distribution. } \value{ \code{dstp} gives the density, \code{pstp} gives the distribution function, \code{qstp} gives the quantile function, and \code{rstp} generates random deviates. } \seealso{ \code{\link{dcauchy}}, \code{\link{dmvt}}, \code{\link{dmvtp}}, \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, \code{\link{dst}}, \code{\link{dt}}. } \examples{ library(LaplacesDemon) x <- dstp(1,0,1,10) x <- pstp(1,0,1,10) x <- qstp(0.5,0,1,10) x <- rstp(100,0,1,10) #Plot Probability Functions x <- seq(from=-5, to=5, by=0.1) plot(x, dstp(x,0,1,0.1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dstp(x,0,1,1), type="l", col="green") lines(x, dstp(x,0,1,10), type="l", col="blue") legend(1, 0.9, expression(paste(mu==0, ", ", tau==1, ", ", nu==0.5), paste(mu==0, ", ", tau==1, ", ", nu==1), paste(mu==0, ", ", tau==1, ", ", nu==10)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/burnin.Rd0000755000176200001440000000554715144316355015345 0ustar liggesusers\name{burnin} \alias{burnin} \title{Burn-in} \description{ The \code{burnin} function estimates the duration of burn-in in iterations for one or more Markov chains. ``Burn-in'' refers to the initial portion of a Markov chain that is not stationary and is still affected by its initial value. } \usage{ burnin(x, method="BMK") } \arguments{ \item{x}{This is a vector or matrix of posterior samples for which a the number of burn-in iterations will be estimated.} \item{method}{This argument defaults to \code{"BMK"}, in which case stationarity is estimated with the \code{\link{BMK.Diagnostic}} function. Alternatively, the \code{\link{Geweke.Diagnostic}} function may be used when \code{method="Geweke"} or the \code{\link{KS.Diagnostic}} function may be used when \code{method="KS"}.} } \details{ Burn-in is a colloquial term for the initial iterations in a Markov chain prior to its convergence to the target distribution. During burn-in, the chain is not considered to have ``forgotten'' its initial value. Burn-in is not a theoretical part of MCMC, but its use is the norm because of the need to limit the number of posterior samples due to computer memory. If burn-in were retained rather than discarded, then more posterior samples would have to be retained. If a Markov chain starts anywhere close to the center of its target distribution, then burn-in iterations do not need to be discarded. In the \code{\link{LaplacesDemon}} function, stationarity is estimated with the \code{\link{BMK.Diagnostic}} function on all thinned posterior samples of each chain, beginning at cumulative 10\% intervals relative to the total number of samples, and the lowest number in which all chains are stationary is considered the burn-in. The term, ``burn-in'', originated in electronics regarding the initial testing of component failure at the factory to eliminate initial failures (Geyer, 2011). Although ``burn-in' has been the standard term for decades, some are referring to these as ``warm-up'' iterations. } \value{ The \code{burnin} function returns a vector equal in length to the number of MCMC chains in \code{x}, and each element indicates the maximum iteration in burn-in. } \references{ Geyer, C.J. (2011). "Introduction to Markov Chain Monte Carlo". In S Brooks, A Gelman, G Jones, and M Xiao-Li (eds.), "Handbook of Markov Chain Monte Carlo", p. 3--48. Chapman and Hall, Boca Raton, FL. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{BMK.Diagnostic}}, \code{\link{deburn}}, \code{\link{Geweke.Diagnostic}}, \code{\link{KS.Diagnostic}}, and \code{\link{LaplacesDemon}}. } \examples{ library(LaplacesDemon) x <- rnorm(1000) burnin(x) } \keyword{Diagnostic} \keyword{Stationarity} \keyword{Utility} LaplacesDemon/man/dist.Inverse.Matrix.Gamma.Rd0000755000176200001440000000554615144316355020710 0ustar liggesusers\name{dist.Inverse.Matrix.Gamma} \alias{dinvmatrixgamma} \title{Inverse Matrix Gamma Distribution} \description{ This function provides the density for the inverse matrix gamma distribution. } \usage{ dinvmatrixgamma(X, alpha, beta, Psi, log=FALSE) } \arguments{ \item{X}{This is a \eqn{k \times k}{k x k} positive-definite covariance matrix.} \item{alpha}{This is a scalar shape parameter (the degrees of freedom), \eqn{\alpha}{alpha}.} \item{beta}{This is a scalar, positive-only scale parameter, \eqn{\beta}{beta}.} \item{Psi}{This is a \eqn{k \times k}{k x k} positive-definite scale matrix.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate Matrix \item Density: \eqn{p(\theta) = \frac{|\Psi|^\alpha}{\beta^{k \alpha} \Gamma_k(\alpha)} |\theta|^{-\alpha-(k+1)/2}\exp(tr(-\frac{1}{\beta}\Psi\theta^{-1}))}{p(theta) = {|Psi|^alpha / [beta^(k alpha) Gamma[k](alpha)]} |theta|^[-alpha-(k+1)/2] exp(tr(-(1/beta)Psi theta^(-1)))} \item Inventors: Unknown \item Notation 1: \eqn{\theta \sim \mathcal{IMG}_k(\alpha, \beta, \Psi)}{theta ~ IMG[k](alpha, beta, Psi)} \item Notation 2: \eqn{p(\theta) = \mathcal{IMG}_k(\theta | \alpha, \beta, \Psi)}{p(theta) = IMG[k](theta | alpha, beta, Psi)} \item Parameter 1: shape \eqn{\alpha > 2}{alpha > 2} \item Parameter 2: scale \eqn{\beta > 0}{beta > 0} \item Parameter 3: positive-definite \eqn{k \times k}{k x k} scale matrix \eqn{\Psi}{Psi} \item Mean: \item Variance: \item Mode: } The inverse matrix gamma (IMG), also called the inverse matrix-variate gamma, distribution is a generalization of the inverse gamma distribution to positive-definite matrices. It is a more general and flexible version of the inverse Wishart distribution (\code{\link{dinvwishart}}), and is a conjugate prior of the covariance matrix of a multivariate normal distribution (\code{\link{dmvn}}) and matrix normal distribution (\code{\link{dmatrixnorm}}). The compound distribution resulting from compounding a matrix normal with an inverse matrix gamma prior over the covariance matrix is a generalized matrix t-distribution. The inverse matrix gamma distribution is identical to the inverse Wishart distribution when \eqn{\alpha = \nu / 2}{alpha = nu / 2} and \eqn{\beta = 2}{beta = 2}. } \value{ \code{dinvmatrixgamma} gives the density. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dinvgamma}} \code{\link{dmatrixnorm}}, \code{\link{dmvn}}, and \code{\link{dinvwishart}} } \examples{ library(LaplacesDemon) k <- 10 dinvmatrixgamma(X=diag(k), alpha=(k+1)/2, beta=2, Psi=diag(k), log=TRUE) dinvwishart(Sigma=diag(k), nu=k+1, S=diag(k), log=TRUE) } \keyword{Distribution}LaplacesDemon/man/plot.juxtapose.Rd0000755000176200001440000000242715144316355017041 0ustar liggesusers\name{plot.juxtapose} \alias{plot.juxtapose} \title{Plot MCMC Juxtaposition} \description{ This may be used to plot a juxtaposition of MCMC algorithms according either to \code{\link{IAT}} or ISM (Independent Samples per Minute). } \usage{\method{plot}{juxtapose}(x, Style="ISM", \dots)} \arguments{ \item{x}{This required argument is an object of class \code{juxtapose}.} \item{Style}{This argument accepts either \code{IAT} or \code{ISM}, and defaults to \code{ISM}.} \item{\dots}{Additional arguments are unused.} } \details{ When \code{Style="IAT"}, the medians and 95\% probability intervals of the integrated autocorrelation times (IATs) of MCMC algorithms are displayed in a caterpillar plot. The best, or least inefficient, MCMC algorithm is the algorithm with the lowest IAT. When \code{Style="ISM"}, the medians and 95\% probability intervals of the numbers of independent samples per minute (ISM) of MCMC algorithms are displayed in a caterpillar plot. The best, or least inefficient, MCMC algorithm is the algorithm with the highest ISM. For more information, see the \code{\link{Juxtapose}} function. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{Juxtapose}}} \keyword{Plot}LaplacesDemon/man/LaplacesDemon-package.Rd0000755000176200001440000000540715144316355020143 0ustar liggesusers\name{LaplacesDemon-package} \alias{LaplacesDemon-package} \alias{.colVars} \alias{.iqagh} \alias{.iqaghsg} \alias{.iqcagh} \alias{.laaga} \alias{.labfgs} \alias{.labhhh} \alias{.lacg} \alias{.ladfp} \alias{.lahar} \alias{.lahj} \alias{.lalbfgs} \alias{.lalm} \alias{.lanm} \alias{.lanr} \alias{.lapso} \alias{.larprop} \alias{.lasgd} \alias{.lasoma} \alias{.laspg} \alias{.lasr1} \alias{.latr} \alias{.mcmcadmg} \alias{.mcmcafss} \alias{.mcmcagg} \alias{.mcmcahmc} \alias{.mcmcaies} \alias{.mcmcam} \alias{.mcmcamm} \alias{.mcmcamm.b} \alias{.mcmcamwg} \alias{.mcmccharm} \alias{.mcmcdemc} \alias{.mcmcdram} \alias{.mcmcdrm} \alias{.mcmcess} \alias{.mcmcgibbs} \alias{.mcmcgg} \alias{.mcmcggcp} \alias{.mcmcggcpp} \alias{.mcmcggdp} \alias{.mcmcggdpp} \alias{.mcmcharm} \alias{.mcmchmc} \alias{.mcmchmcda} \alias{.mcmcim} \alias{.mcmcinca} \alias{.mcmcmala} \alias{.mcmcmcmcmc} \alias{.mcmcmtm} \alias{.mcmcmwg} \alias{.mcmcnuts} \alias{.mcmcohss} \alias{.mcmcram} \alias{.mcmcrdmh} \alias{.mcmcrefractive} \alias{.mcmcrj} \alias{.mcmcrss} \alias{.mcmcrwm} \alias{.mcmcsamwg} \alias{.mcmcsgld} \alias{.mcmcslice} \alias{.mcmcsmwg} \alias{.mcmcthmc} \alias{.mcmctwalk} \alias{.mcmcuess} \alias{.mcmcusamwg} \alias{.mcmcusmwg} \alias{.rowVars} \alias{.vbsalimans2} \docType{package} \title{ \packageTitle{LaplacesDemon} } \description{ \packageDescription{LaplacesDemon} } \details{ The DESCRIPTION file: \packageDESCRIPTION{LaplacesDemon} \packageIndices{LaplacesDemon} The goal of LaplacesDemon, often referred to as LD, is to provide a complete and self-contained Bayesian environment within R. For example, this package includes dozens of MCMC algorithms, Laplace Approximation, iterative quadrature, variational Bayes, parallelization, big data, PMC, over 100 examples in the ``Examples'' vignette, dozens of additional probability distributions, numerous MCMC diagnostics, Bayes factors, posterior predictive checks, a variety of plots, elicitation, parameter and variable importance, Bayesian forms of test statistics (such as Durbin-Watson, Jarque-Bera, etc.), validation, and numerous additional utility functions, such as functions for multimodality, matrices, or timing your model specification. Other vignettes include an introduction to Bayesian inference, as well as a tutorial. No further development of this package is currently being done as the original maintainer has stopped working on the package. Contributions to this package are welcome at \url{https://github.com/LaplacesDemonR/LaplacesDemon}. The main function in this package is the \code{LaplacesDemon} function, and the best place to start is probably with the LaplacesDemon Tutorial vignette. } \author{ \packageAuthor{LaplacesDemon} Maintainer: \packageMaintainer{LaplacesDemon} } \keyword{package} LaplacesDemon/man/dist.Log.Normal.Precision.Rd0000755000176200001440000000756315144316355020714 0ustar liggesusers\name{dist.Log.Normal.Precision} \alias{dlnormp} \alias{plnormp} \alias{qlnormp} \alias{rlnormp} \title{Log-Normal Distribution: Precision Parameterization} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate log-normal distribution with mean \eqn{\mu}{mu} and precision \eqn{\tau}{tau}. } \usage{ dlnormp(x, mu, tau=NULL, var=NULL, log=FALSE) plnormp(q, mu, tau, lower.tail=TRUE, log.p=FALSE) qlnormp(p, mu, tau, lower.tail=TRUE, log.p=FALSE) rlnormp(n, mu, tau=NULL, var=NULL) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mu}{This is the mean parameter \eqn{\mu}{mu}.} \item{tau}{This is the precision parameter \eqn{\tau}{tau}, which must be positive. Tau and var cannot be used together} \item{var}{This is the variance parameter, which must be positive. Tau and var cannot be used together} \item{log, log.p}{Logical. If \code{TRUE}, then probabilities \eqn{p} are given as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{Logical. If \code{TRUE} (default), then probabilities are \eqn{Pr[X \le x]}{Pr[X <= x]}, otherwise, \eqn{Pr[X > x]}{Pr[X > x]}.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \sqrt{\frac{\tau}{2\pi}} \frac{1}{\theta} \exp(-\frac{\tau}{2} (\log(\theta - \mu))^2)}{p(theta) = sqrt(tau/(2*pi)) * (1/theta) * exp(-(tau/2)*(log(theta-mu))^2)} \item Inventor: Carl Friedrich Gauss or Abraham De Moivre \item Notation 1: \eqn{\theta \sim \mathrm{Log-}\mathcal{N}(\mu, \tau^{-1})}{theta ~ Log-N(mu, tau^(-1))} \item Notation 2: \eqn{p(\theta) = \mathrm{Log-}\mathcal{N}(\theta | \mu, \tau^{-1})}{p(theta) = Log-N(theta | mu, tau^(-1))} \item Parameter 1: mean parameter \eqn{\mu}{mu} \item Parameter 2: precision parameter \eqn{\tau > 0}{tau > 0} \item Mean: \eqn{E(\theta) = \exp(\mu + \tau^{-1} / 2)}{E(theta) = exp(mu + tau^(-1) / 2)} \item Variance: \eqn{var(\theta) = (\exp(\tau^{-1}) - 1)\exp(2\mu + \tau^{-1})}{var(theta) = exp(tau^(-1) - 1) * exp(2*mu + tau^(-1))} \item Mode: \eqn{mode(\theta) = \exp(\mu - \tau^{-1})}{mode(theta) = exp(mu - tau^(-1))} } The log-normal distribution, also called the Galton distribution, is applied to a variable whose logarithm is normally-distributed. The distribution is usually parameterized with mean and variance, or in Bayesian inference, with mean and precision, where precision is the inverse of the variance. In contrast, \code{Base R} parameterizes the log-normal distribution with the mean and standard deviation. These functions provide the precision parameterization for convenience and familiarity. A flat distribution is obtained in the limit as \eqn{\tau \rightarrow 0}{tau -> 0}. These functions are similar to those in \code{base R}. } \value{ \code{dlnormp} gives the density, \code{plnormp} gives the distribution function, \code{qlnormp} gives the quantile function, and \code{rlnormp} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dnorm}}, \code{\link{dnormp}}, \code{\link{dnormv}}, and \code{\link{prec2var}}. } \examples{ library(LaplacesDemon) x <- dlnormp(1,0,1) x <- plnormp(1,0,1) x <- qlnormp(0.5,0,1) x <- rlnormp(100,0,1) #Plot Probability Functions x <- seq(from=0.1, to=3, by=0.01) plot(x, dlnormp(x,0,0.1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dlnormp(x,0,1), type="l", col="green") lines(x, dlnormp(x,0,5), type="l", col="blue") legend(2, 0.9, expression(paste(mu==0, ", ", tau==0.1), paste(mu==0, ", ", tau==1), paste(mu==0, ", ", tau==5)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/MinnesotaPrior.Rd0000755000176200001440000001060615144316355017011 0ustar liggesusers\name{MinnesotaPrior} \alias{MinnesotaPrior} \title{Minnesota Prior} \description{ The Minnesota prior, also called the Litterman prior, is a shrinkage prior for autoregressive parameters in vector autoregressive (VAR) models. There are many variations of the Minnesota prior. This Minnesota prior is calculated as presented in Lutkepohl (2005, p. 225), and returns one or more prior covariance matrices in an array. } \usage{ MinnesotaPrior(J, lags=c(1,2), lambda=1, theta=0.5, sigma) } \arguments{ \item{J}{This is the scalar number of time-series in the VAR.} \item{lags}{This accepts an integer vector of lags of the autoregressive parameters. The lags are not required to be successive.} \item{lambda}{This accepts a scalar, positive-only hyperparameter that controls how tightly the parameter of the first lag is concentrated around zero. A smaller value results in smaller diagonal variance. When equal to zero, the posterior equals the prior and data is not influential. When equal to infinity, no shrinkage occurs and posterior expectations are closest to estimates from ordinary least squares (OLS). It has been asserted that as the number, \eqn{J}, of time-series increases, this hyperparameter should decrease.} \item{theta}{This accepts a scalar hyperparameter in the interval [0,1]. When one, off-diagonal elements have variance similar or equal to diagonal elements. When zero, off-diagonal elements have zero variance. A smaller value is associated with less off-diagonal variance.} \item{sigma}{This accepts a vector of length \eqn{J} of residual standard deviations of the dependent variables given the expectations.} } \details{ The Minnesota prior was introduced in Doan, Litterman, and Sims (1984) as a shrinkage prior for autoregressive parameters in vector autoregressive (VAR) models. The Minnesota prior was reviewed in Litterman (1986), and numerous variations have been presented since. This is the version of the Minnesota prior as described in Lutkepohl (2005, p. 225) for stationary time-series. Given one or more \eqn{J \times J} matrices of autoregressive parameters in a VAR model, the user specifies two tuning hyperparameters for the Minnesota prior: \code{lambda} and \code{theta}. Each iteration of the numerical approximation algorithm, the latest vector of residual standard deviation parameters is supplied to the \code{MinnesotaPrior} function, which then returns an array that contains one or more prior covariance matrices for the autoregressive parameters. Multiple prior covariance matrices are returned when multiple lags are specified. The tuning hyperparameters, \code{lambda} and \code{theta}, can be estimated from the data via hierarchical Bayes. It is important to note that the Minnesota prior does not technically return a covariance matrix, because the matrix is not symmetric, and therefore not positive-definite. For this reason, a Minnesota prior covariance matrix should not be supplied as a covariance matrix to a multivariate normal distribution, such as with the \code{\link{dmvn}} function, though it would be accepted and then (incorrectly) converted to a symmetric matrix. Instead, \code{\link{dnormv}} should be used for element-wise evaluation. While the Minnesota prior is used to specify the prior covariance for VAR autoregressive parameters, prior means are often all set to zero, or sometimes the first lag is set to an identity matrix. An example is provided in the Examples vignette. } \value{ This function returns a \eqn{J \times J \times L}{J x J x L} array for \eqn{J} time-series and \eqn{L} lags. } \references{ Doan, T., Litterman, R.B. and Sims, C.A. (1984). "Forecasting and Conditional Projection using Realistic Prior Distributions". \emph{Econometric Reviews}, 3, p. 1--144. Litterman, R.B. (1986). "Forecasting with Bayesian Vector Autoregressions - Five Years of Experience". \emph{Journal of Business & Economic Statistics}, 4, p. 25--38. Lutkepohl, H. (2005). "New Introduction to Multiple Time Series Analysis". Springer, Germany. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{dmvn}}, \code{\link{dnormv}}, and \code{\link{LaplacesDemon}}. } \keyword{Litterman Prior} \keyword{Utility}LaplacesDemon/man/as.covar.Rd0000755000176200001440000000450215144316355015552 0ustar liggesusers\name{as.covar} \alias{as.covar} \title{Proposal Covariance} \description{ This function returns the most recent covariance matrix or a list of blocking covariance matrices from an object of class \code{demonoid}, the most recent covariance matrix from \code{iterquad}, \code{laplace}, or \code{vb}, the most recent covariance matrix from the chain with the lowest deviance in an object of class \code{demonoid.hpc}, and a number of covariance matrices of an object of class \code{pmc} equal to the number of mixture components. The returned covariance matrix or matrices are intended to be the initial proposal covariance matrix or matrices for future updates. A variance vector from an object of class \code{demonoid} or \code{demonoid.hpc} is converted to a covariance matrix. } \usage{ as.covar(x) } \arguments{ \item{x}{This is an object of class \code{demonoid}, \code{demonoid.hpc}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}.} } \details{ Unless it is known beforehand how many iterations are required for iterative quadrature, Laplace Approximation, or Variational Bayes to converge, MCMC to appear converged, or the normalized perplexity to stabilize in PMC, multiple updates are necessary. An additional update, however, should not begin with the same proposal covariance matrix or matrices as the original update, because it will have to repeat the work already accomplished. For this reason, the \code{as.covar} function may be used at the end of an update to change the previous initial values to the latest values. The \code{as.covar} function is most helpful with objects of class \code{pmc} that have multiple mixture components. For more information, see \code{\link{PMC}}. } \value{ The returned value is a matrix (or array in the case of PMC with multiple mixture components) of the latest observed or proposal covariance, which may now be used as an initial proposal covariance matrix or matrices for a future update. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \keyword{Utility}LaplacesDemon/man/dist.Multivariate.Laplace.Cholesky.Rd0000755000176200001440000001550715144316355022575 0ustar liggesusers\name{dist.Multivariate.Laplace.Cholesky} \alias{dmvlc} \alias{rmvlc} \title{Multivariate Laplace Distribution: Cholesky Parameterization} \description{ These functions provide the density and random number generation for the multivariate Laplace distribution, given the Cholesky parameterization. } \usage{ dmvlc(x, mu, U, log=FALSE) rmvlc(n, mu, U) } \arguments{ \item{x}{This is data or parameters in the form of a vector of length \eqn{k} or a matrix with \eqn{k} columns.} \item{n}{This is the number of random draws.} \item{mu}{This is mean vector \eqn{\mu}{mu} with length \eqn{k} or matrix with \eqn{k} columns.} \item{U}{This is the \eqn{k \times k}{k x k} upper-triangular matrix that is Cholesky factor \eqn{\textbf{U}}{U} of covariance matrix \eqn{\Sigma}{Sigma}.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Multivariate \item Density: \deqn{p(\theta) = \frac{2}{(2\pi)^{k/2} |\Sigma|^{1/2}} \frac{(\pi/(2\sqrt{2(\theta - \mu)^T \Sigma^{-1} (\theta - \mu)}))^{1/2} \exp(-\sqrt{2(\theta - \mu)^T \Sigma^{-1} (\theta - \mu)})}{\sqrt{((\theta - \mu)^T \Sigma^{-1} (\theta - \mu) / 2)}^{k/2-1}}}{p(theta) = (2 / ((2*pi)^(k/2) * |Sigma|^(1/2))) ((sqrt(pi/(2*sqrt(2*(theta-mu)^TSigma^(-1)(theta-mu)))) * exp(-sqrt(2*(theta-mu)^TSigma^(-1)(theta-mu)))) / sqrt((theta-mu)^TSigma^(-1)(theta-mu)/2)^(k/2-1))} \item Inventor: Fang et al. (1990) \item Notation 1: \eqn{\theta \sim \mathcal{MVL}(\mu, \Sigma)}{theta ~ MVL(mu, Sigma)} \item Notation 2: \eqn{\theta \sim \mathcal{L}_k(\mu, \Sigma)}{theta ~ L[k](mu, Sigma)} \item Notation 3: \eqn{p(\theta) = \mathcal{MVL}(\theta | \mu, \Sigma)}{p(theta) = MVL(theta | mu, Sigma)} \item Notation 4: \eqn{p(\theta) = \mathcal{L}_k(\theta | \mu, \Sigma)}{p(theta) = L[k](theta | mu, Sigma)} \item Parameter 1: location vector \eqn{\mu}{mu} \item Parameter 2: positive-definite \eqn{k \times k}{k x k} covariance matrix \eqn{\Sigma}{Sigma} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = \Sigma}{var(theta) = Sigma} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The multivariate Laplace distribution is a multidimensional extension of the one-dimensional or univariate symmetric Laplace distribution. There are multiple forms of the multivariate Laplace distribution. The bivariate case was introduced by Ulrich and Chen (1987), and the first form in larger dimensions may have been Fang et al. (1990), which requires a Bessel function. Alternatively, multivariate Laplace was soon introduced as a special case of a multivariate Linnik distribution (Anderson, 1992), and later as a special case of the multivariate power exponential distribution (Fernandez et al., 1995; Ernst, 1998). Bayesian considerations appear in Haro-Lopez and Smith (1999). Wainwright and Simoncelli (2000) presented multivariate Laplace as a Gaussian scale mixture. Kotz et al. (2001) present the distribution formally. Here, the density is calculated with the asymptotic formula for the Bessel function as presented in Wang et al. (2008). The multivariate Laplace distribution is an attractive alternative to the multivariate normal distribution due to its wider tails, and remains a two-parameter distribution (though alternative three-parameter forms have been introduced as well), unlike the three-parameter multivariate t distribution, which is often used as a robust alternative to the multivariate normal distribution. In practice, \eqn{\textbf{U}}{U} is fully unconstrained for proposals when its diagonal is log-transformed. The diagonal is exponentiated after a proposal and before other calculations. Overall, the Cholesky parameterization is faster than the traditional parameterization. Compared with \code{dmvl}, \code{dmvlc} must additionally matrix-multiply the Cholesky back to the covariance matrix, but it does not have to check for or correct the covariance matrix to positive-definiteness, which overall is slower. Compared with \code{rmvl}, \code{rmvlc} is faster because the Cholesky decomposition has already been performed. } \value{ \code{dmvlc} gives the density, and \code{rmvlc} generates random deviates. } \references{ Anderson, D.N. (1992). "A Multivariate Linnik Distribution". \emph{Statistical Probability Letters}, 14, p. 333--336. Eltoft, T., Kim, T., and Lee, T. (2006). "On the Multivariate Laplace Distribution". \emph{IEEE Signal Processing Letters}, 13(5), p. 300--303. Ernst, M. D. (1998). "A Multivariate Generalized Laplace Distribution". \emph{Computational Statistics}, 13, p. 227--232. Fang, K.T., Kotz, S., and Ng, K.W. (1990). "Symmetric Multivariate and Related Distributions". Monographs on Statistics and Probability, 36, Chapman-Hall, London. Fernandez, C., Osiewalski, J. and Steel, M.F.J. (1995). "Modeling and Inference with v-spherical Distributions". \emph{Journal of the American Statistical Association}, 90, p. 1331--1340. Gomez, E., Gomez-Villegas, M.A., and Marin, J.M. (1998). "A Multivariate Generalization of the Power Exponential Family of Distributions". \emph{Communications in Statistics-Theory and Methods}, 27(3), p. 589--600. Haro-Lopez, R.A. and Smith, A.F.M. (1999). "On Robust Bayesian Analysis for Location and Scale Parameters". \emph{Journal of Multivariate Analysis}, 70, p. 30--56. Kotz., S., Kozubowski, T.J., and Podgorski, K. (2001). "The Laplace Distribution and Generalizations: A Revisit with Applications to Communications, Economics, Engineering, and Finance". Birkhauser: Boston, MA. Ulrich, G. and Chen, C.C. (1987). "A Bivariate Double Exponential Distribution and its Generalization". \emph{ASA Proceedings on Statistical Computing}, p. 127--129. Wang, D., Zhang, C., and Zhao, X. (2008). "Multivariate Laplace Filter: A Heavy-Tailed Model for Target Tracking". \emph{Proceedings of the 19th International Conference on Pattern Recognition}: FL. Wainwright, M.J. and Simoncelli, E.P. (2000). "Scale Mixtures of Gaussians and the Statistics of Natural Images". \emph{Advances in Neural Information Processing Systems}, 12, p. 855--861. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{chol}}, \code{\link{daml}}, \code{\link{dlaplace}}, \code{\link{dmvnc}}, \code{\link{dmvnpc}}, \code{\link{dmvpec}}, \code{\link{dmvtc}}, \code{\link{dnorm}}, \code{\link{dnormp}}, and \code{\link{dnormv}}. } \examples{ library(LaplacesDemon) Sigma <- diag(3) U <- chol(Sigma) x <- dmvlc(c(1,2,3), c(0,1,2), U) X <- rmvlc(1000, c(0,1,2), U) joint.density.plot(X[,1], X[,2], color=TRUE) } \keyword{Distribution}LaplacesDemon/man/dist.Laplace.Precision.Rd0000755000176200001440000001043615144316355020276 0ustar liggesusers\name{dist.Laplace.Precision} \alias{dlaplacep} \alias{plaplacep} \alias{qlaplacep} \alias{rlaplacep} \title{Laplace Distribution: Precision Parameterization} \description{ These functions provide the density, distribution function, quantile function, and random generation for the univariate, symmetric, Laplace distribution with location parameter \eqn{\mu}{mu} and precision parameter \eqn{\tau}{tau}, which is the inverse of the usual scale parameter, \eqn{\lambda}{lambda}. } \usage{ dlaplacep(x, mu=0, tau=1, log=FALSE) plaplacep(q, mu=0, tau=1) qlaplacep(p, mu=0, tau=1) rlaplacep(n, mu=0, tau=1) } \arguments{ \item{x, q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{mu}{This is the location parameter \eqn{\mu}{mu}.} \item{tau}{This is the precision parameter \eqn{\tau}{tau}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{\tau}{2} \exp(-\tau |\theta-\mu|)}{p(theta) = (tau/2) * exp(-tau*abs(theta-mu))} \item Inventor: Pierre-Simon Laplace (1774) \item Notation 1: \eqn{\theta \sim \mathrm{Laplace}(\mu,\tau^{-1})}{theta ~ Laplace(mu, tau^(-1))} \item Notation 2: \eqn{\theta \sim \mathcal{L}(\mu, \tau^{-1})}{theta ~ L(mu, tau^(-1))} \item Notation 3: \eqn{p(\theta) = \mathrm{Laplace}(\mu,\tau^{-1})}{p(theta) = Laplace(mu, tau^(-1))} \item Notation 4: \eqn{p(\theta) = \mathcal{L}(\theta | \mu, \tau^{-1})}{p(theta) = L(theta | mu, tau(-1))} \item Parameter 1: location parameter \eqn{\mu}{mu} \item Parameter 2: precision parameter \eqn{\tau > 0}{tau > 0} \item Mean: \eqn{E(\theta) = \mu}{E(theta) = mu} \item Variance: \eqn{var(\theta) = 2 \tau^{-2}}{var(theta) = 2*tau^{-2}} \item Mode: \eqn{mode(\theta) = \mu}{mode(theta) = mu} } The Laplace distribution is also called the double exponential distribution, because it looks like two exponential distributions back to back with respect to location \eqn{\mu}{mu}. It is also called the ``First Law of Laplace'', just as the normal distribution is referred to as the ``Second Law of Laplace''. The Laplace distribution is symmetric with respect to \eqn{\mu}{mu}, though there are asymmetric versions of the Laplace distribution. The PDF of the Laplace distribution is reminiscent of the normal distribution; however, whereas the normal distribution is expressed in terms of the squared difference from the mean \eqn{\mu}{mu}, the Laplace density is expressed in terms of the absolute difference from the mean, \eqn{\mu}{mu}. Consequently, the Laplace distribution has fatter tails than the normal distribution. It has been argued that the Laplace distribution fits most things in nature better than the normal distribution. Elsewhere, there are a large number of extensions to the Laplace distribution, including asymmetric versions and multivariate versions, among many more. These functions provide the precision parameterization for convenience and familiarity in Bayesian inference. } \value{ \code{dlaplacep} gives the density, \code{plaplacep} gives the distribution function, \code{qlaplacep} gives the quantile function, and \code{rlaplacep} generates random deviates. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{dalaplace}}, \code{\link{dexp}}, \code{\link{dlaplace}}, \code{\link{dmvl}}, \code{\link{dnorm}}, \code{\link{dnormp}}, and \code{\link{dnormv}}. } \examples{ library(LaplacesDemon) x <- dlaplacep(1,0,1) x <- plaplacep(1,0,1) x <- qlaplacep(0.5,0,1) x <- rlaplacep(100,0,1) #Plot Probability Functions x <- seq(from=-5, to=5, by=0.1) plot(x, dlaplacep(x,0,0.5), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dlaplacep(x,0,1), type="l", col="green") lines(x, dlaplacep(x,0,2), type="l", col="blue") legend(2, 0.9, expression(paste(mu==0, ", ", tau==0.5), paste(mu==0, ", ", tau==1), paste(mu==0, ", ", tau==2)), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/dist.HalfCauchy.Rd0000755000176200001440000000546615144316355017021 0ustar liggesusers\name{dist.HalfCauchy} \alias{dhalfcauchy} \alias{phalfcauchy} \alias{qhalfcauchy} \alias{rhalfcauchy} \title{Half-Cauchy Distribution} \description{ These functions provide the density, distribution function, quantile function, and random generation for the half-Cauchy distribution. } \usage{ dhalfcauchy(x, scale=25, log=FALSE) phalfcauchy(q, scale=25) qhalfcauchy(p, scale=25) rhalfcauchy(n, scale=25) } \arguments{ \item{x,q}{These are each a vector of quantiles.} \item{p}{This is a vector of probabilities.} \item{n}{This is the number of observations, which must be a positive integer that has length 1.} \item{scale}{This is the scale parameter \eqn{\alpha}{alpha}, which must be positive.} \item{log}{Logical. If \code{log=TRUE}, then the logarithm of the density is returned.} } \details{ \itemize{ \item Application: Continuous Univariate \item Density: \eqn{p(\theta) = \frac{2 \alpha}{\pi(\theta^2 + \alpha^2)}, \quad \theta > 0}{p(theta) = 2alpha / pi(theta^2 + alpha^2), theta >= 0} \item Inventor: Derived from Cauchy \item Notation 1: \eqn{\theta \sim \mathcal{HC}(\alpha)}{theta ~ HC(alpha)} \item Notation 2: \eqn{p(\theta) = \mathcal{HC}(\theta | \alpha)}{p(theta) = HC(theta | alpha)} \item Parameter 1: scale parameter \eqn{\alpha > 0}{alpha > 0} \item Mean: \eqn{E(\theta)}{E(theta)} = does not exist \item Variance: \eqn{var(\theta)}{var(theta)} = does not exist \item Mode: \eqn{mode(\theta) = 0}{mode(theta) = 0} } The half-Cauchy distribution with scale \eqn{\alpha=25}{alpha=25} is a recommended, default, weakly informative prior distribution for a scale parameter. Otherwise, the scale, \eqn{\alpha}{alpha}, is recommended to be set to be just a little larger than the expected standard deviation, as a weakly informative prior distribution on a standard deviation parameter. The Cauchy distribution is known as a pathological distribution because its mean and variance are undefined, and it does not satisfy the central limit theorem. } \value{ \code{dhalfcauchy} gives the density, \code{phalfcauchy} gives the distribution function, \code{qhalfcauchy} gives the quantile function, and \code{rhalfcauchy} generates random deviates. } \seealso{ \code{\link{dcauchy}} } \examples{ library(LaplacesDemon) x <- dhalfcauchy(1,25) x <- phalfcauchy(1,25) x <- qhalfcauchy(0.5,25) x <- rhalfcauchy(1,25) #Plot Probability Functions x <- seq(from=0, to=20, by=0.1) plot(x, dhalfcauchy(x,1), ylim=c(0,1), type="l", main="Probability Function", ylab="density", col="red") lines(x, dhalfcauchy(x,5), type="l", col="green") lines(x, dhalfcauchy(x,10), type="l", col="blue") legend(2, 0.9, expression(alpha==1, alpha==5, alpha==10), lty=c(1,1,1), col=c("red","green","blue")) } \keyword{Distribution}LaplacesDemon/man/data.demonsnacks.Rd0000755000176200001440000000242315144316355017253 0ustar liggesusers\name{data.demonsnacks} \alias{demonsnacks} \title{Demon Snacks Data Set} \usage{data(demonsnacks)} \description{ Late one night, after witnessing Laplace's Demon in action, I followed him back to what seemed to be his lair. Minutes later, he left again. I snuck inside and saw something labeled 'Demon Snacks'. Hurriedly, I recorded the 39 items, each with a name and 10 nutritional attributes. } \format{ This data frame contains 39 rows (with row names) and 10 columns. The following data dictionary describes each variable or column. \describe{ \item{\code{Serving.Size}}{This is serving size in grams.} \item{\code{Calories}}{This is the number of calories.} \item{\code{Total.Fat}}{This is total fat in grams.} \item{\code{Saturated.Fat}}{This is saturated fat in grams.} \item{\code{Cholesterol}}{This is cholesterol in milligrams.} \item{\code{Sodium}}{This is sodium in milligrams.} \item{\code{Total.Carbohydrate}}{This is the total carbohydrates in grams.} \item{\code{Dietary.Fiber}}{This is dietary fiber in grams.} \item{\code{Sugars}}{This is sugar in grams.} \item{\code{Protein}}{This is protein in grams.} } } \source{This data was obtained from the lair of Laplace's Demon!} \keyword{datasets} LaplacesDemon/man/as.initial.values.Rd0000755000176200001440000000532615144316355017374 0ustar liggesusers\name{as.initial.values} \alias{as.initial.values} \title{Initial Values} \description{ This function returns the most recent posterior samples from an object of class \code{demonoid} or \code{demonoid.hpc}, the posterior means of an object of class \code{iterquad}, the posterior modes of an object of class \code{laplace} or \code{vb}, the posterior means of an object of class \code{pmc} with one mixture component, or the latest means of the importance sampling distribution of an object of class \code{pmc} with multiple mixture components. The returned values are intended to be the initial values for future updates. } \usage{ as.initial.values(x) } \arguments{ \item{x}{This is an object of class \code{demonoid}, \code{demonoid.hpc}, \code{iterquad}, \code{laplace}, \code{pmc}, or \code{vb}.} } \details{ Unless it is known beforehand how many iterations are required for \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, or \code{\link{VariationalBayes}} to converge, MCMC in \code{\link{LaplacesDemon}} to appear converged, or the normalized perplexity to stabilize in \code{\link{PMC}}, multiple updates are necessary. An additional update, however, should not begin with the same initial values as the original update, because it will have to repeat the work already accomplished. For this reason, the \code{as.initial.values} function may be used at the end of an update to change the previous initial values to the latest values. When using \code{\link{LaplacesDemon.hpc}}, \code{as.initial.values} should be used when the output is of class \code{demonoid.hpc}, before the \code{\link{Combine}} function is used to combine the multiple chains for use with \code{\link{Consort}} and other functions, because the \code{\link{Combine}} function returns an object of class \code{demonoid}, and the number of chains will become unknown. The \code{\link{Consort}} function may suggest using \code{as.initial.values}, but when applied to an object of class \code{demonoid}, it will return the latest values as if there were only one chain. } \value{ The returned value is a vector (or matrix in the case of an object of class \code{demonoid.hpc}, or \code{pmc} with multiple mixture components) of the latest values, which may now be used as initial values for a future update. } \author{Statisticat, LLC. \email{software@bayesian-inference.com}} \seealso{ \code{\link{Combine}}, \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.hpc}}, \code{\link{PMC}}, and \code{\link{VariationalBayes}}. } \keyword{Initial Values}LaplacesDemon/man/Geweke.Diagnostic.Rd0000755000176200001440000000504215144316355017330 0ustar liggesusers\name{Geweke.Diagnostic} \alias{Geweke.Diagnostic} \title{Geweke's Convergence Diagnostic} \description{ Geweke (1992) proposed a convergence diagnostic for Markov chains. This diagnostic is based on a test for equality of the means of the first and last part of a Markov chain (by default the first 10\% and the last 50\%). If the samples are drawn from a stationary distribution of the chain, then the two means are equal and Geweke's statistic has an asymptotically standard normal distribution. The test statistic is a standard Z-score: the difference between the two sample means divided by its estimated standard error. The standard error is estimated from the spectral density at zero, and so takes into account any autocorrelation. The Z-score is calculated under the assumption that the two parts of the chain are asymptotically independent. The \code{Geweke.Diagnostic} is a univariate diagnostic that is usually applied to each marginal posterior distribution. A multivariate form is not included. By chance alone due to multiple independent tests, 5\% of the marginal posterior distributions should appear non-stationary when stationarity exists. Assessing multivariate convergence is difficult. } \usage{Geweke.Diagnostic(x)} \arguments{ \item{x}{This required argument is a vector or matrix of posterior samples, such as from the output of the \code{\link{LaplacesDemon}} function. Each column vector in a matrix is a chain to be assessed. A minimum of 100 samples are required.} } \details{ The \code{Geweke.Diagnostic} is essentially the same as the \code{geweke.diag} function in the \code{coda} package, but programmed to accept a simple vector or matrix, so it does not require an \code{mcmc} object. } \value{ A vector is returned, in which each element is a Z-score for a test of equality that compares the means of the first and last parts of each chain supplied as \code{x} to \code{Geweke.Diagnostic}. } \references{ Geweke, J. (1992). "Evaluating the Accuracy of Sampling-Based Approaches to Calculating Posterior Moments". In \emph{Bayesian Statistics 4} (ed JM Bernardo, JO Berger, AP Dawid, and AFM Smith). Clarendon Press, Oxford, UK. } \seealso{ \code{\link{burnin}}, \code{\link{is.stationary}}, and \code{\link{LaplacesDemon}} } \examples{ library(LaplacesDemon) Geweke.Diagnostic(rnorm(100)) Geweke.Diagnostic(matrix(rnorm(100),10,10)) } \keyword{Diagnostic} \keyword{MCMC} \keyword{Stationarity} \keyword{Utility}LaplacesDemon/man/BigData.Rd0000755000176200001440000002577615144316355015351 0ustar liggesusers\name{BigData} \alias{BigData} \title{Big Data} \description{ This function enables Bayesian inference with data that is too large for computer memory (RAM) with the simplest method: reading in batches of data (where each batch is a section of rows), applying a function to the batch, and combining the results. } \usage{ BigData(file, nrow, ncol, size=1, Method="add", CPUs=1, Type="PSOCK", FUN, ...) } \arguments{ \item{file}{This required argument accepts a path and filename that must refer to a .csv file, and that must contain only a numeric matrix without a header, row names, or column names.} \item{nrow}{This required argument accepts a scalar integer that indicates the number of rows in the big data matrix.} \item{ncol}{This required argument accepts a scalar integer that indicates the number of columns in the big data matrix.} \item{size}{This argument accepts a scalar integer that specifies the number of rows of each batch. The last batch is not required to have the same number of rows as the other batches. The largest possible size, and therefore the fewest number of batches, should be preferred.} \item{Method}{This argument accepts a scalar string, defaults to "add", and alternatively accepts "rbind". When \code{Method="rbind"}, the user-specified function \code{FUN} is applied to each batch, and results are combined together by rows. For example, if calculating \eqn{\mu = \textbf{X}\beta}{mu = XB} in, say, 10 batches, then the output column vector \eqn{\mu}{mu} is equal to the number of rows of the big data set.} \item{CPUs}{This argument accepts an integer that specifies the number of central processing units (CPUs) of the multicore computer or computer cluster. This argument defaults to \code{CPUs=1}, in which parallel processing does not occur.} \item{Type}{This argument specifies the type of parallel processing to perform, accepting either \code{Type="PSOCK"} or \code{Type="MPI"}.} \item{FUN}{This required argument accepts a user-specified function that will be performed on each batch. The first argument in the function must be the data.} \item{...}{Additional arguments are used within the user-specified function. Additional arguments often refer to parameters.} } \details{ Big data is defined loosely here as data that is too large for computer memory (RAM). The \code{BigData} function uses the split-apply-combine strategy with a big data set. The unmanageable big data set is split into smaller, manageable pieces (batches), a function is applied to each batch, and results are combined. Each iteration, the \code{BigData} function opens a connection to a big data set and keeps the connection open while the \code{scan} function reads in each batch of data (elsewhere, batches are often referred to chunks). A user-specified function is applied to each batch of data, the results are combined together, the connection is closed, and the results are returned. As an introductory example, suppose a statistician updates a linear regression model, but the design matrix \eqn{\textbf{X}}{X} is too large for computer memory. Suppose the design matrix has 100 million rows, and the statistician specifies \code{size=1e6}. The statistician combines dependent variable \eqn{\textbf{y}} with design matrix \eqn{\textbf{X}}. Each iteration in \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{PMC}}, or \code{\link{VariationalBayes}}, the \code{BigData} function sequentially reads in one million rows of the combined data \eqn{\textbf{X}}, calculates expectation vector \eqn{\mu}, and finally returns the sum of the log-likelihood. The sum of the log-likelihood is added together for all batches, and returned. There are many limitations with this function. This function is not fast, in the sense that the entire big data set is processed in batches, each iteration. With iterative methods, this may perform well, albeit slowly. There are many functions that cannot be performed on batches, though most models in the Examples vignette may easily be updated with big data. Large matrices of samples are unaddressed, only the data. Although many (but not all) models may be estimated, many additional functions in this package will not work when applied after the model has updated. Instead, a batch or random sample of data (see the \code{\link{read.matrix}} function for sampling from big data) should be used in the usual way, in the \code{Data} argument, and the \code{Model} function coded in the usual way without the \code{BigData} function. Parallel processing may be performed when the user specifies \code{CPUs} to be greater than one, implying that the specified number of CPUs exists and is available. Parallelization may be performed on a multicore computer or a computer cluster. Either a Simple Network of Workstations (SNOW) or Message Passing Interface (MPI) is used. Each call to \code{BigData} establishes and closes the parallelization, which is costly, and unfortunately results in copious output to the console. With small data sets, parallel processing may be slower, due to computer network communication. With larger data sets, the user should experience a faster run-time. There have been several alternative approaches suggested for big data. Huang and Gelman (2005) propose that the user creates batches by sampling from big data, updating a separate Bayesian model on each batch, and combining the results into a consensus posterior. This many-mini-model approach may be faster when feasible, because multiple models may be updated in parallel, say one per CPU. Such results will work with all functions in this package. With the many-mini-model approach, several methods are proposed for combining posterior samples from batch-level models, such as by using a normal approximation, updating from prior to posterior sequentially (the posterior from the last batch becomes the prior of the next batch), sample from the full posterior via importance sampling from the batched posteriors, and more. Scott et al. (2013) propose a method that they call Consensus Monte Carlo, which consists of breaking the data down into chunks, calling each chunk a shard, and use a many-mini-model approach as well, but propose their own method of weighting the posteriors back together. Balakrishnan and Madigan (2006) introduced a Sequential Monte Carlo (SMC) sampler, a refinement of an earlier proposal, that was designed for big data. It makes one pass through the massive data set, after an initial MCMC estimation on a small sample. Each particle is updated for each record, resulting in numerous evaluations per record. Welling and Teh (2011) proposed a new class of MCMC sampler in which only a random sample of big data is used each iteration. The stochastic gradient Langevin dynamics (SGLD) algorithm is available in the \code{\link{LaplacesDemon}} function. An important alternative to consider is using the \code{ff} package, where "ff" stands for fast access file. The \code{ff} package has been tested successfully with updating a model in \code{LaplacesDemon}. Once the big data set, say \eqn{\textbf{X}}{X}, is an object of class \code{ff_matrix}, simply include it in the list of data as usual, and modify the \code{Model} specification function appropriately. For example, change \code{mu <- tcrossprod(X, t(beta))} to \code{mu <- tcrossprod(X[], t(beta))}. The \code{ff} package is not included as a dependency in the \code{LaplacesDemon} package, so it must be installed and activated. } \value{ The \code{BigData} function returns output that is the result of performing a user-specified function on batches of big data. Output is a matrix, and may have one or more column vectors. } \references{ Balakrishnan, S. and Madigan, D. (2006). "A One-Pass Sequential Monte Carlo Method for Bayesian Analysis of Massive Datasets". \emph{Bayesian Analysis}, 1(2), p. 345--362. Huang, Z. and Gelman, A. (2005) "Sampling for Bayesian Computation with Large Datasets". \emph{SSRN eLibrary}. Scott, S.L., Blocker, A.W. and Bonassi, F.V. (2013). "Bayes and Big Data: The Consensus Monte Carlo Algorithm". In \emph{Bayes 250}. Welling, M. and Teh, Y.W. (2011). "Bayesian Learning via Stochastic Gradient Langevin Dynamics". \emph{Proceedings of the 28th International Conference on Machine Learning (ICML)}, p. 681--688. } \author{Statisticat, LLC \email{software@bayesian-inference.com}} \seealso{ \code{\link{IterativeQuadrature}}, \code{\link{LaplaceApproximation}}, \code{\link{LaplacesDemon}}, \code{\link{LaplacesDemon.RAM}}, \code{\link{PMC}}, \code{\link{PMC.RAM}}, \code{\link{read.matrix}}, and \code{\link{VariationalBayes}}. } \examples{ ### Below is an example of a linear regression model specification ### function in which BigData reads in a batch of 1,000 records of ### Data$N records from a data set that is too large to fully open ### in memory. The example simulates on 10,000 records, which is ### not big data; it's just a toy example. The data set is file X.csv, ### and the first column of matrix X is the dependent variable y. The ### user supplies a function to BigData along with parameters beta and ### sigma. When each batch of 1,000 records is read in, ### mu = XB is calculated, and then the LL is calculated as ### y ~ N(mu, sigma^2). These results are added together from all ### batches, and returned as LL. library(LaplacesDemon) N <- 10000 J <- 10 #Number of predictors, including the intercept X <- matrix(1,N,J) for (j in 2:J) {X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))} beta.orig <- runif(J,-3,3) e <- rnorm(N,0,0.1) y <- as.vector(tcrossprod(beta.orig, X) + e) mon.names <- c("LP","sigma") parm.names <- as.parm.names(list(beta=rep(0,J), log.sigma=0)) PGF <- function(Data) return(c(rnormv(Data$J,0,0.01), log(rhalfcauchy(1,1)))) MyData <- list(J=J, PGF=PGF, N=N, mon.names=mon.names, parm.names=parm.names) #Notice that X and y are not included here filename <- tempfile("X.csv") write.table(cbind(y,X), filename, sep=",", row.names=FALSE, col.names=FALSE) Model <- function(parm, Data) { ### Parameters beta <- parm[1:Data$J] sigma <- exp(parm[Data$J+1]) ### Log(Prior Densities) beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) ### Log-Likelihood LL <- BigData(file=filename, nrow=Data$N, ncol=Data$J+1, size=1000, Method="add", CPUs=1, Type="PSOCK", FUN=function(x, beta, sigma) sum(dnorm(x[,1], tcrossprod(x[,-1], t(beta)), sigma, log=TRUE)), beta, sigma) ### Log-Posterior LP <- LL + beta.prior + sigma.prior Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,sigma), yhat=0,#rnorm(length(mu), mu, sigma), parm=parm) return(Modelout) } ### From here, the user may update the model as usual. } \keyword{High Performance Computing} \keyword{Utility} LaplacesDemon/DESCRIPTION0000755000176200001440000000344215145103447014501 0ustar liggesusersPackage: LaplacesDemon Version: 16.1.8 Title: Complete Environment for Bayesian Inference Authors@R: c(person("Byron", "Hall", role = "aut"), person("Martina", "Hall", role = "aut"), person(family="Statisticat, LLC", role = c("aut", "cph")), person(given = "Charles J.", family="Geyer", role = c("ctb", "cph"), comment="for TR method in LaplaceApproximation, derived from trust::trust"), person(given="Eric", family="Brown", role = "ctb"), person(given="Richard", family="Hermanson", role = "ctb"), person(given="Emmanuel", family="Charpentier", role = "ctb"), person(given="Daniel", family="Heck", role = "ctb"), person(given="Stephane", family="Laurent", role = "ctb"), person(given="Quentin F.", family="Gronau", role = "ctb"), person(given="Henrik", family="Singmann", email="singmann+LaplacesDemon@gmail.com", role="cre")) Depends: R (>= 3.0.0) Imports: parallel, grDevices, graphics, stats, utils Suggests: KernSmooth ByteCompile: TRUE Description: Provides a complete environment for Bayesian inference using a variety of different samplers (see ?LaplacesDemon for an overview). License: MIT + file LICENSE URL: https://github.com/LaplacesDemonR/LaplacesDemon BugReports: https://github.com/LaplacesDemonR/LaplacesDemon/issues NeedsCompilation: no Packaged: 2026-02-17 12:00:50 UTC; singmann Author: Byron Hall [aut], Martina Hall [aut], Statisticat, LLC [aut, cph], Charles J. Geyer [ctb, cph] (for TR method in LaplaceApproximation, derived from trust::trust), Eric Brown [ctb], Richard Hermanson [ctb], Emmanuel Charpentier [ctb], Daniel Heck [ctb], Stephane Laurent [ctb], Quentin F. Gronau [ctb], Henrik Singmann [cre] Maintainer: Henrik Singmann Repository: CRAN Date/Publication: 2026-02-17 15:20:07 UTC