BMS/0000755000175100001440000000000012625003706010712 5ustar hornikusersBMS/inst/0000755000175100001440000000000012624725513011675 5ustar hornikusersBMS/inst/CITATION0000644000175100001440000000172612624725513013040 0ustar hornikusersbibentry(bibtype = "Article", title = "Bayesian Model Averaging Employing Fixed and Flexible Priors: The {BMS} Package for {R}", author = c(person(given = "Stefan", family = "Zeugner", email = "stefan.zeugner@gmail.com"), person(given = "Martin", family = "Feldkircher", email = "martin.feldkircher@oenb.at")), journal = "Journal of Statistical Software", year = "2015", volume = "68", number = "4", pages = "1--37", doi = "10.18637/jss.v068.i04", header = "To cite BMS in publications use:", textVersion = paste("Stefan Zeugner, Martin Feldkircher (2015).", "Bayesian Model Averaging Employing Fixed and Flexible Priors: The BMS Package for R.", "Journal of Statistical Software, 68(4), 1-37.", "doi:10.18637/jss.v068.i04") ) BMS/inst/doc/0000755000175100001440000000000012624725744012450 5ustar hornikusersBMS/inst/doc/bms.R0000644000175100001440000002372612624725744013366 0ustar hornikusers### R code from vignette source 'bms.Rnw' ################################################### ### code chunk number 1: bms.Rnw:16-17 ################################################### options(width=75) ################################################### ### code chunk number 2: bms.Rnw:64-65 ################################################### data(attitude) ################################################### ### code chunk number 3: bms.Rnw:68-69 ################################################### library(BMS) ################################################### ### code chunk number 4: bms.Rnw:72-73 ################################################### att = bms(attitude, mprior = "uniform", g="UIP", user.int=F) ################################################### ### code chunk number 5: bms.Rnw:79-80 ################################################### coef(att) ################################################### ### code chunk number 6: bms.Rnw:87-88 ################################################### coef(att, std.coefs=T, order.by.pip=F, include.constant=T) ################################################### ### code chunk number 7: bms.Rnw:94-95 ################################################### summary(att) ################################################### ### code chunk number 8: bms.Rnw:100-101 ################################################### topmodels.bma(att)[,1:3] ################################################### ### code chunk number 9: bms.Rnw:106-107 ################################################### image(att) ################################################### ### code chunk number 10: bms.Rnw:115-116 ################################################### sum(coef(att)[,1]) ################################################### ### code chunk number 11: bms.Rnw:120-121 ################################################### plotModelsize(att) ################################################### ### code chunk number 12: bms.Rnw:132-133 ################################################### att_fixed = bms(attitude, mprior="fixed", mprior.size=2, user.int=T) ################################################### ### code chunk number 13: bms.Rnw:139-140 ################################################### att_pip = bms(attitude, mprior="pip", mprior.size=c(.01,.5,.5,.5,.5,.5), user.int=F) ################################################### ### code chunk number 14: bms.Rnw:146-147 ################################################### plotModelsize(att_fixed) ################################################### ### code chunk number 15: bms.Rnw:153-155 ################################################### att_random = bms(attitude, mprior="random", mprior.size=3, user.int=F) plotModelsize(att_random) ################################################### ### code chunk number 16: bms.Rnw:161-162 (eval = FALSE) ################################################### ## plotComp(Uniform=att, Fixed=att_fixed, PIP=att_pip, Random=att_random) ################################################### ### code chunk number 17: bms.Rnw:165-166 ################################################### plotComp(Uniform=att, Fixed=att_fixed, PIP=att_pip, Random=att_random, cex=2) ################################################### ### code chunk number 18: bms.Rnw:199-201 ################################################### data(datafls) fls1 = bms(datafls, burn=50000, iter=100000, g="BRIC", mprior="uniform", nmodel=2000, mcmc="bd", user.int=F) ################################################### ### code chunk number 19: bms.Rnw:204-205 ################################################### summary(fls1) ################################################### ### code chunk number 20: bms.Rnw:209-210 ################################################### plotConv(fls1) ################################################### ### code chunk number 21: bms.Rnw:214-215 ################################################### plotConv(fls1[1:100]) ################################################### ### code chunk number 22: bms.Rnw:223-224 ################################################### pmp.bma(fls1)[1:5,] ################################################### ### code chunk number 23: bms.Rnw:227-228 ################################################### colSums(pmp.bma(fls1)) ################################################### ### code chunk number 24: bms.Rnw:231-232 ################################################### coef(fls1)[1:5,] ################################################### ### code chunk number 25: bms.Rnw:235-236 ################################################### coef(fls1,exact=TRUE)[1:5,] ################################################### ### code chunk number 26: bms.Rnw:247-249 ################################################### fls2= bms(datafls, burn=20000, iter=50000, g="BRIC", mprior="uniform", mcmc="rev.jump", start.value=0, user.int=F) summary(fls2) ################################################### ### code chunk number 27: bms.Rnw:252-254 ################################################### fls_combi = c(fls1,fls2) summary(fls_combi) ################################################### ### code chunk number 28: bms.Rnw:267-270 ################################################### fls_g5 = bms(datafls, burn=20000, iter=50000, g=5, mprior="uniform", user.int=F) coef(fls_g5)[1:5,] summary(fls_g5) ################################################### ### code chunk number 29: bms.Rnw:285-287 ################################################### fls_ebl = bms(datafls, burn=20000, iter=50000, g="EBL", mprior="uniform", nmodel=1000, user.int=F) summary(fls_ebl) ################################################### ### code chunk number 30: bms.Rnw:290-291 ################################################### plot(fls_ebl) ################################################### ### code chunk number 31: bms.Rnw:298-300 ################################################### fls_hyper = bms(datafls, burn=20000, iter=50000, g="hyper=UIP", mprior="random", mprior.size=7, nmodel=1000, user.int=F) summary(fls_hyper) ################################################### ### code chunk number 32: bms.Rnw:304-305 ################################################### gdensity(fls_hyper) ################################################### ### code chunk number 33: bms.Rnw:309-310 ################################################### image(fls_hyper) ################################################### ### code chunk number 34: bms.Rnw:318-319 ################################################### density(fls_combi,reg="Muslim") ################################################### ### code chunk number 35: bms.Rnw:323-324 ################################################### coef(fls_combi,exact=T,condi.coef=T)["Muslim",] ################################################### ### code chunk number 36: bms.Rnw:330-331 ################################################### dmuslim=density(fls_hyper,reg="Muslim",addons="Eebl") ################################################### ### code chunk number 37: bms.Rnw:337-338 ################################################### quantile(dmuslim, c(0.025, 0.975)) ################################################### ### code chunk number 38: bms.Rnw:345-348 ################################################### fcstbma= bms(datafls[1:70,], mprior="uniform", burn=20000, iter=50000, user.int=FALSE) pdens = pred.density(fcstbma, newdata=datafls[71:72,]) ################################################### ### code chunk number 39: bms.Rnw:354-355 ################################################### plot(pdens, 2) ################################################### ### code chunk number 40: bms.Rnw:361-362 ################################################### quantile(pdens, c(0.05, 0.95)) ################################################### ### code chunk number 41: bms.Rnw:368-369 ################################################### pdens$dyf(datafls[71:72,1]) ################################################### ### code chunk number 42: bms.Rnw:373-374 ################################################### plot(pdens, "ZM", realized.y=datafls["ZM",1]) ################################################### ### code chunk number 43: bms.Rnw:381-382 ################################################### lps.bma(pdens, datafls[71:72,1]) ################################################### ### code chunk number 44: bms.Rnw:471-472 ################################################### data(attitude) ################################################### ### code chunk number 45: bms.Rnw:475-476 ################################################### att_full = zlm(attitude,g="UIP") ################################################### ### code chunk number 46: bms.Rnw:479-480 ################################################### summary(att_full) ################################################### ### code chunk number 47: bms.Rnw:484-486 ################################################### att_best = as.zlm(att,model=1) summary(att_best) ################################################### ### code chunk number 48: bms.Rnw:491-493 ################################################### att_bestlm = lm(model.frame(as.zlm(att))) summary(att_bestlm) ################################################### ### code chunk number 49: bms.Rnw:502-503 ################################################### att_learn = bms(attitude,mprior="uniform", fixed.reg=c("complaints", "learning") ) ################################################### ### code chunk number 50: bms.Rnw:512-513 ################################################### fls_culture = bms(datafls,fixed.reg=c(1,8:16,24,26:41), mprior="random", mprior.size=28, mcmc="enumeration", user.int=F) ################################################### ### code chunk number 51: bms.Rnw:517-518 ################################################### coef(fls_culture)[28:41, ] ################################################### ### code chunk number 52: bms.Rnw:522-523 ################################################### plotModelsize(fls_culture, ksubset=27:41) BMS/inst/doc/bms.pdf0000644000175100001440000131535712624725513013735 0ustar hornikusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 5400 /Filter /FlateDecode /N 68 /First 553 >> stream x\YsG~_ocDŽu!R-YH%QDB A-ͯ/j$(j#a#DuuUfQyTw4q!}slhbrU# ʩц-]FˠӴhRjR4(7FRc =]4+hL`@k.PgcRI̙cc ON<)79Zj071еis46>jD<8ԑ&&Do#LcLD,q#!SM&;OB!VJqģĞ#f!:D]Hhڐh$T4$a!dE iu$˒v&jgI0;!.hkZ'̞F70@,c2CN ! a 9ڨ@c t̬nœ aEE!ƈ;:5bi'W f 9e)MF׎dQ$$rtlN&Vߛtrz8oILJM{2 ,9pv6]'S=1dM wۉB<sڪM\Vi܉vL''~mӣiǯo k6vyٍLwZee?(HuÚODlw q"u3ߑq_>GďTM`rCh<:h1 #Tn_:W}Ǭ^Hw8Vٮ͞k}m9Ε6Ү8vye+=l`=j{?W03 n+͛ۓWOHW]P$mLݫD\[eZHo 8ߟgqi{B2Ho7_>ywtҵYc;F{K9>=zq6ĺn7ǯ<+Wm|-\s}ZVN-w,tk[W/tk^e 6>8><|vmŶ_;Zy,{>Hn KA;,t/h+iS 1G_{\=+շ&yߩvkKGnqAt/L=<:hMU1"ό0yI՞{T2LBv{\*jY`u*kahCzaq&ë ո$4G2L3|F^}28*}Kx'Zt8-HE' H & M yi^O4|ZU/7'L`:1k^W}qZIFHoOH1#)l,Z%PDVsblS$} ,,*}N;5viRpw- mzJ4Z`vY/PFȂbMrr?޳F[yCʱVUIe&2R|ñ3bD6K=e |od4󪢂 5밖g6Z1nc[oW.@g sW_QS%.=ٳߠ3[6ApݮGLԶ^݂o({U@G|a[knlye!#m~rUpcItlrِ{zdL_ϕ~8QH6#񋋑=̖[{p7 tYw + S8fxH-d} "f)XrR`'AxRK 5'F[~h0qju"Zb)y)xqp\/.Vk?mejrcvVTT&z̃c&1 >W2 }I_DcsF*"$,+H83^idb "aN8$ g W?`#)U;&dtPT?z e ÄlX (P46]lMۮ&H~+(6Hu$gdHV%ohBǘv;.?ԴwzS}x$v1'd5r2@QOA8vV\JRzg٣saY,pQ~Hq(Czwk\ -̯9Ki+%$i l6Cԋ|!$DzW+ȘY:o6Grj<}asSP fa6Q,eK>5{9#r\JKR74i 2DX@h"Ҥ w܌ g\r:`#;[5KkN8}ee|fXmģbYa,*wAґn238P+Z# ;/",6d)pܡ1e< o/y8\ZSFc_ǡ3y$5QoGڣ<8> oH7F(UBg$)q8:FA/3gItۺJ"N݂M3?̅41>gzU`_nΰ|W±pX~rup['z,Jxp:Ų |#4k,RIeU>,GXS/[&ª-p 98:<# yO ղvw E-(kW0,ZpX0V+LHk+|Œ?KƖCU%8LIvߓ f ACOD8MicдөQs^5'jw~u8`bgcF}{"!iV lwG?\Tw^:"ϖ x:^kK$rr$P|H!T|"=]J뢪YBn#k'^r[zmutw0| g2_~(b΋"d^]݉LP+)*c%F-vOHL[j-Ne-G}()>)Z)ֆv[Y _ cʊ qJB` YМՒu"Pܵ< evAm8;2̬PPa]:X&<b c"p(=:KBv}W8_6գޢήi? G24^ߵ}>iۧG=n_o_A=k&U{`~8jaqr3m/O/ןWU;i'WNGɜZvs;o矦a;s޴/oZ~͋YA3Ŭ)˫g?x7iތlW8r`<:{tuA-ԯU/E-$hE;k3Nv`b o]`ˑx+@jZz*xq?X^}/ij߿\ r:99χr0MG˲or Jmq09g6+t\y|$݂.K,/v U(6X_ef뚙/-;?/ڋ)m'l,|Y_Uoa+osbG7Kvc;1ua8xÐ-o'~ן9"Fe7cքji+[x[!B. ׳Nj.ٌ5Yzı b0:Ċ%;w7&f$辽VIDu0QQ-T(:RE$=~rQdU˦g)'~;dX.K*܂1e@['֍fx{͌sSqFŪ#\~VE}vRg٥Nvս~3W98N:gﲦ*)j7 jK K(oe"?~VM{dpv3Vi왪) _7A.PeAQ)pݬײ~hKtN}CX k=FmQ>5T/PZh-}.m&)x4=8~^׵o:O juh@o7~-}˿&"3[|xxҺ]nQXïrrpP7N'? (o8Ϳv/o ׯד)`{MfW\ `k%@#m%W*wM}" ޽>.[31c0^ BtXPuֲmј\f'G~p"ǵr69~JQUP<[98-N J7B]*6%kCmo%$\n/wEeTF#f> stream xZKsϯm%x7;NmWl&ɁiI%{HP&䐵 $u N?|:Dh&]l5+t'w'+~5b>fYr&ON['sgx?{͜/N/rR*79JPj+3IVaj MN m_XG)*u5 N_\ԔW{߇u|m$5kR(, _6%`Ck`HK.!*aUOMrQ[Z M2_TT4dd+K~u^ w Z~߅n֨ۂtW&+n[䳤 )"T i)EM/+LCzS}x ^5Q4O[ש/jF`?تRrtSOYȫhO2s`;? |&f+خ Fs4Hzy7&pT Tqbo2Enq+Ep7%&?]jHtTuء/q@5]jmrZR\XcYնzq0g䙔̱y+BvKB(8ӍL"z>ʎsm.b^e 2B EcYLuA͞r뇧 #8xAs?Abg|U$H2Sdm vNv̝LNgkV&r"#JZ&KRwyjп${й}[q'~bA;j;t]?_!et8_I~$ 2QJg"c5#c.cw9?0_(pF`\7 Œd Q047M J6aǕNyK8(CpWqq $I/|YT󛀝>`'foTǁ?3b_k-4dߴڃ@8~@nM_ޖ nudOzH(cۇ=Sςϑn]/{uu!V@lX}wI$4aIc0}BZL0{vh`ˏ9~/gZ)">6.0!]^1f~@_V!UoYwsA'?Qц0wڿy$ Btr/F>)|\tn#eԲ.1݁io8!*]^9c!% χixSJ$zBkJ*o]k롩qLi[:l>L)b߆C{"x4z@݅̊A}Hbi;T;E.fkmt*YwUP ]Qh!/>[_J$$HidjjV |+kuq\Y^>/M( 9p?bB6tŇ"Ԏ*ċ3V)`{!\tU,U)e1endstream endobj 71 0 obj << /Type /ObjStm /Length 1825 /Filter /FlateDecode /N 68 /First 574 >> stream xZmo6_q[ a@^&Xtiu-ADmuKVkaEȻ=;JBBj5H 4Mc!@A$΁,UQǀIJ= ҂5% "np>)‚ UH0"keֆ H S\* #]s@(pA!HPJUH"T Tdhdr !h!x`96 rw!@q/@;%4ShlFj~QP ёɽH0ֲGH +l B.BZlC@5XƁ 5RXǺe4tzD憁)Q#?"6:_f!g tV#^tZ8:=~&Y^χY2+ҬnD{*+oɨK3O?ut?9}t?r~NSEaG?z5TۀYY ܢJ!)USz۔MgHS&6L1UiZHA]96BaUkW ,K}xpH hƲOc"X:$KQh8"y֊ gԃW?y:φ>祤<,|S<,^xxN_*as6C}c|yzVOxMEȍܳHA\xxp hmM@u"߃39IG isK!*ϓbqnab6/.N#?~d>Q2i{5Ed:Jև+5ɛ^o,rnv^saNFqU?}JQ]X;pb+#k0Ρ|;ٔN~~G[acLcNpc?Pfi59v&m_zrlWwߢ'$k,gxvu@]4⎜k!Χw P)(C 2^R"ȆF#|Mf+sM4-;UI\dIi 4?*-m/'- 57-ٲ{'d^U6FYuOi2iRS6fg}rv%NK:P?k[B,Pp#r>~+' .tu5elQcy4{^͢56ˇi-o|}v :oBGq=)Zg;.p 7q zE^7FveaBS`:٣W<;dܡܷúg>2k2 [" "Ɩ6@P57I*+p]ϐ8usmendstream endobj 140 0 obj << /Filter /FlateDecode /Length 5184 >> stream xLFv?&n~b(۹1n=\Bnj1Qm`i{ F&:ǟ  ~υd HhMl-I:xVWM}aJ"t ^3'{$uƋ9´=QkZ yQ4p _{[I=3UgmnfK@ygCCS\l,iJ6p TR RRrBf٪,ibWK&aFhVL)jWE"j[1"Jkߠ=k췎'[3~6KB:*HuZL@dh6v3v/8_,NZ,bUaȷDJ-(E@_ ٪t:ÕEBڝo@&i((E/8AL] ?@Zq ;PjSRa"dy9^QYJ Zԭfr)3ap~@ y͒AC k{gt37Wc(qKjHS߅o(Xq'eNLlHn$u8xsbh3iy+Q2OZS$ T$|2,UHNQ!k/\} t> x?8hjL: `)>gޟ UǼJM#ƁسE}P>Ӯ샗=#Dr"؃Iz~A@މ1 vT!%L$w⁦ljgSIU!)J#[~.:+\b)+6v#O:0CK2.r.vI\]|;iN"tlK\@'8gǍ[? .J2v۹;Xpl@$J<Gɬ<X4s &pJ>(6!\('IQE|/C+.+@%f(~-enj"W+icΟ"*,yRh]1 mF|_n\: RV lSD`(qY.,wn$^f j_R @Qؚ@Y\ΣK`/fp#|_ST)|lRiO71qd<-HG}oxژ!jKڹI M"4N5bК?i _OU珊3B!Nss3X݈,cCCmj'`ErbWL1@tأX/ aMb{H&%"#sJYf K~*JU+͹\h@(bI˷,nA edU\xKc/`:nxAX67 K9*xݖr,f24=XNXRV?R~i>UA}p<175ԕMS3"R%(CŤ`=E/gcHf!.?P3*9%I+sPwHí(߻o$m.—]M'S'Qi}ƌ;midy- ȂC?wI8+-W`e{ٯħcˤאA$PƂ !~]bPq$ J/ e)1lΞ9 iG"IIsVGm =Km> NR̈́77ϯMX|P"0.ƌy_Ғ\V'hN.$H~;+ԣn"#nB]NL\pRBmϣB4:ݍr4$:{(&f^~܃Q21ʛt؟o'D8*c%04`4 Z!}L9M7leŘ=D"&*w4WA͓Oό1Z#a!TkT]e%m bc Q@j7^hyoo#M$ ǝ`;x㒖 y^Zs<գ4wf#4oé voh K9jgOz4aj;@x0W\fAKkK85^(f$GdvSZnU=thɭXq 2ª' I] CbQJ)$h=E*UE0qX ªadލE2a`x Fv Z@ SWPH5T^K 9?]zO]g=IU;b 7oF Ņ4N7 yY xO]g_o!?,`68aȾY؅ ;::U g'΂*88ܛEIwiKvW,lžq'r 型Fa`(K]]t .BR1K/6M~F&mT`:\N3,g~k`}{ܺN4s5`:{7KU/TݞȸT{{BOǐurlĞhȹiwKC Y[oS9et1> ߕyBw9vd җ1nMot׍5k#ox"/{n:ٰumt\UU=`dBwx_Y{.Z`~' ̈́O,s&SƋ^A`"4ar];+]9yFq,wU.\C5xv^ՍIoI(kFZ3m;"T%c춸l٨E  uJd(J0WȂ`ᄸPVRNml^xYD_ijI0u_\?l(Pwzjup(`ڂ=wzqsKٽl ͖`s\=JIt$݊wVꐭMώ pB RB3?f!>]JhEgى'8Y!ٓv-ReH>/B钇zw^!<\J7ouo]I0}dڎ@9xe~BZtO*+}򕢜wJ'4ؽqe@Q}K֜7M$픂Q ?^9H-G_xǗ$>xX P-MW$jendstream endobj 141 0 obj << /Filter /FlateDecode /Length 5078 >> stream x[P?0Y <GG_>#+a3>wnt(Zmolv 0c-nqQf<,T1YH]όﮁ1%a4>NrU!nq:l;LD׍9UgN:9lgA~:Vi؄촫6cItMd ~[ 0V [P"߫U*f3c5|אּio3n`=iŊ5e;5Y°4ooSBwFRdry`NՉ: 'eR S~F*>RYm3ez M$ sJAt'%`ӫt؄$a!:fϖzF*4W /A-z66BvX]A|| v?Fž$;:C?hLi끦 S|A="o//7Gqn8N~ 8uN x ǻ<ۛ~|?rcz/KB ͍l˚fa6 S1p_nr=XqJy^43q["B֔$a}Hzx، yolx1">[U!1;EfumBP{zн!qM[-}c`&_ܓT4vGpC5\H8ƒ)_eq[HW -}?EI^Ҷ Y NR>?C[ Dg]D) \tc 1dGMUs}֙yy(fE H+'Ǩrqla..vP?t:t8?uIeֽ dLWz깗Fx5J XEK+0'8TQ*aA2 $&tH_%t$`,+R0a4k?}ը 1<ῂ$ȴS %k1 IO*rGlR MRa7ˠOO麸1Bd2>G|x-uxdFjʈb.ݗM}V#9v1l>g/T(S&(6Ƣ$}|P Xptc`QDY0DBTTX!ucau} >P,xۊ9pƐAd?`TZ-Ĭ@I-QA2z?ͳ^JE9Ou̚pMzkrڗM0h33dHa*(Yt 6'|y$g!>Pdyvm(6B? g!![ei@3ŵW$)܎=QKP]fO49kP0YAT3q=SDA `axUQ:y"낖Kpa2NVhðWlO0x{/ U []Y%,̹0,`hv*Mhi&2X#PfqY룑F8^kPLPUqy(aȌKft3}MkeKZ~cͬp7\0ˬdp*'1FP#?=oG1\r?%D5D1)±,2el9;j,b 2NԵlR9j,iv윐VLJ>kQqy'jYd2fVV8]o(J"w>Hd\qQIup՛*bLH–SN.&t%vnTF߶ڋك_"{_;brVm+=vEk,a#Uպ* LRZBb4 v.cr* A]`}Jn3nC*S\ D__z!^A(e 9ÖԔ#|jAZgi80i_fq >+~4ZV$4TQT?U\WsF^Q 0 $&Ȃ޲\ <~uFv^(yXl>I֛I F>ߤN XջZ4ބZUaV`EFߜQ2f8`/Q@cV{[弅*4@cRø'm'}:֚Z=SG֕ҩ/„aAw=C pz)@y!wOx,Ez;'kN CW[-"x0/_E!'Fm0wqX8}AFnY)օ~>yZȥ>i13ig!nϘae~}(:־GyoG8N B?0ʹF Bvdc5G-3ǘZEMIG}mdZ@Os)]dJۅ-!HV>N tZ&@mNP:6kQlr R9S%,`T_!svksW+/#;Tnp.SN^P 6t!db&{WRHh%uY (ZWCA ffYHc K#zuYckm$ZlR.8brpF(<練UÉCחKʶ٧< Π(-KP FΒ":4} Q*Z9$44rz5|4v&W1~=vYnyX_ ) C[!o'Rtί  ÎBFk S_!|-:9#jIӄ(u'~PU'i8:;09X>Mzߟ翬2Em݃xn`4"[z fIfЁHgc Pqz}#95B(n/fkYx/O/6NWG gM V5%4N2A2>9\NK 3ul{Ϝ㘦/z:Ssa|/0NiI`e^h,O^RE~GOR z86甄+ |4%XNB&LvQ$ң'`ϐ!ᜁ*6~a:cy6:}gj&Ie;ꌲO)u8~~>讎N IWjF{E~OnVj rJCoxۋ2b } џ@=;yaU" < [4Uh2[]-+K0tǀ+ [_a 2WǙHendstream endobj 142 0 obj << /Filter /FlateDecode /Length1 1548 /Length2 8870 /Length3 0 /Length 9742 >> stream xڭeXiifFj!d`nSnin3x|Uߵ[e5&s)HbdDl 3+*5#b'n yyK+ɁJ {8Z[Z9q؂L &V [h30@ bf r`" '+Ȝ[9LAv,(lb+ * @IJ4؁= TE\ V4'&`wq9 G8Qq6[YA/Y;IZͬ̕&`'пAvStl)#)%翌&vM8ZXYYPG? G1 ;3@prLM(q,nN0dŅ0ÔZֿT[}*AJ$OAI:0#I+aGvȋYudy(U;1yHIdsx}-껡#R!2RJI b&[ x*$ |d|i)cNf|pxPwO?WJxLgk8jc_29p3f'.'u(W6wzĻS]djq̷ r4U4sP wpL|C+o@eqG=}&Yjl$a=oTuɺ='"%ͮbe<j7R 1dlK b.r‰P&3 耵P"IUX%O]ؕǍ^ˢf6qdbmS!P#|j/[MC1}T`T̏8 @HDA[P֐BCtŀҦJH2(zmx]pߩ|6s*1E_m򏆴RH>rF}Tq&VeL3pcrrm+A@ L|2!u6;P~B'#) uL~Sgġ1aeeE <ᵔt8Ze_ҩ8ɝ3Ky;QL>8!ǖ̈e]k ;ueoekdi᣼kN+u9 kW]dy yO'd>E0AVawU%wrSW(q I'֩ޜVhpE䌂7e["$f[L"~|.@ثN@.qs:=[>`_}h[ThaAW}(':͋q}r # vQ/Y|5b}6B+q}$ߔ4$3iFwrV8mD#+wOGk\EcNRY&M[yOXny GLj};XmGjּNOrECՀyYA<þLeZ9w'Η{J t?b>Z>ZO9< w |UB-@jI MaڟmTS ,7OɤT(r7+GY^]y 6 5>~gQ.d{=aVޚ@(orgX,'H3F=M*w/UG<'![˭w;d,,!\۽t9n FřXΧhRڝ#x)1~Q2#`?DhFk JcZ[8׷WwK~`;gPs8%%|2V]ҿS}=,^10 [mrWU !c.r c*ՙz@4{G!=u$*/ڎvţI琴 .ilk.V$,[!vn+N藥 ֑OL ډ;F%Y?M% r/|ySS4gxi7}Y׬oJXq >1тC̄Re|,M\2Q8?2JZt'\"H1OOwwsKb'{z<?%t74?]\%ωUPh?8OWUB~!Q14 5њq/?d\}slJPqijc3ͤSRBv9NJ+CkF"/g@£9f0~ΟںROpe{$ #|)jrxS-JU.-$?h߲ }!$q }ϐCH2IEۛ͏Z1JQ#s*S:`\ 5(8_MZH ah0D3+gK)sF#ř'A ~ ls^N!i +[8r;!OOxבd"4Le;.[}_ F3FZ^A~s32Gdˈ1bAѵf*]5, JrN#GWïAl & NhhG;ۑ .|)zyT `VF#vaقXE:fdWL-DW'7o&$*x?310uxTIզz%Ř}fT[ҳW^֜b)q>mIts_V1(E!755&`H nG4n?X҃)D-D]qQiQDuz0ImEʸ`e"A/$ }F%>nկS8PtQo2=NGRo*>|ƶxcS^ev1Dd+Eݬ,DwhfPE%~,;Q^n7.i8[2j3Y_1ԞK %sg6Vhz"@?k59'kկy43WtST\J۫% uEs`rn"5EKw+yUw>VX0EG>b<[|+:U9t1"^63FRrD]*g58'J~Ht IOL7UؾC-Ʊ0[\ux)K)> F'Sgƒ1`  dӴzj ])J%W(:\|i |.HEE~63 Op(MdzP"_~_3fʈ:H͜L&- - =Rʥm,"9{g/^i,rgeEq% |My X-nI[s?.'إIńVP>J9EwtWah!}ypIcㆶ0?\Ɛh!]+r_Jm~}s!]V qNQ-Qd ?nH|(cPt^Nٵk1fP6Qw`> ێ\zFMo^Њqݔb 盋 KUX*0n @m,MDŽt#N +]f^YKi |HUeYɕb'+fR琥黵yJU\Ϯ:5"hH#j"˽֘nmLnd\ sqEXUh8\8v{: {}wGXo(lLuB䯺 ga ~O_2yOY:>T{NXXugќqId ;q*n~XFdWx[fruk)#2}X:5i!4+{ʝ|aoRʖ:oM=݄J3/agҎ:?.F 4(2LY-`鬉3LGY<ݬ4 5>Xyz|_H|酠B::vI1 e'52]?ؐ:iaε޶,9"5p2 jvo679SeJкԥA9armuR/H&VW_imc#3sE|m>bWw >UR+#_lSfKHz9GƁ8dڗS}-a']uO?}RRZ׺cT,WzOñ.qBu ;橿d\_ME56ԇYJ櫣Mǘ?ݩ<7lDv JM_¯QT !ZJ(o{?ϤԻrGgZrߢxYtA-سf~\FUTQ+6Ew )%bc1KT'xo~t)FQeoyq+=foG66`#nJ%/ԲfGl@Ycaxwcq*\rJXSo.sv@FAEߤ,>S3o1#mN.808zu+7i{IzeұQPμt?BWYW.C:U:O7h@NI9[X6Znתּ$)*IH+*Iש idF6 Q\zgb-0 DӀ}lEzHuX߀Qy֚RO'1E2oU Kc3CԦ|Ou<~hgcR-^sc{ əOr9+]Dw=mg*0"$ƺ5!mB55l?O<S"Bѵ$N&zEӨVoE-{P^+,5ϤE${8yG(x v9l$|S!E!ߖ9.mދqի6;MF#*n~ j%}#jZ>K#]gxp{*6+  roWD@[s=[UJ*a.,R00= V=⽨nNp3ft׹%c'* )9/hB6p ӛ'D+<+O&ـ.O;nT(hhZY9qZ`P DOm M0`?FIH/Yv (TpQ*mcvާH/]`3::7AV  Os;ƖtQp64)r8?Mf?'[pE'Il5\䩥n>iYZgbԉm0ě;l)u6zO%WvZTp9v6H`uG? >m@`wHThHTxw6^ w$M- Gv`6r*3HQG,fT>`QʚMߎAjS|Ƹ'M}yp~"ft4 GJ~W\U_FXlؠ p2u\WLuw\h@b6Q:.L*/5z~* +眺ǹbۀ&/&+#kJŸxbŷ.*fNi锕}epe%s1TlZ27t([nSag RyX:5QRK)鐙 NPz6Zx~?S#<1 9=:ө(;W@d:M۴yfb5Lf¶v+C)}i-W>:i`gO&vYT˛YTO[TWk=OEQ܌Q3{:*pD6YSK FO=}\?.ρKOɽ#_pY%_1c|?t%aMV8lI!QD2+m!,8PO8a`UM6IUAd3T뱧)Z2 ,#t\n0JWeG;M?wgZs& _g89"(~_5C'$ͱr;q?C^EĖQL&cb \,Qʔ[S~|$>=|Rb%a3VXf9NRLA/K>ҋ 2%I!_1?/84'$Z{iGMQvyt/ݙ;u2ThS{jSVt6f]Y Ǎ^]o2]?>Bm< ;c~DdKo/JВAlE2u]A瑍dK)YW?kne>/ j\MG;'b]4_2!րlutd1~Vܔ,+˫FL&Xedž 5W'Na1~=!lbùH8Oz&Oy!8/* |\1[dt,;?%#endstream endobj 143 0 obj << /Filter /FlateDecode /Length1 1372 /Length2 7353 /Length3 0 /Length 8157 >> stream xڭe\C@z`hnD``an%TZ.IA$zzezdl`E iAܼ8rp sB@Ā QQP  0`p=&$a3[5gdPB@''_@];bÍm`buKHg?;R Ȇ|D*\6[Mr.7WprҴr_?a+gM9z pwT#?n0Ea˸9A A^m(lrr=qo-ciӶ ]W ȽCfܼ d"k.0ꂼB@+8y/$| B]l ^@R@;q:L!A _CG7 y~G7y%a^ o&dI< Y.(7!{Z&oB%Ad sBxl@"l#l/~ < S@B@N R7*!_@\P!va7v}g y!}#ț;łH=zOȭ{$?!y^> YYK.q!%@ QA !.?Mg"-, E+0QdZ4z>u,$8Qsc_7~EBCyC3x䖐1{r'˧[+eW晋CAӡlz^4f +f9DճeG Dx$L;D`r,:<ٌZ^yo^']>+46[9}͞a=DgVw~y]lzE)P*~\,o r(G`[F|:J՛H YJMb\Ov( [ɻJLZ 6sHjp8:HleѦZ.q6pd=ɦ>3;e^vZk);lꜧ/:x}łM8*>AsT*D3=@Hw|G&rCb|<3yƴj]n}[D4!z-"Ay9r6eŅkђWoX#\Ὲ˕>pg}( y'S"ˌUpQv]Psr?z ӈh}[ gZ̷5#D޹s;hZ꺞lU{J_Z#@C'< sKL9 W*O=ž=_Q7H&[, +ѿ~%nRL6pp0*x=1VWJ߹PBgUa`s)j|O^I0"{1Z LɭGJ»:(J)؜q&6&WE:%'-d tt37CM8FHt5/mU򔡢 R*~JH7rS,K-V  Ư %o2T|aNhH3ϰeG |,ڛna+9YG&]9Q7{^z9Bz&bo SDіG ǢmI`dA 4=5}{j=_Y4F[O8^n#y-UfKWe,G}%s8N+|Y귄U^I5h?m3 }'K U-JO٪~wx$5Kh 3|P{ZuֆVMF+ f/-$֥D M΄Ȟ~jR70/ݍð8UQ:ȭHgR\~fFS'IYί"Bl`^SjMFв,<Hm a;+J_P3?u2vr.#01~Α"o0[Y F)j: D7O846i\4}h2/Ib%SKݲ#%nP/OF<š'>\SԺsEEPN}6:0zͅFq!"ƚ?2<3Cja1Emෳᕔvch[aeop.J9AZqz#pLk HzG5G1~wrW34 }*nI/4IgWX.[ԃMF!b/Jv31" /4]Έ[=a{D<<hfelFf̹JZz{ @vnVm8VBW {gbz̃v>2'b'd@OaVWB(_&"2+Mx@@j7Pae!(˨,f魙9#% |D4I]܂-,h|sy7/ؑ>dn fgzy/o*t  tiE vqi_ɮJWSs㮽IIi~W.qPh'ճM#`5̈]#`_p>n- &uLݒy!/@mn5&Y=LBx¦ZˇPN[F,f9sS-+B+S8z e|b r:m?_y8krlTiDD5^0ĕ)f#(kDgXٕ$ɭ33>`Aqn$s:OYj;o5.Nejlߴb/ԢGW} Xێ/ 2.c44/mH ՒlgkO'Ѽ#7}$`rui; |Dˬεa,:cXK6ql//(?:A @hK?ϪҨ}N TxZ֗<^#oX0PoX< nSfYd*7| Ty uOb&/[)yDeBVB3 d!: 7E^&S~Ddn|[@Шt{8Sx%i%A(ܗi*#8+i;i7-Vn[AfoPY*KRM+?8<)vx%j본n,o LȆnR}EXA71C >ISEtR-Сm]xP걛oNZ '˗6\gmHPe %a`V$kM{ןdw*5|RR?`s   ly##}p~v~=3PPsxۗIsk}W|iވOv'AUFtU0vsp}/pBU4܀f β#?r02UCI  O>Whem~iaSI1Trӌ1KIHqz V{pe%2E2V -q8=FX>}wCz,F"6J[lXbN%XӶ}Bb"NVRlJng _m0ZX*i39Rlv_)e'e$Ev:~X+ƨ|&ΝPxrsļZKռx`lwep#Q~8gr$EUg.!VR 7 RY ~=c?e%>\gϾ\vjRcpyp֋5Nl'=},4!kR{K%KyA]H ی~M<kk3mufܼ7w$Ώ㦤t B+}%5khYw30zc;Wư6|⊔[βT?I\θG!G]sQ ,vT( h{|rK~+dPta9eI kJ$27운r {n;Y?Ȟbc-eL ~cv_XD+vDbVwY;@]fk OTZs WD.jD r9t r-- lk9xW`alh\ ɨH{hD;5K ^zɰH3-+ ^zLyf0VL/1A .W7ۺ^M-a!f"Q=W|wQ[D=k*IACYNYwc0RN$t&q: ȧoiWߔQ3ߑ9~J!(_s~yܝ%%ϛ1VSI58;i6Vt6]V4s'H[_&d^3(v4?4p_'KyDɢW0:_RG;W]lm~4G=PY)o=Q/{zڜ0ccoL?}L9Asc$uE4ϵMاʅ]X \Eù5zՄM hxIMi{ʝY%kUŦ3uBX>d] sąA`~S+ {BoGPQX41)BLЄٻ~ rm53jw-EMDEh2O$+F<L$ X@FBя[N56P,"f2h`ꄶfr1[韟y:mAD#cx*w~ &Lv]ʾY7W>pmM & B:VEY1i 'i"!%Oqyp{/7I* -3I! !4jG2wt"pMNjߣXk,d:%RY~^Nk{iƛ`7,*Kc~ZnjZTM=EKFޑFp[">T1oZ*wHR oXt )Y%s4l#hKbF y`Ϊnf3pN+v'HziPz9BP'}@  Y=ַ"_O8XI<12)$cvn_"WF9(qsy$,ÿI|+xc$d4C'^?`RbuBKYECAp#xCg֜97S qƗoř.?_DguMMwC8{o6d^/+ +Nc%jpD?`GbJ=|qTSESGRU@dP_0P8q<ƪMM&ry}`T%AzB-y)$#=׵WUa[6~[Y]53?^;:*#ȤtUfbt'-{?~P ]HlzɅi]}߾ug/c\ὛkuŰ7PL['7ѐ?>Gaf gRr*o:Q#aiFyg@q 87 )ki8ηK' Rg,:?(ȱDeCfQ( ЇSrR2 XtC= =h|vb65xǥHg|B]mP`{25XjKu?r5E9 ͋F)246UweG{2Gꔞk;.i7Iպ.b g%N1W%5mnjz&ϫUF XYF`TM(n1|aU.0X( տbJ Z ۊ.Ћ_?hVQ9pN*GS OįOnZyaп!{G(!r*S7nیFÊõ.34Z}?'jp D0&o0 hnM2#XlSJזoMHhۈӐ=K<{=u^&..5@Km[օ9e"\xY7nX6]Wku&(/@OPcm'OЖ_av="~OYVZ7V`d?2'<:UVWm(EÈF1:N=& *0EOEuePb90;r_lE}7m9SN@GJ83h"nscI\̇um4ZauAљ$; i ?Vir:]l'6M`g/Z@/ԾOI_q#CTPv=d0E^-`hW̴D~~ѳ K3&Vw~<(} ~4 k}uƮCa+ !:CYFV'f>e,z#a(B-_j}b tAٛb wmq夆<). SقsOܮW+1\[/8#B^EGSyQtτH&~lٌh_&d;'x;5[aK:CZM/wV8Je%2B1BA q^#&ytwwFulTQU}`rƄyԝ\ˎa)I(.tûL1tendstream endobj 144 0 obj << /Filter /FlateDecode /Length1 962 /Length2 2381 /Length3 0 /Length 2998 >> stream xڭy<ǭT(I%<ȞF Yf+K3f2UVB,Iʾ$E0J(RȮpn9s>#+eiO2]qb1pqRA<tP @hj"3?DHր E}o d{l PHgI$zX4aLПiئu#B&1"SQؗl+WH8ƜWǏR,Rɿ:ÂDWjJǓ >ك?S  I4p#`OnÂq8v-nGvz#FB=_}r2 @!BdT<~=H B` ۱A2nC )TFQH@O$Нnyx p~?l'1ĿOjHcJ!t0#6@1͇gJ`  5CC!?Ulg^߱;~ `=^eQy|^%N˸][μN$<7Uz[r[A(dw1`6)Qi+Ŏͥa#>_LVu/Lq|ۚ<~1}i"Rv_㱓Ϊ:fF>W"J͋AG1 8_7K-?3qyySn]i{JC{Q#ęOdOƄId ^ GZ).xo7+ŲxnTo0ӟ=? Wk0˱wB/v 3gQJuGi,Yύ 7K7\д:cypuǝZ" MqWŃj> ~ƻ[DAYthy{w#;ΤŽ3:}-:5։<=Ov)w-&ɓ$T힊yiK.m]q6KMDo?j!~͋M@Zn+w&9UvB6RhN(3ֵ:iwª:;lϊn[HRyZo=v``xAMH .X*Q}ybS{m jR9.F=&CD=UZZS<#+M?hˍ4sCG>I:gc^u6ķiyAi/] BoQyu\mȄbVa<1dq*Wj,_m|;:6֥@3Ma&?8*,V^~Wbgp퓛SIgdfЉ;N@ qo֒?x4mu&խ/Bw)mܾ-\s;K%V*/»{V`2LvfM?0\݄~2H\C?5̯grWS>(%ڿ |`9gTH㢊LZ)˔q;}i-^%#r?i{criy۬סb~}T luДY3}72u]%>Ld}J6tq#E銻Ǐ=FK)ǬMIXlP!/:!DqXeO5sytҼ̻ %`KB4{|<ǥ]'ߴD_G'pq.냠9U4<{Axﶱ'e:jUb}9/-VKOIɧI?lZD"iy6Iz=%k $'Qw/w⨞H:QTs}屈ƵN}F? M41ipOȴ{º1B;6'ۼ_v #nي웛s}Ӥendstream endobj 145 0 obj << /Filter /FlateDecode /Length1 749 /Length2 1521 /Length3 0 /Length 2058 >> stream xڭy<!#::̱4X4ٚEc(Jq+RB%duPYR9YZFe$qN~?y?kMd$WdAb2k4@@q]i"mvm{<\xH',\,E4>؀/H$@d!@ d a "`/Ȃ0";_ 1(P%dH2a(/4Pޜ$fhE6q v /c@+d@bSw щ\18$ Id@">Ic >e|OoE. }hW_W II`4(ۊan\:qY HZih q%Jb)dL b-`3Ommx) чGH  W(V3!ez (n!!z٫0:j=)c;xykC7nQp?y/flnV{UKJOb9ԖˏV/d>A/9=p_ꚭ}'o;8{`WO`EPZB(;ZXcJr3oX嵏H'h < r? pmL?]> ^'gtȏT#.v ;<؜&7ŮXSM0֦:k7'W.S;5 *x?$xBx7#ʡ9'Q46kZsvDRkJ:^fkT(2vPpQj ̼K% ^:R6.-$-m2a!3 lܲ1B4톻~2ܨ1)$=񏱭W1H7Ȇ,UkSհiujw ELl,Y7:=4 HIʤXyO>bfuX01X'~E%b&oW_t.v}01f2).*Uz7&g2׸oLVq1ţ5j}Ն-7o7 ݘ*A1yt*qC_P\ƧaUQ7c*|l:?M=t. ^~ZeV3}%A/HSmWF׏;SqF4zSj6;һ;-}JVP+">:`ӕ~EavĂNnWYUYqbԟn?vl{3`5h7>{־΀z6ՏUُ'hʐϑa#\øw)QWcb]TKf >y;̘~ p煆b*n{‡}6 wZƂ>յC5wYESZ&p{cN[zU-&'=ϻ.jO?q*!цlN|tqh2mв=Z[ =V'8^I}`ga}3RO=§î=m~)|,s+,=(u*ݵg!A/Fp┛i8񜾙D#zz׫4#|W}TiAe'RŪuٿנWD>6eavge.yN F緶HTO\*~%X>RoֈU/ J3xS<$i-IGrL.nendstream endobj 146 0 obj << /Filter /FlateDecode /Length1 791 /Length2 2132 /Length3 0 /Length 2688 >> stream xڭy d?~nD|?8_2/64@~g ߟt7) : G^'C@'^8J R ?Ɓp3u1Pzv82ofG@N!H$md?Vg~:˔T" p ^${T!l`J`/ZWEk믥J@W4Do766ju -6Q]pdA bC{I`xEE{gݽTa};Υ[5q#o͔,JPw69RL~GH媈ő+m]&0;'̴=l&jLI8,[C5)/ez\+(²#0sHgȱ6SGJwt&ğO^ɍD}9tCr`D]MK+03rr}|O9D%N= Gb nqhy7;~y 29\t W_yJl~:xE[{:'c.V8MܺPL֊r\֮# ㅳWE)1Ϋ%YX($sV0u8n)ڝv(ʩ䂣4C\н''88BYJ)S\QqSyco@wْy@K )[5UEbQ 9;E>%i^pC7tsJw'.<ĔیKz\-ٖ/^.8vR^p [Kj_hhNq׆htpSL*">dqk  c.bۖcv]U iv"{1;S>$V!]^X[81N){s_bRZv,+NZj65!&.xlzj_7Л8׫ȵK_UmgDł+̼=j*IІ;ShP}(Ko8E4#?GQ4yl^Z)'Pg!Surrn}v_lwI zia>(1"(N,q?iI څ֑W̙'܎_TR\J]E:wH)S [i*{b!z_$C9,< [ݱX#ǧ olL,Yi YMUXr><#o޲*r~s>2T$.3n+MK aނ_ lV@TK/~Y|(S˥N~a ~=ccs*q^_49"؛ށ?[$g|.|_zo5!<ظu;ܸq,dU-|`łO{rreXEMI<ɘ^R%'UA/6> stream xڭy<dz2CȞm,BY23}Ϟ- d]O5BYSIg~~w~}^>0ւn!pX/i0111T@BW`^XYYvdT *9z @Gb:DJ- va&0/C sX/@`+`D}p= .h,/KX$W+ޓd ۦ8dú$) AaMa_ \0hw0^<G f15􂹣.4X$WC^(G`vBo2:Z- @d3FGdA`^XguA0<O/K*%4 He@X)@L0ڪ c+)d%R\.d,<@o"-[7AHy8 O,KJFI.[O2\I~?&z`τXc_-V {?Œ'El19Ɗ[&{&aCft篐G?dʚ&u(H=Mp%JwuhЄr,GcQ45N%sI/DTAZ߶?-eYܕcE.6EbG. ?io~08w[~)D4&;ð&Nތ2)iH;v{^BAk)лE߫tj;c,Bҙ~zA gy-߂||aG$5ZZq%-՜}mw>ZU] l;qS++C4G=T\>7n[dEJ$X,XɬhM`:2]48pѷ,g-jrgE߁,蓴Og06=ufAwppMEM3LE^ӶEی]#uƮ%{!^eudl7.eSM{[x[s5> $~l˹~ NnqmI_=.@E<.m+0h ZJm@(.|ZC;eY5}!i嚩 (lmXiw9o~6q ı W݀:N>]M^ f~&6\()s2g[0Q]FvTT*k9c0hԊJPeN=]}CoҎ'&zU#&>Knh_qOw(.!9rL:eyZbaQ$% \ͤ\K;XOƸe( VzѬ6'(5V%'Aq-k^Uf CyE\|ZņCˈn8kmdgyc |WͻDq®kպ[j&N+_-笼- D;\ p[:n?ja GZqx3j/ /RG*!N' QQW9?T}ʸ}춉tTC[;117FS?u3UiX8Nbz&b#؅ ]{EEү{YH&jkCW0iBB{SUq N ēpxOo@uY! ,םK>դW+~m%kFTѯvѿp 3nHӂ-ήQ뒒ih;bף4g,.T_-P= Gnղ!rL:VV>>D@emrYƾM驡9ՀFЉUS+߃2(=eI }ʂ4WYݞM_G/[ғ}a\(tԣW<o1+(kIV(Eh]|x؇[_pI7N&L4N4Ӝa8qG9ҝ]G1`h=B#p8xs O!F&yAC J"y_?Vnͤz~oHFmFF_lmmƣKηPX%6Tޙza6FnvۍKOMq, m(7Ndŝ@| ĢEBSV.&pEҥbtZ)7eXOr92 /q^~Z.Ukiwoδ) ̑_(` )E,=./@u+y#ׯے?h${Z(͗ThINP ȥJrs;Eh,jcgM{âO 2s%c {E{% ͜G헔lZ{jׁW)GCqu1RC5^{f'.l8@S (hIJ F@?LΚc[ǚ dܤEEO":7-b>[ 10ݥ*3&Bhcjaɮ3#o[Ϛ=g3s;XLso(Ӹ[pUj]v,5|d+2<;H[utM[HusC|k crQ7I;C51wrBɘl]]+W?ʋȏcunDnӭ{:-W'PcV\냻CE7di֩}#v9Bldg%"t+rSQw98^'GL->,u`TJ?}@5u2)*Tض&\I׍`iN3u3`woRVy'?\ܓx}zU5YLf &h1zGU*GC_P~3~[P28XL׻ZLR8 Rk\TmRy+JI@Swgk2XG-`}=9v~TC,/V׫vi{*ޑ{Yϳ B{o#I:(pL^iɦv7W6ta 9p%̢Սo/ z(s.0 ϵS+G7ٺ|L7YufRfK%d4ue B9UsY{=__9@c==,Rveɩ0iDZOJSOs+z:ZZݷh*,~r3Pp}.BMkd[*24 +l.C(5 zUz/%a7 :@>lFCEFVUJS\/dHI!*'I01_[XR13C:.*뾃zΚk(\2+V3{-1Ȧ}hkYo-Fn+<4/Kl*KG{W#Fh9E4a,%.ʍתMuxHX5#vmcf]]CT`Vym 뾗LD65?C,_acvQ4@bd`YM})7e-> stream xڭRy^ڠE!~gppO4BG(9p=}Q(/保PHB_*ʟ3pV( oo,7:`i rW/=/r+>>@"%#/ (<Iyaq e0@WV _HQ2)AпdDAA=Gd <) ?$) SySOHbOEK%e)S~?SvES.£ ,B5#.$Lpȁ֨Rs\c>CV;Q2 U_l zs ےa LӛΎytweܢw tMҊ7NLN$%M1G^X85dW~6bv>o9@9>J;QyƖXIΐ} sj!~W1 K ק){D\p،nJ<&#c"]ٯHqim >PH:Jdp}| t YU5F•,%fh|n<(oQ}k־hPY`|kUJ2)U_^XչGF6 C!CpO_Ih?_nQtz!'xr)RRA$(m[*j/ū9Hڧa, P 7ٯ݄G\lۈj1&wüX.LP)dOI;_K-]|H;:{-8k U;{i7c MmN_=P뱕 XOyGLiO"trNtlK]WR^X\!;n"%yY({8KZ֔чq|knCo'Xh!5oJ_')՝[|bS1JdC}cڀݙ\ wʭQ٤K$-y:Y$^ܒV$$e(ڜ}#gZ]UB'›ԑF _M̢f Pv1dam?`Ag' ]l)c\m٦[5.mhL~I|0_kdy-5[*&6b{A-ۮ/z@:jhn:2_nIDfzߘ??>iq23pMиjbwӉ4ơ{ "ĿG84x\Vᨵ#X82(N-0HN;LivtqٰVOAca󓦏53D˚jŦ*G/36lzÿD}iPN„0jKƃf3X›e'cLr[Y6ԖDm.6Bxvk(S}p),*@;a'[Tk΄s2a||?}ElVՇnF! g/.'AJXu r3óRM*cyKgyn*j1gnֹV?1 ^Bo]7k{]~I1LM4'I_y.Vޛ SP˄qd[[*FRo. DIX:Gĥ?ag3QJ19EN?n{4^ _$Lء5MZmj/kIo@N.kRQQֳ-rivuNq#M{ $DXkY $=ʍa phTl75YL@ZNS^R9Kv/aE2r+,`='8c28:JE5aF0TNCIȝ}ڃn{"-Y]DlB Ih LFڕYn> stream xڭe\kiNf@J`a  閖n}>|wk]CO.n`q8@oJJoϟ@ :=32uxnv.n tz3$W@ 17L]5M@W @ vv[p@ + ls%-.ϢLd Sq8!z?S=t%4W_\3ϳ@s{<r~&G yn"}nc{^?I' x_ge:ʳ*s?xp_@#빹 ߒؙX+b]sW>53x +z{%$<}ع\:SM̈́A5- =<}p|*zJ}H]ħzj/[㐤q;;9*MI|$( V#zݹ&Զ×V R:K6up#;wd>~|K)\Gb~uú 2~-\`s8ĵnvhOl2y̳c] ;]ߓ Sc徛PZ]`xhqت'_MA gF=Bݶ,x+`lUbl6e#,"/03*i#љ%ۛpbmMUz= _|Vr!į(LʑL>C$U` k=  Xq|V߄ɪÈKV xuFc05?TU9ԼD_p.@+t:|@v=.2#>(@|)6d^ї}r$MWj;.u]ۋQR"L`TUS)WnAȅicQWq{gySyۼ_WVlo]w=BgMF]EiμTsMVEޫ*^Y; ypu&'V TWNennlSsh']`G 1F#jR iI'JC+$ke80jO+~ \d9S~Pb]2taVL@MY]>X7-nmc:UVjKO )e[Y;-ðU@{SwBǰ@I50Tb4;9۩7đ!w9-o9DCԑ2ZuvjY&/g}1Կ5Ms^-Y_x(tƐ6&6(/6Qi^1T9 z|H bÛ\"E1G3.!8?8T>CXcTsٶԟX`ksn %/qt%m;6L ˅c x<[ Uӌ0)2,*ƻ&~DwJœi78 "Èt oy$m/xƩp-n6$[B-m3(讬cec#v4A _DW\n/An"Yے%t.*c##1&Q{y`5݊;&I 8}i#oO$zRƣb,SPY 21Llt"} Le^(R&ݯq3t6p&^+s gx!{_+[9 (7*# WʳIJF!b%iprM-t0 d%R%kVwפACk}ih-͔TzH;A/_Ronʕ8%|쟵 v85MhE]Qn,9|_nڰ̘mѱMݍs39> `O'(CR8TՆ}u7ҤkJ& ]r+9|e!o"Ud{NfD8&the;D2layՈXb6Bo2޿P );Uד0'tLVC[wp `+M7tFFU*HXVoW~ǥʽlN }F&PcM|B)Q'M] y w|k'9+mY;'&N%"qWgİq iFf_.ThZ}Pl3de)wD+U7'hTO D Hѝ =61y4w;ERY Td_&YȠ۽Dgjc~t9cq n7vKƽZUE?C9j Wɲ jL>}6L c{iD7х7ͧH,)]#$ ej1ݴt~Z%^c+jA0s3w#rk-'㹇ڝ󡫻*Q.hEi#b_5b ]U.|hE5-3LJdߙX0TrIVAp_&hz召|"f"ud ǿL~ ?Ys r $[`78tłf9GW/:h`eH(1ǨxylAfEJoaErrMhHmk }~q.ކ"S.z! taӯP3PB~Z%iFo*t4 .(1_Ӻv1_xk1̯$Wӽ./A-F,o8 ~m21H֑/5fnT ت[xС̒' (Yd,snY.Sx;;0S#^kb;_S5~Q% w(XG%I1f',TF&E ɛu&Rlm[!@pA㈲yG'n,!{iI9lVBWw& yI 2={w ߩ@Q4{˳ ᗂby,seΒ%A ^:&wlFDOVm6MY;YMkٜsW&&www.4 EM}Q"ۨ.)G<-ޚZltS5Gh3ѣ&#Jc]tc 9o-I#2IlwB#{\zDzQK"t#-ĘX|䥆J? Vד!kMD羚`}c^&@5+>ݲq-eo(2LW`ȵ&!s\ycPoQa )s#j)jl5;$~1 jde4m8Yc}5 ie3о l/7%ߜU~,,jR+C*qx_mcpt kNDf 'zSDIhZC'`HYǏTWa;=" NxQ1MzŎQ'Ѯ.+ї="!ܴe#վv3EN8i }C@-pYlZC _pᴴDg{>ttRDh^EߴK @߳1_xKEcvsۦ '̷Ff$x};YI#eovbTBE=+*+D)Qrq~Sŏbٖzu* DiCFFQ~JKTt4ǺPJ1qK2kCLgc̲ _('m44ۜWJQ׹~0'|K}ZNtM}}ko<*ۻzk4]f4V|slRalsn7thgP)d Պ)#槤_ |#dB䩈wpv"m J}Ib+ +RFlh'cf "z9=7{e1܈w&ͽC.L TS5Gs:ȧwH6").La'Ef?}nT #SZ[ӷ^ ?]uZe~Y-͛3^dHW-K'_Ufz|EF+9(ߕ09RE9bRگ U(!͹?gnd( W"KHMh;dX^q*_zp.72S,v#H ε$dBy_JLp 3}y,.u+-Ȩ*&!  f>hEt'#KVEʥʎ[-Ogg^;XCc*lk61) (7hfⷴĜSos8g:lWh Sڢ q_S&(ĔA#:NAF/o5~5x,eVaFU1o"1o!9qV~43RE[gqlLIO}{%BLJ_8mg6CGYJRc?E)mOmo!| z%ER7&A0!#J1/lk4VsQF7Ki:fd֘sV+ ~U*tUNR!oIȺ;IɄeSC$I>$n `Z2œ}_%E=laᄜ=ɲ-kqS+/{ jVbq1&|vڑvOKG@hTN$ƶY߂`L W Dሒ]{%D 5h8߿ {Y(9OR{  E5dc^ 2a$ ,g~.B}Nr0a"r"9y vLGB1>x#Uz}55B}uDZ*+l1דaD|W7X:SbP Iq;a*(E՘]iڑt쮭.RI>t,/wf)ð,7;dɢEؖ.H#V_I~&d|ļ'jJvҮ(ΫJҬh70Y>3e(qJ[eXNg Ol]ۥw٣\:d[WRb8: ِ=ڋ sDZ`Yy rED!/Ptm_X3#^(T+%jcAbM*IBe`Hڦ#.#-v(38_ź:JhŪ]3\)h,(֣%`Qq+ޜq)3ʂ 7q;ڃ1ݹDQbÝ8OxMo2@4$#w*I&p:#*ȍoGVGffagˬ'Z\6 &> xgQzg3=-$%+Q=7>5+F!2!3ں.dۑOͩ핛T雌'+ :T-U%U(| eN#O^  p7Y 2.CYc!^P{GD'BKL%n}>DrRzо8ߛAHT݋,$o U>h$ܜ{qO2̕{m9O6>)Uv` UCncӗ@X߇H 1FZǴ)Vj+Pp jY<+H/"cҠY\/մOތ1i ;IYF$# ̴Ԯ=Cve~qV0Rw)uLj^=sFG W,/W&YLҍNe>*RuV ?$xE Bt>辢'#3tGOcl=q\nlMzi7IAV/ȔE23p]}}㭛'ׅgHkk/,N> stream xڭSuXT{ו.RΙaKDSR.I)o{}s{ 2(hxxy @$CQPq?@j~ABB@ G8~DrNP$ l hXN`kG xr]+ 00 ` A-m?7ܡHW)69h 4h5(7WvstԴv+ms_ E4(o!OoPYU# ,sx \aP6 Z;BC@O  -u}?􏜶5 roo 0EMD_y3v~!a5iE4`pD(t =?-I@ ߡ?Fh泿 Dk~o-7? =0o:#6 ?҂hC]C@Q!CouCMwE_-GB h(?On~t}Hb1a1!P8?Y0BP0,XV쯔;ZÉ!oYa(x cA jruu/[}u]b&oݭShx9396Poם~гͮ7xԽ35DXH9 AmuX0p~Quzm#hΗ T*NL+ކ--Dw78aIwf2NGc v+WP?P%qn{怉wk(3mjy@u#Š|zvQDQbxbNMduHEmȤn$ -jx}ʊaie;ӽ##IclvYY+gKyU PlQ/ EIO"l'X;XSY-*GW6I) )/Z ƾc(,o|yjmJ5TX"Xjaq>KTuwzVPA]&1*L?Z@+-MbF vd}]k;d5x&:7}Mulඪ 0ClUPJؽDЗ 7.,~+j3YcO 39yf;hh"u[WսwKlmGtzۜtztGc}r_~pv FQ]5Po~Fx;3W^,sx(G\QMVzs,POkP/2d]RQ܍,zG xj#B4JZ O{1%cdT]q让 Ǎ:`WJp4jr~"F<$RK<~$rY`H3!ڲ Y*Η8kE ϔ J!A&”i*mDCJ޾\&-B8U_zzw>>u4JY-xВ#Vawtl!4%Zsu#8%FUE pBh:WEcPȬoc}o2Q#KTE Ir{u8g)CHJ[3 8*T|-o_UDON]Nىc_z|tq.Ns*(: PFoh*8Q~'#QiI*7CZD%k=pfzvdDNId}}3a.f_4~ӗ-]kE#kެdȘ( b3!'QLxVRO0U4yC&}ub42u@3w:$R qY4]Fޡg]j<S K.r9`Ӕе܌.+[*h%!wDlzYYyw(u;)Zޒ⤂ΗYJزϟۮ0&yt'M %/3Vj=0Κm.&,j•ҵ|w9I/5l'>9ؔ6 n';Q(ɻX.F“Bxjl-$~X#+ЧG|_?elЖQ^P>8pg7ʬUeJgk$(IJQkm[u򪤿*2f"\1 n1V?lkQ@Z55a,H+WRW-aHI<6S<WJM͗ jeSֳbnu[\2 9 po'ۅ!6n\`ȗ~7}!#ɤAfaӃ#weK_v-d"ϭ?ۍN S"kZ1RbSu0C_$mr>vld50Ja 4d1ݩ=)2el2bT9^*ϴ$OW% GsXb pAs]{TZk >v]6&yLpbm8W݌&'xxaN'7މ{_8m\Oo%Ʊ 1rzӒ8[\8Z͇:-v{LM9c[ңm?V1;w鷘^ufJZ i#KJSk]9Ec#J%sF^h&0E%+dvb )Igeu)pmIN"cHQwr[Xx9K:ډ0ѧ2Ko:|Lusg]ڒV\z̑WGMC{t,g^[("IOo4kIΧ?ĉ(t4z+Q*4qT| 46Eyiv8me3LCS J->%q /i 6C%[HzǡgJA^Ϲ_1Tf>߿AM.>E@A߄omo^@QG´nQy݉ʸ`]V7Ck;ԕ  ~ZG9.E{M챜ƻb9E`T%W$VVtlUnF)w+ra`]lHL!+ ]Ɖ[*bA7 ~Kc*blUSAv/w {П *D^dLėVjac?q馁q?O42 e?MߘM@]FBd"GVmynA5HLI!5ƪV7,d`9u/_ȴS<ܛY׏a$}cbZbً|¬yzANFPg^xXm·qj̒2U];&39v<5}<%]@T0'ՕnVZm]M4owtUz2JP5ٚW#ItN ]42E}u'7 E>R 7L(|嚹Xޛ_GrM׵=3< 42r ɟ7?K rbhD U z3k \'{ԫfvvNTWU&S{iWYvA3&C|&p>O|5`s[P-jؒ`nr!I*K6噒[`D W◢3j#9+[J:b@ς {-iK ă e FoX+Ljg̸xu[##jP VG\d T{d|Wx:ާ1^*^tWq 7ޡ@p`wccBK$e:m[g\̷ΆK>r9e M1N Em$$牁'v;Y/',feu0m>5j \L<zW툛Vy?&$8R֠(`8X2b"YQ.Pb&F"Sgj]Z ψ-RBK.m^3e Ci‰#jJL^u&;Y@dk2ig{Bb;2#1&],ػOLpʝ~$-HMZbFwƫcy6c Y4?_#><2e(a/_Oyd媲Lb1ЈHB@ K7#5b: 뻯?.n*(ԓVe1e\Y<i¨Lj(Y3g)-5y9KV)Fj+{K^#'jCygxs( i aκF iy }#¹ 4d!ha}#JМG&dӋI)np2LˣGd= ϛlͧ01fZhpُ4c;si-𯮎!:>XqkCM)0l|v؟ 1l>)CVV]b!-9jR|2"$GK~^7̞A *k z_iN5a% n4CB*5ܲJUm_հ/[8s^}jmS %h9>$MQ~_>ׯBR~*|V<ӀڎiB.f% }2{XYTPJKendstream endobj 151 0 obj << /Filter /FlateDecode /Length1 981 /Length2 3670 /Length3 0 /Length 4316 >> stream xڭVy8׎5$TcH ՘a0md؆, "}K-zϹ}\sQLR u@ha1D P74Hŋ8h@=JDQy9RD^I沒E@C9:y"ꢿH +A1! JрAрBx540U"<8opp@80_t1H,W7A1PLp,HF AqaZ^h!WB/X87 7Cאַ'a@C 勀cߴ2hUB\Bd3M"@g#CM&$,~znheN2d]h*,(MXE%قބǥ>jpƌQW:2y\ϊP+L5$UD>0?Xy!:r>mQ4$vynӔ>FIDfT=UiS,:0(3ea~:*t݃H2-П#O158S;k48[fk5}arT(bffFexIS)ޗo5U.#"fhчLO SOT?[FlnbcNg얌8,^mm\*/zZ?J!q)/?..Vt <66o˲0u+Z=a)w]rRai%VB~^OKEG2{Jex,Wr0ԬgLX$HEd3h~8Jr]d&Hy%,9/wAZ)]n~d-2ﴯ}7(LJ(`h#]U &ylnU!TR[!h-PK$AXR d7oQcSSBR3YwEZҡ#~aO) |\L#Bb_%ag E>>RP^߮fme)SFm$%a%A:jfcW{U]wO-h ez]jM]DU}N:7άm!3f'nbMnRm)gSUhS1fL2u33F/l'Ig4&w@y:>zb,=5V%]ےf91\A}yJRF֝oT>i#BlTsޡE\5BMI4Rތ#rAKDBIC>Wtgujӣn*[`]Y4{9ҐpMQ,-XaVsgb ާ)21RMr|l&m}uQ,f[2cy43܎I~* _Aq㫫Qm*d5Щ#,YVP=^]lkXнȤH&>#0n# HIJws1vs#]߅I+K~56Aiܱ"R_Q<'+֍jOJg v*{{E65(nf1'1 ؒ<2dޖL呓l#Px]]жGXNG`$L hZ\K!i܍Os׋j ͙'X`G?{8XXx/D T1 Z״w{?ArTt}_[…b婯n/{~uO_!JHt8N8a,qfǓ2)(E<[g=A c1[5$=NΙtb 89$ ]wL+ߏ! w PDj DP?ʻ>UhUX{':4WM 빠̥MIttrULdUغAiLg+du˾ iU)9p6^̠j}nB{傾&Hӗ<۶a& |ܦ=[X8I7ӟ0>]^m:{8~' ag˧45?*w+Hs:y7[wezT gRXyERx+nCIrfH mTT@hx|N9kد?NX oD;Z]:k3UnлՈA}ЍO‘Cw`#cWX׮-2rDM%@isOŸbo.>Czd_g$tsfeM` ӊXI/WhBI% 7SŒy嶃=K$83 wB"|00qNu1-k\lg0#X2ls @p?4'{%) H,}`wIsڼ bm;UM)3KL-͏I}>V8xn:1þƺ< ]B3{*]w9M@/l5`qe$X({A;w[9pi>`{ءnw-ZmMBNS}QR8! =Rz0}K&B`=Icö&{؜|pWY=威IhjWA) .ͩxʹ%s.ET6&OȄ_ǓPܭ iipV֤͖X6Ml-ujZ x-g aQmQ)fVi7a;ؘ\}ws=4UŕM]Q,kbu3Ęۇ-zVI;DwܵLi.o5՜?u QE@FNkXp%S]7W]n *6dYendstream endobj 152 0 obj << /Filter /FlateDecode /Length1 1001 /Length2 4047 /Length3 0 /Length 4690 >> stream xڭe\T{I ) AHJ 0twwJH 3tt"! (44rG=7o42VhV"TM DLã;bh#.@!2 1)QqJ@Aa~$e8np#0E;#X@L~Lp&B 03p"P_Q.h@0 wƛ&ox04 . 4YpS!5Ҏ=w^Yf/y^?Xmn[WZtm}%IaSב)!i4z+iBUqW?BJ35q!Oirro,o G*>F^$U,+k^h:C$2峈kHKyCUTK%oLsIyLʅjRN'%B\Qǎ|qz~p=kTnmO@j[ri~,&!7Wh)Q5ApeY)q^_L#kk@ fdjvNUze+[m\5t>OԊn=l҅{vE4z1rv1:7ɖoU=6*Y&]5Ɗ"N O6P)6 Ԧ)5 k'baV:J2zm.@YR,;LB4aQ6 f1F!1v̹ Q~#LK! =_;X@*ALѣcsU pKL BN.8mև՜^)e=w|b$Jh̳—Eg^v!gvlllyCJۢ6yޯ5nWyl,).O:{S` z!Bwn{HЋe|U%iCZldO m>;= UnZ#l3 M %`]tԯ3fН5hA_OZnRAV#[4h;,m.Yq*BʽWs+(.Jԯp^ǹЇlp3db)|&a44y7)"_I{|tCLVvlUcC[%9e[,@:}"_+Sh%\%rV#5jBQI]vM&UB3k:""8OP*32H-#7T1[>I9I,B۵w㴴.& Y (,-^Q/{Sl4+:Cc^@Y _5y UiI4-92̀WduNjҶgݾB'c*|yeP7"0/,Z m+3[O % :bsiF{09AXܴ>CdmsGHIu&zKT[_52dWnu~9 ϡ;P@&/ *_K ,:V1XfVy$1կiat/-K;B 9x"E^Mm3EBuዶtaꑽ Ȳ2?x5.J#eN$Y-yC;Y<ٰg;(ƫ|,('j>@XsL̿:>H#35wG2uˁލCms;nh`ITj 8LO\Nbjv oUxgcK!ф=A:8`Jw/YOk(b>Y#,vʏ1vX?u0sɸӺ4ǜY5هlNal3sʰ##ȼњ1TKsO V(53)>?]z"̩GJF"[U.SqtH)35BK$fԆr^.VMn#Rn ɭKG:.ڕLN~}yDI Jc4Y6o}1jo4Ȓ]>9B6m)ŘWO+n_uQ%`22ACO&^l$wBJ+QnqQlvR:Lۧc)brC~=[<5W{-Ջ}Ӥ⯝sG#,8n:aS䎨[#xoUzv$,Avjod^1㫝~HPđPzqEʿkF-{%vs]fi_`Eú?w 嫩yOÛƯ3Vq9(EF2j"Sk}+'#^lt|i3fnR3*"oRRiC✾AnS}⸛]UNG|4Է[Y_uSkFר2W4_,ڏRRLW]0uhzs/k6| SuOT")x{b.!)A/8?endstream endobj 153 0 obj << /Filter /FlateDecode /Length1 988 /Length2 3088 /Length3 0 /Length 3744 >> stream xڭy8TǍC3c%l#y:f4fCc"¤B5el!Be)F$DDb>OϷ￿s׽s9jFX)ЌD!`=^@ԡrr&dMh  tuQ7 zP9L{(ҏ $1h"`@_V 'a % A E ,CNx"Cы@]A 9% PdTX$"!^P d)gq@OMcPfx*S08 MrSkl?%Q*?O'R)#mfCSu:z~s"Y력 dt0,K Ex" #(5pD8LVX'F P&ZH  ,ƐYO'≿4u8߶:CA"]J/Q, ~x&ͪDfu!.z_ؘD Uc25 V&t+Hfi5³ :[]l,ך6Na{T%9㜶Y:JyPQ3BW9zi>y, oL]h怶{nЗC/hJ_ȽQWu4~Y#9o>r_@DŽxXu 5y+\|kx{ڵ&{SRӎڗxsNnc;gWbӓ5Z{W49>L{f|x1%m+$sbHlƁ>c(-K來N:sa:aj+k^0`\.$|${!+Nq03BwsK`u}o׈A?K柂XɄT1:o]Q'FGʌK6wc٣)(={xӛbN ,<Y|vN|ᤓ\a}67?Ѿ+L]TL9e2l2stz,ooywAP>B=Y9r΄]inc<ŧz3y,Ԉ~yO fMTT"_tr4Ҽ^܏d+;ZchUkѿ[(?3F;Sێ0.%L)ro/ڧxDK|-F zL n߳ K7K6l#I%.sZs\E.kh"k.*!;m!)u󢞗yyj$+Zˎtko6S? H|懱ه˪KTFާx>mnsI9|.i>[]Ӻ$ߥɵO"5|62WiPMFGj_.lE7t:б6=ܦOVk$;F*m,3GulB8% |W??:,rnKGF Ɣ#poGޝ|EA&`k-lh2p}-1ButbNÌRUSr=zcinQ5k7u+;>pA`7V"> "n(M):ZF]JKe/V2NA!qlKb=YxaL1·󆛽]f yCDϦgAV|oҞSAa˷a2!McӼ:CY$D3m#\Es=(zz?pR)P"թpwvbRN`2bޘo&]>[y3`ϱEg;(ջ,d ߏ=09Yu"?AI'[%n?a08 xh$XN͐eQk9aG0v.Wzw Sx96EIy+].\QOUs0CA)ZuKI|?]sK[\CIq%̄Ge^j mkzG'Ewݨm! WQI\(MrgsEf\Jh(ۭL_Cv4nj׹=QJfOm_k|R$ Wx9R47?w,>^EPtT04h}.'lgFB3Zl_5r\gkz8ʙO'_P3__]k1ɨ|7؄q-~qΜXȈtsOs"qaz˒}/+1f_ڠd,)y{P${OzIPw:-4*/}}\ _ey1!NoTy.^s4k5;)yy(Zd22J(C%?Ҹ!w#iB-B+,H=IR?⨯uEs羅ilAFRj \$)tytIo˴v(߅]=tjc]eb}fc>#TBtSpehӥYKk(,j_V[a5-|Dc[kc *V2m `|^]."v'&-\@2IWZOfqmӑe"aToZ+f_z&}f򉙪.wGVn+qkagP=z3Kvf'>MoI>pmT]P.HQ-pCEUn,dHTAW~.oǿƼ ΦUaPmRpx9} Lɒtɐ5fgT0R3 #|v^%'[9voP s;.W4լGS{O;{ՙW Izrӌ?=;̃I(W)?C}> stream xڭeXL{ .܃[wwBp'7MΞ5殪~zLEI lۻ0|qE5J db0v@cNV.Zqv '+Sc{%ajl PZ\<V8@ '73 02u,QX#kop;lb @ 1IX4z@(,J`H/W\VyȌɃ\]@NEKA2r߬-L`nl Wdo& c m1mmR*V._ Ð8YyXYYB?>O+I{S=:pr=Q Bo y@0ۃ] KN(&'Eп ",%nVb!v(!(x *  5Ar% /L!WOA%NHl ppK/X \cg?Sr,lB B/MANsSvu/q% H ! !C{k fM)=r_gҐN {[˟(D'1r2Ur@`WOH Ē+_)!C*rNgK'ПrBkĿ__% !!d^v Q9=عLlOfps_Ny7rV,/M?Y6IOCY4+uv/%@;үhk:VY+M->O/Z.ZGE0pFf>=TfO7Rǧ f%sI6S| cZ ug&o#v BY ~t ]BY,*kM5%gg&zr n0/Ȍ&U g^@#Jd.;:D m*I?1A+o&x؄CRz+FueH.g<gg;C4RPQ?ͽi~}ζw5[ )s Lu\/od`<#cCXiW#\3pV7WN#< IetIդ 7" 8̗3k»B#=(gihe&ÚE~yfK>ܕ:EO &eZ9s3ǝfNFGځՑ7/5<P/uT Ty共 G$z7 ]ƓNir IYHUR={=>rխn*fjn3ڎxɂ^\od~A `~~F#OꙦ(-o9eg&jy^ r!Sqv%ٹC086̈́ h~9v&ĵ@=MD_|,&Q cajTNZ;SA,,T^i]dn Tƹ_{s3K|)MkUFj>`lkO4ʰnPPDz^0/:OӒqMg<ϙPܞTkz= (jwl/uV텛umhdNc'LL|јf[,6{a9K/3㸽D|S}yڞ*w었/e^E]KΤ@OUd Ôe`__PcV:±v%E&q!;}rn7ϕ$ſ/]rDynnN)b0IOΆP߽EJ:`,~b}RthS-<]?{cXl9 Cȁ#9 ɷx.lLmZE͉WU(-/,P스ZP4?)Et.eV$?*v,|R[Nf$fۚg@NfS!{q 6Yuӫ :9kPcPO%\w}n[H+  MqCŧ+Ҋp#=G|7/cjfDf}>tk`$?gG[yL=8rt) %(= ׹ߒ'N,e-Jg(e)L~Ib_@Is1=Zsz=P=4$ab#', 9HeA$CFgz$sfHxk9ꫡ>ӥ>N7gH V]b&^zi )\U\n`a9rys4$9hKe%=>β V\iA:,#f-'ņYf->猫)!kȲò$J lr{\I;{{C&n5?ԏtʈła%89N0}dDɠQ%,tt9rgCM9T8xFMLTl`)QxG.H: !n=ldGr,ZKo=<<Ը}.1%ARYīIrcF)m::il~];r \,XEY1ʹVri1pX`ŐkMLH^;ӽo}7G691qY9c bǀߢ,ISDeZҖ:_G-PW9Smq]R2勜xu G;}3W/[$8& 8F1(񢪂C?D%Q%}t$}{Ht cZM5+VES>en걠'Ҵs7{zB<]x'Z6dO) )k}恫lEGy%_[ u>Ka⨫&1Cw` ;ġ',\s<@bXv|nΕ0p$vS "u ⦸'! ]um+ ^EÀ=mF[^_8^H1Dcį:-U1=Q/fyŻ)V׶@5C7 B3PgNs}ǓfUЈajFZÃϘ)^^Mo04cQ\lFT"#(ZψK`,.@_&84\$kֱP1_~⡓y(+JD橀aBnc x {(DRYx*U.h ǒPh+̐֜1_~!{˦`d&qTZhu9k$W[/ba\]uT]n>:g8t7_D%Nc}C9hM` x;S'cu' r{WRlN{MēW")tK)Ǽgu58*U\KGcg&`4qj$Tk>MCm*3Hns.'( R,ғ_ѣpZ"c۲9%~ "s?$!tt8.՞pD^_]DN,0HctFݨu!d|vE833eK^u P<1r^hWu&Ob bg9h@ʴLGL=Knk+DL2Az|bmR%d,%єc|g!Q60$ʞp *~UI h'm1:fE1F7GCEhp<p5eU>Da٪ڻYNšhpMC9"q❡CEK"E- ?lA^c,Qu"<8ά!7bYFg.eLjb+p t;Qa\jJH-`)&8n@9P^i7j5QҹM#&Irh$g;\݄ ~[ TK($YXshd8O=xk#eTC nxV06.7&yJD?8 ׿8{l+2 5ƀcPݱNez}}YAդ@0O,RhmCj먻Jol]3zp}9.~50o7 J OeNnxsݿ|%_nTiC)2Qɤuv%ƿ蛉U4,fjn]`rR;]{%URy\]r^T!\{A4m;n z7eJQ-S_ND+2(Q6n ISTg.{+˦ 7L:@4DBUvy3w'עa'V u0ʔغoa{(k'nlyA!lVGjԓ*W6Py?bP;rCl[^; BG1 ]}DSuD+ݩ;pT*@<͒t7+Ԟg Ly^JI`3&ֻ/Sqؐ @X=F`:XeSe^wo4[d;YN9)=LL ܸqJGA[ olGF5FBlKoٷ `)\ֿ ־ͅA³)=QN۔o*E訵Mq&;Gw^ _J.IeeU8Too?Ss𞎟ķNyծTo ׉mU$sZ &.nշLS$>/=aь?@;_:y; ~Rp`7;jǐz/v29&bѰ/y%{.|5n?l|h,YwnڑVƷVdžήFnܰnјFo*|k3fP[E\&Q#&VͿa;Y5z]již/,Qq1BrƧ8uW _%a$:w9-' 'nL'Q6Ǧ!KlEcH:+вBton+AȘ6Yp1*OoCd{#Y{Dz4\SB4NmAf52LE\b> q0\p)U4ݎxԎ !C=ݪ VbZބwn-́xNQcpҋ(y?:]Q34I+!'rR~9 A!*pXba Zn$r0lZ`VL py4r{(} پ,C: ׳4@vyʕQO, *z\6%,y<5$*Z :Ίݱll4lato(فy3uA]y!(SAɃxܰ8N'u@Jw΂g=^Њ`=YZ@6>l>@xBMήΥ#"*bzͽFqSS%c'Rp4[yKv3bQ$C7}$қ3Y?'pO\>n('0q1tPU+fmQ.a._U=uhUSygͳ#[z"nYمsy*wSbˆ圬zޤ}( sJ}>eVB֜az!3H0DUJG~c oHX0բ%kتvw A׼B`˻XnN4-\%+3{Zך1;kވbqCBVpMUd xSmi)'8X QYu ~UgmTf^t#ZѤd1rścP]DvS AdGnMU2)%={,3aI luw63s4"NIM=vu r1Dn#G~.ۤr:åQJʄH}6 zڃI10["L^Ѻ(iЧT818|sMC`z3J>'cV#>EKdF 1zI.r7;wjL?R)-)Jq؅[].is:w^'[T tJ+qJ3ROr+T<əAIU-1fnVo~NM9>]-R~R|2?z(E_8򖙁ݷ^ +cN1Y9[O<$_.܉ۤA $;hy34 k?n aMrݞ?3-ak>!FaJ<ϒDIl7WrF/6ZJj:5aHwӒTW^ZP11Xb9fϯ?' k#m4HA, m}-@LWv0>99K)kj 9_9zû)W$ ck>0>׬ eS֡Kzt@9͵C"-@#!PI%s!x16={T&f,׺FYs8g3h3ZDy/T^ !ma{NQ^l'$n;>zZ1x_K i8F9ՍTNZ Os uUg$U[M.JoXPg=/|ۺ٪˅TȰc.G1%P eU-nq2(W#Säcڨ5 |Ag`E:u -b ]Fy~GT|J#:6EZ4ku-Z}!;l݆¢cZl2cynAff7fez5hpURAR tIS95/s=2VdīXڀ\1W#R&8Gp=E!O]5uIJxN,eT_4vZL2%Rd'4^u$Y;*r$OZ[*^("I'g]r%-o:l$jnފA~TbVq+5\8_X=uXv~BuX-w`68C&(̯EUte* MS|g!nDV#qdXDsp\zxM@HJE)^Jp(͇Ǥ',˭`w5͌ڝ&iCh9\A%b -ctQч*mԐ iSZ]-vH5*Z`R2-0lk~T9.;ŜQ<.C4RoR5gp9;Mk7 v8 ꓏L*nG1ˉRIendstream endobj 155 0 obj << /Filter /FlateDecode /Length1 2105 /Length2 14228 /Length3 0 /Length 15363 >> stream xڭeX]nA\6I.݃Kpr9{\᮪UZR1ڛ\YX⊪V&D**q'  u5Xy8yN.Zq 'K@d 4-A.LQ?' gȔ `j t-#kgf\n 'g(-X$,` 2CdVK(ܣklki. ')j-Mdjj.6@Q;s&Kg)K `fl dgE/ ̚bu5T-\=1{dcabaa?UJhoji^N.'"x/ fXڙ< ^f&;{%3{' `o07Yxo `qވ,mmlf7b0˾Y,N,NC<`*oZTEZEZ4EZE? ֢Fso}aGg2y#r'c5dfgo?pBtښـw̜@{C ?O,/+yS ;ffeK cg猣+7 f!?hWN0!'?[r]0 qk`+l> V!xv!_ z X1&[lvv]vؿ/78Û d_Z ' P,ߦ_5ǷC Loy1ڃs{!_`-1'3א_'q|[]Em^2VV=rbkWrq8__V O{!x$^o@N.~=bdk/'׎N ~Mf/"./CҚ>IL}3oW@ ^J)w_~(B݃#u"tl8!u>fJ}@~|iRyf},Yp | U2=.nmL:jv2UtDzp5wD~Va- +I/nq0تǥah"Ys5'OxQ\9^xngZ۵ɞ׋w  - 喊X +<h=?bi,ҝ`9rmgU#qI>NO ϳAWb&'/}1_؜pxg8Z&z:0gK̏ՌǮyht+K#D^ ,[rV\e%m {GݷЃH&9,zЭ*u얢F+h@|W,l-WOZǤ?xf'2O uo*{#d~6! ԶL^(Hd䵚C d ~Zww R\M=@чD /JP~Ο9KfqvWCޓ@PFV~vs787Dq _Kr AO1MM}r̢Viw-(6̇֏|哟O)3ޤD.Li!Rt>5#x‎#?rHӳX?wuN:FvQ:8df'<9>1&̕sI;@!d{OYJ&%6gP0FzU8 _SD;ٿS&H{V/_%ٖZBV5.8iUJ \.o^i@IMS4$ƤZ MƬ n:/^" 1Do {Omf~Q{X0G8 ъ>vlDxeQCG+Vm6 b y`~%=ڜŭO>B>=M>mQx@8ut+̤ظ>]{-䭩 ҏ 4ePXUW:?oP(Н z%W"_9Q94\j7L)rI}I BpuIE^+h؎[[g#琉5վVf(2CKYePtɀ=kz6Ȯ|=2SԀI-tښ}%&Y̩wO3w2(StC1ێ9#(\J+,gpj _,20Q>rh穻*5WNz{ZeQe#?>~$1_+Mp4eu_(E9cslt4^F۬DQS PqlMұ9^ * mK@Ɔh>B[vR2~!ޔfB0 O~$g}EY[JdVR+'&⍟\OjYA[R/_imX/o2; \W7ǚJߍr" V FjT?~z+ay~lĀ}Ϻi8i):M %o簇uȷ`!\z/g9AZp뾧 􈂊[eI'g@'"A[vA~x@qXԫ,'1A%ͫd;[p7YZ ^H{\^Veg} HQN'j󨚯ԳhMM֦'_$3aD.)mG*RB.QrɣJXU>ug{d4$q8G-K ~f}^Hc>(׻:|MvC>棽hWAlL9ƭ-Ηy,>Ϯi^/\, 7eBYqYˍGnEaW^!o XY5x̔'uPGs0zWOB<i0+W:l3>≠„,z%^τ]G65e.UP;`VjfR1χt^^ɴ 0$X{|"lfbysi.njXoo Z`w }LSo<+(,|ɘZ:Χ4f?ρu=I% BQUAc;=? RFӉ\y|(NH? ꚞVkϹ1g?[dL, RJ'HdM9V=e}8e9(keNmH'/ɊxtZ 7´!%zж!K"`"ByMtM"3d.-rfڅSL)i}"_v'+"^+fT˭r~{Ve+8rD&k=ShڗqOx wkN/XӋz5nw-{NČB爓6FM݅Ce{↣:Y`æXe0;!HQ4-`CtNZG†јnͧ6c;=?ȶ~$!غc'`$@lgBa}$O(\o_?8Z8Dg|{)x @6/5i` =EajjŷK#zlZ<MuHRj󴠲_g3!'CY:tsa1zoc 0b*W zӸKՇjF|*P'x$TG51nQP}gIG8:6пϽnI(x'djϫ!'C $OLqkݖDSmNQaxOW n섙LkurގwHD}O%SѓR4KV9m3X)(=@a4M8cojkdlgLJchLd{M18  .bZ ۼi"$IrZzwyݓ,S0z;fE_yab W8Taݰv",;rodtl;mlhΧ=m79 +iLׂNBqzM3h1O* QgƖTٝb?ԥ ,o?>ܥSqwf}ŧAmYo`;S^Ъߩy=0vP({HLU햠^f 6:5&f|{xÏ6UGv`8/fHTFoS6~(3HҜV]>Cp:fAlmxYHN[tjaJ*̇=NJ<}f+zօq?l5V-/@A.QS%%_+Md.D*&웸ɦxU\Iu NYO |#4P9X%!r `+G̭8yji\~m/T.EsOGc9kFܼѱωqNSgǓP?)?hb v7J2Q4x|uOLaGLwBucgR\t9E:TV\ڐ%>ѭBBFE,i,2u9ːBs>>5ޣ%X3$3A[ : >Zs#~.wԛ͇r"W\h,[Dr,9?F\#2? <}`kk PR(Օ#~J9Ҋ{t3- %w^rYIg.)uu87^ MCuS \=+`d5'KTwG-.oQk;AhH@`?7m. '%ՆJ(͈GjtnLEdžSg2+{i얠4)Y81DGeW8C?.Xߟ_)نA[Z!>V[3 !]xҚ/QeŲ$nEKWϤ@'BVu7͖)!ݺ  eL*鰽D,VF=lt3}z.3XG7l݁p0 s9ڗLBhIؕ5B%Q9KRs~ 8؄L/1q=i I\KU6Pkv!j]̼ĥs>ͫ$Qg*lUK:j!ıb+5 E(@&^Js8!F2E[tVT7~ ~DQCV+gfʀPBʓ6ddy}aAȌsj7wqzp;VAn:+~QV$/2 wl\۴*yj=d'ȎfƢ`g`V>"3"ӦDO9dYSED:02{"#kUds~.>mkȥ ~[gԖkgCl!|Z mɩǃAW[٪sSX.ԶgQ[ "#W'>VJ ̂Jɣ#m9 Ʃd),Q5іTQcCF‰ ~uw{}͋"es嶯{}Sj^2p},[j"02JZmàC#V}Erwk=*}.? u}#'/A;t]~>NcWO[KL,`ĈQqQtˁ^9<(l'ioT{]XW1kpmrlYP65ә19fۏڊk!| qp#b(bIN0bf"LxS ٓ'xo;Qc-NFVۓjh.ma\ ޷ɤ tߊD;=\`y@ha"|,xZ1fSNx'-0 wY׷h.f#Ya{klW0 1NzEQg8:8!fGlゥY^,q^d*(Z6rM1_Ec9ZɼA,1Kf% ʊZ:vr J@!A%'%ԉM1{n:;Tܖ$NIzUui+ OR1ab$Eާ֬Yt0CgRe%;H~`&@g|FcQrB +þȝ5,vdԊ=mDgܑ(,xlHBf.#s/$ewX6sȾuClnQvi@UᙄWr] z" IԝC*g;wnvc!{ZN-Z,/m|yAJnIVӴ]|4荪׃>%w ~K )->w쫬#4ol}&$v'Sf:/2qrV\=t27(ٞ'ب)^|w_GȗqnZYį%{m=go?ϼc+#B4ԓ7%)MGBu:ųBق0M*3 hsVH:RH,g@M;,FGwHatmS۾N{2W2T?k(A\$/Lͺ$u.~E3GTƽGJRY&aE:˙YO.[eJ︻❄;5]+<{1D pk{P`I`6$H[d ]Z]&5>3߈ӣ-.ի,;F|۞}CkJMi̻@jk /ҟ2_m:/% >^ZH&}.QP R-K&'x8)lY6wOs1K-JtYCsn|;KF B?q7,ekwaWDR| 7VJ.qO-U<(.mwKSeߗBNq ǟrg&Zzv+T:nBL6 ez_1_se-6ȿG2Fuqk^f$H|2.AZBA ouZSMHFFUQ]¡eQ^ '" >C)H@nluN, m{LBJ@zB "(gf/D-5'p 䱯TqwZ_N2M ݅'Dwd:c).$L]s^Ci( B C|~3g~O'0 ffCkO9mܿf{s9^Ɏy1Ѻ=vq*v0?}n7&I^' X4X}zB}d=wmDA>tvw0ָR(Sgt3CNt+dR>4f4ʥM+ڳ1m2ZR)SI*e{x#ߏ^z^$-( {lfNr2\=7XȄs>HWX[jUȘ=T %&5Ɨɻ*Eb[)S3I`$ګP0K 5A !A&AOQIu'qWfYjz^XF3谜!8{Q=` mEnxN,ʋMĕsyuPg|/?EE0[h|^/vR)z-<ܗ> F:h~l9=% D]^WvѴn52$fV˽aP Nqx6܂<#ֵJE{/}dIuu{`uױ t(g+@k2ZZPx O-" ]P`nEڙe P/:OWK{#wP͞G#{%-AX &*1}]:-c/;!z=Ѓ郶4WDB+4p6#+ ?6o:o=ߗ x!_;TS"|6o!\li12b; }C^Uz[ \ft卩JCɉ|cӟvh*s:O!ivP|0{:yodDѮJxbK|%4MYMEqnѱKK#3<7Z;Rl[hخWUdMCR2ˑ`v50: m8V_86ƀ#9ozwhf#ye#x} kjύ28}y`,Ux#g7 QxI}H ]{dgȸ{| јO7sR\9 bX&#.)G6)Yi`7/T-'tMELZl g7̿2<Kbg!}|BOg~tFj{*&vn rxNBrsFz&; JMcm.]B,ߙw-|0E@\ηPnRâ2l{_%|E.ާra ^R xضrg $ͭ(vȡpp\Gr% J~Wő/Phzv>wP*\y@ Xi>Ix ק;8~Fgԉ> 5Rl, o/Lx>+~JFHRv KE;̠oK IQiP* pI$@aOZ? UYuL#GIN3:Ua\Klj [ WcQ=IQҿOOd8kX:a<*d̘(Z;㯉jPmz<H'3װF2::t R` zuTEy)_0Z0.;.rKV6'̈B}5b=FŜ =iSu.HJK͡$dMkEL`WL}H sQ <8 uQ2}KAW!ğYNqف3.%}}_$G lzuk+76 R@cߵr2X;e!72ڙQj|9bz#75xo\h=av X*y*rR~^qʍb-+mu6-r@gRyOv({I S_qܡGtL΍{UI3Ԋ vd}# 3Hh +u%V%]/Ⱥk$iK^et wMbSm R; kJ>!>8u+ c%eO-"QPѐ}rc2X'#Hz o|^y=~$mIhkKA<#9fKLJqE&v٧tz XVMbBT{6gRhS^ivd܇O7VbvNtwܞdFZb)f D3ګ%31N5M>#5#*)r ZFu )qVwwUPG聱zP*x|ZpB(v Vr!lNPHfپL:ԯHuujf=-i 12g} 8 !܃ҌRCӆht?S^}Aw^8LDݸV2In QJ^F;t$v=lP}ƾNy[wY:UgN[_Ԡf5uX<#] e.C׭ʻCNU y\%KappKlB EJ2M\9O ؘS6`OJP|I3tGkSNQ1Fz2`A'Hݵ兠V:U!/⩈OޏVOuHflt/Ӡ\x3'N:4ji/y%ɏ#bW aL1e IX^[=^@1ca ^k[γ1Wys l򢣂EcIM6. '_cu.Vsαp>+:sc$fwS5 s*x*s~q/OƮ=̹ n/$,R^Q$Fs':,vNRgB :QKK*$Βp%u%YȂeP?V`XM/P0ۨ;cj,"~2&>-A9m,=fh4f~mBK\QhgF!'hj.O/5q@}j?7vŮm7vN)X߆J#|ʡ2<5,T 榦*Ŗ[8\ ;~%_չQAS!N`82S}}b:QgGp>d(/iWxv#70,r7&U/<E2ry#uS 8Yg*g cq.Zۡ6ꓺ<{fe:"*Dm^QNjvgX,4YFHq HB:ݻ2>4gOXNfW\ƕ2=|ܙ vQ2Lgm?"$ܕp6byz?yy`+q?&‹O:!0% &5͇x, )z/߶\rPj%JNa/ 2?E)A%US%q|NvkA_t)endstream endobj 156 0 obj << /Filter /FlateDecode /Length1 782 /Length2 788 /Length3 0 /Length 1328 >> stream xڭRiPSWU@TPe+fy`bAa^xyAb *"+bŲX[T+ZāV48D TsssϽNvQL>JH`SLXO8 ')7Z9@xE|=N PHLKb UĤbD)T=b%&t,W*tBPPLJ c8m25Zk*pM.E:BIг 05yVLM!CURP$AB,]'E@Ӫ&!XI\ `qy R!QR8ClNo;4&VzīsQb VpފkmMgDb pZH׻I@1\|Ϙ%KVuVRe}UcVR}Kp -c_͟g6iwURI].M5:9FQcaSNJe69%#t-kWƟTb0TR?uE#Q;=(IϏ, ~uʵMQ.N\l2-="~껮@7yBƙd(~xTg,<؟3pU9g5e5W5;l7_pbhHgkErgޅƌ[_Z fڼ-۶=k36tdȳ.?o!H-4.[;N [Wo{}nuޫz`¥-7t.MglI[ި L1+K<&foZ ΓU 9=ʲrmyzcWr_=V/endstream endobj 157 0 obj << /Filter /FlateDecode /Length1 851 /Length2 1325 /Length3 0 /Length 1909 >> stream xڭR{ ̘49{@8 \aoLoϛvnVI _ų5kMf#bAc0prnOνMF87ګ'Ec舯֫`èR5DZ-}ǭ;db} >Iڧ#7Ofm͎=UjP?kWVO;G_Pʓm UW)1muN ď>l+B]2T~Sg\BgU+ K5kכֿk?LJVp=WϫJT^RVI .q_*/KgQH, 1;Whk D=2Tȩ.uMW.[L=fu|č948O1(7&νp /Nͺ1{~?ٕ^vJ@jB PPp>EiwO/Ԛ mzMո<'R5 aڙ%ePKypGIiÅ)Z Zܖv>fuIp#W@_G|Sƌ FնNnN|N9@F|,I&;y.f6Ajު O_ M\kvM@iϩ뽮jn^gp>N4j;HQɒnic?E NxK'u ^oMA2ޯS0P)٦ q W?n(vm9GMwq+~W4lػB%(p~jEp mzuB|(Q-IUN:ʑ{6'+s[e-|pPl='endstream endobj 158 0 obj << /Filter /FlateDecode /Length1 1010 /Length2 2501 /Length3 0 /Length 3180 >> stream xڭSyCM^L ef8-,P=cl` Ȥx}}0~x,Mc\/*x\*]k_ɭ&" ";8l`NVQ!bw{1_*)۹(FN오>iiL8\2F42UU"sH +C}bһ/ڱ_,Vf[+ lPDޠc%+$]kewTTHmeZ&9u+Iw]g|xZ8d~ǩ< M?SJfT[*w͒%bc!@嬗Eӈsf oc<  Mgcm\qQ GeiR S8FrJq «ko=p LweJ~X ~g4[/?"9Eb~|rPK (ћ+ -Uk;#HjI-@ȗoCUQֳ0KߪUۇ,r\ ؽ3>zOrոA:/]딚*=p=56F;òylJ|jͶ>#H%h~7_9sKjHp9:[0j8,I}&5IXE߆ExmOgs2B- 69|d"{-bkM? jB3jVR/̪+7y5(%~SɁ9G=,=ClݵYr㦾-ji݊?D?W>70 ~ aBʻ*3QML$s9Ob?BcUNKAV4m]ŕ=31^Q۵O9e֟|.i^vsBX զO߽D!zuB M]JbS9gCis)%NfO}ZZשQQ$&fYs})Ĺ۴d#kKןHxř*[\=itL]٥/j_JR5cSTgvi-_Äe2m~Hzc)e#뷃ukzp%\u8̚`kK(YnեZ4/CcG'HmUB:?ToRn|aA<7ɦS#ԺlՂ(zRжR_]id۷}d&W!Wo ZSSX4I3Ow͊P}D4=52:Ӽ y=(Op ~;En;\,HE P-pJүT_!9_4Æ 8-6,4uOQnJ!{+UhbtAՅ;%pEyZF8-w!kJ/ [J7 J*eYl0Һ/x1 3 E6T>Ĉ ÕVTq椩݉znn 7ď-9}7AdĊ$ tV6,߱~Vل4[_`0>Y}ɇ׭np ꡰ?<dfy(Ej? ,51TvȜ9pz1Vr:3q; W"wn=7q#h*+uehȖٸ%endstream endobj 159 0 obj << /Filter /FlateDecode /Length1 1292 /Length2 8432 /Length3 0 /Length 9208 >> stream xڭeThq(.Ji!Kp(Z܂^(ŊKqw)V݋Cq.9|=;'s֞z"STa2šG& 3 "* 2RQ؃ -QCG0 9<6 ++7*@jfoaf' d06 6/= *Pc 3@O@w0 cG w?K`{)$E vMQY/{_LHwsq'kkyC3lhca6N`{lT &N6*hhma,1̬[8[M-6y޿bSwl:\=W(%DJXpjYn y+AG#k `DڱM||co6|k&7traR%?~bۘ7l F pŦX^V J;?-/fVȂI lf^O+,(z5|Gn?U4峎" ^A c p^GK=A78/7uV_bY„$e%KhIb`V'vXYzKhimSAϰc Cn0g>7;r&"GbGxe%Vͦ΍<+.#3{ fǶRtg'/$-)ϴ&]^)OMUr GpPBUA]Wr<&n.{;tT"6"ʹ^crqc$`{&Vt{/@n+W|Y`auIDQB̭K7:]]-oMReܭ#<\5aɽ {v8kvӫZaх Nh߲ y^ w(vz~JHDž9W$pM2_~8ZSLTT*50E8M $K@]{;fm/Ӯ35a \N5aء+C5EaeӫhSjs}mD`Z'R-=0rJp0S~屃X>KF{R/?rh]1vP^fؓR:ۢ"w^BؿJeѷA\6f+5-pO.6Whm V#!+g!]5\٪Fz e2JԳ*)ڔRE,`q It_YOSW$6O$+ݐ*qK? &/ii`3 u=]5)mT͇Jk3t؇fV%"gm~FĊق# _v.y&FG< 5+[C&BC"IeJNn 6f`[וފ߅1{3}Hݛ|0uι!t#YW.sPn~aNg "7J䠦;xĚ!ԻE6i 60ejFYrM[lIYp(2>S95:@.0]nYci"n} Ggv1-gr6Ѫl#U@$Soc2$神-oKșM[sv<VT!Td+[h mw˨.'RZ'l?GxM H,a?"r~HnI *-XV&:Ť`ʃ.qyclۑ/0dR0-> 8TǷѷ473j"H*H_͉W 69  7B7(}X~4w ^-Սk_B8s&&Q*`HCby/,-G2k U"‘zNc h(^Rlx2ɾ*14ͱPjuIa\tN+GZob7AȮ-jyiPneP^CZ6NشɼO b7I,U*EØi l;EŠ$dqܧON1crX; MIv+PAn+'Vn_F@K# /mbZhul{"$rO.|LHΩN9v%UR8Sĩ)zo2,Ct]c1 o.q.dZ4ޒ!SII I=3iTo0+W6`E;[9oIIX4?\^ƴr:}R\b,No&Py{g%a=[\9 fJFK1^XKh.FT]=Hy? (.n]1S҆s TG V|.G,1lG *ת xzvwtYDteUh"8}-rջ顟FBW1`5``ɵbJ\qN2/U`xNʰw0˼#f^ŨOV[{&ep&Di3ow (6\*J-A]rwtsLkyw"3)[LovY?~Pٴ egsDgĆB;|iѯǒ‹?c6#G]qx~͋(*O$7K95$X@s#L=.)Osۄ?*; B$']_6 &v>v dg_y0m zT",{Id_ B 8J=ӗcyv0!}ԁ~+9X^8fn:k)uwit=Ʉ0cM'JN*z务)~7UQa<kk?7*}jdV4 ZaD}I{4a֎=!Wa yn{Q{݆eMvW %ٌ`aOlB=nA=SLF^50Y?&?ؑ<rq?m)GPƥ/=gtA̷gQܦrMrT|D[_a,wleL=i?X/!7zD"o-4W+.p˜p_̀nɺn9J[EC_纅T;+QKʽzEn3w<Ȅڊyy0Rt{Q / J9=&%E Md7ݑGmBŠ^ej7'bc˘Ѯ؞8^(]cw-s[cޒB*E4MKNW& Lp)HQba/vc0KRwIGmMLD<*y, $|.|),PװI:5ڠl6ˌ~jͯYm9KKıePXui^QWml&؇ Q?\Z Wkq|Ia}F"VF Rj"4dQۃxػzaWG(N9!td6!R_`'Ƙj#n:fe͹n 6G3*gǟ5BH-!3ӍʒpL_G !Z!M2w -d#1lVQͰ9KfJxwo\kĺ)t.o3FzPn.s.TP8 r‹\O:apjˬg2Xh1--"Xn+ nm Dzf3B${.cYJ#sje]ށ69_=r_eljz -]L}x ptOk:MԳfdo)7[rb.| ~r$sPXV3Caށ7*D SM3bav %Z<*N}rΩb{[twJ& ι 5:Y\Î.oj'c.!ɷokӏߚ v kOF-{W%|z}Q}I.{y^-#桙{K|VG*y:@HKQ?F"U COKuqC;ĬOR? itVr6Z8-OA [cX^Ϥ3ZcocDEM3 6OQo8)0_PH] لy5)(9B}n(5bz{\q1!BTm^#EFMqϳT\-̟ KZ} ~=5X7jfxs929_0u?'@/iv~:+w16O 2\,yuF5 |q$'O^ٛh+Pdwe(Q$ZB3:s LpRьiVZE\(8庩< 3#N߄"!]<~Uɀͣ_Y5wil|!T}چ(Mˮ#>ߚ[|;ӖC1N~ 'T=Ts<%pI4O #,$rU<r>ݤZMɶ@]M7w=!JFTx(]_Fè/m61m;BG ^Qɉby(a\dW)Dkו.L JrpK.7dŶxYNRVTy,ԈdPF,WDc?U8''%>-ij0ݙttp627v(EG"9c(g | ' v?օT'<[Kb:d' ewO95H)5JoVčO$S{D,('|rNטB,`u`шęJĤw{6ܣE\-k!@R[MIR4GSYn? ;0 &Mˢ78&+u?%$i'knꆟ+++!f)mӜ$$WM(7fQuĵ[OW1Dy֬wJuF/D}BFBpLLWAlNY Kdտt{O9 Z.C.y{eɦ -F;.'MlPǸ j+vz9VA̢{ vKe찍 < |7RmK]"*_>_b%'s E2#jz8ڈ$;+e1Rُp6Yj!%J)!of4k0?#ܦ~w5Iv*`ȉ|S6U/?hM~=zZkI@a^!uAXh{ƁD^yB0G`An)t/ojAY(@Ћw4 şK6}ToJ7M]--N\?A"ըH?SMd>tH&IX` o欝/1h oOT5 oRܲ˜Єyv+\e0FRbVrh{SIDƁ%2/ilV;w<g67sZOUo-3A:^7 M_-3]({[jq#~F$ވJFd"ڃ3$qW (+LQy*CÞTu֜!įr NzWL\ O~xVMlRMM򤸸Xnߝ2~ sZR-l\㸅`^Q**q9yzH;hAC̓@\ǕQ5žδKdt; pRWuQ>00!=<ży좮 8bj6 O<;ᖵ[/bG1Ս#Gg,]!q كTF}}n$FnOq /NJ>wA=+7ӡg# qKG06nb3a+}&k{fxfW3~Y~Mr^%GLAQ #H똈y,I4$ p>G߰9Eif&endstream endobj 160 0 obj << /Filter /FlateDecode /Length1 2034 /Length2 12165 /Length3 0 /Length 13283 >> stream xڭeXq%P܂KݥXťh];>=_ϕ/̚gz֓PSj0Y8ܘXJ|6Vjj A `c[Yl( G'oN =lnP2uCr4 7o@u+d@V`?,<6[; @$Z8:y,@(@eGH-DQ;?6yG{'w7 @Cu@֦o\` * Y̭n.A[dlRRcv˧j vpvOl  ` |%`hv.n7 `@ ;X /^ d 2 ?c7qJ/(J|~%6P@W^%WhQ|%WhQ~%/D+AD+AhD+AhD+A _ 3ACR 6rV6^C֚!ۂ@nvc\ @sS3?.H=sG,Xj?_ 1XA%;]iu K_9q;]bn dCAE@l/l_ߊ!|>66T$dҳbrCpzuC9k[97R br+_6FqBdWM5 dZn dX)d`!_傄B.hs3u+DګP.HOn.һ_ 9_0;Rsq5wt{ !Ɂ$ !UB}^5C2\|~!7!@6_/LȻ y@^ s9Gs0 V-_Mw.$Aە(835>Vf`{>tI;'~}0i#ֽTq =h>VZ-O+9<*PC\1h ѕδӊ oP\ꉕnu"4&q±)?!6]D&&*75w AK8|)y.Bڪ!`M=kٺRX+ XEm hT%|%$>K瀫R5{{ݛ˙~O?6.a~e[A˛tJAwi^ߦ5tvg:i/ ̀0]+2qsApM!˹ĸN3ih lp|Рѭ~1 ƈ = t r R1"Ba'k|w szJqv-}nˬmkARq1go!e1z?9P:3ff蔠z35u4q&]HTE"F8. Z> d}u9tw(^/gSVO#f[ Q?Q+p]6TU׏6LsLh-øϋ蟛ܙH`.|/:0 TXd8J&B.2g5瓉OtC!L`OJOm5d5zJ¬u9G?04 #۵`'s L6ݔr\LnoSﵚƜ-{9C>; fCJ}ۭ:LO϶D<6* [F ⻥E`pLm(W0} }CWl[0ryoY%"\Yr{(`ްZ^?u6(z&ۥKO׻ڮ+e #?3Q>RFxW$ϩ_ս|]=zSϧf<맆n#H*ovӭTjXMɞ䬚Ln4'}⵬w;\Sa<:3Y=dJ0oVhX;璳*lĄIGӲ'T =X4P=.'n4[-'Qϧ?':DR\ !0"EUt QYת3vσOgpoƸdSdJ,BzI}eN9^C\p}Ob$J*/Gan;vL"'1 .7)PS3Vea"N-S8chC[ 1\K<ȕBdś~y.s\wڸVH_=8T^" +IW8DwrsFNU]r]?RcK] ㍩*e$Inz*j[bS2Ft+kp+g}}@8'~>1)ұVK;-CΔm&y)#΃!+38t7e(W!ZiGM;`y=EY:yg{aa 9 K;v}ݏLaıKH3rt6EtJ;a4IN+5Ȥr6c7BXNCuW"")M< I[eJaf˝TXO%z87nx5ǎ,NbeRF,h#14 =q<\ĨkQ*Xw&ņ|le|ŗ0\?l$UZ=TQ[89tKtZp ~ml-.RDhyZ.ځpkq!)4e/r>On~m%T:~oK/FҎ">N*h)\,>K!s)~\3w<;"^BS jRCCL][lI}}8^?PT2ȑ]$ o]{u%-FWDMGCJ["J3A[z"8F&鸐zFi%اB٠-(5kRvp) @Svϖ޲|Ћfi&7i/HXA 2C38 L$Rr܌sTP; R!^4R6DE*]ĴӵZ.<"j/ `DT;82BNNêCϰw&[7Sl:0jMF=MLamWC$ 1K*8 ?8#,(ń|&2R;r*紃:m߁bS:p#g%Cmyy<ԅR}hk4;%^ZZTuQ?1?ɐN 9Z1'oiIK0w˸ui$.SkZ\;hJ:aGo $2_fWaFeJ&3O,+dV=y8w)ڄJ8} P,d [۔lL4@M0,XDz}8NUAP_(YOpPdu[N=0fB",w6i#vp-(;$^$eV8tY y$0|Yvꉻ?wٌ&Ou#&wG PQ~O P^h[~VBRBpH-6 ( X*UpAq+ĭ9zyb1{9}~Œ ba'8k@Xz9D>^>ǰJ;ԵO;+jNd7cz3 +c`\֬c2}O* K-boQ0E!Uv;e]IߝXQKO}M41%*?FeS bn֏ $1Wk/ -bkaɡ"H"K4'EyAϱn2nja:Ks/R8e`TGËd6J캱 Gl&Ik֢h*<0?奱1αCQ3(9mDS]ÉLtR5EB'"IQGN_TX]ap[ʣ?d an+DǸ |s%ΪC4te~FW"ƤW];9/%P!25 G"|5PKpCqi?N`q bOy7AΒ^7]U^dl1]vRPSV|QM[ϓ lX,kcA8ﮭt^H3KZpz'#JEo T$zwV>R5v:[y[YY:n]cc#$l Rh.z !D l SN81ڏ* ȋ"(u^mVJEes?`:i-H:YMG}lBIHqn,Wu*OIkQi<ӀpC. A1DceԯhGFH+g|ʤvoHRwID cIt+v [6> %.w B`;zWڠF-aK:El (GYܪܚ84=U/|"&"Q?nŀÔL`b;xFj7A+٦<<*pG}'JfGiqa޿m.1m\U 7b% F x"~ؗ?Й#vy)G**/87q]XLJ_JD'sPѫmժJrn@0Ii+J(Oi"1ݲҐ̿q T`{wh#W{Z7~@,S`a) H ˍHf .אG{GE`,j2n̡KMB>{:}@ RA* _bIrq4y,}z%H|5 }a! :RӵZåG%6j&br0;~fO*t"ؑ_mtkF .p k#gH֋2w,4C'=σ)5S9# f6|ۯ[34Rht8x>JfAKJ>P jN+2g8FƳu-劭 fCBy,FP%Puߵ}YϦ(iD owKRXH CSBp^.*fG*6C~iof1:/FYi_x΃4{l\1 0US΋SLhhG݉)ZE+3/B}|#ͪ\ jx{G`%Uhx`n 6rF Er@ ϯNUK/w#Y8m%)fヸ #(?Twxf#WfUnx CG/]1>]$aSsQXPqkP ظ J8w*K|_(>Јڒ_T0DG4 m)`ג៝@ylX-3 `] Y}"BRfab 9]tG^D,iJ'&X=ƧpyB!&} F1ԃq  ͑^64EI.=D#ƍJ3+ĭrM)r. \(F=(7N3k58MPmX>Gs0bOt@ %@9Of $K@?nc\yZ& Yp'b6Ƭ׵`>l, "RVm)I-*(X~GvtJdtHf`b?)5TN ii**zd0fȗJN"9F>iPVnNƹpvf1oeɯcmt Ừe%M_n}-y&Ճ6/WL,lw[1i ɼ:joe |vKWt //v;W =OUMMp3K¶8v_CL iJry5<׼.8꩔,oGs"s>h@=ThmeaO0NyƵbŕR{u[{9/f?ʜFK=bA,PASV7*9<'F ށ*\饞6|_z6L&\!~7]c]_xg9 J <_3\yًkRQdJg0uJ1"XU˭}MѸdeNAB9]VQPYizLL1`4 MÐ[@J"GH ӗ&ל#eF+No\>X )&J{5!&w mܶYa5|,*:qޙ~U!F gHvUq&(-AC1#3ƽ_IeK˔QK|/]q-nYѝ([zտф]Z2H|kl٫rDnݲk ]E 5\-qRh'!y12Q}CQb<%9%mJ{3e1|Ut1pcq oE?%0Y^~cBHJC[@ I_cgw:W# HM;*X'AV䴩6ù@*'×k~x_ĭ5}3gVvoԪp͝雏#6!{AtY#Ce=H7<%*a6eUY8E~bP@O M:cpv4|_b,xx#27LN1B `O+a&+U:9ۯG.2or`clz%PI k+!IF)S bN=_vHE״g9Ky XP'4[mE+V$#ȗ| XЩȭo9,vaќnoo$1 J>jH 57ZWaJPׯei*qaּ/&sx->*Y)KK-#YT5Xxyt7ۊÕfZۿØA?gd%1*TkՃiN:(-"oQQ_%qN^~̡#[U{7ǑNՁ+o՜-ߢẢH8W,ͽdd6gLx" |xU6Ј!*_) 3@?,kI̋X%dB>%Jg#>:mLݟhY&s'v(p:7bbB.pv|I0بMޯ~l[ 4*-1TVU*/L9PBQ7K`z\RX*@Q,G'|x[#<2/~QOJ^ASWc|~+Z,X^䭞@w"FMu^gO`X+d߾<0:)r #T59-Ԑ'}cc']u#gr UÕ40Ќw@n_pGf+*nE AQuEDk6$(!VUd(K.R%۝y$>W]z3LTxk6N9!XG2^zSݷ *ZAFI}bC8~'nGXjڜI}*klc"JcX 6}/tP*5QVTqf c%`Sە7 qUXQO5C5-v&k Ƈp2_d²fX*D?Ğ\_+;BɪFt ܴMTaT?:h NA=iX{(bB*5Z%)ZDY?(ki.SG-#1&^X*kEI.VybjQ %TNƬ&3ʟ\LQuN SEayuIpf5;{Vkcf|bA_NBR`f洞Tsfs$_D>'jQ;cfdE*Lc/wneхd43Oe3sKu\Y @~rt@BQ1wx)/Kz7uFX%qY76PLU6`# tc2+<  x]z+} *]{qR ە 2d$fL=` p\8鴌x󖕌:, KROC[-)tb<%]U_dhywn<^uh$0=l!f ?気ÅwW{t^gvm4!5As _KԎ?JPendstream endobj 161 0 obj << /Type /ObjStm /Length 1623 /Filter /FlateDecode /N 67 /First 592 >> stream xZ[OG~8*<[E !A!75ʃc/^WI}3g 8sv7͕(I򆔱(-Q:J,5t|D! N(!KF)E\~6xRNgnYk,4*'jJ`HhI-i=i/%c@@OB"$t7{Ofd=# &e8Ò'7d")I=c+ w-5Y,$v,%"%;!d/Y6U#6n&R&DZѰi,5G (G.IVdOIED0-I+@j|(YB@vS`(1N`/O*ʂf_oYF2]#q.ZefI##ZˑjOILƃâwH+UVy5-| ~uħ7_*9/ϐ,wѦvjO ~1,o%$;ZÐA b:M4\yE?_n*o઒N:q0Уx;p6(XtOB廲:-ILͬ:UoEΌxQ]TOh0giyY[35r4rfj +([dvlqMullxC/.i[.y_}LW`4&]+nm-܇-Xj\dwg|>_kz"Ff ֹcq5|}v˫n껳0[ЬB1 0<$̰򀮛}R{`[ ۬^mYq#lKf3lk>9gUpԾ=,aa`Yukg6KiC,L|mb݇C /IH a,+l-[fh9i=tZ_~Kߔ5n|Z|vr[ IBc/k|źvjšg鼙='8(ɴ9O:t0)yug|oBA0Nƴ@;i*6:p47N zIfoC3:O?|73YN~.L[p5OK#"o\zk+w_wXo;w<˿;}m{͎Gwg]?Q'x#-vs'^P}U PH|??)FLXsQUK1oC4b<%[3y>TA Y$eU_ĨHkꟖgch*>.uU|jb` n moZEo؉,7c/!endstream endobj 229 0 obj << /Filter /FlateDecode /Length 5013 >> stream x<ێFvŨ˺Hu eT/d wA q#KlU:W >(BrD=fh|QHE&+ o"yJu;~ý@FtµA\xHm lOapË0˘Gi0ItK}S=pjrEA[!(2E] ]n5Mm\VZlB!jb N{&GݮD}f8]X_q1\}ˬ 0`T˩2)`0ûEP9blTk?ݓ[^hbhkQ&;O^rٵCHzٕRo:nLISWO_mwwLj+&tDjTf&51M,{l?nƹWdَT|ǓHU`83&?ӕ1,o+B1OS4]6O_1?bܥn?wQ*PBL$Adfd6XÌ 4sS Gg)j*k;SIIF9P0by!!}# ]g#%ųLhapix_' 49<[(f:Y ea-8w JMԂf`m%:A3P%X*@CO U/ K{ `bW8U/[&3#[09d#?%EW\5rpZ/uf8S=gsma+8fTEF RmuMpę .kݐOA4uC[Ye t`ypLI#A y714uvcdyXF:r ܈501Aֆb}¾_ÎH<98h Rw;!9;HxyQ縃9HXSc>f#tzAAXsͷ YwQk{B>cX[kS=rL{dQ^3$陟 mNwFǘyS1c>a{^r*\R%H<0eSZ`$hfm,1dp$pfR<׆GEcGm/62tU2u^+xRb_s˗TS𺍔 V4\nJPXr3כ<CdrJ4QTɈ.\ 6%x!ӆ,'%;\6E.@~/y*z_@CX)e0)< vi /25^FZq6MIʙ% Pϥ+b7JYت>A$p dE&{2+ealSXj0tߟ|Ry0W*OjȆ!c4cZ@p(gШ9-wr`&.I z?q4ÎJ=ѓO\Ɖ1FU"NU*MR~n9;F2S6DEZ>p#14 nN.ҶOf'<3Ɯ+tiHӬo}N(8tf< Q)Sar% ǔ+;֩UZe|?Sp_BXSevliԾJH6y-Y[\GZb5^{$PL"5, :[U:Dhff]^d6a~ *JGS|v0C$HMr ݤNg jo p"ЍLM 8j%8M0Sَs ;nO8Ӱ߅cž|) O//p5W)bNei$J&|װ83]وќ@I_ɖJP.9MQ;h)okS$)jalDyǡP:F4G$P/z}!GPFbL"Հs)>?HsDSzL =մӰ04d5mI Z?/|YVߧ6=eƔx QJ-0eu5s{˟B OwK8Xa`1&6[~p1VC1Ōqx 7z*4>}?9l3X*92$dzx<C>RN`&P. xX>alo04J{E4G je@)bgx}UBH sŧl=Te Usj93-M~h)J*") ~>r׾ݬ|m5{I&vbV\FsN](-9˺(,VTM3ˢ&eϭIPJؤ$SeJJ5CZjT64\^XM$6)q+j|R6.ϭRQ5OMҒ0T4rcHnR)*m ECeRҧԯ^'5a2DZ*ԋ*&|iQWFc״Q'DUDZW}I_Z2?TyUml2L$yv߸M~bOHp[Ku §7 Y%t*gNf[ jSý{N_}կ0V(Wj4I50M޾T-W~iQ4P5::]  {MuRhR"<ȋHQGNnB7/dݿ@bLQyҴ%s9mɜ+(1A>L);rZUrB_I`w'|.&2160 ǵrđWVNzAM~ЃOp<aeK+6(y t2$t9ER=M L6X-{Jj7 8ÏP'J[ywj$a<2䷥M (k{Ѧ\B竤w9am=9KOW)}_Js^"s6تXEPjE3YɱfQă>ۖO׎bFٻy6n[yT%e]w$CrX9~MGJbfVWպ+n ^3ovkւOw,nQ褀3Dn/8bZCPN䲷;ijeWǭl,uc9_ uc6,٬ E Kj5V(&L5hA,IO4,LGYSPcd&8 LT`ֳs]`C/f kDoCla^Y86qn p!f!UM;e*nir*ReVVX@\T†2rN!]~T,k I 3g݀)?f1E@f5ST2w y.s֠"Tl=N.PN&ӿXd+3 NID2mw4pOʃw7l䞿!(YnɁ=p::~ x@=Y-s T{ȯv!!ՠTۄ09Bws=/vx +\J~ ~: zUO}(N8.i^zrZfN^+.gi=vH}].o ]n^xc~Xtk U:Wy3Խ3 G(IOeS NBWrcMUgƊ˲t c'-$Л$>)2N(I"oD8{O/Coeہ2d _-C U5~;U*=k{8V<+Qg6c{ p|*wa_3?|{pcM`&1}8J/B8.D#mPغ"utit"B;klHubendstream endobj 230 0 obj << /Filter /FlateDecode /Length 3127 >> stream xZm~B0`TX4w)Z vc-R~p\|EBRwwvKΗi?P\3z>{ʘEY,ۅITȍʤX/sW&- =Œ+GeZw4HLm{B,4FL ^E=쩆ـ֒4ם4/H+"*rVD02"G.Ka1:_Y#Yf:+# E w4]P?jF+;TvDqLWSLLT#yӚ2#}DXX kl6"f6+K ggJ}]lkZYFXNƏۢ- ;֐zFEie|muHԓ"r7&ʀ%<~Ә(w/m^*Hd,S-6(Ʌ"1+o#YsL֝Eyy7Np|IE+!0vsY$6@JPW{-[ܰv+#)ȫe VE2tÄƛ%!hH23S|a"s,R`z^'ķѸ95'W ILADXbOUyEx[HС}F"툎Q#@"@{y9&:(Ur,QTSIVT9*7*G4d@OHb5AKUNJGsCGQ'*5j:tuMZt rKĬ1[_MZ|ہ+ÌV_ NM*Q%BzM7[9NkL<68J7||MMH0ny#9~-_=$?%Zipn)@?JB4Qg;rwk{oEH7^BF&dMcGw|<ݔ@+4k.iأIǚޛ\D:/R:J-h.ՠJzqiAȭ=&=7ޜc>w!C>dieKܡ\րᎻQ'OtPTJZ ͥ='be"m C%XNbfq&Ɂ DI&߃Dǜ(r:/6qz ΋E>lF:@zNq&G#( >jum0"HQ{u^8E?̤A &J,fr$v$c}ʆG@PҌPd0tZ\8CNLngEzb0`j+ؔ@0O6 ҍ릇Dooo1j0|=w8߇7L݄gW| 8rcSc]H}{0OXKxGywCVҞ1I vg?j (KөT.6VE,Գ])o[; SAp({:I4Mk"/rHGc~z}*!{+›e) q5fF*qnygQR*j ii1TzKЍr%NOtpX,,>9:@ KOjFiw5QüUb(aK _9+@Psj5u118h6v{I-c8+nKBav.疣m[tRk%JGn()ADq ՝R-E:HƫH^/傇o:nqA gk D;/[їO$Vj^[iwTR7tc.LC24u !RIrmgtSϜ>Z/(/R?՘rN_P}^R4F-UO(x9G (e$'v Vt:yQ!l6/qڰNn-? %"e,&93J;q.z=;eth^RWDkD{`V}1&m #/]̀!2o7t WtsBU1E8vw|Yp&5lUM-Mҥ6/I`0ųtU?(¯֡̕64pW=cpb2$2Rwi$DG&OhYXendstream endobj 231 0 obj << /BBox [ 0 0 432 432 ] /FormType 1 /PTEX.FileName (bms-009.pdf) /PTEX.InfoDict 81 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 82 0 R /F3 83 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 2021 /Filter /FlateDecode >> stream xZKo6>Ckh}!al Nk;/cȥ$iӤ! Oߌ(i(gw7W;Fc޽}^Woh{2i"\ݐ߿>ȏחD0rqp|K^=/_gﮜa,Qm psIipӎ"޿ڿ:CJ ҐQa RpgiJBR6i@ 7;>*96*Dج9_17*rl%AcNSd䀌3Nsml%z 8vںq­ aGLI'SrW G:qǩ9 N2@3"d5ŰhX8ኞqep[T2O= 45:؛%o6` DS`>c-ah;@3sT7L$%eF!P’ФB%r(I!P"X cHJʌ"&:rjsQ֏@iXS 4tU˷:gTJJ@GZz4\Q)IC7boH;^@$il$HT#SQ u+j&dhL^F'nu" lY,p ,P7$d*NG!3bwTQfzJ|yWw\Mpي(aM h5:(&`j*cd 0|ֈwv%o+6Y 0]%/)375$5jWf))?Pb k{)Ya#Sǎ0R%eiJ()Q&=xFJEwY()20^wI% ,5Zw4܁4Y`GG%%Q~G(lLkS) `R GJ 'GJL0%שP[30r͑ʠjՊ2tkȉCVzf$ g%^ v64z73~ID#[⎨%:?8DJ[(|(|^m3E( +.z3@s# `ʮI*7\°(pхW#I}IZN-ff:/_m/ֵ4r EZޟ*ʼn''wV([˫?gS%|E$5zd $._W.#S?MI?݋;Nv )?_+,4lCG8&>ۄpqM8/\oH0 p0"-&a7/`beܛ}qpo"&~ýqwqo"XL {&Wqĸ7GߔM7$_$37%nJ}s73^|=sw7Kܔ)qun)*\WP֬MO%^z82o%.e}ƺ>W_K\?|ɻq"FwD\KrОSkt55%}jtc2}lXN%{R3'nO "QI7:H.VF2&D8t 3%x0Y>D8]Gۨ&8ez}wI\ӆdby??`%@'QO !bԄC%doI"{ź=޾Vu~i}8(ђ*,OpXe<-D~r[A1 ;ɕ4-~0dʝk(obw5`b;oq&vW /V&,d0gJO.;? - f0QQDYj~!oT`ܹ&vÛkons0:;''''/ġm>\G:8̷a96I}}endstream endobj 232 0 obj << /Filter /FlateDecode /Length 2309 >> stream xڵnF݀ZXEI0 FAq- ٲ,*s k}Z֫6Ni]\a1jYBUyCG1mj) _F .^`Rnuq6ښ2^]\~]{M׼lMpK=j}nuM~Бp-헍ƨLf6Si"\w ac "2[p ux!2%n# ?#巋oR)؊oGlps(>A>eA4ìX?J7w5|f[aꆡ!(ïm`=]ģ=Cdz6h]Ϫ[j'rhIX ;?jp={fj˦*Fƈ&ABqejs<+Svx1G'>da^{>Mg@{cUD‰4}ğ 8N3r|U=@Ql6X}톔.ɮ$ 'ڞO0I%DP ":&0qT]ō t<8уLrfw3l-s`WQPBzYVh֮E$$nƇ~6!mKBe6ӋXlC[IO%=5gwK$z,ҏ!n" >C6; n7FWQMU :s[pPmǃ|<pst4B0i ݧȷ[]L0פ.@D7ʭIdĩlѭi' nHB,7,Sb3v+5ف,npj'p63oVkSJ5Ejp kxJ,d'\=VUD.rL~8Hz.0TIEd:9ae"|j^sfb3Jfh;RsTum4,@ 4`}\-w)>`tTN)vrb+y }˙)݊%vAU4` '|MkPG`\?blTeK,wbj_A[H #TE?D.JŞ^zD4ctkq],*ڂoLOv)@;R-* ! %YPQe Zz(0c^<,P). srBPSHCC~^}ÜIu DIf}U]uebN$^~e8HXgD["!E#Br4+`&b V*Xzm\֒C/ښր`ęnӹ8(zl2nv+=ݰW1Zc!u lc/$"t:>z#R=ÖOz< =ֿv䕪Jb$1 % ώc?~<04W! ';S"瞇m/Ym燝ԫiF ?i! /(Pb~p'-Ng]9~Z/$ ͓[|2*Ru= ^e>y ? A~) C=~o.v\Xj,$t> /Font << /F2 89 0 R /F3 90 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 963 /Filter /FlateDecode >> stream xVKo7 ϯ{(+zME 4=9$&X#%iYՂq($k /+~F 2:,F v[8/ 20蓮I>?ӛ`Dp-ۉ 7S$ ɡg: b5z4>O#zl٠3`cJ*'F;gY`&4V4ѯ~X8i0NW'k1&VMԵfcZU1/bWw~ƑO_Zc"]*yIfĀi\Ӌ|OWt1It{9=+tRe}lə,~n"Gdf-6p)c)¾\>NLJ<|8HDqߎ_O; ,\x|[_/ays>♵5,psxw X$%,[#ÁN*ytYcjX:샗`=5f\9d2WP Zur90'KVk ԊI::UPi4@G@9(n*PΎϪ???+m5qϸ249jXIؒGN=PNdP߭wDfT˰nι1H9iyg@dFNMh%RcZ|U" (lsxtHf^!NGF)wGC@Necx)aI9 QKc9Dv|%uUjuCpA]Ƀ~~fww_:ܺ!aHN|n"Tr:wF5׹mBr͗n2Zjei2S:_74pC_zk}$IɷisE_rk39s}"^ _mGҧ> stream x]oݿB~/^\}HZJDίr)vLrw8;_T jJ5 +к^^HRMow{p=Uº*~}y1Z4B QBfqYXcY[l[*߉~;O0n˕w Ñ;\zZmXz@}wJ/i nn\;~-,Ta U *p~RzÀ#iLrt pi* _X Kfq׻(dRFE>Q'i3nCKQw;i7&#xGGSaT>~{<1h% !vNܝ|+Z2c#Fj f֐.I}|>1kVH:cOpm~(=% Wcn)2wuNTt$}$S߁pCp+_'Z=I7I(PO+#6|}(@{}T-](MvC,XݓYx0QFUWYvFnc;XI떝Ě`}مR?†P D(!ڶ%Lb`KKXiBvV9]]޲[6Վ'U} f},Sdj0C^.SxxG붌7@8 hsS1xٌ1ce y>JBTPnW:M똋pJq(>KӰ !#_yabCK.Y$Ԗ}?IeO.mXcG;_RbE'ܑDN1dк'z`R76Z ̧l>Y`# k9kSrB?Mۖ.Q8S鵭&Y'CPSxs};5k] gX<}0v xG۬z9H]Ռx!auHBL5e~$'?j`> '<[B}5>aRnZp%Sq\.'GR8b#V02z`J7hsBB/2 A#!]ə95Bi^ 7(@^89?;5HMP!%VZ`8YPuڞuڛ?o)xxuПHjp\O"'y3k뢹 1sAhJ%ИMF}>bZw| Pr zؕѦS Nv= 趤S:.,Mq s*rP=bAųVR H -s dwo9}34=3Z|~r/RɵyveiS9A%q 1&~ףK-] %7}!$9Ǿv>O]o v.e[`\48k8dzHbA~m{7ލSgA@":*(* *㋿^S%PZǟbP ԋ/tz{/eT2uyt2u,e p o];nf5(!?* =4xgҨJPIU Ms1+uӺ3͛NNŞ7QYFui`hjj$)P{Kw-mR ><~~vom!G#R׆4(\I6DGݯL&Z RKAfMG!Rb0C]"ZqyT?iVo%yErP᷎TU!Rmw'υ8vq5rAa%HtEqV Yvc^H%W[ɯkY3$ uZLhE !(. N+ kO3J&g7.W5Jt u wiN1|3"Y*?2 uD03 OgDuIr3ױpci1%?2r?d[f#7tMa̖osj?V|SO8|3[ d:M q*WŸ!>_b0ۊQ4)K1|R.H*Ν`WXXԭ\*3L@EB>WWA*F ^^3Zv3@ɌdޓjFĊlnzu$nPSh4yO}͜W$V N > stream xڽZ` 2 iIZ~J@'rDE|vwfvf$;F?|-w=g}Y Wum/n.REctZwq~q8z8y G|.6. 8¡hpzGCk>X84ǴYDG>-}%6`3S͸H+΀/ mDLST ?K]9{292>Ҥ~]jr1gB b2a@4еu^E%zI e =lһ$ K2(}[t*"[5B3s=܆l&sz:zぐX#v {-dX ߟ$ܐv.>"x@E-yHyFgfpV>RʩqoÉ܄7Ë9RUt2;ͪI(45$ށ _'R2m"6pJ:.U VH :Θ82^B=1!yG{FwҕJ ~B*zM U1Nv TK鈇1P΃ Mš ԰iY+%B d26l.`\ UlvT>;%ݭ'd ~xڨ'ݝ՞. ,U})^Vj_ySAgRuk.`Z/ΤEw=孷XM/q <_G[JcpB[pͣFX|n|lNUj2;@vJ/D N:b%ɻ孂.?f$Cl:UL0jCF 24~ Ί=жqʛ|~.kXhC*R.LK剼=4.qTi>ԛ:Ķ2>ӕ?}: _SŒ|XvoX)۔OR6KbO ʶQlS(&1# UHYT+RY=P|c!:/^XJZL'Z`4'jwXˑAi(:膐5!;J?!DEu[㓏q Q7y6A] n}tlc|,(HŰ:cX81fꝉÜhL[eOyk+E}BoRv5ij %p%;~΀P4Ͼ Q-~bz:2)sI/b+h*t٪9#iuhޙQ|G@oNIXx;KvAv d-`x#?b;Hldn_n`MbC뛃djozjr5@}Jv4BW %k/QTrC. r5CK6]Yzۈ~`=%tVYy~-UMzTIM8 pCH[5>4δ#LOF=9%0:qW,!r "7Qfʄ:rle_Az|9B\4?*(W%",D_VOR>Ӹo\ N¤"gb`ZQ3BUE{Fg-&ilpS&ktEb6>\kޔ |s DI^"iBuǂĪͿ[ eۃ`q-xx)'lh:l}2n P+aK+z&}8Jptjѽ%L[&F\]tuDP;݈Dpa).B-w{?L"H20 8&QB}#6){+3S7_&Skץ[@X;ї$bHrz|-U3*{~l;JJU|HKtꝀ0KZBRU17ew*"B]@Py) l{4r^ ^|_^OYSe]Զ" 3.gڦT{\!@է"}2'{\@.IFG0VS#^o aTdqP^ڔpq3SB5fgͤ St3^LNIuK}g&ue}sdd/d>m|J`ɬcR_ Fhu:r*xk*L㊀Tvb^E9};oQ> /Font << /F2 97 0 R /F3 98 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 982 /Filter /FlateDecode >> stream xWMo7 ϯ{(+1HR^ k6qQHhovO$5!;/`#*`k1p:o(dRІ !1 >-[HRpxB ZA١y!h` 2F FT@@ I'$cK^o*^J =dYxMnkJrö́n%jpIaZ4v0n/k>dj?ْӟˏo<DC#FN΁'DÕ `٧)_;p<\(+p u ]DnpRᶅ5vU69 nas.l?\r,*t FT_vt|<㧃N'>~}:߁l_O}-Ͽ2z 8/mLJ@xH3QZP*YtEFuX0zNȊN.p&p+p­VN;hs?ylKvmPPHCͶٛ:%ա9T8:u͡ѡlPకZCg ts8D7꼋 .-Q#+wF,9r{4 5՚}Ak4B6hb>is*iGQ`VXyQv(#ݣDd6Ȟik)Cc3_t# 90*&)(e"xQ" F4D8tWE6ftOE3 %{=v&qNۗy>ѭ/yȖPNy,s{ Vhu-ТVo!V}Z17>7lM[e[+YR&$y9/ǃendstream endobj 237 0 obj << /Filter /FlateDecode /Length 1196 >> stream xڥVMs6WHMCHLzhZϤ$:9$dэȐrw@KC {o$?hS(ȍ2'7\9+C&q&םM~/_ʂ,rīd}hTmMbkLU']>}_i~ 6ݮ2G7em__iޤ `~umY˺owhd:Aod=lbl%k *8R, /89V?W.f'J냝yaQ5pQ؄$Q  AM@~ 5Ӵ̚ /8׌<"  ǰ9X(mxL73Qs*>qLCL]H3?a HvVef=R8 0Ubc ^>[(v {E=ʱD7GeZdSB fCJd^!| F"pJ_% 8\`1bnѿԇ)7P"L ؋ {myoN1yci.F#"}HD=w9'I~B`&~l6'++; t?DҰzv$/bmV/m\$' ߎ{ܸiГm;6=·lgnpfmAS9J|3Y*~仕/EJ[^Tb}x̽;MN€?F5QWl3OsEȅҋ{#6GK9P)~ϒ'tU^gnERUV.pr OdbiNpB%4Ћd/j#Ku󂇮H6;9A 0'J_̵t!Dq[ã͔|}1Ov0!)[,D;[\& u^ 8(X2m.h@ p鹃GY̿g, ˪hk ;hp9ժ4: HQa__9X.+<+ԠwCxUVUP05jendstream endobj 238 0 obj << /BBox [ 0 0 432 432 ] /FormType 1 /PTEX.FileName (bms-017.pdf) /PTEX.InfoDict 102 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F1 103 0 R /F2 104 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 1314 /Filter /FlateDecode >> stream xWKo7Q>kyAC$'vw5;ߌ%Rԝ6|PT(x^9ouʖUkFh >&49pYu36F5]#| ?y]S :r!r z0=٢mV9 nQ u8pTt+4 蔎8Op|8͝*ZzHUIIRfzKMRm7ˁ&|>nL+'%7HXixN\W%o.q xՠv{4h~Z<Io8u؃٠>8$gN*JZs؃uFBa]" ψV֨Px8~&c, N|."~c;nЋ(zt@X㡘ڜ\vm! 17BZCX gFYBDp WNZ>)1/8q+BPlE $mQsirE#d(Mn]awaeA/ Ehu9ȥ@UcH.Z0jzy1.<N*rd}|fFxԓs&_On Dho&K5;JACrufB0`8{ 62L=b w;,y&zznٞnQ?88ݞoGNs%CmLZI!wdd%ZlrGsdQFq|:aCFqFriBdI Q-^wtqܾPfj~+Z?\7x]|V˧]W6Lܗc2bqߍ9fK,^޶5cۣ=@;ZM'vӫ8;7y\Nn#`^pA(|H?a%onenֿpe5u0Vًjxz7\M SZz5f{O8UhΨluBz*W btʧ¯f]?7q7l{JW=]O^m'g*Cn|endstream endobj 239 0 obj << /Filter /FlateDecode /Length 2632 >> stream xYYo~ׯ7Sf7yxc'V G=R~}Öf5>*-:׺Ywg?y4)qgovfٟ -eDٳehb.[]\\-pnΗT ^Fn~>Mmc?>{mcZD<xzx8ҘX*;Kcꄝ?W\ao?¿[\`g?Άp1v/ gE^T([+z&EѼPc[/NХ|nxځ482`u3\Uu*Ϳ,6ð#A,3+crOGavz㴋f4rKRYYϳBp:=K'ly9O8,c)xʁAPȁxBǢ OgubRT,[ї| Heިr*̷ndOA^2 YdvhO09-tD㢱T(#r+'~_b1N$DNNG&.fmPh+\zM5q ι:> X$)P1\SKA$}#S;!Ղ `r8#!|3yh5*k/1\WкA[m/ܖc;X4UB8G'"G Wawtty#FL|@Z:4ҏO` P&lj:\^09,C3 LCU3'CH{3! TKnM8YWl44:ұ]pXQ0a>`'%zM>+ld:2MR>5g%*bdo?(O0J(߀i[~L،w$*h5 %wD ugꊂH< ~T4b*ۡ[ ?poP#9Z3]@I,V ndv)"dǨfo6QZ!.‰0#?0i26NJj"T,Jhy[Nis h s!Q6Aq)LB<9<9Kd"SY st ~ipXd"0,XM$ierJ#q'X)lR'+0<|FfDGsp 7BӍIvq@Nk \r``#rɕC Ho4+U.%]xw`Ǫ ~KFAFdhTn/xY$ljs ;^F* vܺKμГ'k(6~+饬I\m?"'rUq CynDn0yS6[W8ULp _4{Ιz/F neѥ <ʱay¼L1D 3&dž%O#5 qh] SES+]MnT6_=I<0CJn`BU]#bzY sjm^œUͷWm@J67߭ AֲaY97*:9+ͭV̀>$kYD7옍\9{wE K[ERb''3f[(sd0f* T_sDzɫ_/ Z , eTv.:ܜ ՜83vЉo} hvKrm,2]/ɶ߃"=JgMMiN 7ŦGX}J?}J&"pb;0vbQj޶tPLiԅMa%0taSs$F9q`_F>)^M y'AW0en' .Lx^ʒ`<͕i )yǤT I+2151m+~^ǃv:\39]“+IU:oͷK9ǧ-TGtSEN[uɠ.1%F5!v~@Gxau*Ó_>dK!Mk͝X*oPfS0'qݒc3v/xe [;ħ=/.bG)ǤvN ::V9mo+>[G:~OՆסz;I/y#LpWcԔRP$R\kROjMTֵMj Gh\ F7sg8a+endstream endobj 240 0 obj << /Filter /FlateDecode /Length 4834 >> stream xڭ[YƑ~Pa*nV:Z79<@IL#++/3 _|}U|5[]߭L]eWmeOؘasU5z 7 =[?žڜ}q=-& ^f.%Įp:MJa-RX?{GF#-F(9(oi{_;k )v)ٚ[6>i ߇DhMm͕+[8ba3:e-si0ZH]QuM2%_έDp?}^t1[|3SIJ6~ ([zv*k{{łյEU6"X~4HeʭpضYMVX0΃zl4A<43np{D_vۗEն"^VsDVuM{NcȤUu.\Fvuux d*_6ĺU]tmې"] w 0R`J4-PQSL| hkܯ[_eyP_Ds-l v.6z#b%(u:ݹ2S7lè㗲o`_m/l0R T 9O39+-+wv/M>_x دmho)F%l:+˙dg45E8[6.zMf2"bq35#/pҚm9`}HEnO6_]QՎ}U2)aE̲P5`_uEep79WVqwUSv9ɯdw0X_@j4X?*A)mGMm,04!ٝ>8-zpʷjHL'5}@%iPwh؆G(hE!U5N*_@pA=Gp^I^[QttzH}U3 H8ysIE0^](0.śOdh QO@ś@ ,3\F3(‚O(@ `Bד@No|%N4&XLud@k%5áY~BIa^S'~G` c PtS+Ѐ.ia> d au/['ܹlAu3iQGSrj5X܃a#^D>6/Ή$YcY -w,a*sMM׬禮SBg1%.VXp)6ӡz? :w>,}LĤ&U,M,,)+5a0m Q|bikD=I۟ =&A&}]5;ۈ9S%f|Uxϳ;iֈ5iԴ/2X,1&نI:Io[#_[E WQrWweqxDsNab#3]3G_B-]˅sEkA ԶNSm8Xhc.]va&[q^p1hRhݎ]a%40xnXkBg|O`G`&7+ Μ굂0$ 2x43Z]@xb_qMKM3hIr J-"jvRN!q؅C-7X%Jx vhw2E]='e*-n5>E2!  s߃p, =Ptsf񱐠7($bzBOc 717 yv tES7|)\j^%ڈgIߘ G-ltRS%Hw2X: ! ' I>=z6ff"Ydfv.M8Km*~ :B'Qoc,j J,Wƻ;1y %Yߑ, <=2 J"ynYZ^D276aAXSqL`)*/Ӕ 1BtZ=Fpeh0cbů_N/eHDWrhkjc-@%N ,-. W7iU|T2s劲 e^ܚ]!AF)K]|ڦS> tX y `i~NdnK S9>fޯ4'S<Ս]- xZ@W9|27 5_;䲩DSe S-8*T!jy%,)j2F0MZON2ƺ7(x|^L*6w[8IniT`ɘIDUod0Ӫoܦ.>$pCdSĹcb&Mg >|=&{͟K[mj pWnGBkVRZx_?zY{L6|+cҙObbh=.1W,{~ݐж00]<$x4e!n/ǡWB28o*_[n8ڷAs]Ǥ(O< ǒWUV E;@ &%A=IS`w˟L7I$]~B=wA>aϜ>&1]Q,¡ZA%:+upM^ԩ0r’QOO,km?ʇhS` ߧy X.Jg?+h6`+!$Pp54%'| ml܅ EM1|{!bm!q |c H D 4cSX$a8fhiL/iNs<`h|OiҚHz+y/1d0Naq AΏʷ1BU{>]IgN~~+3 dǾW~#/%TFT/ [&CW+㜿d-T֨Js9 s];]ބGrsYi}9_ "Gy[soZ_ˈiSÏh?kWWٞ0ЫLAMh9@Z|X, B% ))qL^SX>]H*Sm2,MO~&/57B\$dz'kAԾ~~'O.,R3rMr`,W h4% d)տQ!ȹP VeT5uVL,Z_|ݩ^&5kܩ(Ij"(W>JnXLS`[_wK*5$O ?_*Jyɭܷ!<ۍ1"(ULV/̲gJB|\i]dqUyW*"jAo#Q/ _Rp6*Urzx1JJ,ۦ U.0pvOrµfכxb_ DlZߒWHV5N_y^_\_$,r E"[4]df26?chH\6n-^*wYEԡbˡЋ_reV __gWrχ*[_/3iʦh\uQ6CBHn &pĠL06ĠZ.k 8~&-UÑ9Q$I|yKe_ʬS<DvIMFޢ)1;r lWuVw4= 8| ~=f7)lN%7i~SCv0oHRkrǛMHT~"fڪӖcpxj6-Vևݦ*9ĦGxS\!\2I旚$?y ώ> /Font << /F2 112 0 R /F3 113 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 16468 /Filter /FlateDecode >> stream xK5Kz9߿b ufDƉa[4RI3\lmS?!]_kWDddd/??/~\gO1ʧϟ7f;_G>>o?~\w?Ǩ2_>8קFqO]kX=֏>~V~,m_W~~zk.Z>wy~,~/z{wq^6瑩M=?>o`ǧ\38ǏJ\ދۏ뻥==~X|.}w7)x7uugՀ{%>xw^8G榲 |[jG]<|s]ьuߎvY= ӗ~Z?j@:gӸSƙqyq7{(Gij'G\'vfz>3}ޱ[/>%[Hm;뎓{eEYTpm?53JѦu8IHy= 7}N/q_C[7\29B/ ~; ;%? ;ZNޖً(s=]OM˷׮L&̔sS / ex:?6K hY:* -vDtʫ2RUV~+gBJHyCmϗ ,k\8l~wWJJ~eW" F~KF)_}N~wɳRBƙ]t\{o *YPtq1. UZMB)Q%*x8Mݓ.4O1 *n]|,h1JU}}TQ΂- v2.4fFζQmc.%x6R?)wi^pU.lH_}qqfTC*؇k{ί~5Vu\·o gg+{.pP{Հ,/oW$>_y [j~ #Kh?a"5>&4.r:q)as:}bߟY p撳+;~xT=lK8ӳ&~|h#WOu_t 1;_pgo)oKu9)uτ'Z>>ml# C{6s gok M.+]dtWU-뻛WCW"|eunSJf[)0/[k45кLh?卮$>}`+W8]ͨN wuo_:{f$]z <ܽow}].+@itoe w w}:.-hyޮUpvQ=Nrs߃'os?60e7)B^vbC^zȫZ↼>O!coqPק¹%!ק{^S꾇Pe8j!< +n.EM.C97U`-o(z߸Om-J־}z/Kz~}(Z_:#-8[XkXkM(kq ~ZҲ}w tU*oeㅲ:9u+zNUTtCdUoۊUQE;j􈻁vV;Yhc[\Obau}>hcU#=V@X]zw<}x?ڍM_1~ʣo!N#a|qrOݢ-(+ꑰT˧8zZXFT=[طoc}bŕo+Vlcٳƾ_18^Bj偱ixtG˽ƾM6=w#:"bImcC0Vuc]"X.f[3c]ĺ`aJ&Ӟ~^+6ZXʶuUض$5!_&Vרi Gչj0V'mc}A6=IaBc=bW>~tUdMAY}q@Y&eQ%7ʢ2hhcUف>`ݢrecnjco}:cSɦ6zƢm2 mH6my;v`dh0;6V5TCEƪi',νⶕu[РFyTC#e] TBY ]b79q#WgCYoJ~vzw4oW:~;v(Z~*` cuy۷~$Swoe]v=ρ+bU_v}:MTcw(p6ʪDw5WlzCYoD8;ӃV~6ʪ"bO#zn5JYc`Ϫx %NXz~<؄3b ; s5wU7q[-41mƞJwX^晴E0?FNtՕ0[ !cQsiXc}jcP[3~mGaUXXJX֕8)K@<-rkoQV},v@XY6QӮ^7 U ǺLBXNna߳1>}$uQ9c9V< W_bBS3%L>[dJXИY aճM-F[Zi7+p'C>"{!Wnï!䄰*Wb])l@X])aQTbSz~1%lѧhaQ# M-55lj؟TLC+€a}{\LBz'Sb~&̝ a] }$,O;$,x6mj&'n,:sx6VOtCvAX:1)U -u ª_ .肰p}>r\}Bd,wĦ/Z//BrXi:G'^0{u `ُ/|a輍]*O M cvolVXNXJ`yy|=ǧdSu?V7JRŸ5|\.뽒/x lBWI&/]k`{KM,ߢOv`BXY^N傰 jbɇaٱ L} l ! 喏>q , ,w!5NL|k솰n Y|dMAߪ7nbUSU.7 7^#Ł9<.Wn )7E!HvBX \roauXVZx:>| ֟>ߍg> !Cn:vg=>]+]_:jexS!{p-yr6;D<)} {k8>&J-,ª Or~)haU#:<b(H\ OWK{ 7S|i[v!Qj U'N#a}DR*x-6}R>g?@XUE]bZتO+$UP$Zęҕc)3}`Ǧ{?Rӝgdz;rfaZX+}ªkXمx8皁s-e+tUK,aqrnbqU7_~96Mz\0q`>OX<=^p RU ^!l`QR%FEQr{U+bj)l=,.YF>gJX:FI4L̿01y |RK¾gqFꍘ aӧ5soJMRᯃc?𖷰U1L[ aha]f^S l gLz [.q=[ a}A%<р@XaU=u=b } lJ}u |j/x<`9xa˽,%>1wr;Jcmu?PYy`G*tNcmf;W>|}FRC@#cy6`K e})>U%le]>#|p#e]e\f'p˧1IG<@q`#:SgqbSi@q`Mq ʪ6(hRӖ7u'4tUVbqgi2 d,dwzcU)nS;;ŭrzhnOoy۸cOft{?|ڈrӝ޷K#lz3c}hixH=?n yh:ǝ9z6[Yc׸\ilSҸw4XnYf~3%p zW~3%[c]jS4kɘoc;MyOcYcu간Ol(mHm,\<4'0sl-/}yceU#Ŕ4k60=n \a0VcUtuMJmP\تOgVCXB<.uQMqt}y5X [iOw}p T2]² sܩOsidyg~1t/sW/u|9k]2.0qws`vŽW֛꜁g{@X'c *q|1e6 KӘ|a߮4 z sj-쀰.*jay ;<'0rD1ρy ;%,? K睧4γ@񔰨c' gq7oNokctj܉[7ɌY a}o ltܔZئOB #Ws !yg T .ayDp ;!wcqz4?ٙg^gx]nluqLZXZJY7|<'0q -=^H$,**1M Lyr,.:obĨ(Vͯfa.sZ֗LN}: zٲZ2Sؘ_@:9P$4NaWs繩dgAXU(^=산oGZx`:]@|G5E]V2B=u0{d{Si94/YǗۿ L+ײzAX L>O)i^';6=l`8ƺbʇ 0-fiZz=yq4= ipcg`igX=J(ǦһEEg`i˝OywvC]"ۑ%ay=l/1L8T&Cەg~wqz 2+]Δ|_yq筯ӌֱ7%Lw=pW7_Jزާwɫ; WAUpW P60= j!?`8Y(+]x[JX98%|U9Op}U8tH{Dkr +IV)&|J*/m6,ߋ/~ɹW&TݧˡԢ>q>q`6}.,&PvpꊆJ4qLzӔ[4XQˡRj;*r< yn<Ģl-1۩W\yQ'|%!pFvʇs"آab~ojJļ #xX/0{=pC-oj'_#]x20E}bg bK)饔2:>SX$'jby<=>k1)kza>0FM, R|gvB|)\1Ur7F~,p? 2|R}9pϴk]\ OlL3sݓd|}ˏQ=uB䑰ro^8p8e'6f;#΁e>:ONYªVS[dA M>jayj~ LāYG-lM,OZXM_Ns>on}&+oϓK.HsVUШ?gxE4'0=3R ˕ѽ|Λg1p?K)&_ -soSK)ie¶Kܮ<9s_ Lb{ijaBla[]sNGTK)&E¶K\\|57V¶'tۓ" \귖]Tbnb-lS9e֟IX^AM8A; ¶<<޳mg 4L}>[6'U>oa590 ׶R(%%ng V~O;0Y" S.q=W~,pMݜׄY~ .q?aaV/a`KX:әn{Kb@tN:U!_%,s]ܫKܟB`08އ=!-VVl-E8? C}Zi&g Oa;}95_ׅ쩾ǃvQE{~ 'ߡgӮ]]bxK~ ;6:,[dyi-8aZX!ail`Z30-l’%fT_SqvŽ%5O LW>B%I#ª uC [X71)vEt4}>[9X|) . uo3Z^\`z,?gz_c5xK3pli0dŽg{ر/)X\l +ꔺ%g ;vºL1)M :vK#*y{`ZX!0 ;OacSAgͯ}zmSnv].1T؟l9u,0Mp|C#_2 :0la]fg` w-)Ti|zS3 ygr%xӜs5bc#`̳+DבSq_|w+Th >*_:8ra}L|? ~'u`r=>1}sN1Q&~KOaY@Fj߃P mAA _{LYO>FvE}+z_i+vkDF-~o_??~՟~)ÿ}~>Ĝ1o~ӟYY淿A?~5{}}ەolC1؎qy zI J5l 8`{\LsFv2B{l_xm,m:`;x_0dÕ6b37f&lM.n;a;f2C{'lfvN؞gvXHƣ{'lǤyvL؎ 1'bb cS8nf1ad~3S">oG6J#>#")3bl`l\Afl7Ì혶T>ovC"3~pbiDDqv,QM点LپuȔG)ۑaKb/F`oو ϾbmL3i;/Y3Li#kgvL,6tHf Gi;As~wm0N&eEa/ࢰ)(r=47;c^dB{4øյL0n6Rtp:Yܓ' ";soYEAug" |]w}oa[c^l=YЗ-ї~Kr7~i *iR7^@v0HE 7u w#Y yN^;u{Evr&7|=B+p"R9 U܍,VSB5rjwep7}+3$))'9 >jSson";""K";Pvd/Dn$uݢY0g'p? ц CG'1>Mu} O?ĉ~q6}y`E^"65"Y\{+N,| ?"ľ'&\5A턈61O>;f)@3o^}dnu{QVjxA=C؛U}Q}F팭>Fr6j$Dng$V,j؉<#&0r;a>ρ}ofVK7sQ/sUV:Qe@[].L#El{_oGn_2<#r1?+rQ?;rRJ[1rRv6 ¦5 W =j,ˆqJFnK@K E EFn=2"3ֽNF1V*xsj!lBBXDngD6o΀gVyG_ԑ gTfB a9mܼ;`Fn. r;!"ray fFnޚہq}="uFn_Jwn EX(8)rTbEm Ӫ:cM;f aZX})|pܗ1r{){p)2h#̈#(r{Q7r[2#JĹߍ Gn?Ă7 * 0r;cߛBwۋ3r{QvFn/+[ъ*KFcTecTEB)X;){%~# `S7[=K E*[=t6rTQarTXQ5*U"3>Ȍo\%a Uesĺ>DG$nDFzˀMnuݹ>a=9t Q¢z$ފɆF쑰FkT#BX F˔p 푰<m#ŰR躴3[IXdE$,Q¢dvgO\F-LkמT>RS|/HN6&?+]&&nO" mRmJ*c,x[g0P&W*)U.ߦlA#{ Dm,x5h:oq"1bT NlAܞS]}ľ# ܞ cd7)Ȉ^M5"4b |>!/"^Ya++ 'V)[8gB➎y / ;6Ո2M|R^W(#m';fv8>߆Fk"!,ne8EKm#Wt6Z.aa,aa _Fk FKF.a-lhaE %k;!Ef3!2ܱ B t Kh軄E%,C%¢ufdm#5BX#Ec%5b¢a kD kF'80n{NvE7`HXOKX#2pY¢m#%JX(5BXt05BX#Ec( !aEKF̀PR巸eVvƆ"V62b{++3ѱa#-ntlk'mK2n;!@qkɸ\>XJE/h(׈uRQAh(Gňy)J3msPƯ=ؓ52Zq p=т[ ʊy0Pv}b}MeR(:c&Bء ʷXv}^&;C؄XvcS De6.ldFѼ)a aXa'# S¢6%¢6-hFKF^ߔFo kIJ D kF|LaL*JXGfch#WqCw6. kD]J*3z ErIXErIX#e:5bw#u6 ߆Fk^:maс\d0BX#ňӶHNa}ѥ%a-a(aOy5" }%a(a5]a=%aDOuIXe@5BX#5BX g- KT(K!!,zNrRK ӊLE52m[awgM6"Dyv/>D.l$d Bf%]iFkFF -"Fkb7>JN!,%"aH=>aavXiFǯ޴m#5BX#5BX#%JX#eD6BX#5B#l;!p߰m#5bh#5BWa !SvBkF%"aF BX5@kF& !%õ!k;!aJX#\A!CT)3r5m5rq^!5B!BX#u6ݣoֶ!,A2F3k;#@w1kBXIKX#Vx7BX#%J=a8MAXNav*k;!%*Da.aa(ajN8ʁ\:p P!5rh!5r@!52 (a]S&FKF.(F.a&JX#Ha#CbNφFkGԶQ)Fd!!, kFkFdaa`HX#5P!, kFkD kD(8jaֈ2b(Ԉ##Vx7bh#V&*9rXP1)-mF,kZx¨=:j_mD$k}8FIT葱RQFiµ>5"̈ <]d0"CX='M%s rH)3"J)#jh#Vfy>)eF zd,@.6bq^#^ar`?7a-a aj:Waޅ=C)a P!5BXʛRJNׁIx!,-njB !,- kFkFF2"%JX#52VPa̛rԶ!,- d +d6Pu 5B#jD kFkl@gK%,:ja-aֈ2#%JX{mI !s}=D&m s 5BX`F !Ga =2i(aa8M)e!!  !5v 5BX#5BX&@KX#5BX#ca %m'F&m !qySaaDXA!%JX#VHaVHahae<"ZX!RXa{(F'm) )MB +D ) )EB B$m) )-^v b%m'FKFk|8MAX5BX#Sn!,Q)eFkFkFK{~"Vaam5BX#5u 5BX5BX#S}R|$!!"K쑰D !!!,Qssa#%m'D kl-D B +^VޔRX!RX!haxraB +B B {)O.VHahavϰRvBkē #%JX#c BX#=MF !IBkƕ7%axr)i;!{XA5:-D kׁLB=M62TaXA!c8M)%mۈaBX5@kFkD ~`->@IFKF [9IF +@ +9piSN6BvgہVHawu- ) )-<>ׁHa3ﳅ@ +l&RX!ZX!RX!sS+o ) 8p), }`r haVHa~HahaVHa+ )O.VHaVHaV8M)%mu -D +B |ʁVHahaVXǁMͼVx)MB +B< ZX!RX!RXʛSO7l3 2T)@[6A;}#~9C;Clg&pg~ӝ?/|gـg}Mx&#Ͷw~?َozc^bR$nZBF_}7ůIy;O?#endstream endobj 242 0 obj << /Filter /FlateDecode /Length 1635 >> stream xڭWKo6WdhDIZq ֻZ[>\Iy+JCaKG*U೫mfUYW&^|\=F ;  B~yskf*U>ˍVuQ`G_a|CP00C ܕJT Cڠ95q̂!d/(u˼nq `\Ψ$ܻz5NOdQ0®B;02%rXJ7Y-ځmwUH$[KIjlTXD7/djmlv=|҅~!|A8I7U=aV:0}0Bh-kILv1BB9k$4훔@ȃ/QLJ{*iUlH~=l! Kwͻ#yM kL7B]=3S;jv=߈IB)w$aFjS<~Ř51 FQ4~U8Z* ZDbeW.v&?4Et$ I%FE4"ue´%셠{J'"&}=<&3a~ٵ7)EފGaS(Fص*è`~pE#x ̆ 8 Rg&3+c^3ʪ Xsڌ_ }t<V#v+BYW17^ChceyebXX*)ym' ; Y#Ñt\/j߀ dP:U7-E :c gXhUDFS٨B2NvL>u{yNfܛV"x""`6#0A,gB~4_02ac$u cpbMwzk{;Z|"2у=$#҉p %qFa>=tܛV:R̩‘#rѽ!N/A^8z(7B%47ʛ"3 _iw- h3%~>M6:3J0u 9K \=-=pHW[Nkpu)g\B.ij FY -+m5z>ZaJo*;=p~\)/7sX)KNR Hb8zamGEN"V65*!† zZ_) \Cˠ7,=ΚaؽaZ{ߨB!d8v+T+-L]3ӪV!!5L}[X-طYW#?讂蟪N}gH\}:UuYaE%F%pZ>5%p^8y+LOpdpI80щ ^ikgbʹ(829=m*Jť eJ"@lJ qǎrnDt,Y_)n4瞞o-poFX{ʠ%|{Q#PZalvendstream endobj 243 0 obj << /BBox [ 0 0 432 432 ] /FormType 1 /PTEX.FileName (bms-021.pdf) /PTEX.InfoDict 118 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 119 0 R /F3 120 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 1939 /Filter /FlateDecode >> stream xMoU7Wx,z<첈VE%RJ@T~~ߙqh.v xf<{ȽsOGU)9Nb>Gw{p3|n><{{} (š옢oѽ?{rd_> k( _y.K| SY}-JT {:JG!dE V;ФsR]|Y` jx:uZtQ,7R㚾?q0S4g'VsM )鴪:E51|7a!8}ƒx2nՍV#cۀ.h,+IIDbhlAnWh?"¯3-ñH|Ww6=4 1H#urfN/Ʈlv=ZnQd]<5joؽ)vAѮ ApZ4]nA],i!UuItII؉5E'9N]"MM7F#$YHZrE95MAĬq:UwXuudŮy XZ Kd"!б/mŧ; ]uEz!VaCͥ䨆,ᗗפI, dh $q p̳ɒy? #:B0t$o# 3|+oլx ZrFɴ-VCf?DtB q{,Ӛ2f'.$^<@K=b)>RueYļ3ғ,> ׅ\*' ?z&uލךvO6}Fw[EM!u&}{\r_Fw{0Y\A.߻p.^cOύL1tdO(rd9qr;e227{ƁjzϾBj6KirGVbm>}rS_q˸d2nrۙV-aq#$\v rT^sUmΧAm~<}>q#,1?>1lց吂J\f̅r>lx5qe'Ht})$7`䳳۷7յ{|{>_zo>p6_|{hM!37? Pp'GQ,s0;nޘuM4hp^n*ڶOnbt s7IM$}PٸP܄i2:MDqMn^)QMEu&Tzx4܄l7慛k'2 ݓq&.f&1ܴq&tҝn`&7啛`V 7'n6$HWn.Dvn+7δsh'1hk4ЪŸ6C\XMp'0l$慜վINOrS|䄴D8ڋ7|h;>;_^q*cHh0Xv0F6D*nm^˴ru4Y?I(+{|=?xpLK='~-endstream endobj 244 0 obj << /Filter /FlateDecode /Length 2484 >> stream xڕYKoHW 9,0`g29esCYR?l6%*!_]U]UU,23 c}jLM՟WYZVUaiIܦI#2}7ө_ynp+ħKdz;§PwrO N+_Ǜ7<ڵ0uLR=`$?KpnQuQx#Y}X"9y#yh'8v\vu ES]>o v7 n&}fqȣ˫x;> W$]pq<Y!0;(7U,*#av`a?2JZ$ep5m-ǀ\>˒7oSpj#L=I{œI^Z!xkV ܖn# q9Ǟ"pNz=<'Z%RRۓж{@%rw5̘\‰tƕ->*#"E=DޑJD RN/ͬz")Uo"Y̬\2fO|Q@ .tWiS.b.i>ّ'"@MC7iY KgECs8իG7r !C|xyNN|K&_qhs#BD&(PvЌ@4`^BD63@XYl*azv1 _Ss>TϡnV<QaƥqS{Ba 6D!mLNNa2hOWIDw), ۥMs ^"ouM2^NT5ns (KRcp܆1 D[Ʉ@H޲J'hY<߼')դAk!o8 j] `/'Ȯ 剶_rӇڿ*̸ ^P"V}mVdAAEo=eQ*mVpkt9ZƭfK֕V@rÓ;$y:c35ԕ$~噂yB#B3#Ua!&y1*Ƌ8ЙAӛCa}_qds9FsBwUlsҥ R6Nr5ͪvi}#J~ꭻ\ǐ{'ti䫧C"# ,rMRM1u) Gp}`_(7qnq &4ՔY?- a՞}~')+5SDWvj0hy֐}wRۜauwA؄m DW-3p=R=QB(L\*Dglێ>F z񠱐U MQI ;H1fj  N%4KK ;h9~ qV{ӠѺV~%kwҍNVd%wD]h)`s=R("wlPda̕+CP{Wҁ'P%S DTPiCQ44 {*FrUYȦ}xg#uo8g6ͼ*Z'QV_X!kTQr}Ȣ`fg 4USxo1ش:r3[SWWZ_W/b4YXyjrsbբ%-ҝ 1`,*'es^S@[IqWV flxi6[nV5l*:#PYQ'[B I79Jfc2c6ъd7'~&UˌPjڔ$_g2|sSh##:ߖ.IAL#zX+7&_?TÒA٬$Xy0\$0N/Tlendstream endobj 245 0 obj << /Filter /FlateDecode /Length 3867 >> stream xɒ5*F/TرRqJCbfp3X筍HS^_~/ܢL< c}bL(M*_.o/kC+WuTL>#WpVOt2iRexdݼF!uw/8#\f>]K9sh | 1˓{k[- 4qg {,ehڶŖ4,7ܻ-|[#N t sGqiSoyĻo'?Y;q{;H4If|?j($/A#Qm rfcϙbٵL"R; Ek^enVSN_ ɳ 'HJ7"r*-ZghkW6 ep: };h@Dov5p[cH/aVQRږ9")5ȮAv T?\gsnq;x3=։~H uK^YPn<s'8GyhNjIqaѦ͋t^(vqh[]7vbN@wxnfv-n(䂹]53l窗c>4L}⳱3`9ǖ oF-|-q+#qzKaZ2ZAk'0DALnx+7/zl%rۆDrw{kYҋD':@b`Lf~z56SSIܣ4ڻz= ăvΞ0?@:3̓u칡1l ۻ }Wmr, fXE֨w/f$)`YxƂpYuYF$&C(U61*`]d^v&{tCٗ܎g&ў9K Zf}UE8/KQձle!Rsbf)kw%1 +b͉a܎0{=h {+wYڊA;?{j61R/0/T`E#lrdD(fzļF 6 ɾÍ"', ҏ|K`V%Xr__y,m/ 飀8EkA EwLԢ¿0DVդv0S|g'븦ZƼ{Roȫ,Ph񩉍b@v?2ȼzuA#DS4Z232XI~}owFlk-x jv">% uhCJy>?fT_I%qg$,T67JϠ\NF&r 7Pz< eQ@7b?" -UhI@*REy%UbXDk \hJ!`r6 Њ`oCL[ᕵkWQ(.%lŸeYʗ|϶(|9-1vlVak%?7QH6Gٙ# ^˟ej7YaF0ܙQo("lY,"$mgCguO?ZjĹ|iLea$L4&+Rq9~ZC %cj~TO-`yTxXe~,,v ڤ(H̹]N,'VeRO9c$yฬ pXfE}4UDׇA%*ГLM᠎-u0>ofSkժR}+doNs&ָZq^hf&<'ȩ~D=ٕӝFJ?]< G? Ptͻ|fZ\g㪱tNpT2SiƁIl&㦆[di6gA&,f"q3Qj̝sќTQR6bO*e dK,OY8`>vIC)P U5JlY0`fAu6RR"!E^V{1޽N\L۝q( ZMi}3,u1O4W eN#\8&~ 0z!yQěCWEs9i3#>M,fȸ/\ĐcC$>z@SO'=)F c b rEhϒ~;wC' c̊/DDlvc Nk&rH%E{vbٱzxhtT=B\(5I!szЁkblm i Qt7JZX|g|BFnijI Zr4Cܳ {y ai>Tћ ]50rPS >H+f&kkOJ$鱺VN zSۧAB*0$DցZ'{ޔu\8qaէ0}?toh "V906~dT"bܔB;5Qc#cSx8G{#Xb=ہaȚ_qd] m/aZ^el6E8EYp2n3s2oM1Γpĝ4Ιx''P>98b>z >yρ_ |.̢ȁ2'e݋LH\U.i.{}8;IebU3). &ejA7\[i=HHdx2*?!''a; +t&'屾Xu0QD~1v5roxܥu-A+UDnsduZttgm[,DeXU3aC8nx,",Z"tb]hG٢-V@wo@nr>rC'EV @V#C+=W#Q_)L2w|eӛp${u8Ժc3]*ymYɸY~ZH3oSw&0pUj̽YYL noaƯjwJ~~<)(tѕ% p6jH=g(c*RꖿBÑu#}3q5+ߒ鎛d 9?1#}8IZ ҚLpA*0xO;q}\V%ߚj@/ٜgID2(?endstream endobj 246 0 obj << /Filter /FlateDecode /Length 3712 >> stream x[o`0X Wyi6@-wԉN!Orɣ$(:;;٣_8Һ(|aOiz}۟2Yk{fuYz*L5^B]FdOON]U&KdJVp?urssK~g_\C i-Jz\{ Yjz=_'p}ímV}DO}lPie&v •0VG@ac5H}Y4e/#?d5]\OONKEg§jbu澯%"U%:H ,H~'L51W{sW[Q' 8 ,4ebȞz0ԳTb"^?IsZ8,7 6r<ըi)03 4a)JxC1c)!0$LQgxB5x(Z F5&g ɫ8cAnį/˒^sfwى؀a E?C\([&9agp 6=s# SɰXQ8Tlǃ<; ;e҉z7~R&"DRVi"rdQEeY1aE_+"rKyʏjMd^.ewn}QK; nAjKr\hV1gsڸζ㗭K}m_>v<&eIv򸎐vM774x} +\_2JXɉrsaO .^@{^.._cPy4A3v-,"G&1c(J<6O.NEגu\5(zwGNWE}\ԧE]4qQOEJL!Fd>nGL/P<:6y<%>TlJ;=!7iQMf+]4߈oo!!DR?˫P+Ӽ*%[-6< E@/]lhA[hQ! wqKm[,Ž3EuuFE iu%CU͖;Yƚ^lxLK‡X ֦pJݼ=BV\Nu|*h8I 8WggZuE ^]+=jOs>z|ZEzfT-4gWYfR[;Nƨk5 BT6/ჸm^8͚n4vS뤢?\حblމR-o{[`ww?oߊ |s-cnSdr|% Nkӣ#S>gix IЭ׼&[g[ iFED?Fb2a7?l\FD(2q85y +0_>l2 df[J ڹm]SBҺ ~R]l*)kkGP<+f-[KֆL}PR|V|lsn8qkKoAfwEMʱ[~|& ӡJ5h׶gb[Kyqp;Bk:|Ýq6,*eb12 =Z 3n0ԫPXJy  |b&9SAثq/],n4Nay,H0n :PߜUi3:7&uӓ:QI,cKjIþ^NjF^ʠE~X`=î!.`?Bei'R_9B0սcX 5aT:Ms6`qiߵ3'8hX ('W9JU/Þ9<sm io97*47 ;n]o(QNM/ A=bR -Tؔ5d akg&ըcyo:%ñHvGia*hAѧ=c|*;yl8Vzv9lM{8_|fC)̔ux`3z [=.DM8ٗ'V͏e pʏk5;pbKrHP ywNF6z-/-R3UE6H!T3yl(i{|6Am87YN,EXzT$tb. p8 !v   rhU|3Gʣt)DN:E+*!ĻMGt8o8AR˯h]B/?$fzbxZFNgҸ] Pp\[F\ML%5LxY'YO}pk/Ի| [ xxoZ&gEnT ~M_Mw x~t}4~/pwK=.6n8Wq=jǶWϏPlauZ{O kݣkhQ^-npG9]zGFN`*r6R \h1e`Ut΁tܬ#§A/rMab2tYr{$q8(R;/a%l-tͨp3_'qqQd#^oY%V|,{ZZ\Xfendstream endobj 247 0 obj << /Filter /FlateDecode /Length 4925 >> stream xڥ;ے8v U[qs e'fdd^~:{y 09C8pw_&Gnֳ󦮩%bkǝ,Fall.\;l1A#y Ϳ.Ź=δ9Hk^>]-F ny[GF,_1=V[7=q%DZ& m(CPY ?{j ~TF( GF 8%H.)swU7Б: %, Y~?RfEoo+=xR.=r9 S(@|H>xY9HdT3үUkEtVδkaE h%Uӷ`Wu 'f:9ܾk^vr_H(aJyaD' dwfza%Bh?"H{.@$*I # ̙D_vVm~iN\MӚj]Q.oeakUUv.d?[eUUwSzJio7{/?c½ă4YG>|d)9"c*-͙7Mr6v)^@M.$#'mZwUm>RfamZf /rKmڠ]c@G(xJ%534jWjm|"Cy™uMzB^EWuHSPqe3jm6 c˂.T3?~Ac1_G"A,(SZ)gq-2KM2(EX>:d}| kͰTwoNz*KIЋ4}+u1"҄*).S(?Hׂk}uBjhZ #<=ߨmǠ^ʚV"5nx*31 AK:Ct$? &LZC{ѕ Tk0uw]P3F@ ]J9291deNY' E*zҫS], 9BItOB揳t ]MM2asBO:}^ {}Xml}]_6݊ p 72 Bzaf8W*\Mt_O<3s_^z\ԣuH30tSްx`=if(jf[z:=Sy3W̶0Il!9GV4ވ >jDj\ȉ8ԄxZrp~cX2 L΁F|!%Amh0M+Ac ,&\gv{# (/൵}γ}4^#2TЕуT5ݣ2 4a<ه}36c$J|J!I4u5Ct7Dim* Y]d=o::` _%yǠht?ig*O&=-]F|a5юXeg-)gǞg܆K\{^bp]I׊=f:UtJ>JK 4=pxpU]$$7OCr,W49Xok5R⎺n6Os/d1G pmeJmaiCe]8E I4Ɖث?ݟ-~oٟWŋ탴D|Э0a W]%VҷmgtC>Cl](瓾$:bS_=J`:-l'0,v4{  XGs9==DNdP,"S)*11`KlBUvJ4Q1bV'[+SWL#EracP&B<mv!(zb-(o7z0NЦyUwxj8ȏ< M7Lmw7D :c?E|ߏ\ twG!_r }ϚLcp(F9#W/":v\%9 S m 04RJOЍUxX:TcScs!^NQxE\wk4-+X9iEm .[78_n\(Bta-̦o 2i2Yj$[&t!ɸ20xٓt3K qiR^Ik-6هB6h3${" sz̳Ӹ5M7huҁxp nəԾMM[̓d^a+w1_mjw6͇`._G7);d}1':gзRb8Z.֘%#%l[NXn^d҆)q=γ*ҿ꜕XFkcYzrͬTms_ǙB%VOP6^I8Q1$r,bǏroRFgUspSMWZ;S}r>Ԏ rч„07jNj qNRŵ CO5e]j`7t*0לXf'L)1/ebHzzbN'wYu;1 k aw!slB.K苹'dK*ݯeA3tNrRmM3yOqP\e,Ցlx_gU50T?jxOIE xWLTmhQB_C݄Ru2ߩg4w&?Cd(Ԟ/: aXPmhE+o"}tlԻ+ObFȧlf_vʤӇrm%s"^: H`oG|x!Yۇ b?gll g[Jz }fY, ݼM/Z Iw*zNjTP  e[UpD?u|<=h)~So0Y:C-ik7Lbjx(([ņ I\Z1_*iͼY 8rv66k}ra.JhȑNcY+ g[S95 mn% o(F N bdƶAPGߞ̨굑JoVjY`}6_(cE܅7`E砐Eaج/hl.~HWMDUU4 Syu/u|Qe壤q_it`kU]Z0ه˫]ZP#Z4wOm_ygA~fS S]zQ60ށCVƖQ*n] 6Z|byܝ_d]u}!"k6jC1g!|P/oiKO d,,&G9711z-M] o쌈mg wS,MI"<U9!qW@SG> G'|h jT-H\z?qkJ6gWIh}3M,^i!iUUjgm{->/p>G2C.m Z>vAG6\so _=}4ڡ0n ;tf,#>PD/1}qpZ\nM՗jFPȿ>'h W;Yb/#40u1ܠs5k9obdD%M$!\  pa}R`u8J1T DP@}mϬk)nUa:S ӊ{g@'8rhk58IGSV|Wؠ,hap''/<-aA昷E`ex}lNi@g;wI6`Z6_>RXQ;Qw[U'Ȁendstream endobj 248 0 obj << /Filter /FlateDecode /Length 2957 >> stream xڥZYs~ׯ`TZlbq0rb~جNYO:)ɌIQ;CF70Htُ/QW]\Δ4~ f;obY~Dž?М^}zm5>WK|Tp 't?6I9)腮uth;s1RͬRӸ+t3sL͌B:rBճ[9gR:>ő2Bp>SVE-+MI_Ml y EVϟz%e-TWx=P Uo(FKJFWЃ],rm9,t 1̦CAK<&k0`V.pv!a1;[*)jWӈubm:SD?t{_8qOɒ;G3?&y7HdTrSkQB=`tQei)Ҵ{J EJAGD80"L4@ESa nw7pw!oOdAVe,7dah ɠ]%X4 jUG6L_i~HWV|Y<'bi KzΟ U{)t6n re.jBZږ@m@[">j}#=\brD|XHnP &dP ؕ#Ju+pqudb$3koJTAL-ɋlyɝ7 lĈSi7[}4o,9-ΛEGH:ʿ=&곥vAx?喀fLE>􅳬vf'LlG. .uN&`HrR&eoijDs]߇V9]l&7" B,$rH46n d |tB@U*k>EN$,?.<.!fdedްmhT6\'}{EӦ|RCqd*vq;))aV#Kt{=uZp1xus0B5BCXxAbuɄMBvMbt0a~+nzvTIFVi|+E<2M-?t1&*)*1.&A ZWTۨhu멭@NW2p u*.6rm/CM5_PRd),,%8Dc9zYa,Fw洚i#?CGf|‚rq0PE3ːhtM֝ ׏cj t,_6+ *O#JYa-+pB|1 Q$k~u(*4&RjuQd/M̓}![꣒iU66|ɳVS!WLaz]!?!>zw~ո"5f˄\?a煣r0-Z'#e bҿ`:JZ?P$>n2_EA4^NNUJ)ս9饑ᅻ @+^|ewW\C!S~P+]@n&}LHCN07vWp|5DI4 $Z~dy߂eq u,ޭQ`ɯ7>q/q)vE5]1ۧc 6᳒Z 8s26G:HBs`+Ho=A_UyW`G`)өܰr l83»rTXފ.Eu\ta}YRU)gp?UiCJ>SU9O!QIؚ ːsN9 Nյ.C# \5d@Atќ 75d~)-s4th"<&DL(RA +]de7ݗEbcmǮz副bwjY YUVf.lOy|ţX1xt0Ki5N/{&ji+veE**yx솕3xjݔNK>+*ȫ+P ] ?fmC\#: d3[2>LH]9aU>x( x/;@,7c4ݶ-N՞&ͮKM)Ю!%c-!8,׆Rr"A;sWTP0_e:]ٚ{uL̖Cn!SJܕ?# NlyVĽ!EYa\\eL-c~i|5YVĚXdEFZ/LDvendstream endobj 249 0 obj << /Filter /FlateDecode /Length 143 >> stream x33Q0P0BcScCB.c4H$r9yr\`W4K)YKE!P EA? 1C 2d6] ;\=1nAendstream endobj 250 0 obj << /Filter /FlateDecode /Length 102 >> stream x3236V0P0S02S04U05VH1*(C$s<,=\ %E\N \. ц \. 6uu`$@Փ+ 2endstream endobj 251 0 obj << /Filter /FlateDecode /Length1 756 /Length2 1192 /Length3 0 /Length 1724 >> stream xڭRy8\Yt||ӱ▄FS*L%$Q2=j/KTdL&kl1| %DK4Yf,%4Bb|?s=gpbQ;-HpS@$:㌌\+FP^; ŎH4N…1|`b!Nf2@A(pp}c!B,D,QFph|q(!afLSdGXP4N,X[#v7,#Hͣq>( "[|!,z鄰9 ~3D38 #}%qKI O(JOF rpsRkm퇅k/8I sd]7/ėo1,R?cGzXjCsh@LǼK`X_iʮdխwܯq, .S~J%-ڕ^Svovc}3-aF##Vj׿]7jU%Ui_7xAlYZ?MS)~{0t l][T"b6r3AExt}վ E+5|QO__p*_o2N 1wnrcn=^jN+_Y彻@bFզiefSs/q̦&%&\/sFCsS3 魭F#=iô$F(M֥\5-YnIWba?M5Mܼwf/FIbit 2x1>A7{l{._^8M܁T/g-!s͚_.ߣ$jp.yaP:b\y5CFmP)/kЙ/aNĜ?{ۛ*tI9[Ճ¬y8~-!Q]^_ۡ7L{+:G-TB_] ~HGw۞dAWuiM1T$+w"Zo38y>;nّR5X;rH? +9^Y^vtY!l/aT{endstream endobj 252 0 obj << /Filter /FlateDecode /Length1 1753 /Length2 10202 /Length3 0 /Length 11182 >> stream xڭUX\4Ɲ%h%k ';!@pN3{ߞzkՒ$UVc1s0I:ػ20Y,Lb cW+{qcW/ f`9yYx(b^V1"v g+Sc{%ajl Ps0z1DlmtTA. gw `GIﰙA.`QHZX dTt!K*C?>?vV^S` r(8o@fVnv7+jlke*boa 00s;l"i 2Sr5:ٛ_`.#$HWZU`~fy`<zL,BgI؛:YكO' |D7y@`@&{Wp /}E qo {C<3(@7fC` npbUE |C`A<`7`@7FƦ6 W[[?$4:؂OFٽ da1d )_C9;[ \s+8I;=\b[.k = eYN-lnGV{+{_y<7;W- &s4v׎O |=mN8ں8'7W_+bGl?kr}k yVj krp۹OpVgS翭[4zzf9[f:x0 Y' |9}>bs+K yLLBӚ$NCBo`] DBܡH OAb@ |'*^_ AuS8B3n])eDW<"F?z7 ǜ}ne6u[:=7X`j͘l {Q^κjY#As#K3MEWB)fO~#X#[#ŲO#!,oMU7_j|HOlm |Hn7VrLٌ[U!H-׉jzxTJZw)v4O-e'; >1pd}(g<ֺQ`G;~i,2̪8gTS9صbK#8މrCb.:skB=A|2)űnh:Zx(hƍ,w% ibRjbat(.T%~*1Rc'w56 %%ʔ$Nۤ{X5tOPFJa0q!&>$6+3iMzeAՔ[-PEI?`xNJorY"94%+auhUuPsX q Z2d=NPAGvG< 7r q{6t- 1aF%]$QDQh+&mF.'"=VD8FQ^>#֯52YY|Ʊa5}_ A0-dmD E H{~.NmS(Y OC9 6TF9J0jn-6AJdw[<*PcGa~ߟo -*E{q_Wepv h&9~{ RX&ѰЮ%.^YӜy}ڿ >q1|áR}1u"h|RE^F+y8$Aؓm%!:jE&hF~Cy殤khlt# Bq\/04*xP^I0bgi[j'/y*m6iz:'(׳Cu?ӿ"{ ҝ7Twbvn`,JGtS{Jl ˀJ[~%gٝom䷆daO!6QS>hҽ}!P?E w\0-͝p$k}Oy9T{$ Lh d-5Aymwo{oey+1g!{gUr.{ꛫqHAPɉlPs(_CWQީ/Ry@ Ԇ_Nyd@q" د`q?|ohpXCr]hsؔOPJCg 4(u+ԿRT38h~,"ͣȠPGlsjzSLCnيz|w+Ղ+0ұgx\gg94Y.iZ|CNx=**1 -8 RTI;<3k;k'.7 >x4@ʏɻ$7:/O@o0@ߧ .d7_"#||[X )ST~A5<=^= hz$.raF=}/0Cn;[+Va^GP@? a^[N$q3q5Mzs/GEajIl8"'/ocKj?\(Xn/t+f2+ؾsȸwF? 87٭Uň4g3Uڳ^uP>d}+e I\)t?iv ArIo*+H.U :^n!B0ߢ!uT:ҨZLnqUxlPlcu䚺 aN=˨A/\V~pM7_إ*eZ)4S.⡦~*/! &f TEc@m$>eSʪoLwŐ@MT/*c`57TBy!)f [Θ2]|ER:E"hNrLLb.hdʕv3ҔiFCRy}gKp<j_)@&j\ bz):&?WK2+ԑ۴^Y{STRRoaXσFn|f* mMf{G `*K󲺛_ʏ$una{ۣL}Ā砛pɩ4EQ Nc\?1OlB< lMٔQT:$Fhɹ=Ѯ_.@ J0AmN-`A2(g>p*hcJ v'+Ir"Ѩ48 pYx HOU18v.-Nt)+xtboIjH~u+"%vҞSD*(3"xyGk+#}5Ѵ<+&GHšdώ0D.Y^vw7͏oiC{ =\:C;yx ! ڟ̻ȣV&B3RR݊(f&xy!I}! } @Aa1C,+ԭڀc:{b SŊ4mzQqKܡUk, j:> o$($XlÏ Rb[}8ը/1_rh"9c ~"N5Mv؍K$\P"[͢giغ9'BBfP@}q `V_-yr]g"YbNV 9^0hnp0LV tŐہ6ij6_km%=6f'OAL`h?B`{\.?˜LC`y ]N$8-E>Q<޿IH";ϥ3>\ '\iu}rrߋMhf|ߓaC+k^cGR=nY7EqT.U=a$>c^z8 Q 5#gɮTO;4ew^2E64r[ vrڇb@5x $?~viOR7~ GUMNS‡$¢8-ɼ2b) 5 UXkƧ3Vko8]95>8LlaqjtYۦ!c ߉rr3wڹ%f,29ؑQ| vVg?P$`Cf;pП\-4[xz3Vf Mvb[bػJZG5h|\x,K%b=Tfa+L#]N;Ya0вcɍZxXﰢbeC&Բ, ٣Է;Nݬ}_~$3N'A|I`"84)BTYv.ˡM!G*4# @Ulr-(5U7&=hUĄeg}ոV‹#2!h-<C#uYw0~^Pˀ05Ar(+eEdܮ_ݠ{fj`B)Қ?2S-C++xfYZKF!mOEUı^CQrMC OJ䵨]bmf-{ ee32&a8Zǡ2r)?K*4އ\r[zʥ:F>Nȝڇ\8߅-.ԶzEuZ6L," dyDrDۀ#Eۓ]( ;6C9.Ud~3 ˇ/JPF͓r.=Es lnYL;_ 4iJ"iڊ{e|2]4X 4_LɲPCU^nee|[QH콴p?W]VP\~B 4P&t@$4XZ35FaBsn /KИJPoA$N$<6.94٬D0 G;;3ɠRyjKu &8"؉w.9Vx!,D8U(ivMn7 N9 ed")K 5YBO Rӡ}ۗ 6j5@>v\OLQcs:GN Ŭ~զJ\U2(g0>zR|WSل \6pƱwrJT<_n\uhoB9B}bnc|6fA(S(LI9{UcSc!VT)e¾`g ˓:Nf_c>Ӆ3@D}םt%b?CdmSML'}k>oYǭ_z+U­_GxTy،_/"=,g; ߹Ru'7iS4џi#[~DH&_hw|و~cv9|*P;PYŀfk8pxyP5ʃgdC:%~b =[jGPM8^O3ϊڇx3DLLư?yP5{P cFkh Ny%~^|_d:Uё| )rh(jIw,3c`HII_x\leU>oG]ktIke2v#r̸/w7Mi0}ibE[{L.F I_ SD&AanGՑU4xUY5 &!*8иaG>Ngr\.2BS'qd"-7a?hrT*+pp kWO~+God@l!(s X <1ra8 阏 !&]%J̻h6ˏ2L+:pn(I|cɳ 27>5H~Fĕmn}j&z⍍}}<9> *ٽ"ن r(]rjPccZǐ >x;Œal`Kդk'00F|hBJ0la̜&+uKvr,O/SD [ 7Y+}_j xbu͑{l5w4:^*R|Ja<ʖOE w6Z:Q*$ίΕJ^|u^AVDJJ\]z&  Ӫs{e,ppFFdOS;_rS/#JnuuѮvb{TPR 0MtuO=$n~nұe3{Z麽hإx= WM/ 7,0jD30a0{wƩ.FPBw]\he+2A3 -mZv=L"<(-gwU;L>ٻ^R@!,F5-YLg+5&!\2* 6G4n˥Ҿj49/gcL>Pepna&&'"ClIM4bQ sQr=R!vwA"%P+=ZU]dtׄLT"Y Sw>h;ސQF Edwm{T==.`U Hnwau'M8ܗ x"эϣ6uvۧڂέ:ԣ\Zz]caE͓?cZHRF6d}(aO~]LYMtǡߢmnV24 0{kd|o$it}g'` ~:Wq8LSK)xE݅ >n*g?K*mmCƥ[KBchBLQz1y܎u093kTTtiS:{ +u< QN=aXo!1uHEuOķ$7)T",f0u42%V<flͰg Qgf.&2$˹^khaHleaեs'/xTGTo 9r@0rk%Pr.t),?ۼuaXT A3?Ժ~~#i95'W5?F6 7X5b( ۅ9#&m\w)"3^wp_5ێ|.7|Rp發JlKUܞ8pyq y, Y'&hL*,nճθ`5{sK Sn{bd9oo4yehCl+ ;]dO[yl۪y:?E*qJAw"fr^lSփJ3c\Or14?r\>U7Nqۜ6ۆ|e3j+R~d]ȇFs8 1zyTn.EURQ 1PkAiP8]唼(K|W%&m@Z4yIbGpZnŪP:ɎNEԐn!-}So?k>a;RfNxL!"$͢HK,~m+iNO -$a&-N~l-Dd<" 'G)GO9Ljڵ#׼ # 3[9f^,1f=E07) d2 ^ٍiM!$ <_Ԃn;`Q'Seai np|ǝ&G#PB*pb _6,X8`ӡTi300nݶVˡjZ׫J1F΋q)Cˢ}Mr3%F =[PNf^٦獲$O\ `@a䫻^l/XgP4& CTh} T^=JP Y4cTue/) W6WTsPĪ }c¤\E5^ Ɯ즸q${סft I.S/$ '!!pmki}5aE_z͜ڰVkog$yGXD o9 neTuD<&s/SXu|T8 $qr׊ # bP /_پ-t6cZ"9Q9޻lƬQCw研H ?UQƦŗdnW5IECe8fZC8QjZq0UoFr4C7t.x^K$%ݧtsR9Ix/KpϷr=2IH ԗ=ͮysvh\ƫPgOzozX:dpJf8 f^4/Dw6i􋷤 p(.+d _VkT+|FV@n:ԿI3N3ϜmXSe;p[x$-ڠ[L9)=Z#Ycz[^c=.!M ݠDkw8stа۾c>xO[LB j z1 )ӆF0MH# gHv0MȔ_SM1؃,}cXA*? endstream endobj 253 0 obj << /Filter /FlateDecode /Length1 744 /Length2 560 /Length3 0 /Length 1071 >> stream xSU uLOJu+53Rp 4U03RUu.JM,sI,IR04Tp,MW04U002224RUp/,L(Qp)2WpM-LNSM,HZRQZZTeh\ǥrg^Z9D8&UZT tБ @'T*qJB7ܭ4'/1d<(0s3s* s JKR|SRЕB曚Y.Y옗khg`l ,vˬHM ,IPHK)N楠;z`{EiCb,WRY`P "0*ʬP6300*B+.׼̼t#S3ĢJ.QF Ն y) @(CV!-  y Q.L_89WT*Z(X([֢K.-*J+'`PiKMHMy-?ٺ%ku/byb˛"vL 6^G[g_J*\Eׯ'"5[,`_Fxes4<͘HjY:7(ן)jq iMR2.xWH+r6ϋkF|ߩp0S1--:[?k[aL* )ns8hYՓ\{Tc c>=|)$yfUJ)-/4]/vgNk=,-W;߿Mܲ=>zuul*SwE&ty3rהꋷNNvіkܜUF> stream xڭveX5]" %0t#ݝ 50tt HwI74H7G}2kk}t6`$ Uypea`k/M , ^HP_PG uAl ]0@슨akЅB^i_'v[/ = ?.0A @P8@ (-aWD?nkW^`@jo!on`;z] n.`&lux2B1K+jkr!n^z+_#āA<<< D KjqCA5 f폃8$ nv`?B0)(e !>P7BDy@߈@HU A"*&g 6`ֶ`/o;?O?( D1[ wC Wވ;7{5rCa$ BR@t? b?!&t An@;iP7nnD5 _moekrln ֏17 lg4ȿ]B! 1oI`W/P '.`b/G} BtF\ -v=GS^D? B:!R[GCF%E#"f C,_1 ^)0luj+]"_Yơ%Ysףd1Uzwxtpjϸ Ip䬹m6jlu ?#;g kάW=:(b\G`!'RPH!E?&)AG e_TVogNo"W1 hLfz1yWJK*Ȳ}QtR Y4xhɑtAyRρ|<'u9 Yb0RZwp` F-dJzGmEBiQE氮K R]S34#6+2=d-QԸq)1/oef!T ~ s \ xDo\"yήDZ%J.N\5<ؙ\ϻ ^툰=31i։ .pi^^%" q16NF q~I+k/j}%oKk-;HDk]. Ÿ1czMіuJ.:n %V9BFT஽hp]ND곭8q(+E!':QW10N}CP.h*}-@i='7 dj#'XEvΧ3/+mrT#Ju^?seڻ~H]2S";vĥVfŵd>ds{ X^6֕p;*!?Yt)Wq=rLOy)99IXyjӵJzr!X>y3o寞֕%qO$}d3Y<x*RBs*PUo>ʔrAhðbgyg¯& ʚ)W ^W;o *ZlB] ݚ2˭Dw쁭|T]S:8:YK,8WoQh-by& TYDg4}nQ=Y'hj:e~X]wseQi5?l=ctEsUģO~>p" 1 cqDHєKkKAtU+YA4n νP;] 9ijb,Wl"2-ye )[K`J_G\9{J5-7NROjg1' W`IP/s7MмgZt_Lg+1:I$+ gL>4&YKuEX6ΌAcO.*g^"_qk,۹&ˊPѻ6i|EzӪ?hin<̡&Ǽ H>? $}䈃5~}NٔΨk?'HZ+( m?510cRS\?/y~l H[_\M {cOgoW=9m5}EB_$_)'/j<\3* S/]="gT94('bթLN5wCٷ4(o~yyt12+KOP&Q6&ynJFg>=p]D n*F?-gDc\Akʦ+j8Q!/:5ZDs.!uc T[Yt|9vY9YLd2q:y ^!|{[ޡ^}g`b ȝ'ۭ@[Isՠ!Kib٫@fUwl([W/Pd2ղ%K!Zqfk/źNk/?Ԕ .>ǀNH^EagΊxiDmuV-ak7(]V'JkNpMkVbDӄ~'a䣈X첌\()x%ۯsVv'ow{VlERxR5]sװOewykoQE+O ,f˶տVhT$J80-s`Vt 2ϣ3ϮL:7ul> zVC&cwXgog5S,b0VtaGvgbi?Wz] P} 4/vL3,KҮ%LDǦNCb;do4_m[UKg)&ԕX;NcH~ &LCp#LDFc\-& 80(~Wٍ\猬X Zo;M$,@}BzDVupJ}%3KY>tԨ1nQxRDMT:R+}7\"ըjkzث_u!߂iQ89yI<(+a/r|"`$}R!R/HJvG@#ZENUIY {Ur_=6mXW'j+\?NO9 Ca3$F+xt /oq 8>4?}8C*`I~/iC}8e,~(u14qjDDf%FZ9cp{Y~9KB>Rn||O}={'&5||'?t}5;IU+b:M֫ޤhܟq܄I,wr~iPT[Y[2J1!ի|Qr VG0W9TUx׺=qi9^bF|B 'DՂrڭMr34E+AJȹ^E{S Gpf8Ro@A TH@0IDHvyT\טM')&=Yq#4цlFoMۢvlbJw.ңnJ%IX/Y!/AgJt\\WP Py +?ίqm Sƙ{2}|4KY59&I_[F/ sqK2.p{hKE7oP!-0}~VU,^ƎSWgP Cwi3385ǞRep#k~t6 Ղ 8&\k—haG6u,)/LrW4C^7m[W?챜~͢5>o*>CY)Л|3-urꯕQ*l-13nMEM*ޠT?]:|~J99'2/fh&lFfo^Xn ԓb:DG~H-|R&LDt'O$FaUEz,F<bwt3)72lA8=Q0 [v()YIg7q-7jvt ?;X^K*o}&h^{]ԫ2ک9b7Z\*GZ>eMĒUywU0՚,h/;DlvfKXgYݓvB1;z4۽qh%fBΝ]IT.tQ$4 ޠ|)ocB=>uMʰu.Еԉ~ Y߶mǥ/*MÊrdGHz3W{5el3펅8YB˚niM'(ܲlT^Π)Yx]A51t쐦))˱SO(K N3χ֣<,N⨫u##_:0_/[z_ ]io;~\TN2ebN<슊64/XN}^q }Cws4.fHkD'sVNVZ@߷=vO0SƠJ-X2rx|hS>.6OXQEOT5/?%Kɳj{W_, |n { ˬ B2\{u߳, JU6L.Oorp8jPth{3A#330"_̶ #qgSY3l@)RO}Cmۡo@)zrw>3vvVTXhoܿp/[ c0lɬ{nqmc "o ѨqhxΕĨ= M|$ aGKEM ۆRDkWԾZaR "AoDDv }ۣ5{g ~}ÂG1. Z9dh,g>˻!+AlTEwojNg \+1݆ы9;/Zrޣ{Oʷ$>TGMZz1 cJ CI}'U~iMbu(PwDu=&[iU AC%G5G`M36yabj%5D3&6Tz12F!fGhF%(ݒLcOW";y%¸fHofg=' ҥ$ R .ySkd,x(Bb J$PS]{;hHMxm%tMj{/R)U~D0M|AZb3eMgTxe/hoޅRPgySMJcpY`^8H$l6yfDY$rmOsNAo \hOre*|;.vѲs\T8>5nt[n%Ԯ -<2^ʗE]lǝEsL^Ͻ9P8#e_.rB)gY}9:ąҽQ'K4N=(Y^644h!$`~u:*:ܡKd+kX`&rڭa"]zOSy$oG7qXj1^IB;iP?LٳF sb .rUѕ_ࡲ2?Jߊ{ ҒKS^KiSz5@]x#v)R"TR~B)i@$<^ЛlX&D$ۼHSzbj!נ.ޭ 5XP\%3AxeM$ũ&!DǨ/~nrv^+'7Q:H<~}6YϾ<ugS,A{kQC?qW‡b*Dl-ڨ,^j0 Pp[>JnE7@Ni!91faO0ՇIGbg F7U}n7%#5kr:5߅.hU3^MSkp~x9<-VMEj8ьO&a^=ݖ,QSe?T~x\w<X7B1*᜘vr\pBQao7wrI٘Uwu7oSL}way:A=+JJK!( |އ1l\}BtvC_N(ܟMr!."fڦw‚E")@ k`6)uHSD=["et}UTc餳%3z(,{w2_NzIy}kK(C~H+ʌ_1/Igw k n0s LP3TGcN kۅvfG}xbv#1u O'ԠB/Cχ+ph_XT*%W%$@F꜊+38&3b}gR\̪ ۳O孛$R:!;꺓<%%)ІhQ+ ` bDr2Vc of4kZ9 nğ=^szSI>=b$'y!:ܰn똋;mԈW&# EUkpoNX˃Xf2Q@Eܦ($TL V/z+Z!ETظs٫u$]Mf~kxԙ ;͐a)H%n$䦲 UԼ8Kj'HS ߮ k;k# 5q*#S|~"&y  >ꋃ~Q-jv.g&XoJ͢iF:;U樹'Er )N"6lYW\D)g1FTb nGj>~ +4G?t.i0)[@ok |TUю' E~丙WYU9JKn"6';([?4vJ}Sɽ#k3ّR}fa}))Lg0H8$b0Y/Fc7,, j, cqP9cYJgz&-~~>ECeUI5VO"3\igi9 Aŏt?'qǯ^D/??jf!4un jUT99D&ԋe6O4GYO6UܛO,r`_V*{\7g]-'Y[9)ܔm6& ay?/ǧíʈ; bxRnNdO /-Jy[Kq%eZqLWU0!m5ǜ@5R~nfR5D>:~.i@b VrHz9Ur [HIv+‹DVl#[Μx ]4֯^ڤdlvA|j{  J8Y*1VP=NA0>wԪCm4YI'1hZ9GfGVRT 7!7dUCX:Ň/*@OhBd|a+q,σT1ڱ:&V/\^7:a ^;_z~&͐"r'wg.mօv{,g qzv,QoM7ҥ.vnaȈ)`K0nGU.34on@!g3m=w&Ѥ^X`zFȍ6TkXΆ@Z2o1?DHG݅Mg{p2qPn ;SۚKIu5^z;:T*bM<go;`jlKT$J 0bHy8@M(Z5,69?\/G`l!h:2Zz @djFƑ46,9xP*z i&yMV/3oItsmendstream endobj 255 0 obj << /BBox [ 0 0 432 432 ] /FormType 1 /PTEX.FileName (bms-030.pdf) /PTEX.InfoDict 165 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 166 0 R /F3 167 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 10801 /Filter /FlateDecode >> stream x͝M&+eb,- h@i`YHVBIiތ8-Ka/Tf$u M뷯}WWm,o-~xJz^[?}HoLJ͇o?y^|mW^>]pa䷾w0ϷDJy\^Mo˫K.ܓpoS+o *Hy-UORʛRm6˫jcjomJJo3oOUr}r7GIK*v8Lu'}>a\~* vv=BzެO)i<ڽ.P[uc~).qD)O#)⓯ g??xg?@ վK^4&cvٮ} yb}ى}c;/sG_(BЈh޷LRҥUvg>w"tD,Q%ide+֤#䚢=4bw*I#tQWJkjˉ?ꏴزaoeDtC6 I+<[D+e7j'#mC#f*%iNE[пPD:͑ꪄs@O"G<~.zZ`6=wDE$"tD,麼FEzDK77D +SFP(cQ#㊈25S4bQQ jh\^G2vw_f\2<ʘ|y-Sk2<zl^FqExqoTk'6(cR℞ߨq_S2G'La9p>~G@D%DBD87D tD8S6 (D Kq"#S|"ɠ1Ed;N@D8dDN3Eh"O&'D r"O2+'DX=")ٗa|"OPghBOl"™"9':|",'r?|",Љ0>1~z#,t֘"X{I#/&)N wiiwyFf}O77ܿ`?;/y? :唾`HKZ=W)w^Y;kv{7L1-|]Oi]v]Ҿ`U+_nxo ݴiSUikwS~ڿdF-ױU]R*+Mk>&h?x2k2]{%k_\۳O/42A4ېi &U6v%Dͮ #zmmv?}hs66X)J#8͕i.Z;G~"ϥXօ|RR5wSkk璵ReMtW}˚`TTSa*[UڢږdE+9dhپeeJҤѵZ*qQRixNQOc vgkb\\vsVYg{yX=W N:\UȴJzN:j*{qƺrYlզpܲ+9LY6zG4Ok;-/X5cqr:=gGQ::u\獕KrTn RMsEUm`&}i͕hgT5|;'P#P*}*}~ }6~/:}XÿoOj88'qע^ ."}ticwCR5Qt*٬mgx/X赪1~N]Zx:.1u!K%K6RCOpK_|pc҇߸/.y2$ +Aen 5]}ͪ'UuVWRSߌJJB'̺}NfI/&kVUgmqJ߅g(*}~q$CEIɮ33+}e To K-}[J_կV_ڋmE%}}XGpӹ\ԞK/.9R3Z+)Z͇<3t2ꓯ:&DUG$P3[q:'N rux%Dvc{.dͤ϶6 n^sWΙ:U~l}$DHIԢS/4-_g%K$/lԠItᤝ`#U8A%%z5ed[n$%`JVÏT$_8ع:v5t *}ܵҍûoυWwkqBO )'K[S`9ϕ ed&'I`9`ooR}ux'8EpV eI: DӀ<24q%5qpɝ;5S.8O`_Tη:N zm].RevLpO&ilB昐 /XtH&웹+H'u:TX|]Ii"ƭ>^.`$u=tܡ[ k%_wvx]'8m]t%t>O2M>A>AT)'9 lgʲ>A>ɕlHFɐlVz%;'8 Sr}+WWX4p>Qe>w]ҷqх- l$ᗤ=VvTRS%%/\J}S+W^Ad+풾\rS鋭:yC >Fo$赒ӤN N交o#uxiOVR5qWr};}RkӽN8[Ju[]Z.դ϶V>JYNJ q/έ>A >s}#Q5IUcZV``.zc>=6|#I'ze]v=Σtӗ~˖3,W.8չZjUUU[}.kONι>-}e߸ϛ2%ݗSp=_^Ae)Bjau)9_ EHNtN+ӫ,^>I:#*I'>>WoIwSG<Շr'x\tKYd _yI&j2.$\ `aAf,=[JmV$ƅ'}GZ})u$$IumVhWo肮Sc傋=L |ᢻ?sROp#AC;/^ۺ8'H =}q s:}l շo;e3i# sMgGѻ/I'd:շȊ4nIi\7ux[Y漤ON\aK/^~l^A>I:>YKw~I:Q%%%' tb$B$t/I':}1x{*R?R~I: Y$tHB"Sn>W:Yą~V_cUKic4!v#aɧ.#SX-QZ凥O:ƗFxI~,JWNJbiCOVgda]cL67PYl,}bl@^..j#ux'6C=3ӤjOnUtXB^;U/OJ_yr<+OBR_&Y$ħx KB_bKe~Mn83oe)CU̹R wx V\W%}tӯ ǭvI_mk0S+֏M4:yr!Q9էtc҇oJ{.kwxKK\ uxő:jP@m VxWFx'~6CN -QkEppɝs}4E:4!v03w0BvՐo+x āf0QTp߷',}WN$}=[w .Wo#K_/u_K၍GxY$4ϫ19ܯs5\>AZ"ȭ>yWOke@ jkr KxxW]ɤj Fp'Iq!f\ s.zFx'~->O9A絚C;srO Y'c#P.fP{(vہgwP<۽svnl+ w}U'߷Dr]do5 ػҳ{~C|wYp=p:C=up p W3{L6{Le ̄grwH%g=B6=@ȍ54/ k}}G=`>x@4qRIT\= H;S{|= h:2:Ɨ嚙{|0u2Gw* 惋jsbS; eAƙ(ش@(4DstC7mb< $,Zp ;l1-6Z!O{ ?{‹ _s@'c8{ȸ{~ {ڀ|j8 !X2{@B%ߜx?=)bO]6,%`]tX2Čb<0qXxb=`گ{!Rmx=`0B$0i"A5wߨpB[Bh3n)pRm)XB~2Op {@Jn `;h_w b 1$6褹LT=3Z6$6pX{NP=@~ iF bp=}Ls ČV` Ĵ@ 1M=`"30 y_L -=`iu!#wj=l{44iit2 n07p=`= >agHbFaTz j D *ks?{@Ő\s (C MQ\?GQNiuPo{tc1jzs&17B =0b5 ՌS=Ȇ[ `հk bu]X1B,p-6.#b1${!Fmn Ȼ{@-}^)@h B`uQbf6$CQ l6.X bY+tQl8lXLV|=^ X !} }>4=h{!0B!}h=3,&}> (&}B!}w@w@!}hnCg{9-ZB!}P.C!}>Bо2d@Hcp8M!}h{a1 h{Zn3tf@Ha7 B =CH_ /҇B!}ˤMs i>(p0BR CwB I_@Ha5 6@H_ isTqev B2{#st4= ҧhP@K`!}43w 4B=n iuX|ZY:g(v]hnpmZBm1V{~2lacҧ}+rp4GV>,CHBI_ Oi@3l&}B I'>CwĴ@HZ =gL!}> [>CwB!}%vBH_ @H_ J|wB I_ > M!}>aQkbFq fNVXXG%˖bZ]࢒=#z$t@(ZCwXQ=G%fiu2l6XS%= `mZ] ^s q%XGXۅXL4B(^3  Č@LԐ{@ S!s`@,068 'lZ] f17Qlm m b10@,3 # Ĵ@h.Vud4B, b d3[prXXBs= 3°B!}ͤ/ۅ #wB = 3&}B!}ˤ/!}p#w &@H_ K !}kI_ /gXM!}XGf@HtH_ O8L!}>i ..yij!}@s B = 83-pppŎ X3-6_Bh3mF({-u_Gƅ+>M{@rGsp4Es  |Fc:2`8zao..q- S8B {F9t=і6C[Gnh)!}DZ )|b GSC3Iv4(`vlh8і#sud =֑9b Gv_Lhvy 6/%@ꅓK^.}u]8O%= G'Ll}B^LaZL{@`53l&}@Ha7 b0 y= ק!/. {@ /gGF!}-3,&}@Ha5 B I_`BI|aB = ?..y}8ˤ/=Nt{!!}>l u:.({@ /gL!}K&}B I_ /@#cˤ/DžJ{c.dbhh.}&}&}hhv)]h8ͥ/9KII⒇KI⒧KIJ.>ǖ.4S4hL.}&}&}@2.4s>ǒ/B>`usυKn.}]8ݥ14s4>G>G>0+Mn%]h縨@態KvV/\BV7 !}>f \r7 BI4Z/4f>\8Xڅ}\hҧ p4s46>G>G>`ws4s\psɕ.}ФѤAfKwUϺp/o :PWFfչms_Iuم;V:3['w:[?)tvӴCڟnt,DϬo~W웟}j ?-W endstream endobj 256 0 obj << /Filter /FlateDecode /Length 2453 >> stream xڥYmo# _a(`cce2Ҩ^nL/?$Ex-P,fCJIQIE*'gR!J J)y&.۹7gRد.5[kf3ZʹBY?8~XyX̏󉞥rC.P@af-'Kޑ sJlYsV mxQ> /rDe4C?ES|i(Mh?]E#5+kv׮-uilVn?i݉d&DB  ZFER;oVlAmyY$=I}~Fr6mVjE%hL|oђÆEQ<{A2\]pTak#;TDjp(b 7k9lb}dKMt/|k ː4< >0MB+4R sXS\L |W%6$5* [$R7{Ѵ-] gqEfKͮXUjq\^)3w"v ̈R5;H̴ºaǟ0!>왆0*J fQɰ|3hn-*1Ba(B\. IcF8KZWuRY'MQsWh)t;`ޅ&u#&X0"ώs3VQ.C$->tC`9~FwaIbP!X,lbی1(ykțP #G0BaT9_"0 mÌӳfq,M!{:`ؾt9C1 b*<@K*|%?ޓA@Y!JE!Fl}_ > ֜Nqق ӦbU{Q2 8.u:s _\US-TI'DD\xВ + e]Ay 4ب"w|هTe"p8Z8Gnp=W-ݰlc$('i,Z9ύ:\[L/9 f;`Qц-xȚ(mI>p6|T{ɶ.b$M[p~ x daXeUbcƙ Bp|;Yo>#@i#E SlgǦl_Kސ>r<.`s*(LYkWglg Q@Ƈ AfxS1 q{s6H{fOtOjq (-~Qt b+iOA(k U5`.C 6$uN'jփɰ Qj܌񔊇7/ԫ 3)݈U)*Ke0q]g/aTZW|cS#ŸՄkq ǝ\"jφ[|$eR˩ ,7il-0wL>[3ȱtoIB8IV֕0rKȿy7$n7c)[N`Ek5ҫ[wrPRg.+ϲ;sV fUͰ- l俗եMzbZ,xV|O(\w]@ wE54st* a4b?M "> /Font << /F2 173 0 R /F3 174 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 3847 /Filter /FlateDecode >> stream xMqW̒\Lְ@@$"ᅑP}$>9Us"b%LMWuu{>t81룵({?z9>?|n~֏=yu|?_?]<|ccGiǷOTbV&VlgZaV؇G=NGbi+oϕhAV>zD3geϠ%%ZiDG$?3I3qUR8;qT))7q%:3 ĵ8HaQMiS-n^<%gⶩ7o҈=WG΋HOc azLG ^mS+LGM`(I0LcK_s$/ڬ/*)pTצ"xfmP $j#Ռ+q&ڦXbY-qؔUlfKHGF Z"5V+浓HkOi3c7<V;7 oT`=E$o԰7hbZ7gIUk9\4|(K&jYXGMFOVC c3G,ȶ2P'􍷧Z= p\a5d+?x&{5/;)@? wtr#kV"_qI{!$I-3"d-TTH JNzr^pTB?I ןΏC]Dt'%L=/NO0^M;nz?z1~h+(<6L-3ڞcAaoF'7q '{ח~vWn*h=sRu,m V-D +J~3yP_9(1(vPc"$.e0A=w2adߔwbP"?0EJzCuğ+3?,(#/aZ%SV\{oV,>u#4ee6ݸXfPzDTgYD=GʿXb?JPT#epUĠW޾ "/lRؘAi~L?=' cYg;l/zP~g1sqIA^a*YzdۑzAٻ V+#+Lcw-Wl+z>c2TKª^AGJzf~{Zk'X<|u dOm U+/vz%P+z_[|5UGHR {3Yу[? <Ы֛CE^m9z_s~*zPzV=J8{=-1gl+z]a:'$ 3l}Wу9 ϸs8 =8^Ϋ;^Ian$OKVgy$ȿ€U[HhBD<]O+J|E+VuFx~Ѓ~ExV/ ?#^GoWxT wCo$E~PX?-ׯ`^Ѓ= e~5O$ig*.Y_ iGVקOqpd j>la.[3zk zK֋'LV[m>栭՚L3= G8>@6~.&zlуB6|>޹U6M6v'e}=xZ߅a!,7_Rdk:|Ђn|~m=حc<> Fz߈GVW^?+k+د=۱_K=]уIT4ꑘZZ?Zyߍf!c:oX_ox?Vу303.GY>+Yb=Oރ|:P5gqs}e+Bc =: J_-UE@}g-pKT^|?ZWhrP _읳pij>z;9ٟp4Uot9hx'UN4ė뉯/ir׫zϣw?_>oǻ/M|<}܀}{$߼_y#!GOx|D/ G_eY OUdC!6'mpx~tڠWd}9iy|=:R}W|r]T}=pwc*`*'_|R]GXڧF+!?u;.woU?F9tQfayj̲xcOds17GeJTs='"Og?=Tb|ǯ~/?Vx[} :>(~=ѣ_/^㋷Zrc%&'S?8h/-);zZ>~TJÐeWj^?eԸtNٱAׂ>?zY=?7tJbĿoZ]>]}&~Np1Aendstream endobj 258 0 obj << /Filter /FlateDecode /Length 1117 >> stream xڝVKo6W("zP=thKQ=tBiGdYw^G($g8OGcu]&Mt+&y[dN~N/K{ooJ]L72l*`ףyvsx%)(~GU:zw5el)u^`oQE6/ "4Eޚ3iU)ol˪!|pi[ oBH63z4-IK&Qlŀ]k%  Q=_fVG N29$/hIϙ 1seu;tX>X "gQWI߄+Q)R [\ѳ}zitӉGCbe[R(+%$xIM:xN;@X' ot^E&#Fbߡ JW"{*Eu<%W+=׌)%8r\;ؤ9.a/ _G&iMcBS¿:0# (%Gk6dZj'5<cDA_%')G8R4y٘,o㷓M/~?Oʼ,t;]?#BDQse}.pEl,2,TA܃tF}0,Ï#B.||eǙbGuJ[׹r:p]_db_3\cfx7E[^v.4*ק^.:=QRYNʹ% (Mt4Q&>:Ev,EY|{[jl֓8zc~rmC^Tf.:Dqpp*<:{ySav~T:`<,q9XbTN~ِ]&Ue\ްDčhQn> /Font << /F2 179 0 R /F3 180 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 52013 /Filter /FlateDecode >> stream xr$6S4dݧm7`x`x>mC-Ȭ*֗h;vr#?l?۶yS^G ǟoo??׿sl_?ÿ9?7ߟ:_vOS}o}~3ۿȓo_׿?y?m9?%'O~_OBϏ|~PRwwDbbOaDD }5OH~ݧT< jg|]Y5#BweQ ;QǮ䏰5c! `;~2vߠN"D]xiǰ\}{ Y+otPȃK~?u 7Rz",]@@A%N?)liGL#otp(]?]?yy;|*!}ED;@@CN+?9>ݦ)v?m% -P^^_Z"䥿#SʟdLg+ߠ.WTvS58{qfHe T< SXVnvSX_!!3z7D^ۣ1-PiNvnS;ϐaY'NK;z(w1S tkg7z\=NOgˎ.E"fsle4Oynv<7iF`<7i;@7z@蠮 F D#<}G yTC y?1]~g' ;/%bެIĬߘ{?~G?~vrk`GgK"vrIN%0nhO[Ou_%b)`naw\;dfr:8QD̼z t|?鬛tV#0Uᬛtv}G4rUJ{I׷x֨$bl|TcA!<:`w|?._lcGL6qӼ- q%ps L4<Ms]ꮖ8+yWeDd̓<  aDv4vu>"vKv:(WP>"~vCXV~vCXO_,3a/{)܈¾Oɍ!J`]X?!]8-l\8U!\U}JnD*UFnvY7F`:Y7>en!yjL&i]#0m T6"v1jJ` CX7)8ٳ3 s sȼH3$I;v?:}ҋ,`'~GGc_w=69"fQjVnSX5Mm! V8I#b:9>"*!va솰_ &I=I*UpPoezĤ>."י1:#f}rLKG2Qynv<4OynvӼq,7jM#bvq1mwk~Y?J`8Y?ᬇ]ǝpw;ۂKSeoL1K*8Tv*;ص5BB:?"<#bʣnGG ὠaHDKG"ATpk:~J`8Y?k9(s%t_8Z"~VIZ߸mW(߶ Lg g즳 4|{WG̚=n:ޛY/YtM` Lc~xH:8GFIM_Y+TCX a$qH%:{Ê&p) aԧO{J"na*{Gew ªn >Sta]=ާºQ!ݔg}~n997ngAy?*#UW ug7TzSx坺DDtNKk|i/]_Z"KUOS/}G%bQ)EXWn8UWT}}\9K"Np+R]"wP]"T|^ԵS/ށ xΗ*8^#K9=h`FZ"f9|H"xN|kC;7]= x*8 aڽOF`jC;7v^s=f=b]yܬ x S P}c]t~~Onpz}XG9SQHukQH1,Q Kt[g7,z~f:&ؓM#bBzljݿq;Pu L47鏃SC?'tpTD zĬ?ߘc%oTpf7Y+0[1{wK"n e[gV{OGLսo5SuMǥs^`<%BU" dIcDu0O"T|&;-=xoTph>ZS1LTphf7[w]Y{7׻{N"Z7U!v}\=Gvj7n]Xnwq`̓O $ӮC4?m9!pEݖc7nl؍ڵ؍]ږ#K2.]4p-}GLaW)zV#0U!v}5 8;"P~Et9Nю еD;^1D_; )ˎf#UIHJ}b0KxqHsz},^|E phWvzO`h`nhDR{V@FX` @J*.oIX:8j$bf75@/lKlbJl_ ($Jl Jl  !D0%B>[g ,#Ηt/ ?KGSRң{#YTpf7Uwj-R]@uVa%V"a;H+jx>Jy݁hj,*8T_aS1ULUpf7UwKM7YUpX%8-Qa{/GLK=bZnZ>._'qu~¾PSX/[XVnvSqni)qw}_TS;/[;NvnvS;s,,F*8ʺ4n0n`=cIYR"nއ=bSa4n0n`NgZ 8 %;d^~܃`ˏ{P`^~܃ʰc+r}WDyӂe8 5sW ]6ժH-ZuXkaѫ%zEZ`;HPz\6~ H F@P`:H` DwP]"u8۹A=ڮ%b1uh*8.A^ u⬂8;Qbԁuݖ~a-qQ<.zZb;5@]"a%+ ~+#==b*P^=ytp(f7p;<!;Yeڭ7鏛G#0QᏛg}\w|^óq{m^M6Oynv<7iF`<7ic)Ozlq~Sqh?*8q8ų%"p?iSuakOC Ep(fn% Sb%)1{3 ;i (qA*qG M;v'IB-wk9ɷ;Ҝ |J>{@. (fWQeT"2*/_$/{ fYvT]o5pCՌ1U_ͨ묥J`Cu7y@@uH<^ؼ Jd+5Dü Jd+wz&~;zS'yWeDu0.gbyq, r`Ǯ=NT_lUp8>O*ﳸ=b:s L4<Mڹ6}Vg^]eTP]"%. P~ѿ$E]"8]uD0UG P #9Ǭ} ,$A*\qPB [ʽ1nZ?av.RA)`ȓ@ $84h X>~,apSGwtXqPGw SXu҈{ߪk*8Tw;؅egaS#bjz\~DL4S;ڹM\c;/9hٿSAH=?^ e{>Xa؞|烳=~QYξnbFG!p SXºOawc1[":8 ⬃]1"FqvS:U=.]h, 8&Tp̫U1i<M. L Li ߏ;wĎkTpLV}>gȩ`>`맮svWCcOcho2pzH^vTPeDP|(tAU=0TOz:XalT[2P"`EhkX&Z9lop5֠rkڒv=Jng)˄7 o h/Y%gǴy޼ ..-dzkNv*8׭sUukDڝ͗~]ܹ L4S;ڹMW㣓~FqbW_!I!uF gk4uFl-cK"Qy*8kW[w~=nCu7JxtNK 1-q,\߸A > Lyi yj7s;3YePv#QW TU_="` s#8a{MUP^S?;F}ٹE`_>!/Qr@At?;Ͼl8idP RE4N>PFXg##f7RDUK]!p&0mwk*8lw;?J?F;  Dڝ3i U+knvLˡ p.*옂_)~o`=AJw~=>p}̾Q7}̾qULUpf7Uw>x( xv;`@I p\QOgdDll7;,l ~vP8q֬1S+9--) aԧmJľ%p|]zOuGpO1b b<4&pgaTPd7tyjW)gv=^~fXK %mg-Y%KVSAʒ%9?GeǍwe{#w}z^# [; کM}j~vhfuңrlAZt\:Mn @N R6/hw_IqwQw_IBynY7F`:Y7sW=`rOXuyRvqBؾħv{Ĕ}ohnSǕ<T.9=NR~M.y~[{ɻ eCvc5Wo"srKqC97;P|ӺK*iѦrOZw m*Hhs V X %z^ `tTN yr2 HNv9 b@HHDO#D^]qEPHG@&KIcA^ׇ4qO5t^,_ Ja$*A,\$*Dp&d9hgnO \tE5ּ`hWaDIoΕ'$b%bP`Wx?#Fª:؅Ǯ+oǮ_cMüxŃ5/y0̋k^xDQPV3\K?w^3qz 29V"Ƽ8 "6P"wP]" {to.>׏tr~>.lgξ%A uz ԅ_ م.lvajD0G赢j t-H7μsF~C- o6?7^){`~A ~\>Ÿ+n.9qwp+l|6k Vfn 7;l g:78dJ{V=: J)a7^صj._s &0{^d{na(eKO܈'qRq8ג&k^wN"$_$venH(IĭN=bjS.|pP$b6*n?oܹwQ^=*8*S@$A Q@$+ u~|~QŽ%0w ܋%: pl-82RKzd(G6JzdPBO\7pQO!l:@ VEh{=U~Z)՟_y1k^\ww٣[/UQܥM`7Y@4( nv'f@ٸ|N}ܬq6._ABظ|D܍7t;x'? Pv {tz\ʤ>+w]nX&n{*tiF.KW)li0U jtSQ+Jc- :=3Eo 3~Eg=g9c𤀨Z[߾>PIt@5$9*J:{5/-_Kk˯\ג $;[5؂Dvr]y|_s̨wYUp49Zi=bZnZ`eח&,+NL-0Q9V!yL yq˔2 ,2<˴]@^̾/6AoXf6ß(9sQ/( }$e]TvYrkωE='TpK%na5SXqSXºOa]/t/Z8KL7Ta;x yBGYwtYݽ,)벻 uqq됏zDH >.̓2+EA2 p'Fh#(=].F=i tqG :B//-Y eɲqm RoQf6Vض¶mmcmLڽ'A.7WjCe}<7;d<$l_?gl_?~=.ǦB -sNJfO"`9A|"sF2IW&B6DF-!e"=FQ?ϿTk^jy{{7;匽F:wc:4Wءr3yﳏg7u,g}dzP7Ξު%GLսo5SuMտwV Ő(*/;lrJ)ۗcWnvL R/gzm?i?i Q{Q&$)=B/$| lm}kR|os 7p9 =u+%4TʖPQBC5Jhl -yCA?Nؼ6oyc]F®ߨ\G T؟ ess=\an>n|k_)( RzKTP}_7|? ]tQ?cuPY 4VS -  <+ml߈8йP+bz2S<e r<=+Q AZ|P9 27# 6EUm?·B}]@ٟ׵q~<ο8_*V^"%. P$6Ba. {u$pSY=ZT)KʂHjW4 w& %l+Qbm H%iy<L)l)dJ"w:H9["l/j g%v Y7i4O#0Sa4N>)xSnȟ)Q4~] aoz\xop)wP&8 ] T͜V;]B κwÅ<cj_:-s0^:s`tFTxHF IrX#HʡEtF gkdxAMjuEAuo7KQR* .uSÅn~rK2ب7<˱QY~?]_dtQ(<2?^vXeS)ay} ܽFʸ* |LA%iOm ߨ zb6ƚWOm?ru{2N"vAbwEP :$ҍD0J;H.[8s1x/l^YΚWvü敝5ymg.c{5ن N?͒Yr5Z?Xs(rErb"tT  D@g?. 2QI4/ L?'XڟΆ"{7J߲,4 qbGBq?$BN:!}Z @$قz-/ TXZb#=bL.`O%bf7ULUp]u?Dup ;yMi' Юv;oI0|ԏE><7F(cJ NP+{?o}W @۟A9tr(cy~6ʖ3lά9l83lά9l83lF?+yvjwvnhwvnhw~z& 3ٙPAT_VA8Op.E_v4Uiz~Uҳ˭TYO03UïT ReO%jX*kIlP2h:U/٨B%d"̪^zɆ%lT] *O6㘎Z]q5\O'D\OgUz[.nUmŭm9ۖ[uHmޖ[u-؅ &{f U +._)]>- ԗbcF;2yW7~`2J.ʹyRy,ϫu*ϫ=3Fd$U?AzM5d^zM5!v}jlrPzA>ISzlugwGl rjY4 Gu\y~t@s&pZܴFUyџz3{^& hdTH8;2@ـfGN0z TĖ$nvGp'8;AzfGzT/`H4@8L 4 `PǞ.y!ek*DvhF48 eACYLJkpJRo5p8iIqmF`Z7i7o|ԟ[UZϽ HaGnAaGnԡV$U6 I3/ü b`͋0Sﮐz~P*7C ƾz`즎U`=b55]l)V+SVЭL[b2je i dZbm%Vvr7ks9z\Ș^'@®@ z8Pc9i{@r`[%Ud p,=Ɖ/3brüqύ*-*Ht%e˸:Yۗ- *Up7X]*HeW] pNh 6 mv.g -s4̑2G#OQn$ຳ l!!l a [w~ͼ1 lVyA\v># 1w)qnέ %56s֌BٚQ([c ek\ Ahoe_;H' dždnv?aJفlHۯuPj wYВ@N`IWe ~#m07ܿ H#gGZa@H [H LXwyᄛ8bGP"T2/Ck.'jJJjjJJ#W%B-o- 0y$̓<  aDnH<>\=gJ;{|&0mWy y iy*8s}8?{"ցKgSgSAʻ饎[:*Hyt6w+(_&{ T^KNwvВ{%Kq|%K/ShT_/Ch T}M^S!iSA***y^I3[3\\[ck2e_ e2fm_U}O\~s^8{EPJpV@l g%qV"g;H8+ٰg!AٰΆ.vag ;Oe}eHPҺ|Dr}:@G%ʌZB2nZ+\74཰풫U@i jZM\E(:[S"<ђ'Z2k VfW[fljݲ5Բvu_~ a{uO 󮃄=wd&yޫ>{n5p֧yn5SuMǕGqޓI"TU, aD@KJ6Q;MZU~^ nvPbT_.~\H0tH?WD$.$C Bb .FI+4pnstz^=NM?֧)igmOa{ ڞv3h:b_y}YU@2-7{cK%\,YpWLj_U{UP}9vzJWjUjUJWjUV;H\[1kDbV֒VXKZ1,iŰ֒V%]={LWu=<%,i$Qǎ5@;v xoptQ`PשJ T̈́FziВWNs!8#A5oPAP j7 YA]׹Q7X\A"AARyl@f&0I$wJ\,IVIVItIt9oTFl/sX]Bw ]Ug ]g @}lO>8@0 pTvWPqO]@ T:T+T:IT2I앀 k dĶhk*H]e߶j[Ohc*AU.d'+W[ 2mN.v72+'::@XU]]"]|#]|U|#*DFۺT)a#t 8/bq8#:5^У&ܼ 7Xe%6%܌g{e;qB[?"P2>2c*H[?اr ~\P ...**. ' =Bz1zf %y=B/ ԫղGG襧zXzZ$0A+px)aH=qLpLP KW^7h^L 3ړlRePH$ 9Ma]zZuM`;4OynvӼǕ:뽖]Tg;xg1{-;½vqT_?#<< [3(l(R3H͆"9\9l(@vN" %7۬<Ѭ<N+;nǹ@0rc'.h"v;l/T a7jHY*#c4jAl-Ѩ1hYbd͋0/Fl:#4׻w\!l* :nP]nq+47r@}mCضlF([Ɩele3 k0Җ2 _HT]>İ^X*HY|"Ů(y7i=?VeG8sF Y$uCo#%߆;H߆VJJ¿0ԁi%8" T\TS! 4.u$\G4j.*G3\ h4A>:vv9ᡂ9vJyg!'5l}Hg TF"kz֧Xp}̗/*OâG4 %z$<_@#9਋G=j7n By29VNrp=ޛ X|>²]ňD`Kd`Kd`KgOPx_@U~Wr_"8g+:[~ζ Rz˶r*tC˴6O>m#9Srkw,$bjwx ̚RoսZew0nbw78_\QRqw6RXF@-w#q7;X(礠x ́Bn(G` @?DΆ^_z9lH˕*HJ7;hr% R/W ڣ:+hH XYgc57@z걲jTs+[ތʖ7#;gW^AjRycp{ydGF=U>yz+Ur˄ IAT_>)>lqZ^WW%Da  !D@aA`TQ"PW)qp]e`RD@܎tH9^ xo~pײ<eI"jKe^~Qo̵|7Ȳ3ld` ~̆16QSol1 LP0pn@f6M"4:5a&. 39"dDIR+?U'9.էzp(WO e^;I$UTNR:IBvb?ؼنEoh[4mfmVgYFw`К<`jD* 3^^+5W+ԙz]~bG^H]yac~^ꤱ;^fY?7F+;@:3n_Tw["`! hdT! & W<"ryD"BpP@XB+qHv#⩳ ĪG #ΒzBK"דhIp⚘"[%J, M w'#(\[q^3; m;H嬺ޕer9w|?6Q-kA Z/\'}/lIk]uNZR}L@z> Cl{-[ǩCv˧`sPhg l-r,~*Ү8Q-{]ԗm^Xj [iaUe2$߫Yլj{5^<4 $DxEPIN@] $jw!Ȍ 2A= $ఞv89VgNeN3\75*r`ʮ( zK|au~_ABP' +`he!Z\YAMKhT'L\QufyEP]WI#jF z z zDSxuT@RdUdhzTOV=Yg+PB 0~ei55=遀 sͥj80@k,z 0:`a =)#;m\j J;iLny'Zj/ D@g ,`ϔL)՟etSǪ?٨o6"p"e@6@W _^7ul#:HY]1=Q~y*eF*y'@^6? Q㞛4ycȟBawK؝v}^dyD>&{=o" @j#j'iPذ&l{]dq{ $+Za3JO64P@ȬHZ@L 4؅@sbN.riLdz&[s7Mg2==|;9QB9՘@SlMdzz&[3ٚ@jCg5=LOdzz&[3ٚL3ᓄ>yzS'<1@H&+ =YQɊrOeg/gT)LQ(ѠPظ)+j%wlySw2 ԟ-`_s72!ro9[2+Wۦ.~r۔Dp~og,Zw~ƽ-~1O`3/y.g 廜 r&0˙F`3n3>~>># 溳6ݰ ͎+u7@ݍ2Pw  l~;dmjRd-i%ͲY4ڒVVV/l^lDUBVҪQ@Z5 Hli=* aDT,x+B}%,XAdJH}{ɰZe %fDί=~k_{rl9K`u"vG0;v+{^a7 QQN;jBQzFsUQ24Q3oY]7 gꘝ1u]^mv $U~~TAJi87 5(lJ\?s^y/*HKR>5θ"t9]ՌZhfV :-tZr2Te7ޫX-tA-4^ȹ\.t ]4KX4-G5АjM՚5-VkZQk Ȯmbjn& f fOj[M 5WЬF44WصԺDK/dVG@\T0! 3'LP@:H ~7|k*[V* .jI;JY[]j#;Rsߏ;68qT.`մz+M\v/j zv˶C\q/H3rE@SQ||2:_/>VԯjVC"bB2|@suҼ<rC"`O G`ЖD Lϯ? eI$'2G$mǝִT=@^ jw^⚙G[MТDzNlR#KU'OĪ'Q? F.FV&D2VO$=LDVO$=gu!jr_QPWB Q.DBT#PQ[?@j+HW 83^(Hۍ>Uf5Í+ \1lVܬ6mr+Hw ޖ7Ar^5k^5cާz={ާ$߫Gn4=B>ԅ.(N]uwuP/wa$To QezQezt ,Gqhs̶Xzt~ك;x#8g8AM:hmtZp9@ZгG`sy 8AR z')y7 `t8# `V0zqxG=w7R9&#IDnkDI"p p Z@5t6FKt똬1Yc[?`r=6olțQ+֊fAlV{6dlHIC3Z}rG`gVn.@.VȮЍ tp=sOv:KNG{tP!jQ78[^7ަ7RFyvE==n3 w돗]4?nv|?mGfޞ=iwc3k*4Pud#ݹy~~خuߏ+ aX~˯bU, W*_~'A1׺"PpN) %D0K]@ z %~}f,j " [VAʒlfuFZ̾v;mio't$sظξn W(} =}i=N-{/\`}6y_7ū U&aGẸ'8pA*kd뽯[5yV"k^BC4TѨO!ȪQB4, $DÒ$+BZhБn#BGV :-g[s%rwl}Klψ9Im{lF~TDbcض=64mͪͪE2`Hf@h{Fۑ2HTZ."WAJ[. l^zpXt^nM՚f5tkִ߾^' =2-U挀UX>>&[>>y.IiHY LKtD"%aX']꽭 DD I O'u O'?{ UR/eڝնc^9AN I/ulɁ'$3d;֓46ınWǺ_#!'u>ú~S!+U+Jl -!9I+E"=pE",܄e=/;ҟ<*H O{;_ V؍*sl9ȝ$-9NRx'9+ھ(`2D@/0>+bYzrmHΛəAfrof- \pTJX/829^pr_ 7C"K[1zOzk0H.qzv'H vvv`kvw`K K-mpa۝Bn؃. V$rI"`[) ]>X]>'x~6g)9hhPg|L"BU'{B^,ՋzU/$l ǃ;@7j998u+mGl3[#[BNKIIMHhr ЮTcW۲ږնLeم`޽- 20CꁜD(l $'J S%'B ~ 'B%'B;'B?':/'HNCJkӐB]#GCv#jSn!\oB[`NH7HxⲜș_rz6$go>K${YdW$$K.IG$mxlZq.Lg7<$ ؊{P&mu,M@RҲu,-[2},-ci]') =IQ"A{6gSMf=8 TZn+@WV]SXMrS)Z|*WV;_vSeh͚hVYsL43ѬIfMZ4zҢSl"G .X\4sѬE;\4sѬE; υsG*uZ"jzEPT"@5.9+ KtD"%n1\AV$ r# k';%&,˥(X=IqWz+7,V֋/4ٟ(ŗߏ;<^" 3qPL~K~^|#n^ h,e2͎GU԰Y"`^8%uK,vysAsq~ٮtEо.+ޡ4ȓږxYlk,/R[jVKnuɿO"gõE|k~6qA Yѳ "ɨW 6.g\$'1A$ c  2L8]@ױ@O$ҕ"O$ςJ^G9OTq!htzyɋ^a +`Xq탇CgR unƇLI&CD$R"8D#v kBd"NFh nX@aͻ)`B2r  Ps֜Tp@<@) \8pp=a-dp@UPot^ohQ;*"P>,OEi,vy_QY3Y JZBȯ]9Z#G+>rVu\7҂熞 4m'V8ZGwh;NxxulV ?is::{z:>D@ឬ[;;[ڭnvl^T݊v oVz۵ۮv޶k]:' ,01/'%v`$+d{ۼF6{ kn8Aep0+AٰD . /r & rHL9Mr(x5/귀 ^lNVh㾃/ G.r 8x`Uqt Zwg/lE㆓6dvĐ Z]@ $Z]8RNPĭ#dpV'z8cۄY(ـ#&%ȍ!$ppP5n<,G؃x/n_{k/*h+/ףfin]p KͥR_~~"q2/ Oe?_Tkk`wOUAD<4ZALզ9r0ې1#M^r %fu{kۏ^:. GH}XAEН*]OJ~S':]DWk[]| RNt˷-j|zȮ@N$D^27vcϩ-+Km\u,wy!g@@@@@@(ՆI lU[Y9^՞ͻu~Ga*8O)S KDP<ZA=ٲwO=:{?[pz8F+z8#zj:,yJ*t{9\*påE`P769A(YyyyJ)iS2AZcดxjOv4<L0v4KxѼT-eA/= A A:$o0қ9Б׮ӒEJCW_OоNK/Ӿ|I׵g`v.PZ^g98;azsqN;2e} E >OuS8sq\|]-N%8‒=nhlΑqCS Dr@_H8H8_p8 >''y'y''y''{'''DsEEEFbr-؝3:Aʠ\k Nl3[Xܶ‒-cb]?, nwn xqT R^0]e ڂ r##x#x###B˂%ݽg#[^}Vd"Y p R "Y : "үƱ(' 8eXxƱ(wTvNvNu LFFFCXYOU@1KMs btotztztototztz(s MlM^Yy{Ӄ(Cm e H8q=# hKA[.hKmـՠL@ܖ0?U@J7 ӽG 'y_2K&ိP,2z.zbn@(a z#pȋ,(>AjzoozoȨ/@p^VG"  y =Laqpb% %Y Y/KA "q5F9>EzlEolEzlEzlEo>|x.ekYwK&<%o6J0L@ݛככݛכSՓ) ),Y& s)d!!!sQT\dW-pɓ^g Ɩ?8vN P Ȟ,Ns+H 't& "cb#WFKG m 39Ъȉ tL#gc&X@wZ![![А*uྃ7@ǿ:%h8 2}c/4$x! "ψz>\|:#x tG>n&]ύ)JcA耏@|/#x8׎6=m624H 3E/$&Gu4wtowz@:h$A#AFВeG£MO'%XwBZ萖/%!-3%39P`<9(1 E^AG^1aГmu ȨE@FzǑ]] 龃=8Gw\A:`Tpcd;`;ွ' &p)a2 >f d 2}=d]q!xĨ䠜8TEt;pD= Wu;\ZS|x}A1~tXDݰv<A8`ESFSFSFtɩ99CAP;9CAts,n{ߕ a^I^[<0or`3i=8I\ ˧O;kO7' b'O:'v.% 2NRḌIX ~78.H/ V~.LY(\,v|ݸ ߝ H[:gș+cOz>*OXf g ȉў &Fk;FfDZ`{zgKț^H{zLzOͫxWxtߗ+W{tWk쾯V}/*/WC_^UC/\G-४͑lso/^xm~sZߜV7kWW#J`@c<WWä'$}XDQE<uZ k ׮ZwGNN {:]h] ^ T@8&9Q829"L{tD@AHt ;HZ -@ Z* .FKMJ= wp $\ ~^WZswU0CUw>Q>QiVZՓl$[iVGЮ;=DJ:6!+-ذ+ {ճ3>:C[yP^xI+ &Z.Б^D @."M~@q>\vzr3Ű7v Ǜ3)kEr-F^ C#Zp% HkG +D!Wx!i i i sŭgNPm19X-՝A$Am!j>@_zG:"! r3U=L$xBJ!yD7LqnɁIߝyrnhy5vX&U-<2|ZTq'7q1=(|J={^|]]jhYVZsd=O..gŽ\)2J`xdT9x_ r,9UT)SN*ȨB&gRΤ.]TA*؂TA'vz)ߪx~B ~H W9 :)Bx B/d Z X"`jbGEEHuJ[n-vV5;8[I&[TomRI&ز@nnhyUA󶊛nhyVFoze\ީmNmvjSۼiprjsppò0qD:zp =FQ-NodwoA{`;~u[uz]u]^ߦ}^uz׽]CfGK9vlVkFz -: t AGp'8lmnt+ f؈DG&/"7yMtDnՀpi$`rYN $:p0D8@tD8Ug-n 63˛q, #Gڅyè} A!aDEg:B8ً^p#!q0: g#38Lf +pg<9qY%yVA ă@H WD ^pÇ>g-;q0E :[;{Ug%W ItHr!>U/3$ŎN$XO]){[Av-ZY {UL䠼;h@ MLaC3(LG!g/ 9YeOmu' dpp2ҋ-"(❰t𒷖IZ&ykDeIZ&ykDe+@n  P&Tؑ ˫x*P?=2 ڶ!3JzԘdTַm_ULfJe}kC@ #/rb'7W^ezI%QD^ersM2 $m&axF@MaJNTn.~) N +AYU0HڭȐ Ux@(8(O/Aq}* ȍ +PQ$8V0ARUm[=mܶvVm[ ڪh?[9T8X t᧯}3WW^94t|G9k)b$^4oA=[s4o5Gi_y>ly6/aH-8 ҫr[:xa k,tXcOZ-tpbC b( m 9iC 'rБG.-u*S8,Ɂ:~ HJ Px3{"mDx'ȍوSFE핈w K33f/ܐIdVbq R&A88=ۦK. K-Y~ɳm%K (6}ܝpXxo(і_,Y~J>N>A_MV;"gN%bJŔ㉻`wZ@nbϞ9')k,2me*˴UigT\ ^Bsceڍi0{faL-Y+[ )B$ gd+̨Rx\9xWu:B[90rЧ`BL[iw0m-;x`ڂŵ RB^U"Р,x♉y;Q# 2*eU]Vi۫zf6̪.?A0~W EW/Rґ򕎔 afy?97Z@,ڿN^:bzN$t"pJgT49wƻpMũ ^p@;[ΥޑѕNtEʼn;RT/ҹΥcX$ɻ)_\@J>a\#At 2q p}ݹ>AE+O t{Ùșl]@rZ}3g/ "yTp!-'9*":}׷#>C@ط#y&p}|jm_~E_؉J+39 "y`p`; Q?ҍjlO6O"O< &= ) Jy㭄g%ςK< .5x\;h6AG^h+ѦWL^6mze2[88XdضppLf H5Af/=@ do .5GYx $gR^S+}JyO)f*L xĐg#TdꝌ^nQmBW|yԚ[+08`)d2_G{ @ '\pN[+@ozK!O-BozKȩJ>/P Bo'WdL_+>֮XVk Oy*`Z\2G8|@Mksս+$Sq "+O:K@n"8Y)<4`!^Qr*CT:+8 S;@Sq ,2Gz92ΑtLrd#SȴQ1|h+]@<9( P4ܰ 6AʶwES Rp0D80r0&l.jN@Ɠ"X^F_#HgHȭ39ȑV aЉ' D4@J:_ SK p' 5چ#+n@ |ɷ@6 U^ۜ2pp3]r\& ,iNʧ)p8X@}2X8`=Av }ң'N8tp.tr`?@pu`„O*+ak;HNa"(pE8APS| O >a˵{q1j՟b1{Q}1r]u ]='x_X{^iWZ}) «\]UR;zR~x0,_)1ۃ#XĎk}UM9 |^9uo tH)G:=uo>|{SN\K Zw2K~1 N:)댴Ǒѝ2Sp^Z 8(p:H8A } 9z ppfXY_ U8NZ#xG@ 77znhnk[khZӁ[ :ixX1w8ˡ+^iOvr/Vy|/Iw{l=&Ûzr:Ϡ^bϴؽV5=sux3\=sުivZݓ]eiuOvݓ]e=*GjҊҊҊҊHiM~ueBű}BW >Z*'B˫xp[@H<@jm'ձFu^______߽[ $GStxlH):}"EO>'RtDlH8b59K$y3B*"y3BfD7#$oFH􌐼!X4X4X監 {97VJ6#|c%od3L +n9}"}›;233crZF:WnTuTuUuUuTuq]{wҿ888bA,H{#{OAJ ǕR0ܡІtqA`+[h[h[<[<[h[ŵv{UΚ]jOL.dqwB]Uw2;^];JQƯ{BmJO^TzPѬ⽃-wpݵzOJ?՛透_.oh5p^ O?՛*=T)ת^a8p#Q;^+@Rߡ .V 1_){YD][Z;vTxn&JO ;Ȟl<='AN'%Ɂ{(u`{(u=A8zb %xK'M,X`r'uP\yrp+M>9| H7Ûo?Yf#Km 7w+AyO,|+h^ r\\ SM9=sxSM9=ޔs #UQ^9b""ѢѢ""u:9^Z @P +Le- ;3L|ē f&>@J\03qdOgOgOgZä볌&U> bӳzr`{,zr@5Z<t0a =yD%r`ku"1pq\a FFaWur@Ü|.S\ZɁl>$ Rոv1j'bYvp@V]wvkAǒ )̲$5%:үNTqԑa'Ȱutd\ 8*:@'+uz=95ZE>@jTtɎ_0O+: R0'x #W՛+:^inMv+=V4w{^K M=To:1x>.+,/2'Yځ*o|[/2˷ ^Yc%c"SR@T/2Agɩ$x6"&\ l0RM ^fR5T0S5ppkOY'4H")2S` VU-R@4 `\ɸ@^yrVq *|G µw Ɂ7u `# Nd;\L[Bo`W.bv 85gaBa&r;L8N,ɾ,.EHo/khrѸ .`b;'i| N;yDN;!W[Nu'ϛ /a> V!wOr8bOrGO o;2Ft$7> B7~!w< OrNj/ O;~|8.{<̪'>c'j|,rZj;>QO|;Ǵ'y'e$=Ix+O|;އ'OrÏDch'>O{]}|/rG/q'Qh_ {_c{q?1ʆOr>-r6'> OyÅ0N$wɈO|;~oBx䎗'#6q$w+#…0L'>?/־B_؟_LY]_ExSC㐛'> / kÅ/j|Qg!w<'>IW2B$w"w};>x WXO?f.rǕ}O#OR|ݠ+[rNj!544vl;w{!7iwm/{UxWic_lnel9?IoP«WlC'w~[,RUUjHw}BxT«}!5?BxVS/J? rSxj~Rk!5׭ZģD_XHo{;HoEx'>I}_Ʒ/'>IC0x }_=*k#ORb;Qj} m,R[䎇}.R{M,rǏ|}"5s5xo ~i8$5^«~~m[7/^KUx1'WM!5S3>>aN>Ij|ןBj\nߋ޿x g>!5?!5Hʿ#OR9(<CM_;HOIUoV_HGG 5E˿X+"5ޢ›ۯro!5O!w'>I G7#v"5ǯO'Mf]  jjWRe;!5^«_R?˿O!5ZD[-l]l.mq%b_%Wu ;UݿKKTEj|o귨֟7Bj ?SWxW"E)YHdGd'vGHoEj|/R{rǏ}a !5n'?K[R^H;TRRJ~/Ej|oqH?xxx ]ھOEoxxƫŻM"5ϯBj\ɷZ=hW״hV45R'kQx-;$ƕ?dbs]}vȷ?H#!5l#po]? }}*OHWj߿,rsa_Bj|Bj|۟Z[Px BxTQ1|oo-ƛ~^_gHS!5lOJ O ]q?YBj|_? g?#Bj|Bj\bOQ;g?(Y#xc6R5W=u\7OM˧Y4-fӔSHW_-Mw=u;iTQG˟4%(_s!5bR~RXa?rǃ?R'%}A_ߧ.vY?xh {RUHb?Tjߊ[1xWQ}n_ )]>?g}@Hk~z\y5&5 w*bmȄs!5oWSR22qn {ɺgۿU"5iBHQG4_/Hb߯/!w\/Cz6>tBj\jUM!5u4=5;5=zbWY֔},w(ƕV?wWgut?] UooUכ?3o בzSCHǏ;t>An?T*sOOKUOT?qjZ|G@ƿq!hv}pa߿RoO/^_T*sןBj\:~J4?nfۿ)~֯U[ln_ߨ]Ը/v}3n 7_U?taqe_tk_t=?v;?Q룪Pu_k~]ׯh75>>>n4_>~W!5gx~վ7~5kv}wa?Bj|?Bjܾ/ ߟf?/žoBi7}~rj|_7s~AÎCÎ/߾HOHg}~_ߗ}~_WU}~_u}F~:~Cx5ҏǨc! 4 _Bj\h_/vf#>WOZ>Ff:a?~~O>?g|%d[o?twWjdGl=>FW,Mjf;~[o㇪jfo?f']J?[C6l~Ffn닦/Z/VEϿοE˿X-b_SHww']du_˶~Eׯ]bWu_k~Mׯu]nuUm?Wk?k=cP5^ _g4l|[/7isA]f4iz_k~֯onnۿ7lh>h>hjQH+Y]6ؚ_jֿxߗe}~߾? }U_ߧf_l~}u}ݟ?o5_l|_/]]?tmtkt?:qMtREo[t۾Uo[uV۾Mot6۾]wujo?*-ntsat:~BhM{~V,hG-'͟,g~ٶ_Oo毖jjoifk~_ݞuaυ4?4a揖?jhϚ?[/Xݾ6m5 ^5UW˿ϿBikn_]7uԵ[oO?um_n]w!jheF?Z?inןBj|Ot:G}~dGtV۾Mot6۾]out>][i\_ֵ[Iۗڗ?n?$'wI}m'ɺ}m}}ܭn}m﫺}mk߬n>ӿBݞ/Ե[տYlw?dgw/K>]]]/tu~tŶ_mW}~_5Ͷlwݶ]߲Hggww[뷢_l/?A/%]dt_K~Y/e]lWt_+~EׯU]jWu_k~Mׯ5]fu_3ǪBU_WUߴ|O7~wf4=4;4m_5k_5m_5k_5i?ӴYtS }6?nU}d?M}nd7nl7Ͷ}~~/}mߢ_nj۷}_k}mߦ_>k?v1=s4n7vw=]w=]nnϏ:/ݿ:~~W#ݞ>~E?b?_u~v]߿ ]vz7~~>_O{kz~z~L>?.IUA??`}oo4~a}~ϏQ??'d}6~f}~Y??b_}~/{~x7^}~ϯM?o" ~~>aidq~~W;v|=A`w;v|}~^ƻӡtXU˧ZT-5W??>O?Oa&4 =tۧ4IO?OtInxC>p!7HCz4}\ gߞ^\>'> ̸.\>m.O?ni N|.w?p!w|Ƭ>In1}\ i|}"O|>dp!7|?qfՆ 3fOrۼ3 s'ǝ_䆇'cƼ=p!w|9'᱌5rS>.iS>p!w'> /3' (SoZ9pj߾sBѓ IsקۗOIy|ޟsC?ׯxQC:<Ʃ⿯F3۟ɏBL3jg 1Ho퇟F>毿ajq!w(Տ~o~-0!*y<`gZ2&cϟ?%ё¸\Hwч^~ByI!%rKEs`X}/fv4G9~_՗HUn;q2W{ղqcx%ZO?˟1K1xKb딎<}1؇8Togt{îv~?ɯEz +Ƴ|~CsF3݆S_~׿ > u=z}ۿ_SC?Lë3oތ]~6m)ǟ!%̛Շub__}l"NSc^DM~%af-qVǿ{LScS-aֳ~}/}%HD}qL9:Q黟}9 e:G?Iyxӿ|f//g?_|6}˻ƅ:矅Oyϟ]9jM\/r/pREu"Uon,r/-T_^ޭEe@^*EP,RȻvl{ 0E*|{q2BrUMTk_^ͰEqp@ٷP-r/0Rt+P=E}:Z$S[$W T>xI*p\u;"uW ꆜEr$6"Q%Z/w\@qErԅQ/7mqm/\@'E }Z\@QiP7 /]d=FE E ZZq𦫅}TsZ\ ?]X?*q|\c+oh! T+ӁW߳/X !g,] wQ.)(]?P TE R@(NN]>.Yw?I_n$yߞXh!PY1B duzB '(A'w}Ln!?gl R! 蛪|xxx:^wwwwS.]]]]]QK|xxxx*PTʰ :AwwwwwwwX~{л] |xxxxxxxx}h(`!#......@ U GOX n#',l׽~{Gm+ V z/?B Lz+mBorY? (a\, ^έ5C+ [?1n ԏ LYลuEoq   @ i/ ^}ԺV , VďEo D{uV`, Vg}@GV`[q֣8#i/ ^>^`[xI{)~] z/>b Lz+PG za~-ٙendstream endobj 260 0 obj << /Filter /FlateDecode /Length 1606 >> stream xڥX[o6~ϯ /CuIQ*I_sD;nP%\setVŸδqJ6sQ4z{TijC$3mj9) op'ŭUJؾ9?{ڬQm]*̶֚֫Z/oUU6y?>q>5c)\5<<|*u o d1 =|6;䓞y}GG|7/,aZW~WFaԈ wIAD>hh,praSEhoUb >Xd+k*Kp.U[ Pm[g|'Λ}a0b i03 Ϸ*jws§ho-p#i+qu@!h4h׋/}ә0AwO ^\-F{#'`5ym)vQ³y䃤׉ağ;9 ZΈPVHB]&l J$S`FEcekI|2N?aT.VsCEO^- IHWT $W]O#D7Fխ wm'B򘡵hjދvקؽRc?[f0ȑ H,gP|}*xŏK k/_S7 *ttDY$PҖH_K&f3jI,!P9I1*") ӎBR:su7.׏DyUªQi|-=.NI}AC>ziȐ~\Ÿ|'MR)7vW7RZVA&jx4\2t '9yI㱣FKSSD)N [Yg^jK6`=VZ ?=4^7|q5f<!T)#$>&L.ts`^e0fXS+%7+Xi_)LQ W:1ia [Җ"-q;{0Z_S.뼞_d{]`mfX t߽ yT#<*#Mq>I7 M/f7c'M>Q݅Dp~hT8Gۋ{a?y?N*XK5Pq5&?OxJ崉K<0VʺmCl/ґw|/abKC&\*?u뗊#S Kxv4ҵD_=823)3KNBox<@0v [!hh}[r'f (m9q'r]2^U gs͡TF6ߧ1,9S^uWsQqu5ꎱτ"_/??,״Gn55_oAi_¯gMg~?X endstream endobj 261 0 obj << /BBox [ 0 0 432 432 ] /FormType 1 /PTEX.FileName (bms-034.pdf) /PTEX.InfoDict 184 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 185 0 R /F3 186 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 2628 /Filter /FlateDecode >> stream xYM_1 槏 8"9>d m`AjΛB!$i{O[![(eC[3Լ{cĐSbɿo?[^\{}I1ĸ=mjKѹЛ N@%0ǁ:oFTFH@3vEwJ!`@xg:P +jNVFnF9P 3(TB[78P V:h[L`5`?2Ւ` ],B 0tVG~3Lݿ)%PLu,$겜JHzBTC^Z0=a蒩F(zPdj 9UN|unΡ A]2[05A،Y*W:ǕYDENY9t+!%¡BSZOhGBj[DbdU|nDb46h34<lPX=|,Zub5^RHֹѥt)?L۴Ђ#6HvQf95gN5қ[B"Ϫt\!rQ9c'LN"MJ:H9$po` ǯu>qE&N&HIY/Bgy^yۃ碰Bu$OW}!`}B(Qx녯O8ǶRd$b g'>}!r\ۺ3 ږޢzHe3 |`. ,2 Z"2~߹ԗX1'_di˟6&H`#dP#D0oٟ !2Ӫpb. )xOFbrD韡%'HHCߘZ,ܙ|0#;f$Bu_8^Ei ac> Q42Gt΋XDB>xOnxq,%p< M#rdT߃D>^Fón$*ʎ!l a H2@>ig>?Ќc>Z8 a|$Zc>Fj2XeH8I"Ү:Zb΋!7R/z&rtnDQ$ :E (+ 2UĠ{@|8 >yq/p&Wſe+ۃ#|A ."[ɸZ>{ubQ|ao;?5  |BGuq~CX򪇹+샢dr~X3l= 63o<אP~:v2ąBzzl=)ݏ]OV}v=d']ج$3h/x@߭@42KI9!h Ҫ&yEᏟZWY0W \<` :l3ƪnغƟPEW>4i`SA}lWs >9I:87v+٪w7tXՇ8kP5;4;k6hsk'X5)2!aߧxy:xsk!q1üA6;O>;4/1=|mM 5/X4ĘN6u;|ƯJ~o~4!0!f˼ٽeGMW9&|]^}nuVv_X_qKxPW?"y=kv mv~@&Cs{p:yYSƽً;@>R95 ZӮvZeUߗ|7tm}.i_.a!Fck*ju/>zcLGۣoپzy/r{ܾݾ{_|wT룥9j<=(,Gky --CU@ei#':L\WO?9ܖ_iʩ9|FGa}M\;D^5Ϳ?Q8+5G;Kqw:ԇ.#hو,;Vw/P ~p?y`|wW_[gMendstream endobj 262 0 obj << /Filter /FlateDecode /Length 1429 >> stream xڥWًF߿BIj2)mH %e }HBZڵm9mF)bdI4LbWƄkӍVeUHc4) _N^t7/eQl6+J>1TluOXUyڬ2}z^粷al6)`+ms\3MD+dtee(d; ҙs4H_(y$a5UK0ߊ=Jj <~ ;UoB.衎]DŢ- Eyx80HX"%us]V9 F7BD`w5u hE>v)W!ܗ{L98c+Gs 7MrPCY2  U^euƆƤte߆Qf[rOZO8K,Mx x<D+B ޮ`fhމhqEy/x')8p~+v?Լ,R,PXE}ѲnWK3:&9Z)o?/A%[J+o 9’!M&~2["<̙PL~'γvjjSVrOIab"Fe3b7zbi1ۋñpE._uagO|S1(8n-h J7Nq\p[k'%H.+ǦI㎛U3GS-7ģY5]TL_ 6+iKaTR]4PIO2J;4+}æ_;V`$>s@{k 6(G&U(54K )@h˫P6.+UB;g-|ٍ-lQ5b(fIX}q#PZBKQq' ܼ\Ϯ3!( 5zUuR9x$Cb9'p{<.Tb.X gJm+mke[`z;YܭNbxUSxY7kUZ(.TU'x uIiwji7fo۱Ei5ˡovGYg!_Ч=ܧh Cj0NvKu: ,7MN=KX|g=g Œ*@Ձ~TjfP?x{tvG$@TX\]'\fU&^5endstream endobj 263 0 obj << /BBox [ 0 0 432 432 ] /FormType 1 /PTEX.FileName (bms-036.pdf) /PTEX.InfoDict 190 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 191 0 R /F3 192 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 7294 /Filter /FlateDecode >> stream x]K%Ern,5)14m,Y @݌Ʋ'++N5G8ܪxGd?__GG(RG׏? G>{KGϏQ.΅޽ȗFP9d؍1Džlqpyk!sFHF:r3^_QF3n1Å1ۅ҅0JWԎX.ԏ.4YEyt N(tTx 0֣W[2؎ngc[18ao<Ϳb t e6TYrD[Bz$[Bvd[B~d[B(QlaC{MQHl Ӗm ci#jl,fJPa7FGį&c &#NG Q2#e朳qsՍSXڔ\"Nn678whl ,A loh\%E3([H*]yOa1kKSEޚ HrUI) !B `= ~bhI[*wkV 9Ub浄ڔWEo"v:U0<#nAD+ٗZTPﴬkU605cioMy!x+`P.WS\݃k`^4n tB01G1ͯDuoŲ[J3=/XJv4[\ewʥDKD<#6S)@Id jR8H66  kidS<$Q"Y%ą0Y-эʆ$al}`ϔLPO?zD#~O&U0&Ed 4Meџپ0YTs Gԅ`It,k fVh C)U7ڳD+6_TX^XQ&ItC[[0Ƀ(I6+!Y?cNE|p2 AAɬEFRy6Xw6ʃ%&\u 0~.=SQATd*T0^WyPPy0lƪUR}nAR}Wm[RyP[eF -, ,jAŌzT6X$ z*#gfh]~Oۚ,T|j&WƘ}Nʨ3D )zDEaվNT.n_gfuTma}}כˢŧA((`C%[hCʢ"BYv2;VcܯfQ9Yr컢VXIM>(jD9#hdQT:L#u Y@Tvg<M:VYݼu ׀}t6 Q-87E9˯`{V588}E'V͗`(gbQΆፁE`?xqs񀢊p0gw ,+CF.VsNdҋ}5W4L:zЏ_{U]ޔݺO]ݯꒉ?/~ nx(Dkz ߱:O;G8:hStw- |oo[[Ԛ`W^cǿ@Z`f]{r)љj3<n(/*7Z>ٗ,!|>~wݷ_Vx'_:%5j|DF͙,>^3n6$R}Fi9נt I&^r,f6*RUXZEb:,j+b޻ip> s؋i/JgXvNW=jՋ^e6aA%7BD*+c$,xR -Sm[H 5Q^8je/B$gdP* P„~i/ )3;?C\ jyѫDzp1Й9~5G$&~p(UP)A[nd7wthLv OT6I)^`pWBmO<VЈ__~"AZz6[ ޑ $:sTgb_pHYufyո¶v"rc!fNjiZ"v^]xۋ0Iz~sވw5i썻]%4'fgP: N\JLf Y]BZrX.a]A'b[~X%{7 Rőr I$KfUMlDdAd! H8Gj񋼖b?\,\/'+rkۇl3)R@ZEb7)Mr!(;ӗk|9DP-s3mŷ2ܝ K4 &{jњ/w0;8ۂ5Xt2a@#``Ģ7UH*&Ë~0JO*MR nlm zsI HE; <.u3&~@ A @r&-f#poz@"L@"II@h_Kj=NqU3[uХsb彊W}=!^fL\Adn+ga n*(#RQiM>S }d_Ifh40V&uzRЛ\\.'v̵٘ð)uMs:Eu)?/8~%nAf53ϻBHW dG Q5=)Qr{1QHd.f?]ZfA!e\Ht(3H"BURs~vfZ& )Jл/!sǙA3; RmP xkJ5zІNwK;}Q4{hHZ.qB+>JaLenY08 ,AS2) \eTP(QRAEU/HIg2)\ UP =>t6 =JE~/􈗷H&.f[A@@" ND0wi g8֤L9\(Xҟ II.x(8#ZͱjW$WoVhL2x<9nMޒI Vē Ha+GȁA@73~*QGQzOG!8gɡAϴE@֞O/*jl HyhGJ. oV%Nh[q+~pM܈U_#y^c)|@F@Z.S\KCPAUdT6,sجI}bLJ¼/9%~),J2Vf8fOf \Q}!fp%IL\1H%Db@u, #IE@wHIn29JE{䔹 Y#Tt ]!9E[ p?pcxH93n5&Q:ʠTy%ri.MuvAצU,oU789.kI՛bۄ{a{ 0۳ٞ݃lo\[a'Zav{HNޚ(Jʸͺq!j?`VNI@'qF4/ﱁx~Wa4AoqdmйjkK[~PŮ sAOjQ۾7d\)?pe [@d}|ENnRAZ 5 |v|6?1BxRGkbb@rѩAHm"R^G%q$ VA"w@__u͙a %IWƭRfE,6.-AflVzzYΠ0့fȹȹ< %Uqѝ[op6zp/jZk$݀Sۧzew`coP/9$zM-Зq&o \LL0gg^6qwX>rh|/3E@n(Roe3yyy>XR|p| 7)zpp~ 1 sAғ;:MEߩnȵ-x^M86sB+qBK֝e'qNi yĚЩIpӠUGnSt{W& +eO\%+nl6H.-ނW1n])§y}vA8#q(qHGeǠO&/A/(赨>lW8aA*_4 =%b>dNIQSEF!O#}@w"m@'n_`;rh6>ոK%vv1cn+1?U64@/ۚ}]3%p|=S&S([mG7roJP)l^w9Mh#@o6p ERޑÓ}}j^ ڋj$ʝ^a;y/#4Ÿ)|řřit֫o j[4x; 3")bۥ,73\Βg& y4Jz)V*AϳeE@e%b&\{k@8)z/%J5]J[J{q}/L@ߋed LlVV@z-*Dr  |H=C=C5S%6裓W~7_gp s0iܭbZ8/sI?sI_/jtM̧XeYz/op% {=Wu3jn7?=2H64::H2Mrd_;^i>Nn&Nnn;$op w'O]mJ;4 KIYM'|곓Ows|;T$s,oM| {ݑOo\*rO4uZqSeK ? S oq#o}t;X;o,HSvC+7G Y׮w3t$/j' &n9ZLKW.Lס zR! KN Ɵ7y߷#&h}.yEIQs g-O˨3cvR^a)&|V,z^KV^^F7_ݏqDuݢW}K?/|~ɾL> stream xڝi !@ h!FS$i.PQhZڈB|9RE̛7> >7ֳ淛":XIiNxΘٷOv}y{s:oB̸*o64_&kW3>;2<}Kg#<ꊼl:< ]Kl.\Qeql!":qO{ QV"K|=_x$LB4=/ {$LHb}B~BKaJPQ>d~_?7*( ݘ6*Wyhj48݉.: 7pgM yBU}IVaSS{>|V#*teX!wU3G2[)Do _7ٲןǔ-:_Ӈr㼊,},/d E?uz"7^ })sf|@728 -Xk1Avؖp~/\tǨﮈ=]ÐfQEbS(%Wb')4 JMWuv5FQsgX) gzBwD-4i^ʲ Ypc!Y+NoT~G4$P# 0j}0|@Ǜ,f_OUQ[5bsJP:]Q8-eHB"B%h|ScsBb\^LJptl`C!r*TyMS j::ZG#)64ALV畯 vGaY.=I-{f]*3sQ1?TD.2a:_2KǎsD}"D?ㄌSym>Z}@b"!Oh>buˊc3n\D6~iE37V2B)0yJƣnT3>,++=& `{@ BBhd~OA7 5HH8Y1ahx_Oe.PI[/ɎLX%<~$#1 ;;QA!GlڴEc-gpl_Uj0=&ʏG^,0>@bC!681.-)6'X- 1ݤsRD@L葷 .J+Y^M`Gqx+X(\#t{Д>|NHZ^WD 5j4PpqPN!%Pδ{ aBdNקz5wIK˯e n<DݘOd#R16iW;p'(GqW:2J]oת[&WQU+/\ڨ̏+4j'(ōv!ebP Z Rtu䵊#}HRa-.]Pb@.>| (8O}~?QqLHQDҦ$ :yN¡٨0V)'/^ i3o;ndI2hϒs9!Do/E"o%֨Z.~ú03(Sd{H.T a x]rlΛvO}hM{}J-qǕyQF}z@iW5^Y*}("/Bl=U *BYW?V.oO{UbM yYE+ab*Hlxf}rlr9z04p=G^J(3LYK{vvÁAe> ܒ? (Q+ed?K}l?oKdo'W gl,9Хn-'~l7l8>IEѷoϝ #K""XG(&VI3*؅&zq{AO94B2l)&*$.bMLQ5|Ϧ5]e 6 Pofj#]EW7lendstream endobj 265 0 obj << /BBox [ 0 0 432 432 ] /FormType 1 /PTEX.FileName (bms-039.pdf) /PTEX.InfoDict 196 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 197 0 R /F3 198 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 2738 /Filter /FlateDecode >> stream xYK_Kf/UF!$Rl/pD 69T{19_WTuS҃Tҳ/֑k~Ԛ1,ZG6}^aR>|g-}qߦJzN%9?F9Yi@j '.4@=cM!#ԌHQ$ZGQ&tQa:oi7IvNT:4K~4HiGڠDzN Th$ + U6,lJ=W=8% H,ZLZ:a=,"&X fA;Z!l]@Rrq:Naez|VU {(Kk؃8oocahhDH[aJҌ _lh΃cW{FmYinеmiO#HRv4#bݡ8·%AF+9bmM>e]H: `7R?_ȍ(|b؂2uY| q _?4gȟ,f=Z"V/1; j0WOEQx P bHT&aXiMX8 +Pi@\X0FVD)8Y_A`eg} zCBd Xci/z0=BG=%* zQ/HG^)X7>͂8ȳ]&G=0w r2!F314R{uT5@ Mد~㨧Mփ7U:'?*`Of0Mm ԃ{Jxč=u~ԎчI'xQ ZaE`_!cY[+=S@\e&m ~_R^F'>Rg|ZL IQk6T+`=8V77z|۝U {VC;v~# '6i~){ƑwX5!cvOW"iL F=iQ#J_ a/{촮IyiFn$*#!4ȿ}CUPL#>A>?F?U?8 Hk Ѱ`㌍8٢?%qkz`!ov"66e?"` l$ |mc"" v<!_Hy\$rӼkjP}019o$YyEӣñfgt`=1xC+O͋#PG=p8/ڞH_LE&'/?-py{͋5E ~gc`ΗN;Ø?IHLΧ76.˚__ynU"ܤy?]X)Ԇ5;ԴGZyCUM (SQ59qZ.Id7 2`jo.2]3ɚ#xI*[Z%)KRye:wٔѦES#< ^xUiKL2JIxsjg5y7OM}?}: l~on>qx/5 p}/_ߦnpI/9{~{mz#\ښu(@W'0/ 9Ll1{{M[7_[Æw6r6޳?G۷nԕk/|՘4Ǡ IUG4\c-?ޑz0{_Ϙ(=#͓W/Ys/Zendstream endobj 266 0 obj << /Filter /FlateDecode /Length 2603 >> stream xڝY[o~ׯ c΅CbF4(`ԊXqwJ{n3RԒs9s\s*U{ﲋLRd5vUvq}Z\.]/vx<^//Ӯiŏo?)R93{XuE c‘)U؁9-sȡ'[ٽMG4qjOhma95ai@r=xlM %WuQ֑;JG,r6WO2u'-U7r@V[":cJVeo *9qSZe51-*STfxY |%V6)ңon ]R8VL\l:H@au` =<=D+W9aCFe>FNwӚqZٻ=xG9qᕬ[\Z@dr ?A6ϋ\B۱aë4t3 3iufs֛/g* 4vn;U J63u ?D4]Zy IҊ;5XKFKWH~}oI;hNÉvlAE5{)erM2BkL`Â{-kGMH,m]416ja= 9oPsNyňy# 8dV1&MA;0i 6 Z*ƗҶI^< "p;VRFyWNc{Oc@9iB!S9$NR[d4&#tZv$%QȻa!~^zh^kz\K^Ÿ" 2LajVG"Z ;1H<#Xqyw?-aȕ MxJyzzf <7:E8_Uɷ>=VdI%vpAcT0rcf Z4&Z:( NFizRo*Zo-!snF;R7:H.I96ތtIKXBгz;Cz~lWĤkӤQSH>9oXB}  9mIT+ɣ%3\>} }u:/eM( 5W|&OHi -<2c,/K-N/e3e\Yy\ ؘ6s~IL97g^'!;D?'<+(|`Ia$V!NϞ.iƲKw+ӝGLoӰU7$k* M mf-\Y9HJ4PQItA½U+6)BJ \NU]P̅PsԺbCaQӎ,K;Mѹ:~mӼӁs do+b&H$\H_F'yao}øҀx7v3g#b"vtS+o^,9ib|9i*9k+mwׁDz踑`NI|n¯x9bueWcbk}mo8K5Zԫ)ZG>e(T#C⬽?18#ـ?Wu/endstream endobj 267 0 obj << /BBox [ 0 0 432 432 ] /FormType 1 /PTEX.FileName (bms-042.pdf) /PTEX.InfoDict 202 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 203 0 R /F3 204 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 2761 /Filter /FlateDecode >> stream xYn]߯%LUW^t&U3==8}]驤-imxuk^.^pBn 3QrA͈:JZDk+2儎2QLBd7!>qBx~!F}3k_̱FTtF!2IYۘBrmV"֫$ XȶՉPݲu!$)I2xInZ;N/"&X68wB8oMtex\.CvYplg|< "U R=mVXU]J"Ba[Y-}Bb\Upn^E8ue P-Sm3-m'XEe{8 cx\p0W>L+ e+Š(nBGhw<)a^i'Rzzu35ݗCޤ鿈_ԃlf^T @Ӈ5ZS+I?q>d}x2茈Ѻ@8oT€{`c3w<͘%U "%ZA4SDn4Þ׎jqkuty3#_jjj01VR(TJݾ]#Y/x2 XEE S42ɦ! cR?>SK̂P2Ҡ # yP-;31 P B(,0ćs^l0ۥc7`~D yI>.5my1Ġ 2?SC`G迢&v-3 fTZ f f' 5I\\C‘F2E,Ր"\X?+hx5gH|G&QQ$ws_i|p0ژ‹ -2%ųw4 d[͈ ŝ4"E֑O;k2 (?7i5:ǙC>h Z@C>8%(o1w5Hk~&J4q2tdQ@#;6=ze Ղ?B`_q; 810Wd]{_%:R#6(V띉İ} &Ov!!HEJJ~=%MMñ򦈛FwaAԧ6weS;XL,52,slQoL;e6[*q2?C~g>Ml3~߃/"~Bho^؏X~enT w^{CgLwОU/Z{2zݲ~m^4W}ab_,D[ ưUx1_s-|`:=U E\[TX/8 Ey4 O/k]\VFcuT9'U]=:l2q:h\Y_I],-$cE#֘&@Ř$#7M\qVfM\5Iyw~7@CLjn?c 6h`>K+dP)^SAᦦxb{վZHV7?Gp2iܫTJ dYd[)v=@tI)}_!ys>kwPybf@xĝ⠾҇,Қ$,dءقz(!jQ9#.nzu@qv=X5Ԩ|Ë$s6QlA#*מuRN??DGeɑ%_ZÙX-u,l}Iɻ6ޯ=Ǚvս~W0?O#(2]#)%?#<"S\La\GW|@Ozk>~ol8A&olO΂:[c{|7FnpړTܩ, j\v =|}+WL*A rs_?:׿?yڃtxzˇPBe7_^ë%h3]> stream xXݏ۸߿88CԢAshZtʻ^/J-wӇXp-p>~3ۛ})UUnsh[*Wnn7mV'hGh_gh{h?fy&C5Q~q%yhگ@{{椷o{:&ՅlF﷩ΜOps sh4 ɸ獜dD䕐WkRxԒZYC`*P̔ɾ֔ɝ)?ῆIځ~|V)s__QuRu=#A0fD^&R4>58dH83'=4LB\HTWUC<G,E;(k4 9-lxY901܋Jw|c[ă6nGzsN :_|"bLA9LIjQeHTnq\g=J4pzԛ3:Ź4z\):cm؎d|hxf8~fƞNX$t<ދYm$r3I*QWѐ<|ZAؽg&-<W6:?h8]S0U ov7eY"i2on \ئWp)KU(kPQ3eQFu M@08>NAo]k  FY`t΋iέ<Ęna6ߧڪT䈀gOx6uU J V6K~E!"ķyvsOX, z@s4(6:a]V ¶J#\lESi"\lrcETxbh hl"_įpxy558X(qn$Tl`mE!"Y)% d-@HzMȳ|O)x)LGa`tucx`Nww4,cPB8W ⧲#ozґSZ}>FFI]a |Hk7.Ô'$+ZO稦C/ۨx- s0v8VmNR5RgR!,cRM>H/ݬkqWr>H(;s O\pЉiā{7>"Y3oC>S{!!Mt234ퟡ׿ͳm`X‰ h R}w\5 rKz-}>Ü*LdcU^@ P&RNs@&-RQ=*Qș')}SYf TJ~U:Kg9 m2H,DnTZ,K:I5ecL~?2D|TIQR#'c8qIJݤ6nHV^tgW)ZTk ͏-T7ipr\gY{e|z~&/e<2I[I.g(3aɾd.ЅK1Ts5%7ܳꝘw#`Cɼ~s\Z949Hɢ9)uq%̸{T p4 `tM@𙃾y@X! `@F_*PvtZOI6נf*d_ 7A sΠd Ka`JegB|!O$_,3B.TCF>)`8vCeEsCg?ͯv\4jy,lUtGvSf^> *u.JYq»ֿendstream endobj 269 0 obj << /Filter /FlateDecode /Length 2387 >> stream xڭYKs8WHUHЗ)?d#{ȴ²,(9l)Jڝ%ng_:{89'.1p?ؾp/=iUۊ9(h-?2O|*%bK)*{*T4B0(P OJ#@ Ǚ咠g{4͆4l½cX*v [հE^`g3N꛺IKV&Q=P irXd% 5 H~`X=KN)+ jۈ  ¾K`H/#)bg2]=-b>/uՒFOuӇ~ٖݲǓ^WYEw#їDaة'㦩,xr:_)yKBRE+<}^qp}x;ቆp4q}`j*4+pV4%+M?'ioG,5h oX("uף/BDQ\̐AX{t6!<99اbM} L™Ib ,>K 2N ooWyܵ?cvS%_h IN QEZ75 #:eU-_8qnc|"M~}<ǐ0L~<"RfSBF"ei0 ./6aEK_o1i!b,} T`; B RE@a|lD9;kt]*&@&?\yRc9Wg^߃%F &/G G4aػbPs6(ag0UͽjD V8$:Fs؜ճذntK3&Ow`IOj>kH~r _5=ܜNf#N6i9_]<3I!#:>#8*T'p{V-l yErOHKRȰ;e&n(v *rdPkT,R"$DKu0R cۋ᭼XFIoU qv\vBDĹ$^D EE9$Rx w`-Wx&3qj]1ӎR @g|d0{c,E,[vNetCOۡ{9̂~CD~M8Q_JV9RPB%=-^זH+iB.-ٌP3Vk,.faω8FpežaS jc7' ޏ%>w/abɐ,]ƠgrPMSP^%Cۖ$Udct}%YtV&Zs̆pj 9j*V+(ݑ"a.ui* ;-5yA^,bx뉕*LȍY¸(N%9Òڮ;VS 6TKu ;_~}@PdB^J tc ߏ"4 :HWbGuÍCݿ!a}w=o;T[vMM?{gep7r<2s hbd=@)H~d_ )9fܽ<ʓr󤲞`妗K #BZ ( =ŋ0xlPG!7 1lll=p<6W#, 'Kmw~㵰gRL:8}K/tX}KP& Q;:8I gwjIw? -)-SP0ـUi<'zI{ϻ9>ؽ؝4KT/{:9Y+K`=4fK@e*!A:WH/t KQl[d읶@z]b.\)Nldv{eVAմYKHL 6?+UCww꯼,endstream endobj 270 0 obj << /Filter /FlateDecode /Length 2367 >> stream xrί@4(vDU*9dN9 l|eh,dSuN~gJ$Bj>80. cn`'NpW͚b8ig FR8'6͓̃wC-1yUX[Q~woxߺUۼ-ojmka!5&ԩSi'$3?K<Zs&?Dt"FyD Zi2``$)'i+5saxHXGyBes7mx8" J^f2̻p9ٟȼ/^^S%Itdž0ޘe^- -¡sx#f gƤ3# /g'9Kl#\Y0&(NϯO~.`{ H8;x^JPӓOb]Ձ͵MJEPY$JCZ ,9zBtQ~*`^-nɠ.H2 |!(a!}B2xfEH B"0n] Mv1=Ko)71Xe=?0c9EAI,_$ۇ~?YTyG?zfi$`S~&tA9Ȳ:YqzB|ą`D \ĆC"]iH(Ty众RHRrKY%VB0 T=H򩏪:;+[@Owe[ 3P1c,fb[l?Ck}; 6^F?NOtcKx:+LI:=?{X1(Tַיܷg<&?c#WHX(}F0ޟS$}@.btS& IwIu.^NG :Ib 0>& VQœwt0٦Bj^ "_A:>mݿRK0 靭ti}R3/7GFTs/M#Σ#ߞ@ΐ JN Zʍ|Ea%1 wT؀%t$ ĝHܖ]Aqy$h^: ԽJmTYFz \|gyKJǡOu˃))hg0OyyƟ%.HcwXG{aHWTlDv:02:ELQM+h`U`yΘ|0> W\׀תo0&36zj\}S9M7J/RKsu$Zqy^>Hrwi/!XʼnMCĪr<VHc!Q~Đ(N}2T*l~: r6+i8i |/s07;?f n=P*HY-6DWH-O=C!6Z$% D>vwycLTNۍ1Qa ID H{DEF)h> stream x[[w~Pi, $uωRIsz(i%(l+ර %'99~|3|3+sFG\(ƹ;`N٣gG?4fY?Ǘ+3Z" Y 0 1aDJH-H8'35-L~ w[q.Q0d7O27"R9+ Uiku3:,al.h779;z&,L xwpyJnaRkBKSz̴hd&kZE=WZ7ϐ(Ro&1Msln_5bwMT x[dbw@q``ʱ\fV\_B4~ k/,R_h)xZ$WnN %+˴K-dR*wa[YТ\4wwauKZ0Y9 |灉'g؄ s|+[p&bVL_*}XQEzR±NtIL͸UEXV~P^+ysa7ٜ>V e*oї9x/" 2 V)m"j:8Ǝ U BcN*fG29A\GÛ{q]gl_bgt2Lf ҇m ^:L7ж(0 1m'm?CB;\M:u:\:ƕKJ7wX'skWb=m3YӜ[5{8B [7{0y+i!KwȒAR:Դ2X^*o3|e2p֒8}\a0Hf~7~yv1|s9}-Otg*EgWP_݄,xݬ/}G7š%XؖH`ZfAݕD4rNch3V(x$czDGR\xޡp!=ߣsm6_`iT–{4U˕|QюUl㺨\W"t>x$fsFt5ר5S#rp`L$}enj"x?aeI:p ,RFAz[ͨfT,ׅ/Rl9i;|4l,S2%(ʻ_s2DU6i(DζDb;@HK)0sX+Wʕ jU0G@8N9O+NvO8PUHVUԎV:8b#]5RU:='Y%k5Nuaԅ$&,C4`NHrU7FQ5 { /DOI^P. ۏj.k! j͸6Es,7ij%>#$Gc]E:;b坰/rNI>r7˓b.@v}~Ai~h#[96\?p}Q}fS]!q\VO -+HvKGE:u!ªTQrw9DqQx2tF/p%bt6:F,RdW >"Ę[]&gv+ Ybo[| H-\-1 ZXyRɜ8bM[FQ `Xi-硊.xRM]C//H? 9aμcHyFymui2q[*SL?cuj*]i\cT;+iWJd9 ̅?ۛt0q\;]T}+Xe]Ɠ"LyH;^ʇcI.`.!52 c3⥨NpftpX}cW nL-u& EvWd1>6$CdLc6db:ш?$ s0SI' A)x ȃ+G*J򣕂6‡TC:|piwZՍ4K7־=1@SCEg{;E^fZU!rI;rd},/_{]%{Q@vhj3: Cȱq DS6ש%ePÆa7ϡ)K.<5L{kjm4U +\'8|ӓ.-_/]nS_Ew 5On!1 ~IsI]L{K* i7V+5>> (2eRxпm|xi1pTv-|c;!%lc_3"fZjb- _BrM~sv~0j:AB [R:L:Cf7VQFnnGI͏ez;qjEb+voXjzWN%7`+nwl0 "854,#/p/ @IɇL9A:%?'|v]T2ňZY/LN,WI V1k6Ӷ+ݡAh#LCd:Һ)ZY/t ui:6V]PZfU 7gAjK[Pw`CG ՄWX_x?5ΉTs+czZIпlC3ЛqxWDBF6}Ң),ğIt28Va_h,ǝ"+_d!cTfhۓʙc2#*i,H餬T[Vn) /髻:Ur;ag\2 yh8@N5m*E߳A[haQ6nP!fϧ:oTy@PytVh\ Ok9b&_\[LB1Nڅ{CER>z_%-#J:Ҫ8I ^OHj8Mkdž4,*cGe")ce &wyqEA,})i4 . IG&뗁Q&u2`ؚ)}H% *o`bD{!vAlD" WoNDd @~ݡkζpqs1Pֿ ż\q@L \?.GށL%-b&Wڻ,1#Te:fKْpe_oj >Wk7wǃܟ^I/|[vuG Mg />? x9Qͥd*m.D]endstream endobj 272 0 obj << /Filter /FlateDecode /Length 2931 >> stream xko };= icz>b- Yl6JZ.|D.gwf=|uw]xU[\8u(Q^n>\pM곕)t\,\*\&\~AW ZV.cnh &!l4O<az啎"ԙpP,^2%Ħ"at-Cn@_2m,tC 0 ;ೀPeV_ݲ|Ml_>@gOQ g tJ@) صDzIrlLVx%#'iM%HfM؅5ʌ lBD T?l+lY3t*3b1**fr#k,/#y{`c"kl@kjur-O钸auq*zofvT*W@W4={TB#.ΑPN{SA"~ sK:6$7+öG =W ).]0ڢ!ڲ@ɖ#"|޽G{i,; L`yZh>=`Q{ľS i-LUi5Lm†XW:'<`򚎞;fT*>$&Y-6۸w1GMi lҐY@fX}t.<8$1hrdqFw> (=&dBE@؎nG{: KV?2Q6χZbE˩},ޕ۠@~HB,{%=$ږ޵qaO7cu,?ь.xg =@-E=r3![ :mxQGZUT*sUjjӜ]*VQ D P͇I~}:͘H^QDqd>N(ϔhNt5* %ωK W~KsNHhOw'uťA `BØhI]' 0n,K5᜾I}%&dRP_*=XZʇx`//jC0+[u_Ou¨" a-ip}%;7]:AIBHOʘ%q.=Jeʘ<,3Tw(l[heNcJ܃=-}ZM(yjߌtFƺ~^Lk%~1)lJM ")CB]\?ٹ˷\^Ib%G%l`?4Z|Nb ^CU?L9쟐kSɭ.^5)]VY/kֈ9ץlYie\k`#]3bR%K$o_Prc (JqUFоF,5}vvP{[z' hֽF{1l}KSJ 1)@<3-[-@ŝ +d3+n==TS!xR"MqZK5H*JPgIu,~qs衋<{jv;J O$fčišƻ;hY6APg C)g/?T_|NRqY4Mƙʠ+UE_!c_Lql M?\'e*&$iwɎccUpm_d!d6E)_,%['pv}>3h$7sY97ԕ3.{V)zV]U=]wN~V%)\͋XL.DK-^ҴQp+HH}~If5Cg9jc}H&ʣ4 VH$bF4# g^r_ƕChNqhX9˞\=fDkf +_ͽiX)Ya6#C:IDgީ\(l؈$ ګnvTbo@) rH>9#6{l0^)[3tKpTQTϏ71fIH=qvQL0pkzݿ5H]bnj]$!_xoraMx&8Q4^p%'V7~"TǙNy)=Mv~Sw>aO$s, <$#S"]':0bҿ#6kg ]R{o|csr0iʹH6]`|DQ ?##.s t#!]k8ñCT,5gSV2g#7lau05-Ua*3"XKL Fo^_}w2endstream endobj 273 0 obj << /Filter /FlateDecode /Length 4001 >> stream xڽkp@q:b.I. i]~p@'lz\(lwYxcvwf󺯯|1*ۙ2eV=+j[ͮ׳WWj~^ ]?OFW[x}1o%? p9?Gx8m$]sխt=K0g6zxoiy?#=oPna C5Bn9g9mKW˿03EÓ^Seʳi"g"<]vf;y o1? ƏWEv- 1&]U6S -KɆ)|IPY^8;DqjM ִF7x/EUբZо0GzˉAAn O=[ZeOG|c%i[wǰ_2#j$w"a X(M?[^& 5/ Hʣ>Q6Cَ{"Q1ّ$)%L4춌qU ͩT́yR?Z=Em'SLbҊTX}Nhi \'h3Bs5fh[ N}+T!iQRkDchS"ШUV+>ޱEP*j(齫]Ԭot/`͸ZTS]>»:/0LJ$3_[2;ȝ$ow YrAn(Kgx(]ۆt9ox_ ثzp݌ H5ob.ERm;މ=t*x ?hD]D{‧_EIXL€఍<lψDA%Y~?':ys*"%f+zw)zɑR'tKh8#~ɰc2﹐ZG [ e ڥڴG,PʤMMAdtbfOx>!:}O << ?1Es(mWoN;(+u6'_%&/EZM&d J]A\k!\ F-}|oeŐ"t oRcY'u:}bo#Z趑\n[N6K+iQpkGoX8`$b"5CLI*Vw74Cau=»eLrb]] m5YUaG|J=,AT¹?i㔿xSh ȣ/d#SG܆`b܌kHw4Hܤ* o]tέ3TTPoEgHJy+ DicȐhEy;QZZ ⡂Q/'5)1Ɋ^SLh JDq%@ߝ5є`W]&%2{9SP[%A1U%#5o{̔$%yٝJ0D@@mU h£f`]`ݎNE5X wҭctubCkD <%m.F:P.] {tbRtD/vߦ=u>NI9U%L7]f2KCT8Vv-qy;qN`t,jRץ8>co'̔߳8|zlUOkHyZ5@|ѝNCA: U!Ή[GBXc2n Sz&eh"YeTU>i"ꈳUFoi-N hm/B cg͏M63Rp?,EGTDWHV4=~IB-bP 4Ex'SJQ*5 nbбNhP!sDTI(6%O|:V,&:J{C2L?7,4Ko*i I{(?)|$- )0o= 4%f^2z"8QV&Oo|f{e|]d+fWGL>$ s9oYk|g^.tzǻzP9厛J.]Ș΋nd0$y{F ` 0| \b܊e.UF%sm 70*+tH6K%MK-6+b37dJh}@lӞysױrZrQҺ/*{K?Et!'${N=UmpD\Yv}p?9UT)&RSuYi/rJÐsfFotP ;"GŴ'֝T`i91ֻYI:)# [iZ}\t5WC66u!n7\sJ&^a9d]/)N@~A8c EGJ~8)%>Z_ mWoOQ0+0`CMQ -_L!{iR^ORNZjiʻ0"Wendstream endobj 274 0 obj << /BBox [ 0 0 432 432 ] /FormType 1 /PTEX.FileName (bms-052.pdf) /PTEX.InfoDict 221 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 222 0 R /F3 223 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 1356 /Filter /FlateDecode >> stream xXIk&7>Da 10a8 qק6y܁J]]Mxsc>/ogud! `3F0W7s8gcg!?/z4/?g>-\uμYM 6fs`c)esx˦қX]YNlنrL'? |`gs)"E`W~=g:T631f셥 D6oOfnj'OG]ܵ,K̻簷e1: 'S! \ŁC6AǛ8mWqr%.uȊ菬9 .-˛Ku3cSՋxA: 94u<^ȇf>g:YU r݊+Yڨ1>*lB(˓_I4g_͛OW?pe~x9%9ޜ0-/FK E.*vys;y`v=OEAllLf:,\P թb"yҊȵ>uW#o7Օ>Q]ŵd[`V.Siez U Z:{aa[Xq!9PZ |M NPq"4?&uE'87VBg:Tۦ2dWh鶰NF8VΰV^*S噡Ŭ_P;*\F9ˑuk11Q"8<^J@6, \dM=3FyJ(W Y!D"O֎3Rg2䇃9؀[L YhY,r*[ Q'!+íG 4 J΀X+ CV&h#(nyqVְw='cښʹl;Ͼ28z_3w;'iؚ(t@g yؘ} " yj" y\=3tXwYĝoǾyf^3 ڸ^jKCno/8so˿endstream endobj 275 0 obj << /Filter /FlateDecode /Length 1474 >> stream xڕXmo6 _oMƵ^,[l^6`C nrK..wDRС"[ɇ|Hɽܼ/MV9ݯ3m*so~>e-#FG4fRiF Ĝ+ԑys6fhxЮaԽ%]bFsU*/gȊ a`lags)G*$WؗaE J`CGS^`6̔(!ï#^%˸Jd IXE9d5i bIM*SoɴOa+UVH@Q}K؀|2Oð3ӽ G 0[22"H&bcS¼D+QՊ TW Zx^J2Q"^3J{Ec݌j'Y'i~^v^8!ij%hY b`nc"6( DjEHYbU9تx[G>xk-EȁWŴk=ѩą.ܱR>ҧRݣ?BoeA(_ݑ&-EL<(n:r~O 5KrpEbPuXnc*W7oV$BEł crnZBlRŌFMiq:sYCmtx{pX :`&Z>S?)a#Uq rP!%N7Cp#6],R*'ZJ`c"z7?RwwW} @MOB.2Cj/'E^յQD"7?&Y\ A9;{+8tu}Mᄂʋ+kv%C50?`rwI`'|$|v^F6?ˋS  4Oχ묎(NtrtJډ<,}mkʨ .>h7yLyS03oqBendstream endobj 276 0 obj << /Filter /FlateDecode /Length1 1228 /Length2 6722 /Length3 0 /Length 7461 >> stream xڭeXAAbsh`t` )i;$EZA.i?ϳ~{|Zk籮g!\6+"эW ֐3r03]n0T +*TZ!_1A1!f wJ:@]`֖@ K7{%Aݼp8P W݀VP;#/O*6NY򀺸"MDA8½6P[&Eza뿛+ᚖ{Rn{;uj l.j99dT,0kYG;8Uܬ큶pWq[@o !ǿE%M韶eͼ9Є9^^d"'SpF|B@KKoA Зsz^H nG?׆ ArE@7A 0 &dO߄ @~N7 A,dά!^dS?HRG2Z?) yi@?)[ duCm~Gy]+HW r&#J^ RD!|CKG(* dZ @- y=P/54ZOPk6t M@ 9?Y7xDAyCOAs|݆F{* u'_!m_OQ&Gʓw!lzEz&2_ )fCYuҜ#—<1Ccp,!^b罹{riJ1ㆋ?J:J0`OjfUnsyӘ{7EsSFګUJ*nY˩λr6_;h1A@`̫m x!iէ{j:t>q'Wa[BƤX ']]fZ~~b\ ާaaY;Je6?; =PhCsLF7gŠpf/:QwZhGg>&}0$y85rTEyÄS:@*hMdQ6夺ΥsˣڧtQirD>pa$r`\l&+/i"F^2$Ca;&J8Vvq2nְ-n!VΗٕJe< RpBqqV,M(N;o}|ɉ X>Co?u./ک$fp Z^@:I2Hd2oG_vmU&_i2⬡fb[3Ǥ4*sb~R  ㏎[}NbpCqRƼKeQ !kL):Q =gUIh"zl"g4p]EC>+ Y4\ "G<:/Ć5kn|=ެ ft0<ԉR/~[60fᦏ ãf{\i0HJbO;x*5]VlZ7N8cwv:Mx|ZY JMY4ouHx(ʵNzݵ~o!x1{]S;\L.'o<WSIO-zTŸ:cN׶!'K\T*%\fkiM: \j9e͌4|E=xܴNWg' 4Sލʷze,bj1씠.g"]$z }C;.i=qƬR\ef`@>wF:<" +/k`f*.d|b >V|&]kJzUߎ3^. _}op`ajgKz14a/o,zu|;*xz1S+x,1Dh˞{<@q y"p(+Wf'>P0<9Fk6 ?k~.x&7آ0vN.g$=mSb,)2PjI HU~$k+ǐMk٭Ex#E[+VK!F׉4>Y *{q 7Ot햌2-(OBZWgCmΦUVJ~]s($oB\pg7<5~YOiGd-2hg,rި۟n ܏YYUuQuT~.:[Q뻂go-zn3nZgWH).;HvHf.被E8ۿА?`Ѐ wdcQl&"K7hT(__#a)'1(r֏RW X-nU?RgQ("=6d7p=Fs ?#PF9{LTsU@%U'50ub~b#a0 @ byQPQ#"/֒+"iHVow,LldqQtAZ?,+Yú'2E GG^E{Zy"g_u=.O} NZy+OĪd?Ž=P5Fv Q*'F4X*»Z:~,<K1,6b;%q mf^O* m9QG<3)? Ax6HoQ>RCXQ想 2 |5 Pm7?꾮W[6뻎{C9Z`G X&5/vRO_,y6u%pPv&))s7t0j#*gq~I-ɜw1o I.Z<]? h`D'? 1?mM'ȚT7[QYwLǰe{(ja5٣Ⴃ< ~[=S9/x(oO 9tOWgٹ؊>MҚI?0Q5]cәCҶʡpK\h|wpʼ$ڿ9=4J0cNĀrǸi\;Bӑimԗ‰zk<8Z⼙?nD(x]v%WB6AjU* Lvy%fp MID#ݚP4Fϵʰ1؟Hz n.&+p`P=҃:z+8j^T*Pf8,u;Q[wSUtK¼^z=#5ZS,&O*mW$*-WIaQRv ' kv7#OňPmVPecܢJQYלVR/?;E!={צ]ۄ*x%l#5 PMݲ/  >j7 {)jBzERS>?h;G$fKaQXG/VT@PcĞ20W?}bv`~B@)ּ:H0F<8ЫZ_(DwƦ0x%6ҠӗŽd\T*h@4mgŜ*GĨΌ#$Sݚ.؛@3X9=+lLi(Bg6.Sk*>!60> YS:+ 1TWh%˼_}o͇'R.V KZ1ps ~D?9;*pbzlpJkҌDFb}yAGےEJM$oN?h(ʍ*ZJ_:1-kW)L!GyӛoEsgj 2\akl"e9P7—W\}LEZPq%-T$mJ#p.YҌқ!bԌm&dwy,a  k]pSgfB xl ' )7] 9b2-KnӢ_?5":cf!҃%o-\#bNҳ^uuD@IcRveJ<lesZ-L+W =Nl-9" @(6aPj䐉2Q?S>9M$f~xRQt`W) ot?4nzpe*oUQLD;3f~ s$aPH:4;a=9%lB\-s[́ d/ oQqjSg:zsuO2@E&)qe|E?+6~lUЛH1yGI_ŮS{udSQ))vlgV0Zwh 3uB :hCDuM `1y%ؓ)fqE|%6 Sr?д%~L&Ҕ&~/V\̝D 5rþ\F@"bnS81J@/옸Q-Tn=239oEKgdLgf%ց< =;x–XBO;EzMb?8ɢEeHaRy+lH {P>{:ӹEKF=R_ k"v֚ٔ1~LĬ3\c(4=N^6Յ|S_e@R8ZԾkY05~XUiT$-Ūy*iaop:i|m jUS-@ Lfdpa:3ki7z!595~˹ډj/ŊTsQ]-{3 (+IO?(ז)7V)LHXC?Ǘ& Ho:#ڔ ^f S1weI}%gJ T٠]rLcc_:cCHc 2M!JgmtԒIL 8)rѩ3M%I=!U^(-?`9L;7˓f.qBblO}mfF霑Ʀ`m z4m7_zʔ- noPn eRllJ _^:HJF+cCf$+V_ LAq6C^,<]kVEN|G2?=w\vao]~*_aK¨Q[\,:l]2;mI;PluH1]zsSǥFxv,=.sгʧ3fC9 \JhaogHš'EǏė[4-@EԚG=3uppqcl[An& 8*.˘ˮ5I.-[jWiߢB4,ęe])R-HRYѮV}c2s#*# ݗ? V6vJ*_޿rqġ°$Ԣz'͈,˶WLYCZuIu e5Ҳ5٩+PՄyFb#/6'^aSQ;z9S6LC.s:2pbvd~ 8M(r^NW TL7С9 4`ѕ_rfVQKc:s6O.).*-uo4?wM"fVHc'y xI N7 INf`iEyHfQjs? 0{sh^A PHCQ> stream xڭ}\SUDžxkCD(Ƙ"Le Dޱݻ@|D&J) ihiW&b(]0?}<<;><)I0$TL~"j 4GG?%DU8IAU8<;NWx| OޠN~iȡPP(z` DUjd bD*P,8I0'hi&!!!ǫ8Mp RL25C FR `n&3Nqo)WH1T4PpL@$ `rX۫<g@q86 *K3yHgPp#CcVig(NW+ @QĜb$%>@X¡z5̟H1N$;@JTM>q& 10"fRE3@B*iA\;y:G%V&361]]ӅK5E<KS*!(c Nah$UdKG 驋5֠b=󲺪{x.'},>7mQhgO!6RjnsO% 3-Iӟ8.xr_)Xs=?=B8mqsx1?8> /W [ 1 3 1 ] /Info 69 0 R /Root 68 0 R /Size 279 /ID [<07bb52cca716a03b06dae614a4b25a6b>] >> stream x+aصβ[.Ju"g8EJRr jSN`)rrER";+0sx5=yq cI/`#Co2=6DF/+QF7 2JoN:]C7%L|b 868*/1acX3;PQ+D?{FOkMHq>+9XX:֔H<~ zpmohԇSMӄ6:\{4G7u o&׎n8sMkI}z>= options(width=75) @ \section{A Brief Introduction to Bayesian Model Averaging} This section reiterates some basic concepts, and introduces some notation for readers with limited knowledge of BMA. Readers with more experience in BMA should skip this chapter and directly go to section \ref{sec:example}. For a more thorough introduction to BMA, consult \citet{Hoetingetal99}. \subsection{Bayesian Model Averaging} Bayesian Model Averaging (BMA) addresses model uncertainty in a canonical regression problem. Suppose a linear model structure, with $y$ being the dependent variable, $\alpha_\gamma$ a constant, $\beta_\gamma$ the coefficients, and $\varepsilon$ a normal IID error term with variance $\sigma^2$: \begin{equation} y= \alpha_\gamma + X_\gamma \beta_\gamma + \varepsilon \qquad \varepsilon \sim N(0, \sigma^2 I) \label{eq:lm} \end{equation} A problem arises when there are many potential explanatory variables in a matrix $X$: Which variables $X_\gamma \in \{X\}$ should be then included in the model? And how important are they? The direct approach to do inference on a single linear model that includes all variables is inefficient or even infeasible with a limited number of observations. BMA tackles the problem by estimating models for all possible combinations of $\{X\}$ and constructing a weighted average over all of them. If $X$ contains $K$ potential variables, this means estimating $2^K$ variable combinations and thus $2^K$ models. The model weights for this averaging stem from posterior model probabilities that arise from Bayes' theorem: \begin{equation} p(M_\gamma | y, X) \; = \; \frac{p(y |M_\gamma, X) p(M_\gamma)}{p(y|X)} \; = \frac{p(y |M_\gamma, X) p(M_\gamma) }{\sum_{s=1}^{2^K} p(y| M_s, X) p(M_s)} \label{eq:bf} \end{equation} Here, $p(y|X)$ denotes the \emph{integrated} likelihood which is constant over all models and is thus simply a multiplicative term. Therefore, the posterior model probability (PMP) $p(M_\gamma|y,X)$ is proportional to\footnote{ Proportionality is expressed with the sign $\propto$: i.e. $p(M_\gamma | y, X) \; \propto \; p(y |M_\gamma, X) p(M_\gamma)$ } the marginal likelihood of the model $p(y |M_\gamma, X) $ (the probability of the data given the model $M_\gamma$) times a prior model probability $p(M_\gamma)$ -- that is, how probable the researcher thinks model $M_\gamma$ before looking at the data. Renormalization then leads to the PMPs and thus the model weighted posterior distribution for any statistic $\theta$ (e.g. the coefficients $\beta$): $$ p(\theta| y, X) = \sum_{\gamma=1}^{2^K } p(\theta | M_\gamma, y, X) p(M_\gamma| X, y) $$ The model prior $p(M_\gamma)$ has to be elicited by the researcher and should reflect prior beliefs. A popular choice is to set a uniform prior probability for each model $p(M_\gamma) \propto 1$ to represent the lack of prior knowledge. Further model prior options will be explored in section \ref{sec:mpriors}. \subsection{Bayesian Linear Models and Zellner's $g$ prior}\label{ssec:zg} The specific expressions for marginal likelihoods $p(M_\gamma|y,X)$ and posterior distributions $p(\theta | M_\gamma, y, X)$ depend on the chosen estimation framework. The literature standard is to use a 'Bayesian regression' linear model with a specific prior structure called 'Zellner's g prior' as will be outlined in this section.\footnote{Note that the presented framework is very similar to the natural normal-gamma-conjugate model - which employs proper priors for $\alpha$ and $\sigma$. Nonetheless, the resulting posterior statistics are virtually identical.}\\ For each individual model $M_\gamma$ suppose a normal error structure as in (\ref{eq:lm}). The need to obtain posterior distributions requires to specify the priors on the model parameters. Here, we place 'improper' priors on the constant and error variance, which means they are evenly distributed over their domain: $p(\alpha_\gamma) \propto 1$, i.e. complete prior uncertainty where the prior is located. Similarly, set $p(\sigma) \propto \sigma^{-1}$. The crucial prior is the one on regression coefficients $\beta_\gamma$: Before looking into the data $(y,X)$, the researcher formulates her prior beliefs on coefficients into a normal distribution with a specified mean and variance. It is common to assume a conservative prior mean of zero for the coefficients to reflect that not much is known about them. Their variance structure is defined according to Zellner's g: $\sigma^2 ( \frac{1}{g} X_\gamma'X_\gamma )^{-1}$: $$ \beta_\gamma | g \sim N \left( 0,\sigma^2 \left( \frac{1}{g} X_\gamma'X_\gamma \right)^{-1}\right) $$ This means that the researcher thinks coefficients are zero, and that their variance-covariance structure is broadly in line with that of the data $X_\gamma$. The hyperparameter $g$ embodies how certain the researcher is that coefficients are indeed zero: A small $g$ means few prior coefficient variance and therefore implies the researcher is quite certain (or conservative) that the coefficients are indeed zero. In contrast, a large $g$ means that the researcher is very uncertain that coefficients are zero. The posterior distribution of coefficients reflects prior uncertainty: Given $g$, it follows a t-distribution with expected value $E(\beta_\gamma|y,X,g,M_\gamma) = \frac{g}{1+g} \hat{\beta}_\gamma$, where $\hat{\beta}_\gamma$ is the standard OLS estimator for model $\gamma$. The expected value of coefficients is thus a convex combination of OLS estimator and prior mean (zero). The more conservative (smaller) $g$, the more important is the prior, and the more the expected value of coefficients is shrunk toward the prior mean zero. As $g \rightarrow \infty$, the coefficient estimator approaches the OLS estimator. Similarly, the posterior variance of $\beta_\gamma$ is affected by the choice of $g$:\footnote{here, $N$ denotes sample size, and $\bar{y}$ the sample mean of the response variable} $$ Cov(\beta_\gamma|y,X,g,M_\gamma) = \frac{(y-\bar{y})'(y-\bar{y})}{N-3} \frac{g}{1+g} \left(1-\frac{g}{1+g} R_\gamma^2\right) (X_\gamma'X_\gamma)^{-1} $$ I.e. the posterior covariance is similar to that of the OLS estimator, times a factor that includes $g$ and $R^2_\gamma$, the OLS R-squared for model $\gamma$. The appendix shows how to apply the function \texttt{zlm} in order to estimate such models out of the BMA context. For BMA, this prior framwork results into a very simple marginal likelihood $p(y|M_\gamma,X,g)$, that is related to the R-squared and includes a size penalty factor adjusting for model size $k_\gamma$: $$ p(y|M_\gamma,X,g) \propto (y-\bar{y})'(y-\bar{y})^{-\frac{N-1}{2} } (1+g)^{-\frac{k_\gamma}{2}} \left( 1- \frac{g}{1+g} \right)^{-\frac{N-1}{2}} $$ The crucial choice here concerns the form of the hyperparameter $g$. A popular 'default' approach is the 'unit information prior' (UIP), which sets $g=N$ commonly for all models and thus attributes about the same information to the prior as is contained in one observation. (Please refer to section \ref{sec:gprior} for a discussion of other $g$-priors.)\footnote{Note that BMS is, in principle not restricted to Zellner's $g$-priors, as quite different coefficient priors might be defined by R-savy users.} \section{A BMA Example: Attitude Data}\label{sec:example} This section shows how to perform basic BMA with a small data set and how to obtain posterior coefficient and model statistics. \subsection{Model Sampling} Equipped with this basic framework, let us explore one of the data sets built into R: The 'attitude' dataset describes the overall satisfaction rating of a large organization's employees, as well as several specific factors such as \verb+complaints+, the way of handling complaints within the organization (for more information type \verb+help(attitude)+). The data includes 6 variables, which means $2^6=64$ model combinations. Let us stick with the UIP g-prior (in this case $g=N=30$). Moreover, assume uniform model priors (which means that our expected prior model parameter size is $K/2=3$). First load the data set by typing <<>>= data(attitude) @ In order to perform BMA you have to load the BMS library first, via the command: <<>>= library(BMS) @ Now perform Bayesian model sampling via the function \verb+bms+, and write results into the variable \verb+att+. <<>>= att = bms(attitude, mprior = "uniform", g="UIP", user.int=F) @ \verb+mprior = "uniform"+ means to assign a uniform model prior, \verb+g="UIP"+, the unit information prior on Zellner's $g$. The option \verb+user.int=F+ is used to suppress user-interactive output for the moment.\footnote{Note that the argument \texttt{g="UIP"} is actually redundant, as this is the default option for \texttt{bms}. The default model prior is somewhat different but does not matter very much with this data. Therefore, the command \texttt{att = bms(attitude)} gives broadly similar results.} The first argument is the data frame \verb+attitude+, and \verb+bms+ assumes that its first column is the response variable.\footnote{The specification of data can be supplied in different manners, e.g. in 'formulas'. Type \texttt{help(lm)} for a comparable function.} \subsection{Coefficient Results} The coefficient results can be obtained via <<>>= coef(att) @ The above matrix shows the variable names and corresponding statistics: The second column \verb+Post Mean+ displays the coefficients averaged over all models, including the models wherein the variable was not contained (implying that the coefficient is zero in this case). The covariate \verb+complaints+ has a comparatively large coefficient and seems to be most important. The importance of the variables in explaining the data is given in the first column \verb+PIP+ which represents posterior inclusion probabilities - i.e. the sum of PMPs for all models wherein a covariate was included. We see that with $99.9\%$, virtually all of posterior model mass rests on models that include \verb+complaints+. In contrast, \verb+learning+ has an intermediate PIP of $40.6\%$, while the other covariates do not seem to matter much. Consequently their (unconditional) coefficients\footnote{Unconditional coefficients are defined as $E(\beta|y,X)=\sum_{\gamma=1}^{2^K} p(\beta_\gamma|, y,X, M_\gamma) p(M_\gamma|y,X)$ i.e. a weighted average over all models, including those where this particular coeffiecnt was restricted to zero. A conditional coeffienct in contrast, is 'conditional on inclusion', i.e. a weighted average only over those models where its regressor was included. Conditional coefficients may be obtained with the command \mbox{\texttt{coef(att, condi.coef =TRUE)}}.} are quite low, since the results quite often include models where these coefficients are zero. The coefficients' posterior standard deviations (\verb+Post SD+) reflect further evidence: \verb+complaints+ is certainly positive, while \verb+advance+ is most likely negative. In fact, the coefficient sign can also be inferred from the fourth column \verb+Cond.Pos.Sign+, the 'posterior probability of a positive coefficient expected value conditional on inclusion', respectively 'sign certainty'. Here, we see that in all encountered models containing this variables, the (expected values of) coefficients for \verb+complaints+ and \verb+learning+ were positive. In contrast, the corresponding number for \verb+privileges+ is near to zero, i.e. in virtually all models that include \verb+privileges+, its coefficient sign is negative. Finally, the last column \verb+idx+ denotes the index of the variables' appearance in the original data set, as our results are obviously sorted by PIP. Further inferring about the importance of our variables, it might be really more interesting to look at their standardized coefficients.\footnote{Standardized coefficients arise if both the response $y$ and the regressors $X$ are normalized to mean zero and variance one -- thus effectively bringing the data down to same order of magnitude.} Type: <<>>= coef(att, std.coefs=T, order.by.pip=F, include.constant=T) @ The standardized coefficients reveal similar importance as discussed above, but one sees that \verb+learning+ actually does not matter much in terms of magnitude. Note that \verb+order.by.pip=F+ represents covariates in their original order. The argument \verb+include.constant=T+ also prints out a (standardized) constant. \subsection{Other Results} Other basic information about the sampling procedure can be obtained via \footnote{Note that the command \texttt{print(att)} is equivalent to \texttt{coef(att); summary(att)}}. <<>>= summary(att) @ It reiterates some of the facts we already know, but adds some additional information such as \verb+Mean no. regressors+, posterior expected model size (cf. section \ref{sec:mpriors}). Finally, let's look into which models actually perform best: The function \verb+topmodels.bma+ prints out binary representations for all models included, but for the sake of illustration let us focus on the best three:\footnote{\texttt{topmodel.bma} results in a matrix in which each row corresponds to a covariate and each column to a model (ordered left-to-right by their PMP). The best three models are therefore in the three leftmost columns resulting from \texttt{topmodel.bma}, which are extracted via index assignment \texttt{[, 1:3]}.} <<>>= topmodels.bma(att)[,1:3] @ \label{topmodcall}We see that the output also includes the posterior model probability for each model.\footnote{To access the PMP for any model, consider the function \texttt{pmpmodel} -- cf. \texttt{help(pmpmodel)} . } The best model, with 29\% posterior model probability,\footnote{The differentiation between \texttt{PMP (Exact)} and \texttt{PMP (MCMC)} is of importance if an MCMC sampler was used -- cf. section \ref{ssec:anavsmcmc} } is the one that only includes \verb+complaints+. However the second best model includes \verb+learning+ in addition and has a PMP of 16\%. Use the command \verb+beta.draws.bma(att)+ to obtain the actual (expected values of) posterior coefficient estimates for each of these models. In order to get a more comprehensive overview over the models, use the command <>= image(att) @ Here, blue color corresponds to a positive coefficient, red to a negative coefficient, and white to non-inclusion (a zero coefficient). On the horizontal axis it shows the best models, scaled by their PMPs. We see again that the best model with most mass only includes \verb+complaints+. Moreover we see that complaints is included in virtually all model mass, and unanimously with a positive coefficient. In contrast, \verb+raises+ is included very little, and its coefficient sign changes according to the model. (Use \verb+image(att,yprop2pip=T)+ for another illustrating variant of this chart.) \section{Model Size and Model Priors}\label{sec:mpriors} Invoking the command \verb+summary(att)+ yielded the important posterior statistic \verb+Mean no. regressors+, the posterior expected model size (i.e. the average number of included regressors), which in our case was $2.11$. Note that the posterior expected model size is equal to the sum of PIPs -- verify via <<>>= sum(coef(att)[,1]) @ This value contrasts with the prior expected model size implictely used in our model sampling: With $2^K$ possible variable combinations, a uniform model prior means a common prior model probability of $p(M_\gamma)=2^{-K}$. However, this implies a prior expected model size of $\sum_{k=0}^K{ {K \choose k} k 2^{-K}}=K/2$. Moreover, since there are more possible models of size 3 than e.g. of size 1 or 5, the uniform model prior puts more mass on intermediate model sizes -- e.g. expecting a model size of $k_\gamma=3$ with ${6 \choose 3} 2^{-K} = 31\%$ probability. In order to examine how far the posterior model size distribution matches up to this prior, type: <>= plotModelsize(att) @ We see that while the model prior implies a symmetric distribution around $K/2=3$, updating it with the data yields a posterior that puts more importance on parsimonious models. In order to illustrate the impact of the uniform model prior assumption, we might consider other popular model priors that allow more freedom in choosing prior expected model size and other factors. \subsection{Binomial Model Prior} The binomial model prior constitutes a simple and popular alternative to the uniform prior we just employed. It starts from the covariates' viewpoint, placing a common and fixed inclusion probability $\theta$ on each regressor. The prior probability of a model of size $k$ is therefore the product of inclusion and exclusion probabilities: $$ p(M_\gamma) = \theta^{k_\gamma} (1-\theta)^{K-k_\gamma} $$ Since expected model size is $\bar{m}= K \theta$, the researcher's prior choice reduces to eliciting a prior expected model size $\bar{m}$ (which defines $\theta$ via the relation $\theta=\bar{m}/K$). Choosing a prior model size of $K/2$ yields $\theta=\frac{1}{2}$ and thus exactly the uniform model prior $p(M_\gamma)=2^{-K}$. Therefore, putting prior model size at a value $<\frac{1}{2}$ tilts the prior distribution toward smaller model sizes and vice versa. For instance, let's impose this fixed inclusion probability prior such that prior model size equals $\bar{m}=2$: Here, the option \verb+user.int=T+ directly prints out the results as from \verb+coef+ and \verb+summary+.\footnote{The command \texttt{g="UIP"} was omitted here since \texttt{bms} sets this by default anyway.} <<>>= att_fixed = bms(attitude, mprior="fixed", mprior.size=2, user.int=T) @ As seen in \verb+Mean no. regressors+, the posterior model size is now $1.61$ which is somewhat smaller than with uniform model priors. Since posterior model size equals the sum of PIPs, many of them have also become smaller than under \verb+att+ But interestingly, the PIP of \verb+complaints+ has remained at near 100\%. \subsection{Custom Prior Inclusion Probabilities} In view of the pervasive impact of \verb+complaints+, one might wonder whether its importance would also remain robust to a greatly unfair prior. For instance, one could define a prior inclusion probability of only $\theta=0.01$ for the \verb+complaints+ while setting a 'standard' prior inclusion probability of $\theta=0.5$ for all other variables. Such a prior might be submitted to \verb+bms+ by assigning a vector of prior inclusion probabilities via its \verb+mprior.size+ argument:\footnote{This implies a prior model size of $\bar{m}= 0.01 + 5 \times 0.5 = 2.51$} <<>>= att_pip = bms(attitude, mprior="pip", mprior.size=c(.01,.5,.5,.5,.5,.5), user.int=F) @ But the results (obtained with \verb+coef(att_pip)+) show that \verb+complaints+ still retains its PIP of near 100\%. Instead, posterior model size decreases (as evidenced in a call to \newline\mbox{\texttt{plotModelsize(att\_pip)}}), and all other variables obtain a far smaller PIP. \subsection{Beta-Binomial Model Priors} Like the uniform prior, the fixed common $\theta$ in the binomial prior centers the mass of of its distribution near the prior model size. A look on the prior model distribution with the following command shows that the prior model size distribution is quite concentrated around its mode. <<>>= plotModelsize(att_fixed) @ This feature is sometimes criticized, in particular by \citet{ls08}: They note that to reflect prior uncertainty about model size, one should rather impose a prior that is less tight around prior expected model size. Therefore, \citet{ls08} propose to put a \emph{hyperprior} on the inclusion probability $\theta$, effectively drawing it from a Beta distribution. In terms of researcher input, this prior again only requires to choose the prior expected model size. However, the resulting prior distribution is considerably less tight and should thus reduce the risk of unintended consequences from imposing a particular prior model size.\footnote{Therefore, the beta-binomial model prior with random theta is implemented as the default choice in \texttt{bms}.} For example, take the beta-binomial prior with prior model size $K/2$\footnote{Note that the arguments here are actually the default values of \texttt{bms}, therefore this command is equivalent to \texttt{att\_random=bms(attitude)}.} -- and compare this to the results from \verb+att+ (which is equivalent to a fixed $\theta$ model prior of prior model size $K/2$.) <>= att_random = bms(attitude, mprior="random", mprior.size=3, user.int=F) plotModelsize(att_random) @ With the beta-binomial specification and prior model size $\bar{m}=K/2$, the model prior is completely flat over model sizes, while the posterior model size turns out to be $1.73$. In terms of coefficient and posterior model size distribution, the results are very similar to those of \verb+att_fixed+, even though the latter approach involved a tighter model prior. Concluding, a decrease of prior importance by the use of the beta-binomial framework supports the results found in \verb+att_fixed+. We can compare the PIPs from the four approaches presented so far with the following command:\footnote{This is equivalent to the command \texttt{plotComp(att, att\_fixed, att\_pip, att\_random)}} <>= plotComp(Uniform=att, Fixed=att_fixed, PIP=att_pip, Random=att_random) @ <>= plotComp(Uniform=att, Fixed=att_fixed, PIP=att_pip, Random=att_random, cex=2) @ Here as well, \verb+att_fixed+ (Fixed) and \verb+att_random+ (Random) display similar results with PIPs plainly smaller than those of \verb+att+ (Uniform). Note that the appendix contains an overview of the built-in model priors available in BMS. Moreover, BMS allows the user to define any custom model prior herself and straightforwardly use it in \texttt{bms} - for examples, check \mbox{\texttt{http://bms.zeugner.eu/custompriors.php}}. Another concept relating to model priors is to keep fixed regressors to be included in every sampled model: Section \ref{ssec:fixreg} provides some examples. \section{MCMC Samplers and More Variables}\label{sec:mcmc} \subsection{MCMC Samplers}\label{ssec:mcmc} With a small number of variables, it is straightforward to enumerate all potential variable combinations to obtain posterior results. For a larger number of covariates, this becomes more time intensive: enumerating all models for 25 covariates takes about 3 hours on a modern PC, and doing a bit more already becomes infeasible: With 50 covariates for instance, there are more than a quadrillion ($\approx 10^{15}$) potential models to consider. % In such a case, MCMC samplers gather results on the most important part of the posterior model distribution and thus approximate it as closely as possible. BMA mostly relies on the Metropolis-Hastings algorithm, which 'walks' through the model space as follows: At step i, the sampler stands at a certain 'current' model $M_i$ with PMP $p(M_i|y,X)$. In step $i+1$ a candidate model $M_j$ is proposed. The sampler switches from the current model to model $M_j$ with probability $p_{i,j}$: $$p_{i,j} = \min(1, p(M_j|y,X)/p(M_i|y,x) )$$ In case model $M_j$ is rejected, the sampler moves to the next step and proposes a new model $M_k$ against $M_i$. In case model $M_j$ is accepted, it becomes the current model and has to survive against further candidate models in the next step. In this manner, the number of times each model is kept will converge to the distribution of posterior model probabilities $p(M_i|y,X)$. In addition to enumerating all models, BMS implements two MCMC samplers that differ in the way they propose candidate models: \begin{itemize} \item \emph{Birth-death sampler} (\verb+bd+): This is the standard model sampler used in most BMA routines. One of the $K$ potential covariates is randomly chosen; if the chosen covariate forms already part of the current model $M_i$, then the candidate model $M_j$ will have the same set of covariates as $M_i$ but for the chosen variable ('dropping' a variable). If the chosen covariate is not contained in $M_i$, then the candidate model will contain all the variables from $M_i$ plus the chosen covariate ('adding' a variable). \item \emph{Reversible-jump sampler} (\verb+rev.jump+): Adapted to BMA by \citet{mad95} this sampler either draws a candidate by the birth-death method with 50\% probability. In the other case (chosen with 50\% probability) a 'swap' is proposed, i.e. the candidate model $M_j$ randomly drops one covariate with respect to $M_i$ and randomly adds one chosen at random from the potential covariates that were not included in model $M_i$. \item \emph{Enumeration} (\verb+enum+): Up to fourteen covariates, complete enumeration of all models is the default option: This means that instead of an approximation by means of the aforementioned MCMC sampling schemes \textit{all} possible models are evaluated. As enumeration becomes quite time-consuming or infeasible for many variables, the default option is \verb+mcmc="bd"+ in case of $K>14$, though enumeration can still be invoked with the command \verb+mcmc="enumerate"+. \end{itemize} The quality of an MCMC approximation to the actual posterior distribution depends on the number of draws the MCMC sampler runs through. In particular, the sampler has to start out from some model\footnote{\texttt{bms} has some simple algorithms implemented to choose 'good' starting models -- consult the option \texttt{start.value} under \texttt{help(bms)} for more information.} that might not be a 'good' one. Hence the first batch of iterations will typically not draw models with high PMPs as the sampler will only after a while converge to spheres of models with the largest marginal likelihoods. Therefore, this first set of iterations (the 'burn-ins') is to be omitted from the computation of results. In \verb+bms+, the argument \verb+burn+ specifies the number of burn-ins, and the argument \verb+iter+ the number of subsequent iterations to be retained. \subsection{An Example: Economic Growth}\label{ssec:fls} In one of the most prominent applications of BMA, \citet{fls:ccg} analyze the importance of 41 explanatory variables on long-term term economic growth in 72 countries by the means of BMA. The data set is built into BMS, a short description is available via \verb+help(datafls)+. They employ a uniform model prior and the birth-death MCMC sampler. Their $g$ prior is set to $g=\max(N,K^2)$, a mechanism such that PMPs asymptotically either behave like the Bayesian information criterion (with $g=N$) or the risk inflation criterion ($g=K^2$) -- in \verb+bms+ this prior is assigned via the argument \verb+g="BRIC"+. Moreover \citet{fls:ccg} employ more than 200 million number of iterations after a substantial number of burn-ins. Since this would take quite a time, the following example reenacts their setting with only 50,000 burn-ins and 100,000 draws and will take about 30 seconds on a modern PC: <<>>= data(datafls) fls1 = bms(datafls, burn=50000, iter=100000, g="BRIC", mprior="uniform", nmodel=2000, mcmc="bd", user.int=F) @ Before looking at the coefficients, check convergence by invoking the \verb+summary+ command:\label{sumfls1}\footnote{Since MCMC sampling chains are never completely equal, the results presented here might differ from what you get on your machine.} <<>>= summary(fls1) @ Under \verb+Corr PMP+, we find the correlation between iteration counts and analytical PMPs for the 2000 best models (the number 2000 was specified with the \verb+nmodel=2000+ argument). At \Sexpr{summary(fls1)["Corr PMP"]}, this correlation is far from perfect but already indicates a good degree of convergence. For a closer look at convergence between analytical and MCMC PMPs, compare the actual distribution of both concepts: <>= plotConv(fls1) @ The chart presents the best 2,000 models encountered ordered by their analytical PMP (the red line), and plots their MCMC iteration counts (the blue line). For an even closer look, one might just check the corresponding image for just the best 100 models with the following command:\footnote{With \texttt{bma} objects such as \texttt{fls1}, the indexing parentheses \texttt{[]} are used to select subsets of the (ranked) best models retained in the object. For instance, while \texttt{fls1} contains 2,000 models, \texttt{fls1[1:100]} only contains the 100 best models among them. Correspondingly, \texttt{fls1[37]} would only contain the 37th-best model. Cf. \texttt{help('[.bma')}} <>= plotConv(fls1[1:100]) @ \subsection{Analytical vs. MCMC likelihoods}\label{ssec:anavsmcmc} The example above already achieved a decent level of correlation among analytical likelihoods and iteration counts with a comparatively small number of sampling draws. In general, the more complicated the distribution of marginal likelihoods, the more difficulties the sampler will meet before converging to a good approximation of PMPs. The quality of approximation may be inferred from the number of times a model got drawn vs. their actual marginal likelihoods. Partly for this reason, \verb+bms+ retains a pre-specified number of models with the highest PMPs encountered during MCMC sampling, for which PMPs and draw counts are stored. Their respective distributions and their correlation indicate how well the sampler has converged. However, due to RAM limits, the sampling chain can hardly retain more than a few 100,000 of these models. Instead, it computes aggregate statistics on-the-fly, taking iteration counts as model weights. For model convergence and some posterior statistics \verb+bms+ retains only the 'top' (highest PMP) \verb+nmodel+ models it encounters during iteration. Since the time for updating the iteration counts for the 'top' models grows in line with their number, the sampler becomes considerably slower the more 'top' models are to be kept. Still, if they are sufficiently numerous, those best models can already cover most of posterior model mass - in this case it is feasible to base posterior statistics on analytical likelihoods instead of MCMC frequencies, just as in the enumeration case from section \ref{sec:example}. From \verb+bms+ results, the PMPs of 'top' models may be displayed with the command \verb+pmp.bma+. For instance, one could display the PMPs of the best five models for \verb+fls1+ as follows:\footnote{\texttt{pmp.bma} returns a matrix with two columns and one row for each model. Consequently \texttt{pmp.bma(fls1)[1:5,]} extracts the first five rows and all columns of this matrix.} <<>>= pmp.bma(fls1)[1:5,] @ The numbers in the left-hand column represent analytical PMPs (\texttt{PMP (Exact)}) while the right-hand side displays MCMC-based PMPs (\texttt{PMP (MCMC)}). Both decline in roughly the same fashion, however sometimes the values for analytical PMPs differ considerably from the MCMC-based ones. This comes from the fact that MCMC-based PMPs derive from the number of iteration counts, while the 'exact' PMPs are calculated from comparing the analytical likelihoods of the best models -- cf. equation (\ref{eq:bf}).\footnote{In the call to \texttt{topmodels.bma} on page \pageref{topmodcall}, the PMPs under 'MCMC' and analytical ('exact') concepts were equal since 1) enumeration bases both 'top' model calculation and aggregate on-the-fly results on analytical PMPs and 2) because all possible models were retained in the object \texttt{att}.} In order to see the importance of all 'top models' with respect to the full model space, we can thus sum up their MCMC-based PMPs as follows: <<>>= colSums(pmp.bma(fls1)) @ Both columns sum up to the same number and show that in total, the top 2,000 models account for ca. \Sexpr{round(colSums(pmp.bma(fls1))[[2]],2)*100}\% of posterior model mass.\footnote{Note that this share was already provided in column \texttt{\% Topmodels} resulting from the \texttt{summary} command on page \pageref{sumfls1}.} They should thus provide a rough approximation of posterior results that might or might not be better than the MCMC-based results. For this purpose, compare the best 5 covariates in terms of PIP by analytical and MCMC methods: \verb+coef(fls1)+ will display the results based on MCMC counts. <<>>= coef(fls1)[1:5,] @ In contrast, the results based on analytical PMPs will be invoked with the \verb+exact+ argument: <<>>= coef(fls1,exact=TRUE)[1:5,] @ The ordering of covariates in terms of PIP as well as the coefficients are roughly similar. However, the PIPs under \verb+exact = TRUE+ are somewhat larger than with MCMC results. Closer inspection will also show that the analytical results downgrade the PIPs of the worst variables with respect to MCMC-PIPs. This stems from the fact that analytical results do not take into account the many 'bad' models that include 'worse' covariates and are factored into MCMC results. Whether to prefer analytical or MCMC results is a matter of taste -- however the literature prefers coefficients the analytical way: \citet{fls:ccg}, for instance, retain 5,000 models and report results based on them. \subsection{Combining Sampling Chains} The MCMC samplers described in section \ref{ssec:mcmc} need to discard the first batch of draws (the burn-ins) since they start out from some peculiar start model and may reach the altitudes of 'high' PMPs only after many iterations. Here, choosing an appropriate start model may help to speed up convergence. By default \verb+bms+ selects its start model as follows: from the full model\footnote{actually, a model with randomly drawn $\min(K,N-3)$ variables}, all covariates with OLS t-statistics $>0.2$ are kept and included in the start model. Other start models may be assigned outright or chosen according to a similar mechanism (cf. argument \verb+start.value+ in \verb+help(bms)+). However, in order to improve the sampler's convergence to the PMP distribution, one might actually start from several different start models. This could by particularly helpful if the models with high PMPs are clustered in distant 'regions'. For instance, one could set up the \citet{fls:ccg} example above to get iteration chains from different starting values and combine them subsequently. Start e.g. a shorter chain from the null model (the model containing just an intercept), and use the 'reversible jump' MCMC sampler: <<>>= fls2= bms(datafls, burn=20000, iter=50000, g="BRIC", mprior="uniform", mcmc="rev.jump", start.value=0, user.int=F) summary(fls2) @ With \Sexpr{round(cor(pmp.bma(fls2))[2,1],2)}, the correlation between analytical and MCMC PMPs is a bit smaller than the \Sexpr{round(cor(pmp.bma(fls1))[2,1],2)} from the \verb+fls1+ example in section \ref{ssec:anavsmcmc}. However, the results of this sampling run may be combined to yield more iterations and thus a better representation of the PMP distribution. <<>>= fls_combi = c(fls1,fls2) summary(fls_combi) @ With \Sexpr{round(cor(pmp.bma(fls_combi))[2,1],2)}, the PMP correlation from the combined results is broadly better than either of its two constituent chains \verb+fls1+ and \verb+fls2+. Still, the PIPs and coefficients do not change much with respect to \verb+fls1+ -- as evidenced e.g. by \verb+plotComp(fls1, fls_combi, comp="Std Mean")+. \section{Alternative Formulations for Zellner's g Prior}\label{sec:gprior} \subsection{Alternative Fixed g-Priors} Virtually all BMA applications rely on the presented framework with Zellner's $g$ prior, and the bulk of them relies on specifying a fixed $g$. As mentioned in section \ref{ssec:zg}, the value of $g$ corresponds to the degree of prior uncertainty: A low $g$ renders the prior coefficient distribution tight around a zero mean, while a large $g$ implies large prior coefficient variance and thus decreases the importance of the coefficient prior. While some popular default elicitation mechanisms for the $g$ prior (we have seen UIP and BRIC) are quite popular, they are also subject to severe criticism. Some (e.g \citealt{fls:bmp}) advocate a comparatively large $g$ prior to minimize prior impact on the results, stay close to OLS coefficients, and represent the absolute lack of prior knowledge. Others (e.g. \citealt{cic08}) demonstrate that such a large $g$ may not be robust to noise innovations and risks over-fitting -- in particular if the the noise component plays a substantial role in the data. Again others \citep{eichi07} advocate intermediate fixed values for the $g$ priors or present alternative default specifications \citep{liang:mgp}.\footnote{Note however, that $g$ should in general be monotonously increasing in $N$: \citet{fls:bmp} prove that this sufficient for 'consistency', i.e. if there is one single linear model as in equation (\ref{eq:lm}), than its PMP asymptotically reaches 100\% as sample size $N \rightarrow \infty$.} In BMS, any fixed $g$-prior may be specified directly by submitting its value to the \verb+bms+ function argument \verb+g+. For instance, compare the results for the \citet{fls:ccg} setting when a more conservative prior such as $g=5$ is employed (and far too few iterations are performed): <<>>= fls_g5 = bms(datafls, burn=20000, iter=50000, g=5, mprior="uniform", user.int=F) coef(fls_g5)[1:5,] summary(fls_g5) @ The PIPs and coefficients for the best five covariates are comparable to the results from section \ref{ssec:fls} but considerably smaller, due to a tight shrinkage factor of $\frac{g}{1+g}=\frac{5}{6}$ (cf. section \ref{ssec:zg}). More important, the posterior expected model size \Sexpr{round(sum(coef(fls_g5)[,1]),1)} exceeds that of \verb+fls_combi+ by a large amount. This stems from the less severe size penalty imposed by eliciting a small $g$. Finally, with \Sexpr{round(cor(pmp.bma(fls_g5))[2,1],2)}, the correlation between analytical and MCMC PMPs means that the MCMC sampler has not at all converged yet. \citet{fz:superM} show that the smaller the $g$ prior, the less concentrated is the PMP distribution, and therefore the harder it is for the MCMC sampler to provide a reasonable approximation to the actual PMP distribution. Hence the above command should actually be run with many more iterations in order to achieve meaningful results. \subsection{Model-specific g-Priors} Eliciting a fixed $g$-prior common to all models can be fraught with difficulties and unintended consequences. Several authors have therefore proposed to rely on model-specific priors (cf. \citealt{liang:mgp} for an overview), of which the following allow for closed-form solutions and are implemented in BMS: \begin{itemize} \item Empirical Bayes $g$ -- local (\verb+EBL+): $g_\gamma=arg max_g \; p(y|M_\gamma,X,g)$. Authors such as \citet{george00} or \citet{hansen01} advocate an 'Empirical Bayes' approach by using information contained in the data $(y,X)$ to elicit $g$ via maximum likelihood. This amounts to setting $g_\gamma=\max(0,F^{OLS}_\gamma-1)$ where $F^{OLS}_\gamma$ is the standard OLS F-statistic for model $M_\gamma$. Apart from obvious advantages discussed below, the \verb+EBL+ prior is not so popular since it involves 'peeking' at the data in prior formulation. Moreover, asymptotic 'consistency' of BMA is not guaranteed in this case. \item Hyper-$g$ prior (\verb+hyper+): \citet{liang:mgp} propose putting a hyper-prior $g$; In order to arrive at closed-form solutions, they suggest a Beta prior on the shrinkage factor of the form $\frac{g}{1+g} \sim Beta \left(1, \frac{a}{2}-1 \right)$, where $a$ is a parameter in the range $2 < a \leq 4$. Then, the prior expected value of the shrinkage factor is $E(\frac{g}{1+g})=\frac{2}{a}$. Moreover, setting $a=4$ corresponds to uniform prior distribution of $\frac{g}{1+g}$ over the interval $[0,1]$, while $a \rightarrow 2$ concentrates prior mass very close to unity (thus corresponding to $g\rightarrow \infty$). (\verb+bms+ allows to set $a$ via the argument \verb+g="hyper=x"+, where \verb+x+ denotes the $a$ parameter.) The virtue of the hyper-prior is that it allows for prior assumptions about $g$, but relies on Bayesian updating to adjust it. This limits the risk of unintended consequences on the posterior results, while retaining the theoretical advantages of a fixed $g$. Therefore \citet{fz:superM} prefer the use of hyper-$g$ over other available $g$-prior frameworks. \end{itemize} Both model-specific $g$ priors adapt to the data: The better the signal-to-noise ratio, the closer the (expected) posterior shrinkage factor will be to one, and vice versa. Therefore average statistics on the shrinkage factor offer the interpretation as a 'goodness-of-fit' indicator (\citet{fz:superM} show that both EBL and hyper-$g$ can be interpreted in terms of the OLS F-statistic). Consider, for instance, the \citet{fls:ccg} example under an Empirical Bayes prior: <<>>= fls_ebl = bms(datafls, burn=20000, iter=50000, g="EBL", mprior="uniform", nmodel=1000, user.int=F) summary(fls_ebl) @ The result \verb+Shrinkage-Stats+ reports a posterior average EBL shrinkage factor of \Sexpr{round(as.numeric(strsplit(summary(fls_ebl)[13],"=")[[1]][[2]]),3)}, which corresponds to a shrinkage factor $\frac{g}{1+g}$ under $g\approx $ \Sexpr{round(1/(1-as.numeric(strsplit(summary(fls_ebl)[13],"=")[[1]][[2]]))-1,-0)}. Consequently, posterior model size is considerably larger than under \verb+fls_combi+, and the sampler has had a harder time to converge, as evidenced in a quite low \verb+Corr PMP+. Both conclusions can also be drawn from performing the \verb+plot(fls_ebl)+ command that combines the \verb+plotModelsize+ and \verb+plotConv+ functions: <>= plot(fls_ebl) @ The upper chart shows that posterior model size distribution remains very close to the model prior; The lower part displays the discord between iteration count frequencies and analytical PMPs. The above results show that using a flexible and model-specific prior on \citet{fls:ccg} data results in rather small posterior estimates of $\frac{g}{1+g}$, thus indicating that the \verb+g="BRIC"+ prior used in \verb+fls_combi+ may be set too far from zero. This interacts with the uniform model prior to concentrate posterior model mass on quite large models. However, imposing a uniform model prior means to expect a model size of $K/2=20.5$, which may seem overblown. Instead, try to impose smaller model size through a corresponding model prior -- e.g. impose a prior model size of 7 as in \citet{bace04}. This can be combined with a hyper-$g$ prior, where the argument \verb+g="hyper=UIP"+ imposes an $a$ parameter such that the prior expected value of $g$ corresponds to the unit information prior ($g=N$).\footnote{This is the default hyper-g prior and may therefore be as well obtained with \texttt{g=\textquotedbl hyper \textquotedbl}. } <<>>= fls_hyper = bms(datafls, burn=20000, iter=50000, g="hyper=UIP", mprior="random", mprior.size=7, nmodel=1000, user.int=F) summary(fls_hyper) @ From \verb+Shrinkage-Stats+, posterior expected shrinkage is \Sexpr{round(fls_hyper$gprior.info$shrinkage.moments[[1]],3) }, with rather tight standard deviation bounds. Similar to the EBL case before, the data thus indicates that shrinkage should be rather small (corresponding to a fixed g of $g \approx$ \Sexpr{round(1/(1-as.numeric(fls_hyper$gprior.info$shrinkage.moments[[1]]))-1,-0)}) and not vary too much from its expected value. Since the hyper-g prior induces a proper posterior distribution for the shrinkage factor, it might be helpful to plot its density with the command below. The chart confirms that posterior shrinkage is tightly concentrated above \Sexpr{ round(fls_hyper$gprior.info$shrinkage.moments[[1]]-as.numeric(strsplit(summary(fls_hyper)[13],"=")[[1]][[3]]),2)}. <>= gdensity(fls_hyper) @ While the hyper-g prior had an effect similar to the EBL case \verb+fls_ebl+, the model prior now employed leaves the data more leeway to adjust posterior model size. The results depart from the expected prior model size and point to an intermediate size of ca. \Sexpr{round(sum(estimates.bma(fls_hyper)[,1]),0)}. The focus on smaller models is evidenced by charting the best 1,000 models with the \verb+image+ command: <>= image(fls_hyper) @ In a broad sense, the coefficient results correspond to those of \verb+fls_combi+, at least in expected values. However, the results from \verb+fls_hyper+ were obtained under more sophisticated priors that were specifically designed to avoid unintended influence from prior parameters: By construction, the large shrinkage factor under \verb+fls_combi+ induced a quite small posterior model size of \Sexpr{round(as.numeric(summary(fls_combi)[[1]]),1)} and concentrated posterior mass tightly on the best models encountered (they make up \Sexpr{round(as.numeric(summary(fls_combi)[[8]]),0)}\% of the entire model mass). In contrast, the hyper-g prior employed for \verb+fls_hyper+ indicated a rather low posterior shrinkage factor and consequently resulted in higher posterior model size (\Sexpr{round(as.numeric(summary(fls_hyper)[[1]]),1)}) and less model mass concentration (\Sexpr{round(as.numeric(summary(fls_hyper)[[8]]),0)}\%). \subsection{Posterior Coefficient Densities} In order to compare more than just coefficient expected values, it is advisable to consult the entire posterior distribution of coefficients. For instance, consult the posterior density of the coefficient for \verb+Muslim+, a variable with a PIP of \Sexpr{round(estimates.bma(fls_combi)["Muslim",1],3)*100}\%: The \verb+density+ method produces marginal densities of posterior coefficient distributions and plots them, where the argument \verb+reg+ specifies the variable to be analyzed. <>= density(fls_combi,reg="Muslim") @ We see that the coefficient is neatly above zero, but somewhat skewed. The integral of this density will add up to \Sexpr{round(estimates.bma(fls_combi, exact=T)["Muslim",1],3)}, conforming to the analytical PIP of \verb+Muslim+. The vertical bars correspond to the analytical coefficient conditional on inclusion from \verb+fls_combi+ as in <<>>= coef(fls_combi,exact=T,condi.coef=T)["Muslim",] @ Note that the posterior marginal density is actually a model-weighted mixture of posterior densities for each model and can this be calculated only for the top models contained in \verb+fls_combi+ (here \Sexpr{length(fls_combi[["topmod"]][["lik"]]())}). Now let us compare this density with the results under the hyper-$g$ prior:\footnote{Since for the hyper-$g$ prior, the marginal posterior coefficient distribution derive from quite complicated expressions, executing this command could take a few seconds.} <>= dmuslim=density(fls_hyper,reg="Muslim",addons="Eebl") @ Here, the \verb+addons+ argument assigns the vertical bars to be drawn: the expected conditional coefficient from MCMC (\verb+E+) results should be indicated in contrast to the expected coefficient based on analytical PMPs (\verb+e+). In addition the expected coefficients under the individual models are plotted (\verb+b+) and a legend is included (\verb+l+). The density seems more symmetric than before and the analytical results seem to be only just smaller than what could be expected from MCMC results. Nonetheless, even though \verb+fls_hyper+ and \verb+fls_combi+ applied very different $g$ and model priors, the results for the \verb+Muslim+ covariate are broadly similar: It is unanimously positive, with a conditional expected value somewhat above $0.01$. In fact 95\% of the posterior coefficient mass seems to be concentrated between \Sexpr{round(quantile.coef.density(dmuslim,.025),3)} and \Sexpr{round(quantile.coef.density(dmuslim,.975),3)}: <<>>= quantile(dmuslim, c(0.025, 0.975)) @ \section{Predictive Densities} Of course, BMA lends itself not only to inference, but also to prediction. The employed 'Bayesian Regression' models naturally give rise to predictive densities, whose mixture yields the BMA predictive density -- a procedure very similar to the coefficient densities explored in the previous section. Let us, for instance, use the information from the first 70 countries contained in \texttt{datafls} to forecast economic growth for the latter two, namely Zambia (identifier \texttt{ZM}) and Zimbabwe (identifier \texttt{ZW}). We then can use the function \texttt{pred.density} on the BMA object \texttt{fcstbma} to form predictions based on the explanatory variables for Zambia and Zimbabwe (which are in \verb+datafls[71:72,]+). <<>>= fcstbma= bms(datafls[1:70,], mprior="uniform", burn=20000, iter=50000, user.int=FALSE) pdens = pred.density(fcstbma, newdata=datafls[71:72,]) @ The resulting object \texttt{pdens} holds the distribution of the forecast for the two countries, conditional on what we know from other countries, and the explanatory data from Zambia and Zimbabwe. The expected value of this growth forecast is very similar to the classical point forecast and can be accessed with \verb+pdens$fit+.\footnote{Note that this is equivalent to \texttt{predict(fcstbma, datafls[71:72, ])} .} Likewise the standard deviations of the predictive distribution correspond to classical standard errors and are returned by \verb+pdens$std.err+. But the predictive density for the growth in e.g. Zimbabwe might be as well visualized with the following command:\footnote{Here, 2 means to plot for the second forecasted observation, in this case \texttt{ZW}, the 72-th row of \texttt{datafls}.} <>= plot(pdens, 2) @ Here, we see that conditional on Zimbabwe's explanatory data, we expect growth to be concentrated around \Sexpr{round(pdens[['fit']][2],2)}. And the actual value in \verb+datafls[72,1]+ with $0.0046$ is not too far off from that prediction. A closer look at both our densities with the function \texttt{quantile} shows that for Zimbabwe, any growth rate between \Sexpr{ round(quantile(pdens,c(.05,.95))[2,1], 2) } and \Sexpr{ round(quantile(pdens,c(.05,.95))[2,2], 2) } is quite likely. <<>>= quantile(pdens, c(0.05, 0.95)) @ For Zambia (\texttt{ZM}), though, the explanatory variables suggest that positive economic growth should be expected. But over our evaluation period, Zambian growth has been even worse than in Zimbabwe (with \Sexpr{ round(datafls[71,1], 2) } as from \verb+datafls["ZM",1]+).\footnote{Note that since \texttt{ZM} is the rowname of the 71-st row of \texttt{datafls}, this is equivalent to calling \texttt{datafls[71, ]}.} Under the predictive density for Zambia, this actual outcome seems quite unlikely. To compare the BMA prediction performs with actual outcomes, we could look e.g. at the forecast error \verb+pdens$fit - datafls[71:72,1]+. However it would be better to take standard errors into account, and even better follow the 'Bayesian way' and evaluate the predictive density of the outcomes as follows: <<>>= pdens$dyf(datafls[71:72,1]) @ The density for Zimbabwe is quite high (similar to the mode of predictive density as seen in the chart above), whereas the one for Zambia is quite low. In order to visualize how bad the forecast for Zambia was, compare a plot of predictive density to the actual outcome, which is situated far to the left. <>= plot(pdens, "ZM", realized.y=datafls["ZM",1]) @ The results for Zambia suggest either that it is an outlier or that our forecast model might not perform that well. One could try out other prior settings or data, and compare the differing models in their joint predictions for Zambia and Zimbabwe (or even more countries). A standard approach to evaluate the goodness of forecasts would be to e.g. look at root mean squared errors. However Bayesians (as e.g \citealt{fls:bmp}) often prefer to look at densities of the outcome variables and combine them in a 'log-predictive score' (LPS). It is defined as follows, where $p(y^f_i | X, y, X^f_i)$ denotes predictive density for $y^f_i$ (Zambian growth) based on the model information $(y, X)$ (the first 70 countries) and the explanatory variables for the forecast observation (Zambian investment, schooling, etc.). $$ - \sum_i \log(p(y^f_i | X, y, X^f_i)) $$ The log-predictive score can be accessed with \verb+lps.bma+. <<>>= lps.bma(pdens, datafls[71:72,1]) @ Note however, that the LPS is only meaningful when comparing different forecast settings. \addcontentsline{toc}{section}{References} \bibliography{bmasmall} %\bibliography{C:/Programme/LatexLibs/bma} \bibliographystyle{apalike} \clearpage \appendix \section{Appendix} \subsection{Available Model Priors -- Synopsis}\label{ssec:mpriorsyn} The following provides an overview over the model priors available in \verb+bms+. Default is \verb+mprior="random"+. For details and examples on built-in priors, consult \verb+help(bms)+. For defining different, custom $g$-priors, consult \verb+help(gprior)+ or \texttt{http://bms.zeugner.eu/custompriors.php}. \subsubsection*{Uniform Model Prior} \begin{itemize} \item \emph{Argument}: \verb+mprior="uniform"+ \item \emph{Parameter}: none \item \emph{Concept}: $p(M_\gamma) \propto 1$ \item \emph{Reference}: none \end{itemize} \subsubsection*{Binomial Model Prior} \begin{itemize} \item \emph{Argument}: \verb+mprior="fixed"+ \item \emph{Parameter} (\verb+mprior.size+): prior model size $\bar{m}$ (scalar); Default is $\bar{m}=K/2$ \item \emph{Concept}: $p(M_\gamma) \propto \left(\frac{\bar{m}}{K}\right)^{k_\gamma} \left(1-\frac{\bar{m}}{K}\right)^{K-k_\gamma}$ \item \emph{Reference}: \citet{bace04} \end{itemize} \subsubsection*{Beta-Binomial Model Prior} \begin{itemize} \item \emph{Argument}: \verb+mprior="random"+ \item \emph{Parameter} (\verb+mprior.size+): prior model size $\bar{m}$ (scalar) \item \emph{Concept}: $p(M_\gamma) \propto \Gamma(1+k_\gamma) \Gamma( \frac{K-m}{m} + K-k_\gamma)$; Default is $\bar{m}=K/2$ \item \emph{Reference}: \citet{ls08} \end{itemize} \subsubsection*{Custom Prior Inclusion Probabilities} \begin{itemize} \item \emph{Argument}: \verb+mprior="pip"+ \item \emph{Parameter} (\verb+mprior.size+): A vector of size $K$, detailing $K$ prior inclusion probabilities $\pi_i$: $0<\pi<1 \; \forall i$ \item \emph{Concept}: $p(M_\gamma) \propto \prod_{i \in \gamma} \pi_i \; \prod_{j \notin \gamma} (1-\pi_j) $ \item \emph{Reference}: none \end{itemize} \subsubsection*{Custom Model Size Prior} \begin{itemize} \item \emph{Argument}: \verb+mprior="customk"+ \item \emph{Parameter} (\verb+mprior.size+): A vector of size $K+1$, detailing prior $\theta_j$ for 0 to K size models: any real >0 admissible \item \emph{Concept}: $p(M_\gamma) \propto \theta_{k_\gamma}$ \item \emph{Reference}: none \end{itemize} \subsection{Available g-Priors -- Synopsis} The following provides an overview over the $g$-priors available in \verb+bms+. Default is \verb+g="UIP"+. For implementation details and examples, consult \verb+help(bms)+. For defining different, custom $g$-priors, consult \verb+help(gprior)+ or \texttt{http://bms.zeugner.eu/custompriors.php}. \subsubsection*{Fixed $g$} \begin{itemize} \item \emph{Argument}: \verb+g=x+ where \verb+x+ is a positive real scalar; \item \emph{Concept}: Fixed $g$ common to all models \item \emph{Reference}: \citet{fls:bmp} \item \emph{Sub-options}: Unit information prior \verb+g="UIP"+ sets $g=N$; \verb+g="BRIC"+ sets $g=\max(N,K^2)$, a combination of BIC and RIC. (Note these two options guarantee asymptotic consistency.) Other options include \verb+g="RIC"+ for $g=K^2$ and \verb+g="HQ"'+ for the Hannan-Quinn setting $g=\log(N)^3$. \end{itemize} \subsubsection*{Empirical Bayes (Local) $g$} \begin{itemize} \item \emph{Argument}: \verb+g="EBL"+ \item \emph{Concept}: Model-specific $g_\gamma$ estimated via maximum likelihood: amounts to $g_\gamma=\max(0,F_\gamma-1)$, where $F_\gamma \equiv \frac{R^2_\gamma (N-1-k_\gamma)}{(1-R^2_\gamma) k_\gamma}$ and $R^2_\gamma$ is the OLS R-squared of model $M_\gamma$. \item \emph{Reference}: \citet{george00}; \citet{liang:mgp} \item \emph{Sub-options}: none \end{itemize} \subsubsection*{Hyper-$g$ prior} \begin{itemize} \item \emph{Argument}: \verb+g="hyper"+ \item \emph{Concept}: A Beta prior on the shrinkage factor with $p(\frac{g}{1+g}) = B(1,\frac{a}{2}-1)$. Parameter $a$ ($2 < a \leq 4$) represents prior beliefs: $a=4$ implies prior shrinkage to be uniformly distributed over $[0,1]$, $a \rightarrow 2$ concentrates mass close to unity. Note that prior expected value of the shrinkage facor is $E(\frac{g}{1+g}) = \frac{2}{a}$. \item \emph{Reference}: \citet{liang:mgp}; \citet{fz:superM} \item \emph{Sub-options}: \verb+g="hyper=x"+ with \verb+x+ defining the parameter $a$ (e.g. \verb+g="hyper=3"+ sets $a=3$). \verb+g="hyper"+ resp. \verb+g="hyper=UIP"+ sets the prior expected shrinkage factor equivalent to the UIP prior $E(\frac{g}{1+g})=\frac{N}{1+N}$; \verb+g="hyper=BRIC"+ sets the prior expected shrinkage factor equivalent to the BRIC prior. Note that the latter two options guarantee asymptotic consistency. \end{itemize} \subsection{'Bayesian Regression' with Zellner's $g$ -- Bayesian Model Selection}\label{ssec:zlm} The linear model presented in section \ref{ssec:zg} using Zellner's $g$ prior is implemented under the function \verb+zlm+. For instance, we might consider the attitude data from section \ref{sec:example} and estimate just the full model containing all 6 variables. For this purpose, first load the built-in data set with the command <<>>= data(attitude) @ The full model is obtained by applying the function \texttt{zlm} on the data set and storing the estimation into \texttt{att\_full}. Zellner's $g$ prior is estimated by the argument \texttt{g} just in the same way as in section \ref{sec:gprior}.\footnote{Likewise, most methods applicable to \texttt{bms}, such as \texttt{density}, \texttt{predict} or \texttt{coef}, work analogously for \texttt{zlm}.} <<>>= att_full = zlm(attitude,g="UIP") @ The results can then be displayed by using e.g. the \verb+summary+ method. <<>>= summary(att_full) @ The results are very similar to those resulting from OLS (which can be obtained via \verb+summary(lm(attitude))+). The less conservative, i.e. the larger $g$ becomes, the closer the results get to OLS. But remember that the full model was not the best model from the BMA application in section \ref{sec:example}. In order to extract the best encountered model, use the function \verb+as.zlm+ to extract this single model for further analysis (with the argument \verb+model+ specifying the rank-order of the model to be extracted). The following command reads the best model from the BMA results in section into the variable \verb+att_best+. <<>>= att_best = as.zlm(att,model=1) summary(att_best) @ As suspected, the best model according to BMA is the on including only \verb+complaints+ and the intercept, as it has the highest log-marginal likelihood (\verb+logLik(att_best)+). In such a way, the command \texttt{as.zlm} can be combined with \texttt{bms} for 'Bayesian Model Selection', i.e. using the model prior and posterior framework to focus on teh model with highest posterior mass. Via the utility \texttt{model.frame}, this best model can be straightforwardly converted into a standard OLS model: <<>>= att_bestlm = lm(model.frame(as.zlm(att))) summary(att_bestlm) @ \subsection{BMA when Keeping a Fixed Set of Regressors}\label{ssec:fixreg} While BMA should usually compare as many models as possible, some considerations might dictate the restriction to a subspace of the $2^K$ models. For complicated settings one might employ a customly designed model prior (cf. section \ref{ssec:mpriorsyn}). The by far most common setting, though, is to keep some regressors fixed in the model setting, and apply Bayesian Model uncertainty only to a subset of regressors. Suppose, for instance, that prior research tells us that any meaningful model for \texttt{attitude} (as in section \ref{sec:example}) must include the variables \texttt{complaints} and \texttt{learning}. The only question is whether the additional four variables matter (which reduces the potential model space to $2^4=16$). We thus sample over these models while keeping \texttt{complaints} and \texttt{learning} as fixed regressors: <<>>= att_learn = bms(attitude,mprior="uniform", fixed.reg=c("complaints", "learning") ) @ The results show that the PIP and the coefficients for the remaining variables increase a bit compared to \texttt{att}. The higher PIPs are related to the fact that the posterior model size (as in \verb+sum(coef(att_learn)[,1])+) is quite larger as under \texttt{att}. This follows naturally from our model prior: putting a uniform prior on all models between parameter size $2$ (the base model) and $6$ (the full model) implies a prior expected model size of $4$ for \texttt{att\_learn} instead of the $3$ for \texttt{att}.\footnote{ The command \texttt{ att\_learn2 = bms(attitude, mprior='fixed', mprior.size=3, fixed.reg=c('complaints', 'learning') ) } produces coefficients that are much more similar to \texttt{att}.} So to achieve comparable results, one needs to take the number of fixed regressors into account when setting the model prior parameter \texttt{mprior.size}. Consider another example: Suppose we would like to sample the importance and coefficients for the cultural dummies in the dataset \texttt{datafls}, conditional on information from the remaining 'hard' variables. This implies keeping 27 fixed regressors, while sampling over the 14 cultural dummies. Since model uncertainty thus applies only to $2^{14}=16,384$ models, we resort to full enumeration of the model space. <<>>= fls_culture = bms(datafls,fixed.reg=c(1,8:16,24,26:41), mprior="random", mprior.size=28, mcmc="enumeration", user.int=F) @ Here, the vector \texttt{c(1,8:16,24,26:41)} denotes the indices of the regressors in \texttt{datafls} to be kept fixed.\footnote{Here, indices start from the first regressor, i.e. they do not take the dependent variable into account. The fixed data used above therefore corresponds to \texttt{datafls[ ,c(1,8:16,24,26:41) $+$ 1]}.} Moreover, we use the beta-binomial ('random') model prior. The prior model size of $30$ embodies our prior expectation that on average $1$ out of the $14$ cultural dummies should be included in the true model. As we only care about those 14 variables, let us just display the results for the 14 variables with the least PIP: <<>>= coef(fls_culture)[28:41, ] @ As before, we find that \texttt{Confucian} (with positive sign) as well as \texttt{Hindu} and \texttt{SubSahara} (negative signs) have the most important impact conditional on 'hard' information. Moreover, the data seems to attribute more importance to cultural dummies as we expectd with our model prior: Comparing prior and posterior model size with the following command shows how much importance is attributed to the dummies. <>= plotModelsize(fls_culture, ksubset=27:41) @ Expected posterior model size is close to \Sexpr{ round(sum(coef(fls_culture)[,1]),0) }, which means that \Sexpr{ round(sum(coef(fls_culture)[,1]),0) -27 } of the cultural dummies should actually be included in a 'true' model. \end{document}BMS/inst/doc/bmasmall.bib0000644000175100001440000000657612624725513014726 0ustar hornikusers@ARTICLE{Hoetingetal99, author = {Hoeting, Jennifer A. and Madigan, David and Raftery, Adrian E and Volinsky,Chris T.}, title = {{Bayesian Model Averaging: A Tutorial}}, journal = {Statistical Science}, year = {1999}, volume = {14, No. 4}, pages = {382-417} } @ARTICLE{ls08, author = {Ley, Eduardo and Steel, Mark F.J}, title = {{On the Effect of Prior Assumptions in Bayesian Model Averaging with Applications to Growth Regressions}}, journal = {Journal of Applied Econometrics}, year = {2009}, volume = {24:4}, pages = {651-674} } @ARTICLE{mad95, author = {Madigan, D. and York, J.}, title = {{Bayesian graphical models for discrete data}}, journal = {International Statistical Review}, year = {1995}, volume = {63.}, pages = {215-232}, timestamp = {2010.01.12} } @ARTICLE{fls:ccg, author = {{Fern{\'a}ndez}, Carmen and Ley, Eduardo and Steel, Mark F.J.}, title = {{Model Uncertainty in Cross-Country Growth Regressions}}, journal = {Journal of Applied Econometrics}, year = {2001}, volume = {16}, pages = {563-576}, timestamp = {2009.03.01} } @ARTICLE{fls:bmp, author = {{Fern{\'a}ndez}, Carmen and Ley, Eduardo and Steel, Mark F.J.}, title = {{Benchmark Priors for Bayesian Model Averaging}}, journal = {Journal of Econometrics}, year = {2001}, volume = {100}, pages = {381-427} } @ARTICLE{cic08, author = {Ciccone, Antonio and Jaroci\'{n}ski, Marek}, title = {{Determinants of Economic Growth: Will Data Tell?}}, journal = {American Economic Journal: Macroeconomics}, year = {2010}, volume = {forthcoming} } @ARTICLE{eichi07, author = {Eicher, T. and Papageorgiou, C. and Raftery, A.E.}, title = {{Determining growth determinants: default priors and predictive performance in Bayesian model averaging}}, journal = {Journal of Applied Econometrics, forthcoming}, year = {2009} } @ARTICLE{liang:mgp, author = {Liang, Feng and Paulo, Rui and Molina, German and Clyde, Merlise A. and Berger, Jim O.}, title = {{Mixtures of g Priors for Bayesian Variable Selection}}, journal = {Journal of the American Statistical Association}, year = {2008}, volume = {103}, pages = {410-423} } @ARTICLE{fz:superM, author = {Feldkircher, Martin and Zeugner, Stefan}, title = {{Benchmark Priors Revisited: On Adaptive Shrinkage and the Supermodel Effect in Bayesian Model Averaging}}, journal = {IMF Working Paper}, year = {2009}, volume = {WP/09/202}, timestamp = {2009.09.13} } @ARTICLE{george00, author = {George, E.I. and Foster, D.P.}, title = {{Calibration and empirical Bayes variable selection}}, journal = {Biometrika}, year = {2000}, volume = {87}, pages = {731--747}, number = {4}, publisher = {Biometrika Trust} } @ARTICLE{hansen01, author = {Hansen, M.H. and Yu, B.}, title = {{Model selection and the principle of minimum description length}}, journal = {Journal of the American Statistical Association}, year = {2001}, volume = {96}, pages = {746--774}, number = {454}, publisher = {ASA} } @ARTICLE{bace04, author = {{Sala-i-Martin}, Xavier and Doppelhofer, Gernot and Miller, Ronald I.}, title = {{Determinants of Long-Term Growth: A Bayesian Averaging of Classical Estimates (BACE) Approach}}, journal = {American Economic Review}, year = {2004}, volume = {94}, pages = {813-835} } BMS/NAMESPACE0000644000175100001440000000270412624725513012142 0ustar hornikusersimport( "methods", "stats" ) importFrom("graphics", "abline", "axis", "grid", "layout", "legend", "lines", "mtext", "par", "plot", "points", "rect", "strwidth", "title" ) export( "as.zlm", "beta.draws.bma", "bin2hex", "bms", "combine_chains", "estimates.bma", "f21hyper", "fullmodel.ssq", "gdensity", "hex2bin", "info.bma", "is.bma", "is.topmod", "lps.bma", "plotComp", "plotConv", "plotModelsize", "pmp.bma", "pmpmodel", "post.pr2", "post.var", "pred.density", "topmod", "topmodels.bma", "zlm", "quantile.pred.density", "quantile.coef.density", "quantile.density" ) S3method("[", "bma") S3method("c", "bma") S3method("coef", "bma") S3method("density", "bma") S3method("deviance", "bma") S3method("image", "bma") S3method("model.frame", "bma") S3method("plot", "bma") S3method("predict", "bma") S3method("print", "bma") S3method("summary", "bma") S3method("variable.names", "bma") S3method("density", "zlm") S3method("deviance", "zlm") S3method("logLik", "zlm") S3method("predict", "zlm") S3method("summary", "zlm") S3method("variable.names", "zlm") S3method("vcov", "zlm") S3method("[", "topmod") S3method("print", "topmod") S3method("plot", "pred.density") S3method("print", "pred.density") S3method("quantile", "pred.density") S3method("quantile", "coef.density") S3method("quantile", "density") BMS/demo/0000755000175100001440000000000012624725513011644 5ustar hornikusersBMS/demo/BMS.growth.R0000644000175100001440000000442012624725513013721 0ustar hornikusers data(datafls) #now do an MC3 sampling over the growth data 'datfls' with 1000 burn-ins, #9000 iterations (ex burn-ins), #and retaining the best 100 models (besides overall MC3 frequencies) invisible(readline("hit to do estimate a short BMA MC3 sampling chain.")) mfls =bms(X.data=datafls,burn=1000,iter=9000,nmodel=100,user.int=T) #The console printout shows some information on the resulting bma object 'mfls'. #The chart details the prior and posterior model size (above), and the likelihoodos and MCMC frequencies of the best 100 models (below). #Setting user.int=FALSE suppresses his kind of output.\n\n ") invisible(readline("Hit for some low-level functions.")) # some results: summary(mfls) # summary.bma() shows basic aggregate results from MC3 sampling invisible(readline("Hit for functions on the coefficients.")) coef(mfls) #based on MCMC frequencies, coef.bma shows # the posterior inclusion probabilities (column 1), # the unconditional expecteded value of coefficients (column 2), # their standard deviations (column 3), # the percentage of times the coefficents had a positive sign # (conditional on inclusion, column 4) invisible(readline("Hit for a different version.")) coef(mfls,exact=T,std.coefs=T) #this is similar to coef.bma(), # however here the numbers are based on the exact marginal # likelihoods of the best (100) models drawn. # Moreover the coefficents are shown in standardized form. invisible(readline("Hit for other low-level commands.")) pmp.bma(mfls) #post. model probs. for top 100 models based on MCMC freqs and likelihoods beta.draws.bma(mfls[1:3]) # show the estimates for the best 3 models # the column names are the inclusion vectors in hex-code # (e.g. 101 for inclusion of variables 1 and 3 is "5" in hexciode ) mfls[3]$topmod #show the third-best model invisible(readline("Hit for some plots ")) invisible(par(ask=TRUE)) density(mfls,reg="BlMktPm") #plot density for regressor "BlMktPm" image(mfls[1:20],FALSE) #plot signs (pos=blue, neg=red, not included=white) for best 20 models plotModelsize(mfls,exact=TRUE) #plot prior and posterioro model size based on exact likelhoods # of best (100) models plot(mfls) #a combined plot invisible(par(ask=FALSE))BMS/demo/00Index0000644000175100001440000000007112624725513012774 0ustar hornikusersBMS.growth Interactive demo: basic BMA applications BMS/NEWS0000644000175100001440000001040412624725513011416 0ustar hornikusers############################################################### Version 0.3.4 (build 2015-11-13) Maintenance release to fix standard changes regarding S3 and S4 methods in R version 3 Two arguments added to function bms: * data: function bms is now fully compatible with the formula and data arguments familar from function ' lm'. see #' attitude' example in help(bms) * randomizeTimer: for geeks, the call to set.seed can be turned off in order to replicate MCMC runs ############################################################### Version 0.3.2 (build 2013-11-17) Maintenance release to cope with changes in R version 3 compared to version 2 ############################################################### Version 0.3.1 (build 2012-08-28) Maintenance release to fix inconsistencies in package version 0.3.0 (Warnings in package checks) under new R versions >=2.14 ############################################################### Version 0.3.0 (build 2011-05-04) (changes compared to version 0.2.5) * USER-VISIBLE CHANGES TO EXISTING FUNCTIONS: ------------------------ * Changed behavior of pmp.bma (see help(pmp.bma)) * NEW FEATURES: ------------------------ * bms now can hold a set of fixed regressors (argument fixed.reg) * New functions pred.density, plot.pred.density, print.pred.density, predict.bma, predict.zlm * New functions quantile.density, quantile.pred.density, quantile.coef.density * New function pmpmodel * New functions post.var and post.pr2 * New functions model.frame.bma, model.frame.zlm, deviance.bma, deviance.zlm, variable.names.bma, variable.names.zlm, logLik.zlm, vcov.zlm * bms can now accommodate user-defined coefficient (g) and model-priors, as well as samplers * BUG FIXES: ------------------------ * bms: + bug with accept.candi = NA fixed + problems with environment in non-standard settings fixed (in internal function .construct.arglist) + mprior =="custompip" is now working properly (fixed in internal function .mprior.pip.init) + fixed problem with sys.call in non-standard calling environments + * plotComp: +also works for single bma object now + fixed display when variable names are too long + fixed many problems with graphical parameters - completely redone * topmod: + bug when likelihood==-Inf, fixed (in internal function .top10) + initializing with bbeta==FALSE now works properly (fixed in .top10) * density.bma: bug with par and plot.new fixed when argument addons contains "p" * image.bma: fixed display problems when variable names too long * plotConv (resp. plot.bma): fixed warning 'In min(x) : no non-missing arguments to min; returning Inf' * plotModelsize: + bugfixes for parameter ksubset + bugfixes for graphical parameters + can now cope with case when model prior is not available * CHANGES TO INTERNAL OBJECTS: ------------------------------ * New classes: gprior, mprior, pred.density, implicit class coef.density * Streamlining and customizability of gprior required changes to following functions: bms, zlm, .choose.gprior, gdensity, .topmod.as.bbetaT New functions gprior.constantg.init, gprior.eblocal.init and .gprior.hyperg.init now provide for generic handling of g-priors Old functions lprob.*.init are still available for compatibility * Streamlining and customizability of mprior required changes to following functions: .choose.mprior, and all .mprior.*.init functions * Streamlining and customizability of sampling functions led to streamlining of: .iterenum, .fls.samp, .rev.jump, .enum_startend * Introduction of bms argument fixed.reg is handled generically by functions .fixedset.mprior, .fixedset.sampler, .starter, .choose.mprior, bms * Speeding-up of syntax (replacing $ with [[, directly calling internal functions) yields 5% speed gain in bms vs version 0.2.5 * .construct.arglist has been vastly changed ############################################################### Version 0.2.5 (build 2010-07-30) * NEW FEATURES ------------ None * BUG FIXES --------- * fixed a bug affecting coefficient appearing BMS/data/0000755000175100001440000000000012624725513011631 5ustar hornikusersBMS/data/datafls.rda0000644000175100001440000002124712624725513013745 0ustar hornikusers|X]AP챗btǨ((M؍],"bŖXX{E]hw{3+bs,=2g WmB]]I,>5uWNW\m$_e۲L\͖`Yí.k2jzs5  O^}Z~4VF߲;~х8XCcqQE^'(Bo//q ,2!1AV\X1m{aNBR]^Vo`};om;A4K 4".6δ2s`Q~\a}{uIPno̮퀩7Y4j}OC]};h08Ak2$D\wup1Xí[¬;Ć3}r6f;9ɐӤU6 Y߹?FOzjĶԱs7㧾"ic7_]T">sVwd –J,[o:о٬莞07&`Cc3&ik-عYuU!y'k!O)7XaSXagڿ_?^z6xub;X0K7yߗf4}]4Ҥ}ˍE\~x~ݾ0QV%G̑.ҚLi;[~Yl̲ύ ueFgKKjh;2KI`λk}R}tk`fC=+з}Z{߂/kTQ3ә䫦t=[Μɠuk]s 0KqWK\V=e؆r|eL/O7U4Rr9A.}M.etc-\'_e_+\p hQl")uK<.W]O[|/ː/kR~V8XfM-\ui4d8BS(Yp! k8Ayn7O^s;kN+_'a=O>_[&#bUG.~6,~Kۨ2ۛ\^[fūϻ#\~Ǘx{xVW".8 ;|0g_-ml T C<ȏs9anH5-qn?v+[Oφ=+=n'͟ DZXz ɑqB<88_XO#cj]#_{TW3,Oeך+j~VêFfz[v^d3\Qɬfry% cJmp/FV1cߺ,X}7>ހ)2u:e0S1VíKǙat3X2/܏T&*z;R[g̶Pv 7G1&; ON32 ``1W/\EbV{_+ fUo[kl=৆uIL6V"*73)u!GK8Ww9X?Σ<Gs} ¸e@J, C*Ntx `<7݇s*'<|4TR7^Ioě2^y{&e.uǣ1EAa=ŸI_(sNDC,. O/#(j?̷o`zgkar%E*eaMY4W W{Kmhaӿqrs*šgDC! =|*'7erI''Ո i8O>aap Ԟu+?7HdQy^:N)+E}x*Dc?tƗ1S-?~p7n{[?£dɟxRQOUNv@9 g(L|ߝu-O+O'VwCG>9}^R` i܎E_lо|F7y>Edh!uCWr : =z_ๆ8/ (Q?i^z?ƣou|w%um1NGzv8ץ=)^H[ǰz7Z'}zqS8bur-MIѼ'5)Iь]나+商E%EizGr{4\owП^#Ip<y"W5I>\:'<oX.[o A\Mz{z-|Q{>z? ;Nk,볨:";iڟiȓOp_CѬ?Cv̟Cik>]գL5Oa\6g3%t98A0y"ޖqTcb7GS΂lė>q*Hj$(~CjyxdNa?a;9(+~:SOE뭠dk~1oӉ/fZo-7eזzǬ^`x{`ϴBkvOi-^}<.Cϵ}Z~T'zIumOA듳>9=(OU=ZS_hMXܹ߅A|L-cͣAў0̧{ Jª# %GX23wi{|!pg?yfiʰq{aUQ]AU{Ԗ71|./iQ V/qXz_ XlEa0JvLpa!a{&j36 |v=RGMȢN2B88=oj]'r6]|taR-3&)yY=5qt$NO0~(h>lENi'|͗n'tŴ|f_V35,>-laf[s_m :+- Ti9ϥmxFbwtWrcQ_`}yd-IPf**5_!?($?G&dE)< s!{n#?Bv3< +alC<ݘDyP;/q)'XDx(aډ{Xb>._Ѯ QM~#8;G' ݄c"BWIyMOR$GORRt?UznͿ7<,,VGum VQ~WN[W",a]zh&ƣ\X)YW`umsc Dq1H/W$pE Vi$(.ؾD%ojU}boYYn>~dFlufP'YcF9Ųje QձخK|gfyn[1+JPg1{FȾ!|P!4N%[E+">e(Gl/tTya7e5Ӹ*q~Y0F͇;8O(O|#zTGU4zR/Nzk1~Q/zIAr4V%=N=ay+yk x;22ԸA>JW]wO; ߁2A|G$IL=堿#E~}!w1_<)HwE(Li!3D{DGxp κßɰuhq(X3r|au zrU%,V->%ma>~6Qo$%y^Y{!:mCؓ= qO_e!v'fR w?74ʬo ؑୈSH=Jt0أ;#tQΥ,"?m+-;C j[(~AOj_~:u8l6y xVcc/R_gFJF(Q TŧLA|LGyDX_saZ7j =:q{ѥz/X7SSw}7pBx8 mq~gS'"G~!i ? &pB{s23*QlvO'/Iu^z5$4_6S8&2 ~%o]:U>UO_K^UBLJ 'p}MȊ*~;\rɱ8NpRC"?:78k'w<}kWhG,O:VϧBrܴ<.IwYO)nkum T0O@ܳ߭>QlBUvp߽]@wGiev:EԷ)|)3(ߦ'50 >v88A\)UnxKM{P/pfNhє{z_'Xʬ|2~!)ˏ7kꢘ^5O7 VY X_4z^Xw(V[Wz^}0r3oW6O]o?[ %+^rչI3e,똣 T{fIqhݍy\G).CZm `9=Pۤ!Gqj_ji<ي~c<|{H$BxюC`?0oq=S}Ĉ~ᾗ>{WO| ~>wE}\r:q/@ם.~>ǍjE,= D_W ooBc5[J uqp=Ǻ'tˋ(9f1agԶ3j6n=V@?wNpAÆyj\=|<݈\+_An>mowgX=>6< L`6r ttM%{y:D'?J]#<>SP/aA~nbrz 4z [y96>#>1T\sfk3@`g awtX@0K'f0*[n^hfeՀ,"B΢-zѝ!;AYNwTuwݹm>.N4 ~S;ӝtm]..oWyW'q'&v88I:8wBb\G(Fs;NII"um\讻"X ,^T`%d[[`-F-h#F xs-`YBMS/R/0000755000175100001440000000000012624725513011121 5ustar hornikusersBMS/R/post.var.R0000644000175100001440000000051612624725513013022 0ustar hornikuserspost.var <- function (object, exact = FALSE) { if (!(is.bma(object) | is(object, "lm"))) stop("Required input is an object of class 'bma' or 'lm'/'zlm'.") od = deviance(object, exact = exact) oy = model.frame(object)[, 1, drop = TRUE] ret = od/length(oy) attr(ret, "nobs") = length(oy) return(ret) } BMS/R/info.bma.R0000644000175100001440000000500212624725513012732 0ustar hornikusersinfo.bma <- function (object, ...) { bmao = object rm(object) foo = bmao$info iter = foo$iter burn = foo$burn timed = foo$timed models.visited = foo$models.visited corr.pmp = foo$corr.pmp K = foo$K N = foo$N msize = foo$msize cumsumweights = foo$cumsumweights if (is.element("mprior.info", names(bmao))) { prior = paste(bmao$mprior.info$mp.mode, "/", bmao$mprior.info$mp.msize) } else { if (is.element("theta", names(bmao$arguments)) && is.element("prior.msize", names(bmao$arguments))) { if (!is.null(bmao$arguments$theta) & !is.null(bmao$arguments$prior.msize)) prior = paste(bmao$arguments$theta, "/", bmao$arguments$prior.msize) else prior = NA } else { prior = paste(bmao$arguments$mprior, "/", bmao$arguments$mprior.size) } } gprior.info = bmao$gprior.info gprior.choice = gprior.info$gtype model.space = 2^K fraction.model = models.visited/model.space * 100 fraction.topmodel = sum(bmao$topmod$ncount())/iter * 100 if (gprior.info$gtype == "hyper") { gprior.choice = paste(gprior.choice, " (a=", 2 + signif(gprior.info$hyper.parameter - 2, digits = 4), ")", sep = "") } nr.reg = msize/cumsumweights info <- as.character(c(format(round(nr.reg, 4), nsmall = 4), format(iter, nsmall = 0), format(burn, nsmall = 0), format(timed, nsmall = 4), models.visited, format(model.space, digits = 2), format(fraction.model, digits = 2), format(fraction.topmodel, digits = 2), format(round(.cor.topmod(bmao$topmod), 4), nsmall = 4), format(N, nsmall = 4), prior, gprior.choice)) names(info) <- c("Mean no. regressors", "Draws", "Burnins", "Time", "No. models visited", "Modelspace 2^K", "% visited", "% Topmodels", "Corr PMP", "No. Obs.", "Model Prior", "g-Prior") if (gprior.info$return.g.stats) { gpriorav = gprior.info$shrinkage.moments[1] gstatsprint = paste("Av=", format(gpriorav, digits = 4), sep = "") if (length(gprior.info$shrinkage.moments) > 1) { gpriorstdev = sqrt(gprior.info$shrinkage.moments[2] - gprior.info$shrinkage.moments[1]^2) gstatsprint = paste(gstatsprint, ", Stdev=", format(gpriorstdev, digits = 2), sep = "") } info <- c(info, gstatsprint) names(info)[13] <- "Shrinkage-Stats" } return(info) } BMS/R/bms.R0000644000175100001440000003136112624725513012031 0ustar hornikusersbms <- function (X.data = NULL, burn = 1000, iter = NA, nmodel = 500, mcmc = "bd", g = "UIP", mprior = "random", mprior.size = NA, user.int = TRUE, start.value = NA, g.stats = TRUE, logfile = FALSE, logstep = 10000, force.full.ols = FALSE, fixed.reg = numeric(0), data = NULL, randomizeTimer = TRUE) { if (missing(X.data) & !missing(data)) X.data = data mf <- match.call(expand.dots = FALSE) if (!is.na(match("X.data", names(mf)))) names(mf)[[match("X.data", names(mf))]] = "formula" m <- match(c("formula", "data"), names(mf), 0L) mf <- mf[c(1L, m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- as.name("model.frame") if (is.data.frame(X.data)) { mf <- X.data } else if (is.matrix(X.data)) { mf <- model.frame(as.data.frame(X.data, drop.unused.levels = TRUE)) } else { mf <- eval(mf, parent.frame()) } X.data = as.matrix(mf) if (any(is.na(X.data))) { X.data = na.omit(X.data) if (nrow(X.data) < 3) { stop("Too few data observations. Please provide at least three data rows without NA entries.") } warning("Argument 'X.data' contains NAs. The corresponding rows have not been taken into account.") } N <- nrow(X.data) K = ncol(X.data) - 1 maxk = N - 3 if (is.null(nmodel[1]) || is.na(nmodel[1]) || nmodel[1] <= 0) { dotop = FALSE nmodel = 0 } else { dotop = TRUE } nameix = 1:K names(nameix) = colnames(X.data[, -1, drop = FALSE]) fixed.pos = nameix[fixed.reg] rm(nameix) if (missing(mcmc) && ((K - length(fixed.pos)) < 15)) { mcmc = "enum" } int = FALSE is.enum = FALSE if (is.function(mcmc)) { samplingfun = mcmc mcmc = "custom" } else { if (length(grep("int", mcmc, ignore.case = TRUE))) { int = TRUE } if (length(grep("enum", mcmc, ignore.case = TRUE))) { is.enum = TRUE samplingfun = .iterenum if (K > maxk) samplingfun = .iterenum.KgtN } else if (length(grep("bd", mcmc, ignore.case = TRUE))) { samplingfun = switch(int + 1, .fls.samp, .fls.samp.int) } else { samplingfun = switch(int + 1, .rev.jump, .rev.jump.int) } } if (int && (length(fixed.pos) > 0L)) { warning("interaction sampler does not allow for non-zero argument fixed.pos; consequently it was set fixed.pos=0") fixed.pos = numeric(0) } sampling = .fixedset.sampler(samplingfun, fullK = K, fixed.pos = fixed.pos, X.data = X.data) if (is.enum) { burn = 0 int = FALSE mcmc = "enum" is.enum = TRUE tmp = .enum_startend(iter = iter, start.value = start.value, K = K, maxk = maxk, fixed.pos = fixed.pos) iter = tmp$iter start.value = tmp$start.value } else { if (is.na(iter)) { iter = 3000 } } if (logfile != FALSE) { if (is.character(logfile)) { sfilename = logfile } else { sfilename = "" } if (nchar(sfilename) > 0) file.create(sfilename) logfile = TRUE cat(as.character(Sys.time()), ": starting loop ... \n", append = TRUE, file = sfilename) if (logstep != 10000) fact = logstep else fact = max(floor((burn + iter)/100), logstep) } y <- as.matrix(X.data[, 1]) X <- as.matrix(X.data[, 2:ncol(X.data)]) y <- y - mean(y) X <- X - matrix(colMeans(X), N, K, byrow = TRUE) XtX.big = crossprod(X) Xty.big = crossprod(X, y) yty = as.vector(crossprod(y)) coreig = eigen(cor(X), symmetric = TRUE, only.values = TRUE)$values if (!force.full.ols) { if (sum(coreig > 1e-07) < min(K, (N - 1))) { force.full.ols = TRUE } } if (any(coreig[1:min(K, (N - 1))] < 1e-16)) { warning(paste("data seems to be rank-deficient: its rank seems to be only ", sum(coreig > 1e-13))) } if (int) { if (length(grep("#", colnames(X.data), fixed = TRUE)) == 0) stop("Please separate column names of interaction terms by # (e.g. A#B)") mPlus = .constr.intmat(X, K) } else { mPlus <- NA } pmplist = .choose.mprior(mprior, mprior.size, K = K, X.data = X.data, fixed.pos = fixed.pos) mprior = pmplist$mp.mode gprior.info = .choose.gprior(g, N, K, return.g.stats = g.stats, yty = yty, X.data = X.data) lprobcalc = gprior.info$lprobcalc start.list = .starter(K, start.value, y, N = N, XtX.big = XtX.big, Xty.big = Xty.big, X = X, fixed.pos = fixed.pos) molddraw = start.list$molddraw start.position = start.list$start.position kold = sum(molddraw) position = (1:K)[molddraw == 1] collect.otherstats = FALSE otherstats = numeric(0) add.otherstats = numeric(0) if (gprior.info$return.g.stats & !(gprior.info$is.constant)) { add.otherstats = gprior.info$shrinkage.moments collect.otherstats = TRUE } cumsumweights = iter null.lik = lprobcalc$just.loglik(ymy = yty, k = 0) if (collect.otherstats) { addup <- function() { inccount <<- inccount + molddraw msize <<- msize + kold if (kold != 0) { bm[c(position, K + position, 2 * K + kold, 3 * K + position)] = c(b1, b2, 1, b1 > 0) bmo <<- bmo + bm } else { null.count <<- null.count + 1 } otherstats <<- lik.list[["otherstats"]] add.otherstats <<- add.otherstats + otherstats } } else { addup <- function() { inccount <<- inccount + molddraw msize <<- msize + kold if (kold != 0) { bm[c(position, K + position, 2 * K + kold, 3 * K + position)] = c(b1, b2, 1, b1 > 0) bmo <<- bmo + bm } else { null.count <<- null.count + 1 } } } if (is.enum) { cumsumweights = 0 if (collect.otherstats) { addup <- function() { weight = exp(pmpold + lprobold - null.lik) inccount <<- inccount + weight * molddraw msize <<- msize + weight * kold cumsumweights <<- cumsumweights + weight if (kold != 0) { bm[c(position, K + position, 2 * K + kold, 3 * K + position)] = weight * c(b1, b2, 1, b1 > 0) bmo <<- bmo + bm } else { null.count <<- null.count + weight } otherstats <<- lik.list[["otherstats"]] add.otherstats <<- add.otherstats + weight * otherstats } } else { addup <- function() { weight = exp(pmpold + lprobold - null.lik) inccount <<- inccount + weight * molddraw msize <<- msize + weight * kold cumsumweights <<- cumsumweights + weight if (kold != 0) { bm[c(position, K + position, 2 * K + kold, 3 * K + position)] = weight * c(b1, b2, 1, b1 > 0) bmo <<- bmo + bm } else { null.count <<- null.count + weight } } } } environment(addup) <- environment() ols.object = .ols.terms2(positions = (1:K)[molddraw == 1], yty = yty, k = kold, N, K = K, XtX.big = XtX.big, Xty.big = Xty.big) lik.list = lprobcalc$lprob.all(ymy = ols.object$ymy, k = kold, bhat = ols.object$bhat, diag.inverse = ols.object$diag.inverse) lprobold = lik.list$lprob b1 = lik.list$b1new b2 = lik.list$b2new pmpold = pmplist$pmp(ki = kold, mdraw = molddraw) topmods = topmod(nbmodels = nmodel, nmaxregressors = K, bbeta = FALSE, lengthfixedvec = length(add.otherstats)) if (mcmc == "enum") { try(topmods$duplicates_possible(FALSE), silent = TRUE) } if (dotop && (burn == 0L)) topmods$addmodel(mylik = pmpold + lprobold, vec01 = molddraw, fixedvec = lik.list$otherstats) null.count = 0 models.visited = 0 inccount = numeric(K) msize = 0 k.vec = numeric(K) b1mo = numeric(K) ab = numeric(K) b2mo = numeric(K) bb = numeric(K) possign = inccount mnewdraw = numeric(K) if (force.full.ols) { candi.is.full.object = TRUE } else { candi.is.full.object = FALSE } bmo = numeric(4 * K) bm = bmo if (is.enum) { addup() } if (!is.finite(pmpold)) pmpold = -1e+90 if (randomizeTimer) set.seed(as.numeric(Sys.time())) t1 <- Sys.time() nrep = burn + iter i = 0 while (i < nrep) { i = i + 1 if (logfile) { if (i%%fact == 0) { if (nchar(sfilename) == 0) message(as.character(Sys.time()), ":", i, "current draw") else cat(as.character(Sys.time()), ":", i, "current draw \n", append = TRUE, file = sfilename) } } a = sampling(molddraw = molddraw, K = K, mPlus = mPlus, maxk = maxk, oldk = kold) mnewdraw = a[["mnewdraw"]] positionnew = a[["positionnew"]] knew = length(positionnew) pmpnew = pmplist[["pmp"]](ki = knew, mdraw = mnewdraw) if (!is.enum) { if (int) { if (length(c(a$dropi, a$addi)) > 2 | i < 3 | force.full.ols) { candi.is.full.object = TRUE } else { candi.is.full.object = FALSE } } if (candi.is.full.object) { ols.candidate = .ols.terms2(positions = positionnew, yty = yty, k = knew, N, K = K, XtX.big = XtX.big, Xty.big = Xty.big) ymy.candi = ols.candidate[["ymy"]] } else { ymy.candi = ols.object[["child.ymy"]](a$addi, a$dropi, k = knew) } if ((ymy.candi < 0) | is.na(ymy.candi)) stop(paste("stumbled on rank-deficient model")) lprobnew = lprobcalc[["just.loglik"]](ymy = ymy.candi, k = knew) accept.candi = as.logical(log(runif(1, 0, 1)) < lprobnew - lprobold + pmpnew - pmpold) } else { accept.candi = TRUE candi.is.full.object = FALSE } if (accept.candi) { if (!candi.is.full.object) { ols.res = ols.object[["mutate"]](addix = a$addi, dropix = a$dropi, newpos = positionnew, newk = knew) } else { ols.object = ols.candidate ols.res = ols.candidate[["full.results"]]() } lik.list = lprobcalc[["lprob.all"]](max(0, ols.res$ymy), knew, ols.res$bhat, ols.res$diag.inverse) lprobold = lik.list[["lprob"]] position = positionnew pmpold = pmpnew molddraw = mnewdraw kold = knew models.visited = models.visited + 1 } if (i > burn) { b1 = lik.list[["b1new"]] b2 = lik.list[["b2new"]] addup() if (dotop) topmods[["addmodel"]](mylik = pmpold + lprobold, vec01 = molddraw, fixedvec = otherstats) } } if (dotop) topmods = .topmod.as.bbetaT(topmods, gprior.info, X.data) timed <- difftime(Sys.time(), t1) if (is.enum) { iter = iter + 1 models.visited = models.visited + 1 } bmo = matrix(bmo, 4, byrow = TRUE) b1mo = bmo[1, ] b2mo = bmo[2, ] k.vec = bmo[3, ] possign = bmo[4, ] rm(bmo) post.inf = .post.calc(gprior.info, add.otherstats, k.vec, null.count, X.data, topmods, b1mo, b2mo, iter, burn, inccount, models.visited, K, N, msize, timed, cumsumweights, mcmc, possign) result = list(info = post.inf$info, arguments = .construct.arglist(bms, environment()), topmod = topmods, start.pos = sort(start.position), gprior.info = post.inf$gprior.info, mprior.info = pmplist, X.data = X.data, reg.names = post.inf$reg.names, bms.call = try(match.call(bms, sys.call(0)), silent = TRUE)) class(result) = c("bma") if (user.int) { print(result) print(timed) plot.bma(result) } return(invisible(result)) } BMS/R/predict.bma.R0000644000175100001440000000405612624725513013441 0ustar hornikuserspredict.bma <- function (object, newdata = NULL, exact = FALSE, topmodels = NULL, ...) { if (!is.bma(object)) { stop("you need to provide a BMA object") return() } if (!is.null(topmodels)) { if (!(is.numeric(topmodels) && is.vector(topmodels))) { stop("topmodels must denote the models to take into account, e.g. 1:5 for the best five.") } else if (object$topmod$nbmodels < max(topmodels)) { stop(paste("Only", object$topmod$nbmodels, "best models are available, but you asked to take the", max(topmodels), "-best model into account.")) } object = object[unique(topmodels)] } if ((!missing(topmodels)) && missing(exact)) exact = TRUE betas = estimates.bma(object, exact = exact, order.by.pip = FALSE, include.constant = FALSE, std.coefs = FALSE, condi.coef = FALSE)[, 2] if (is.null(newdata)) { newX <- as.matrix(object$X.data[, -1, drop = FALSE]) } else { newX = as.matrix(newdata) if (!is.numeric(newX)) stop("newdata must be numeric!") if (is.vector(newdata)) newX = matrix(newdata, 1) if (ncol(newX) != length(betas)) { if (ncol(newX) == length(betas) + 1) { newX = newX[, -1, drop = FALSE] } else { stop("newdata must be a matrix or data.frame with", length(betas), "columns.") } } orinames = colnames(object$X.data[, -1, drop = FALSE]) if (!is.null(colnames(newX)) && !is.null(orinames)) { if (all(orinames %in% colnames(newX)) && !all(orinames == colnames(newX))) { warning("argument newdata had to be reordered according to its column names. Consider submitting the columns of newdata in the right order.") newX = newX[, orinames, drop = FALSE] } } } cons = .post.constant(object$X.data, betas) return(as.vector(newX %*% betas) + cons) } BMS/R/z[.topmod.R0000644000175100001440000000206312624725513013152 0ustar hornikusers`[.topmod` <- function (x, i, ...) { tm = x idx = i if (any(is.na(suppressWarnings(as.integer(idx))))) idx = 1:length(tm$lik()) if (length(tm$betas_raw()) > 1) { bbeta = TRUE bet = as.vector(tm$betas()[, idx]) bet = bet[bet != 0] } else { bbeta = FALSE bet = numeric(0) } if (length(tm$betas2_raw()) > 1) { bbeta2 = TRUE bet2 = as.vector(tm$betas2()[, idx]) bet2 = bet2[bet2 != 0] } else { bbeta2 = FALSE bet2 = numeric(0) } fixvec = tm$fixed_vector() if (!length(as.vector(fixvec))) fixvec = numeric(0) else fixvec = as.vector(t(fixvec[, idx])) .top10(nmaxregressors = tm$nregs, nbmodels = tm$nbmodels, bbeta = bbeta, lengthfixedvec = nrow(tm$fixed_vector()), bbeta2 = bbeta2, inivec_lik = tm$lik()[idx], inivec_bool = tm$bool()[idx], inivec_count = tm$ncount()[idx], inivec_vbeta = bet, inivec_vbeta2 = bet2, inivec_veck = tm$kvec_raw()[idx], inivec_fixvec = fixvec) } BMS/R/fullmodel.ssq.R0000644000175100001440000000120012624725513014025 0ustar hornikusersfullmodel.ssq <- function (yX.data) { if (is.bma(yX.data)) { yX.data <- yX.data$X.data } y <- as.matrix(yX.data[, 1]) X <- as.matrix(yX.data[, 2:ncol(yX.data)]) N <- nrow(X) K = ncol(X) y.mean = mean(y) y <- y - matrix(y.mean, N, 1, byrow = TRUE) X.mean = colMeans(X) X <- X - matrix(X.mean, N, K, byrow = TRUE) Xqr <- qr(X) yty = as.numeric(crossprod(y)) ymy = as.numeric(crossprod(qr.resid(Xqr, y))) ypy = as.numeric(crossprod(qr.fitted(Xqr, y))) R2 = ypy/yty return(list(R2 = R2, ymy = ymy, ypy = ypy, yty = yty, Fstat = (R2/(1 - R2)) * (N - K - 1)/K)) } BMS/R/is.bma.R0000644000175100001440000000026012624725513012413 0ustar hornikusersis.bma <- function (bmao) { if (any(is.element(class(bmao), c("bma", "bma.fcast", "bma.sar", "oldbma", "bmav0")))) return(TRUE) else return(FALSE) } BMS/R/zlm.R0000644000175100001440000000445112624725513012052 0ustar hornikuserszlm <- function (formula, data = NULL, subset = NULL, g = "UIP") { thiscall = match.call() mf <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset"), names(mf), 0L) mf <- mf[c(1L, m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- as.name("model.frame") if (is.matrix(formula)) { mf <- model.frame(as.data.frame(formula, drop.unused.levels = TRUE)) } else { mf <- eval(mf, parent.frame()) } yXdata = as.matrix(mf) N = nrow(yXdata) K = ncol(yXdata) - 1 dmdata = yXdata - matrix(colMeans(yXdata), N, K + 1, byrow = TRUE) yty = c(crossprod(dmdata[, 1])) olsres = .ols.terms2(positions = rep(TRUE, K), yty = yty, N = N, K = K, XtX.big = crossprod(dmdata[, -1, drop = FALSE]), Xty.big = c(crossprod(dmdata[, -1, drop = FALSE], dmdata[, 1])))$full.results() if (is.list(g)) { if (any(is.element(names(g), "gtype"))) gprior.info = g else stop("Please provide a proper g-prior. see help(zlm)") } gprior.info = .choose.gprior(g = g, N = N, K = K, return.g.stats = TRUE, yty = yty) lprobcalc = gprior.info$lprobcalc zres = lprobcalc$lprob.all(ymy = olsres$ymy, k = K, bhat = olsres$bhat, diag.inverse = olsres$diag.inverse) betas = c(zres$b1) betas2 = c(zres$b2) alpha = mean(yXdata[, 1]) - c(crossprod(betas, colMeans(yXdata)[-1])) fitval = c(yXdata[, -1, drop = FALSE] %*% betas) + alpha resids = yXdata[, 1] - fitval if (gprior.info$is.constant) { gprior.info$shrinkage.moments = 1 - 1/(1 + gprior.info$g) } else { gprior.info$shrinkage.moments = zres$otherstats } mt <- attr(mf, "terms") alphabeta = c(alpha, betas) names(alphabeta) <- c("(Intercept)", attr(mt, "term.labels")) res = list() res$coefficients <- alphabeta res$residuals <- resids res$rank <- K + 1 res$fitted.values <- fitval res$df.residual <- N - K - 1 res$xlevels <- .getXlevels(mt, mf) res$call <- thiscall res$terms <- mt res$model <- mf res$na.action <- attr(mf, "na.action") res$coef2moments <- c(NA, betas2) res$marg.lik <- zres$lprob res$gprior.info <- gprior.info res$olsres <- olsres res$zres <- zres class(res) = c("zlm", "lm") return(res) } BMS/R/image.bma.R0000644000175100001440000000430312624725513013064 0ustar hornikusersimage.bma <- function (x, yprop2pip = FALSE, order.by.pip = TRUE, do.par = TRUE, do.grid = TRUE, do.axis = TRUE, cex.axis = 1, ...) { dotargs = match.call(expand.dots = FALSE)$... ests = estimates.bma(x, exact = TRUE, order.by.pip = order.by.pip, include.constant = FALSE) ests = ests[nrow(ests):1, ] pips = ests[, "PIP"] idx = ests[, "Idx"] pmp.res = pmp.bma(x, oldstyle = TRUE) pmps = pmp.res[, 1] normali_factor = sum(pmp.res[, 2]) betasigns = beta.draws.bma(x)[idx, , drop = FALSE] betasigns = betasigns[as.logical(pips), ] betasigns = sign(betasigns)/2 + 0.5 betasigns[betasigns == 0.5] = NA pips = pips[as.logical(pips)] if (yprop2pip) { pipbounds = (c(0, cumsum(pips))) } else { pipbounds = 0:length(pips) names(pipbounds) = c("", names(pips)) } pmpbounds = (c(0, cumsum(pmps))) if (do.par) { oldmar = par()$mar spaceforyaxis = strwidth(names(pipbounds)[which.max(nchar(names(pipbounds)))], units = "inches") * (par("mar")/par("mai"))[[2]] tempmar = oldmar tempmar[2] = min(spaceforyaxis + oldmar[2]/2, 0.5 * par("fin")[[1]] * (par("mar")/par("mai"))[[2]]) par(mar = tempmar) } dotargs = .adjustdots(dotargs, ylab = "", xlab = "Cumulative Model Probabilities", col = c("tomato", "blue"), main = paste("Model Inclusion Based on Best ", length(pmps), " Models")) dotargs$axes <- FALSE tbetasigns = t(betasigns) eval(as.call(c(list(as.name("image.default"), as.name("pmpbounds"), as.name("pipbounds"), as.name("tbetasigns")), as.list(dotargs)))) if (do.axis) { axis(1, at = pmpbounds, labels = round(normali_factor * pmpbounds, 2), cex.axis = cex.axis) axis(2, at = pipbounds, labels = FALSE, line = FALSE) axis(2, at = pipbounds[-1] - diff(pipbounds)/2, labels = names(pipbounds[-1]), tick = FALSE, las = 1, cex.axis = cex.axis) } if (do.grid) { abline(v = round(pmpbounds, 2), lty = "dotted", col = "grey") abline(h = round(pipbounds, 2), lty = "dotted", col = "grey") } if (do.par) { par(mar = oldmar) } } BMS/R/f21hyper.R0000644000175100001440000000116712624725513012711 0ustar hornikusersf21hyper <- function (a, b, c, z) { if ((length(a) != 1) | (length(b) != 1) | (length(c) != 1) | (length(z) != 1)) stop("All function arguments need to be scalars") if ((a < 0) | (b < 0) | (c < 0)) stop("Arguments a, b, and c need to be non-negative") if ((z > 1) | (z <= (-1))) stop("Argument z needs to be between -1 and 1") nmx = max(100, 3 * floor(((a + b) * z - c - 1)/(1 - z))) if (nmx > 10000) warning("Power series probably does not converge") serie = 0:nmx return(1 + sum(cumprod((a + serie)/(c + serie) * (b + serie)/(1 + serie) * z))) } BMS/R/beta.draws.bma.R0000644000175100001440000000057212624725513014040 0ustar hornikusersbeta.draws.bma <- function (bmao, stdev = FALSE) { if (!is.bma(bmao)) { stop("you need to provide a BMA object") return() } resmat = .post.beta.draws(bmao$topmod, bmao$reg.names, FALSE) if (stdev) { mom2 = .post.beta.draws(bmao$topmod, bmao$reg.names, TRUE) resmat = sqrt(mom2 - resmat^2) } return(resmat) } BMS/R/model.frame.bma.R0000644000175100001440000000026112624725513014172 0ustar hornikusersmodel.frame.bma <- function (formula, ...) { if (!is.bma(formula)) stop("argument 'formula' needs to be a bma object") return(as.data.frame(formula$X.data)) } BMS/R/is.topmod.R0000644000175100001440000000017012624725513013156 0ustar hornikusersis.topmod <- function (tmo) { if (is.element("topmod", class(tmo))) return(TRUE) else return(FALSE) } BMS/R/bin2hex.R0000644000175100001440000000073612624725513012611 0ustar hornikusersbin2hex <- function (binvec) { if (!is.logical(binvec)) { if (is.numeric(binvec)) { binvec = as.logical(binvec) } else { stop("need to supply a logical vector like c(T,F) or c(1,0)") } } hexobj <- .hexcode.binvec.convert(length(binvec)) hexcode = hexobj$as.hexcode(binvec) if (nchar(hexcode) > (floor((length(binvec) - 1)/4) + 1)) { hexcode = substring(hexcode, 2) } return(hexcode) } BMS/R/pmp.bma.R0000644000175100001440000000212712624725513012600 0ustar hornikuserspmp.bma <- function (bmao, oldstyle = FALSE) { if (!(is.bma(bmao) || is.topmod(bmao))) stop("bmao needs to be a 'bma' object!") if (is.topmod(bmao)) { topmods = bmao was.enum = FALSE cumsumweights = sum(topmods$ncount()) log.null.lik = 0 } else { topmods = bmao$topmod log.null.lik = (1 - bmao$info$N)/2 * log(as.vector(crossprod(bmao$X.data[, 1] - mean(bmao$X.data[, 1])))) cumsumweights = bmao$info$cumsumweights was.enum = (bmao$arguments$mcmc == "enum") } lt1 = suppressWarnings(topmods$lik() - max(topmods$lik())) lt1 = exp(lt1)/sum(exp(lt1)) if (was.enum) { lt2 = exp(topmods$lik() - log.null.lik)/cumsumweights } else { lt2 = topmods$ncount()/cumsumweights } cpoint = min(length(lt1), length(lt2)) lt1 = lt1[1:cpoint] lt2 = lt2[1:cpoint] if (!oldstyle) lt1 <- lt1 * sum(lt2) topmodout = rbind(lt1, lt2) rownames(topmodout) = c("PMP (Exact)", "PMP (MCMC)") colnames(topmodout) = topmods$bool() return(t(topmodout)) } BMS/R/gdensity.R0000644000175100001440000001322312624725513013073 0ustar hornikusersgdensity <- function (x, n = 512, plot = TRUE, addons = "zles", addons.lwd = 1.5, ...) { dsgivenykernel <- function(kpazvec, sf, N) { (kpazvec[[1]] - 2)/2 * (1 - sf)^((kpazvec[[1]] - 4)/2) * (1 - sf * kpazvec[[2]])^(-(N - 1)/2) } if (!is.bma(x)) stop("argument needs to an object of class 'bma'") if (!(x$gprior$gtype == "hyper")) stop("g prior density makes only sense for hyper-g prior.") if (n < 2) stop("n needs to be at least 2") n = floor(n) dotargs = match.call(expand.dots = FALSE)$... N = x$info$N K = x$info$K tm = x$topmod bools = tm$bool_binary() betas = tm$betas() betas2 = tm$betas2() smoments = tm$fixed_vector() yXdata = as.matrix(x$X.data) yXdata = yXdata - matrix(colMeans(yXdata), N, K + 1, byrow = TRUE) yty = c(crossprod(yXdata[, 1])) positions = lapply(lapply(as.list(as.data.frame(bools)), as.logical), which) ymyvec = unlist(lapply(lapply(positions, .ols.terms2, yty = yty, N = N, K = K, XtX.big = crossprod(yXdata[, -1]), Xty.big = c(crossprod(yXdata[, -1], yXdata[, 1]))), function(x) x$full.results()$ymy)) kvec = tm$kvec_raw() zvec = 1 - ymyvec/yty pmpexact = pmp.bma(x, oldstyle = TRUE)[, 1] f21a = x$gprior.info$hyper.parameter if (length(smoments) == 0) { lprob = x$gprior.info$lprobcalc smoments = sapply(lapply(as.list(as.data.frame(rbind(kvec, ymyvec))), function(x) lprob$lprob.all(ymy = x[2], k = x[1], bhat = numeric(x[1]), diag.inverse = rep(1, x[1]))), "[[", "otherstats") } Es = c(crossprod(smoments[1, ], pmpexact)) Es2 = c(crossprod(smoments[2, ], pmpexact)) Esd = sqrt(Es2 - Es^2) nbsteps = n cutoff = max(0, Es - 5 * Esd) sdiff = (1 - cutoff)/(nbsteps + 1) s.seq = seq(sdiff + cutoff, cutoff + nbsteps * sdiff, sdiff) sdensl = lapply(as.list(as.data.frame(rbind(kvec + f21a, zvec))), dsgivenykernel, sf = s.seq, N = N) intconsts = lapply(lapply(sdensl, sum), "*", sdiff) sdensvecs = mapply("/", sdensl, intconsts) sdens = sdensvecs %*% pmpexact reslist = list(x = s.seq, y = sdens, bw = NULL, n = n, call = sys.call(), data.name = "Shrinkage", has.na = FALSE) class(reslist) = "density" if (!plot) { return(reslist) } dotargs = .adjustdots(dotargs, ylab = "Density", xlab = "Shrinkage factor", main = "Posterior Density of the Shrinkage Factor", type = "l", col = "steelblue4") eval(as.call(c(list(as.name("plot"), as.name("s.seq"), as.name("sdens")), as.list(dotargs)))) leg.col = numeric(0) leg.lty = numeric(0) leg.legend = character(0) if (any(grep("f", addons, ignore.case = TRUE))) { for (m in 1:length(pmpexact)) { Esm = smoments[1, m] if (as.logical(Esm)) { ixlower = max(sum(s.seq < Esm), 1) Esheight = (sdens[ixlower + 1] - sdens[ixlower]) * (Esm - s.seq[ixlower]) + sdens[ixlower] lines(x = rep(Esm, 2), y = c(0, Esheight), col = 8, lwd = addons.lwd) } } leg.col = c(leg.col, 8) leg.lty = c(leg.lty, 1) leg.legend = c(leg.legend, "EV Models") } if (any(grep("e", addons, ignore.case = FALSE))) { abline(v = Es, col = 2, lwd = addons.lwd) leg.col = c(leg.col, 2) leg.lty = c(leg.lty, 1) leg.legend = c(leg.legend, "EV") } if (any(grep("s", addons, ignore.case = FALSE))) { if (!(Es - 2 * Esd) < 0) abline(v = Es - 2 * Esd, col = 2, lty = 2, lwd = addons.lwd) if (!(Es + 2 * Esd) > 1) abline(v = Es + 2 * Esd, col = 2, lty = 2, lwd = addons.lwd) leg.col = c(leg.col, 2) leg.lty = c(leg.lty, 2) leg.legend = c(leg.legend, "2x SD") } if (any(grep("m", addons, ignore.case = TRUE))) { median_index = sum(cumsum(sdens) < sum(sdens)/2) abline(v = (s.seq[median_index] + s.seq[median_index + 1])/2, col = 3, lwd = addons.lwd) leg.col = c(leg.col, 3) leg.lty = c(leg.lty, 1) leg.legend = c(leg.legend, "Median") } if (any(grep("z", addons, ignore.case = TRUE))) { abline(h = 0, col = "gray", lwd = addons.lwd) } if (any(grep("E", addons, ignore.case = FALSE))) { if (all(x$gprior.info$shrinkage.moments == 0)) warning("bma object needs to contain posterior g statistics - cf. argument 'g.stats' in 'help(bms)'") else { abline(v = x$gprior.info$shrinkage.moments[1], col = 4, lwd = addons.lwd) leg.col = c(leg.col, 4) leg.lty = c(leg.lty, 1) leg.legend = c(leg.legend, "EV (MCMC)") } } if (any(grep("S", addons, ignore.case = FALSE))) { if (!all(x$gprior.info$shrinkage.moments == 0)) { ES = x$gprior.info$shrinkage.moments[1] SDs = sqrt(x$gprior.info$shrinkage.moments[2] - x$gprior.info$shrinkage.moments[1]^2) if (ES - 2 * SDs > 0) abline(v = ES - 2 * SDs, col = 4, lty = 2, lwd = addons.lwd) if (ES + 2 * SDs < 1) abline(v = ES + 2 * SDs, col = 4, lty = 2, lwd = addons.lwd) leg.col = c(leg.col, 4) leg.lty = c(leg.lty, 2) leg.legend = c(leg.legend, "2x SD (MCMC)") } } if (any(grep("l", addons, ignore.case = TRUE)) & (length(leg.col) > 0)) { leg.pos = "topleft" legend(x = leg.pos, lty = leg.lty, col = leg.col, legend = leg.legend, box.lwd = 0, bty = "n") } return(invisible(reslist)) } BMS/R/print.pred.density.R0000644000175100001440000000071312624725513015010 0ustar hornikusersprint.pred.density <- function (x, digits = NULL, ...) { outmat = matrix(numeric(0), length(x$fit), 2) colnames(outmat) = c("Exp.Val.", "Std.Err.") rownames(outmat) = names(x$fit) outmat[, 1] = x$fit outmat[, 2] = x$std.err cat("Call:\n") print(x$call) cat(paste("\nDensities for conditional forecast(s)\n", x$n, " data points, based on ", x$nmodel, " models;\n", sep = "")) print(outmat, digits = digits, ...) } BMS/R/quantile.density.R0000644000175100001440000000352212624725513014546 0ustar hornikusersquantile.density <- function (x, probs = seq(0.25, 0.75, 0.25), names = TRUE, normalize = TRUE, ...) { my.quantile.density = function(x, probs, names, normalize, ...) { ycs = (cumsum(x$y) - (x$y - x$y[[1]])/2) * diff(x$x[1:2]) if (normalize) ycs = ycs/(ycs[[length(ycs)]]) xin = x$x maxi = length(ycs) qqs = sapply(as.list(probs), function(qu) { iii = sum(ycs <= qu) if (iii == maxi) return(Inf) else if (iii == 0L) return(-Inf) else { return(xin[[iii + 1]] + ((ycs[[iii + 1]] - qu)/(ycs[[iii + 1]] - ycs[[iii]])) * (xin[[iii]] - xin[[iii + 1]])) } }) if (as.logical(names)) names(qqs) = paste(format(100 * probs, trim = TRUE, digits = max(2L, getOption("digits"))), "%", sep = "") return(qqs) } probs = as.vector(probs) if (is.element("density", class(x))) return(my.quantile.density(x = x, probs = probs, names = names, normalize = normalize)) if (!all(sapply(x, function(dd) is.element("density", class(dd))))) stop("x needs to be a density or list of densities") if (length(x) == 1L) return(my.quantile.density(x = x[[1]], probs = probs, names = names, normalize = normalize)) qout = sapply(x, my.quantile.density, probs = probs, names = FALSE, normalize = normalize) if (!is.matrix(qout)) { if (length(probs) > 1) return(qout) qout = as.matrix(qout) } else qout = t(qout) if (as.logical(names)) colnames(qout) = paste(format(100 * probs, trim = TRUE, digits = max(2L, getOption("digits"))), "%", sep = "") return(qout) } BMS/R/plotConv.R0000644000175100001440000000223512624725513013052 0ustar hornikusersplotConv <- function (bmao, include.legend = TRUE, add.grid = TRUE, ...) { if (!is.bma(bmao)) stop("submit an object of class bma") mat = pmp.bma(bmao, oldstyle = TRUE) norm_const = sum(mat[, 1])/sum(mat[, 2]) mat = cbind(mat[, 2] * norm_const, mat[, 1]) if (length(bmao$topmod$lik()) == 0L) { stop("plotConv needs at least one model stored in topmod in order to produce a plot") } cor.pmp = format(round(.cor.topmod(bmao$topmod), 4), nsmall = 4) dotargs = match.call(plot, expand.dots = FALSE)$... dotargs = .adjustdots(dotargs, lwd = 2, main = paste("Posterior Model Probabilities\n(Corr: ", cor.pmp, ")", sep = ""), lty = 1, col = c("steelblue3", "tomato"), cex.main = 0.8, xlab = "Index of Models", ylab = "", type = "l") eval(as.call(c(list(as.name("matplot"), as.name("mat")), as.list(dotargs)))) if (as.logical(add.grid)) grid() if (as.logical(include.legend)) legend("topright", lty = eval(dotargs$lty), legend = c("PMP (MCMC)", "PMP (Exact)"), col = eval(dotargs$col), ncol = 2, bty = "n", cex = 1, lwd = eval(dotargs$lwd)) } BMS/R/lps.bma.R0000644000175100001440000000072012624725513012577 0ustar hornikuserslps.bma <- function (object, realized.y, newdata = NULL) { if (!any(class(object) %in% c("pred.density", "bma", "zlm"))) stop("object must be of class 'pred.density', 'bma' or 'zlm'!") if (any(class(object) %in% c("bma", "zlm"))) { if (is.null(newdata)) stop("newdata must be provided if object is of class 'bma' or 'zlm'.") object = pred.density(object, newdata = newdata) } return(object$lps(realized.y)) } BMS/R/as.zlm.R0000644000175100001440000000340012624725513012445 0ustar hornikusersas.zlm <- function (bmao, model = 1) { thiscall = match.call() if (!is.bma(bmao)) stop("bmao needs to be a bma object") bools = bmao$topmod$bool() if (all(is.character(model)) && length(model) == 1) { model = (1:length(bools))[bools == model[[1]]] if (length(model) == 0) stop("Provided model hex-index was not found in bmao object topmodels") } else if (all(is.character(model)) && (length(model) > 1)) { mix = match(model, bmao$reg.names) if (any(is.na(mix))) stop("Provided variable names do not conform to bma object") ll = logical(bmao$info$K) ll[mix] = TRUE model = (1:length(bools))[bools == bin2hex(ll)] rm(ll, mix) if (length(model) == 0) stop("Model conforming to provided variable names was not found in bmao object topmodels") } else if ((length(model) == bmao$info$K) && (is.numeric(model) || is.logical(model))) { model = (1:length(bools))[bools == bin2hex(model)] if (length(model) == 0) stop("Provided binary model index was not found in bmao object topmodels") } else if ((length(model) == 1) && (is.numeric(model) || is.logical(model))) { if (model < 1 | model > length(bools)) stop("Provided numeric model index was not found in bmao object topmodels") } else stop("model needs to be an integer, logical or character model index representation (hexcode or variable names)") inclvbls = as.logical(bmao$topmod$bool_binary()[, model, drop = TRUE]) yXdf = as.data.frame(bmao$X.data) zlmres = zlm(as.formula(yXdf[, c(TRUE, inclvbls)]), data = yXdf, g = bmao$gprior.info) zlmres$call <- thiscall return(zlmres) } BMS/R/BMS-internal.R0000644000175100001440000014726012624725513013511 0ustar hornikusers.adjustdots <- function (dotargs, ...) { defargs = list(...) defargnames = names(defargs) dotargs = as.list(dotargs) if (is.null(dotargs)) { dotargs = list() } for (di in seq_len(length(defargs))) { if (!is.element(defargnames[[di]], names(dotargs))) { dotargs[[defargnames[[di]]]] <- defargs[[di]] } } return(dotargs) } .choose.gprior <- function (g, N, K, return.g.stats = FALSE, yty = N, ...) { if (is.list(g)) { if (!all(c("gtype", "is.constant", "return.g.stats", "lprobcalc") %in% names(g))) stop("The provided g-prior list (in argument 'g') does not conform to the standards of a g-prior object.") if (!("g" %in% names(g))) { g$is.constant = FALSE g$g = NA } if (!("shrinkage.moments" %in% names(g))) { g$shrinkage.moments = ifelse((g$is.constant && is.numeric(g)), g/(1 + g), 0) } if (!all(sapply(g$lprobcalc, is.function))) stop("The slot 'lprobcalc' in the provided g-prior list (in argument 'g') does not conform to the standards of a g-prior object.") return(g) } if (is.function(g)) { return(g(g = g, return.g.stats = return.g.stats, N = N, K = K, yty = yty, ...)) } if (is.numeric(g)) { return(.gprior.constg.init(g = g, return.g.stats = return.g.stats, N = N, K = K, yty = yty)) } if (any(grep("EBL", g, ignore.case = TRUE))) { return(.gprior.eblocal.init(g = g, return.g.stats = return.g.stats, N = N, K = K, yty = yty)) } if (any(grep("hyper", g, ignore.case = TRUE))) { return(.gprior.hyperg.init(g = g, return.g.stats = return.g.stats, N = N, K = K, yty = yty)) } return(.gprior.constg.init(g = g, return.g.stats = return.g.stats, N = N, K = K, yty = yty)) } .choose.mprior <- function (mpmode, mpparam, K, ..., fixed.pos = numeric(0)) { origargs = list(mpmode = mpmode, mpparam = mpparam) fixed.pos = { 1:K }[fixed.pos] fixed.exist = as.logical(length(fixed.pos)) fixk = length(fixed.pos) if (!(is.character(mpmode) || is.function(mpmode) || is.list(mpmode))) stop("'mprior' parameter must be character! (or function/list)") if (is.function(mpmode) || is.list(mpmode)) { mpinfo = mpmode } else if (any(grep("fix", mpmode, ignore.case = TRUE))) { mpinfo = .mprior.fixedt.init if (is.numeric(mpparam)) mpparam = mpparam[[1]] - fixk } else if (any(grep("unif", mpmode, ignore.case = TRUE))) { mpinfo = .mprior.uniform.init } else if (any(grep("custom", mpmode, ignore.case = TRUE))) { mpinfo = .mprior.customk.init if (fixed.exist && is.numeric(mpparam)) if (length(mpparam) == K + 1) mpparam = mpparam[(fixk + 1):length(mpparam)] } else if (any(grep("pip", mpmode, ignore.case = TRUE))) { mpinfo = .mprior.pip.init if (fixed.exist && is.numeric(mpparam)) if (length(mpparam) == K) mpparam = mpparam[-fixed.pos] } else { mpinfo = .mprior.randomt.init if (is.numeric(mpparam)) mpparam = mpparam[[1]] - fixk } if (is.function(mpinfo)) mpinfo = .fixedset.mprior(mpinfo, fullK = K, fixed.pos = fixed.pos, K = NA, mpparam = mpparam, mpmode = mpmode, ...) if (!all(c("mp.mode", "mp.msize", "pmp") %in% names(mpinfo))) stop("The provided custom-built model prior is deficient.") if (!("origargs" %in% names(mpinfo))) mpinfo$origargs = origargs if (length(fixed.pos) > 0) mpinfo$fixed.pos = fixed.pos class(mpinfo) <- c("mprior", class(mpinfo)) return(mpinfo) } .constr.intmat <- function (X, K) { intix = grep("#", colnames(X), fixed = TRUE) mPlus = diag(K) colnames(mPlus) <- colnames(X) for (jj in 1:length(intix)) { cix = intix[jj] mPlus[cix, unlist(strsplit(colnames(mPlus)[cix], "#", fixed = TRUE))] = 1 } return(mPlus) } .construct.arglist <- function (funobj, envir = NULL) { namedlist = formals(funobj) argnames = names(namedlist) if (!is.environment(envir)) envir = sys.frame(-1) for (argn in 1:length(namedlist)) { testval = as.logical(try(exists(argnames[argn], envir = envir), silent = TRUE)) if (is.na(testval)) testval = FALSE if (testval) { namedlist[[argn]] = try(get(argnames[argn], envir = envir)) } } return(namedlist) } .cor.topmod <- function (tmo) { if (is.bma(tmo)) tmo = tmo$topmod pmp.10 = pmp.bma(tmo, oldstyle = TRUE) if (nrow(pmp.10) == 1 | suppressWarnings(length(grep("error", class(try(cor(pmp.10[, 1], pmp.10[, 2]), silent = TRUE)))))) { corr.pmp = NA } else { if (var(pmp.10[, 2]) == 0) corr.pmp = NA else corr.pmp = cor(pmp.10[, 1], pmp.10[, 2]) } return(corr.pmp) } .enum_fromindex <- function (lindex) { lindex = lindex[[1]] if (lindex == 0) return(FALSE) log2 = ceiling(log(lindex + 1, 2)) return(as.logical((lindex + 2^((log2 - 1):0))%/%(2^(log2:1))%%2)) } .enum_startend <- function (iter = NA, start.value = 0, K = 1, maxk = K, fixed.pos = numeric(0)) { fixed.pos = { 1:K }[fixed.pos] effk = K - length(fixed.pos) flexpos = { 1:K } if (length(fixed.pos) > 0) flexpos = { 1:K }[-fixed.pos] start.value2 = 0 if (length(start.value) == 1) { start.value2 = suppressWarnings(as.integer(start.value)) if (any(is.na(start.value2)) | start.value2[[1]] < 0 | start.value2[[1]] >= (2^effk - 1)) { start.value = 0 start.value2 = 0 } } else { start.value = 0 } if (length(start.value) == 1) { start.value_cut = .enum_fromindex(start.value2) start.value = rep(1, K) start.value[flexpos] = c(numeric(effk - length(start.value_cut)), start.value_cut) } if (K > maxk) { lastindex = 2^effk - 1 - sum(choose(effk, (maxk + 1):effk)) } else lastindex = 2^effk - 1 if (is.na(iter)) { iter = lastindex - start.value2 } iter = min(iter, 2^effk - 1 - start.value2) return(list(start.value = start.value, iter = iter)) } .f21_4hyperg <- function (N, K, f21a, ltermbounds = c(200, 600, 1400, 3000)) { create.lterms = function(cc) lapply(as.list(ltermbounds), function(x) (a + 0:x)/(cc + 0:x)) a = (N - 1)/2 cv = (f21a + 0:K)/2 lterms = (lapply(cv, create.lterms)) ltermbounds = c(0, ltermbounds[-length(ltermbounds)]) return(list(calcit = function(z, k) { nbterms = sum(ceiling(abs({ a - cv[k + 1] }/{ 1 - z }) * 1.5) >= ltermbounds) return(sum(cumprod(z * lterms[[k + 1]][[nbterms]])) + 1) })) } .f21simple <- function (a, c, z) { f21o = .f21_4hyperg(2 * a + 1, 0, c * 2) f21o$calcit(z, 0) } .fixedset.mprior <- function (mprior.function, fullK, fixed.pos = numeric(0), K = NA, ...) { if (length(fixed.pos) == 0) return(mprior.function(K = fullK, ...)) fixed.pos = { 1:fullK }[fixed.pos] flexpos = { 1:fullK }[-fixed.pos] flexk = length(flexpos) mprior = mprior.function(K = flexk, ...) fixk = length(fixed.pos) mpl = list(mp.mode = mprior$mp.mode, mp.msize = mprior$mp.msize + fixk, pmp = function(ki, mdraw, ...) { return(mprior$pmp(ki = ki - fixk, mdraw = mdraw[flexpos])) }, mp.Kdist = c(numeric(fixk), mprior$mp.Kdist)) return(mpl) } .fixedset.sampler <- function (sampler.function, fullK, fixed.pos = numeric(0), ...) { if (length(fixed.pos) == 0) return(sampler.function) fixed.pos = { 1:fullK }[fixed.pos] flexpos = { 1:fullK }[-fixed.pos] flexk = length(flexpos) outdraw = rep(1, fullK) outfun = function(molddraw = molddraw, K = flexk, ...) { flexdraw = sampler.function(molddraw = molddraw[flexpos], K = flexk, ...) outdraw[flexpos] = flexdraw[["mnewdraw"]] addi = flexdraw[["addi"]] dropi = flexdraw[["dropi"]] if (is.numeric(addi) || is.numeric(dropi)) { if (addi > 0) addi = flexpos[addi] else addi = 0 if (dropi > 0) dropi = flexpos[dropi] else dropi = 0 } return(list(mnewdraw = outdraw, positionnew = { 1:fullK }[as.logical(outdraw)], addi = addi, dropi = dropi)) } return(outfun) } .fls.samp <- function (molddraw = molddraw, K = K, ..., maxk = Inf, oldk = 0) { indch <- ceiling(runif(1, 0, K)) bdropit <- as.logical(molddraw[[indch]]) if (oldk == maxk) if (!bdropit) { indch = (1:K)[molddraw == 1][[ceiling(runif(1, 0, sum(molddraw)))]] bdropit = molddraw[[indch]] } if (bdropit) { addvar <- 0 dropvar <- indch molddraw[[indch]] <- 0 } else { addvar <- indch dropvar <- 0 molddraw[[indch]] <- 1 } positionnew <- { 1:K }[molddraw == 1] return(list(mnewdraw = molddraw, positionnew = positionnew, addi = addvar, dropi = dropvar)) } .fls.samp.int <- function (molddraw = molddraw, K = K, mPlus = mPlus, maxk = Inf, oldk = 0) { indch = ceiling(runif(1, 0, 1) * K) if (molddraw[indch] == 1) { mnewdraw = as.numeric(molddraw > mPlus[, indch]) dropvar = (1:K)[xor(molddraw, mnewdraw)] addvar = 0 } else { mnewdraw = as.numeric(molddraw | mPlus[indch, ]) addvar = (1:K)[xor(molddraw, mnewdraw)] dropvar = 0 } positionnew = which(mnewdraw == 1) if (length(positionnew) > maxk) { return(.fls.samp.int(molddraw = molddraw, K = K, mPlus = mPlus, maxk, oldk)) } else { return(list(mnewdraw = mnewdraw, positionnew = positionnew, addi = addvar, dropi = dropvar)) } } .getpolycoefs <- function (polyroots) { if (length(polyroots) == 1) return(c(1, polyroots)) restterms = .getpolycoefs(polyroots[-1]) c(restterms, 0) + c(0, polyroots[1] * restterms) } .gprior.constg.init <- function (g = NA, return.g.stats = TRUE, N = N, K = K, yty = 1, null.lik = NA, ...) { gg = NULL if (!(is.character(g) || is.numeric(g))) g = "UIP" if (any(grep("BRIC", g, ignore.case = TRUE)) | any(grep("FLS", g, ignore.case = TRUE))) { if (N <= (K^2)) { gg = (K^2) } else { gg = N } gtype = "BRIC" } if (any(grep("RIC", g, ignore.case = TRUE)) && (!any(grep("BRIC", g, ignore.case = TRUE)))) { gg = (K^2) gtype = "RIC" } if (any(grep("HQ", g, ignore.case = TRUE)) | any(grep("Hannan", g, ignore.case = TRUE))) { gg = (log(N))^3 gtype = "Hannan-Quinn" } if (is.numeric(g)) { gg = g gtype = "numeric" } if (is.null(gg)) { if (!(any(grep("UIP", g, ignore.case = TRUE)) | any(grep("BIC", g, ignore.case = TRUE)))) warning("The provided g prior could not be identified. Therefore the default g prior (UIP) has been selected.") gg = N gtype = "UIP" } gprior.info = list(gtype = gtype, is.constant = TRUE, return.g.stats = return.g.stats, shrinkage.moments = gg/(gg + 1), g = gg) g = gg if (!is.numeric(null.lik)) { null.lik = { 1 - N }/2 * log(yty) } g2 = g/{ g + 1 } l1g = log(1 + g) g2sq = g2^2 n1 = N - 1 gprior.info$lprobcalc <- list(just.loglik = function(ymy, k, ...) { return(0.5 * { { n1 - k } * l1g - n1 * log(g * ymy + yty) }) }, lprob.all = function(ymy, k, bhat, diag.inverse, ...) { b1new = g2 * bhat return(list(lprob = 0.5 * { { n1 - k } * l1g - n1 * log(g * ymy + yty) }, b1new = b1new, b2new = { { yty/g + ymy } * g2sq/{ N - 3 } } * diag.inverse + b1new^2, otherstats = numeric(0))) }) class(gprior.info) <- c("gprior", class(gprior.info)) return(gprior.info) } .gprior.eblocal.init <- function (g = NA, return.g.stats = TRUE, N = N, K = K, yty = 1, null.lik = NA, ...) { gprior.info = list(gtype = "EBL", is.constant = FALSE, return.g.stats = return.g.stats, shrinkage.moments = numeric(1), g = NA) if (!is.numeric(null.lik)) { null.lik = (1 - N)/2 * log(yty) } ymy.current = -1 k.current = -1 loglik = null.lik Fstat = numeric(0) g2 = 0 if (return.g.stats) { otherstats = numeric(1) } else { otherstats = numeric(0) } gprior.info$lprobcalc <- list(just.loglik = function(ymy, k, ...) { ymy.current <<- ymy k.current <<- k if (k == 0) { return(null.lik) } Fstat <<- (N - k - 1)/k * (yty - ymy)/ymy if (Fstat > 1) { g0 <- 1/(Fstat - 1) g2 <<- 1/(g0 + 1) } else { g2 <<- 0 return(null.lik) } lFstat = log(Fstat) lg02 = -lFstat loglik <<- 0.5 * { k * lg02 - { N - 1 } * { log(ymy + g0 * yty) + { log(Fstat - 1) - lFstat } } } return(loglik) }, lprob.all = function(ymy, k, bhat, diag.inverse, ...) { if (k == 0) { return(list(lprob = null.lik, b1new = numeric(0), b2new = numeric(0), otherstats = otherstats)) } if ((ymy != ymy.current) | (k != k.current)) { Fstat <<- { N - k - 1 }/k * (yty - ymy)/ymy if (Fstat > 1) { g0 = 1/{ Fstat - 1 } g2 <<- 1/(g0 + 1) lFstat = log(Fstat) lg02 = -lFstat loglik <<- 0.5 * { k * lg02 - { N - 1 } * { log(ymy + g0 * yty) + { log(Fstat - 1) - lFstat } } } } else { g0 = 0 g2 <<- 0 loglik <<- null.lik } } if (return.g.stats) { otherstats = g2 } b1new = g2 * bhat if (g2 > 0) { b2new = { { (1/g2 - 1) * yty + ymy } * { g2^2 }/{ N - 3 } } * diag.inverse + b1new^2 } else { b2new = numeric(k) } return(list(lprob = loglik, b1new = b1new, b2new = b2new, otherstats = otherstats)) }) class(gprior.info) <- c("gprior", class(gprior.info)) return(gprior.info) } .gprior.hyperg.init <- function (g = NA, return.g.stats = TRUE, N = N, K = K, yty = 1, null.lik = NA, ...) { if (!is.character(g)) g = "hyper" if (any(grep("=", g))) { f21a = suppressWarnings(as.numeric(unlist(strsplit(g, "="))[2])) if (!is.numeric(f21a) | is.na(f21a)) { f21a.char = suppressWarnings(as.character(unlist(strsplit(g, "="))[2])) if (any(grep("bric", f21a.char, ignore.case = TRUE))) { f21a = 2 + 2/max(N, K^2) } else if (any(grep("uip", f21a.char, ignore.case = TRUE))) { f21a = 2 + 2/N } else { warning("You did not supply a proper 'a' parameter for the hyper g prior (like e.g. the format g='hyperg=3.1' or g='hyper=UIP') - thus set to default value 'hyper=UIP' instead.") f21a = 2 + 2/N } } else { if (f21a <= 2 | f21a > 4) { f21a = 2 + 2/N warning("You provided an 'a' parameter for the hyper g prior that is not element of (2,4]. I chose the default value 'hyper=UIP' instead.") } } } else { f21a = 2 + 2/N } gprior.info = list(gtype = "hyper", is.constant = FALSE, return.g.stats = return.g.stats, shrinkage.moments = numeric(2), g = NA, hyper.parameter = f21a) if (!is.numeric(null.lik)) { null.lik = { 1 - N }/2 * log(yty) } gmoments = numeric(2) N12 = { N - 1 }/2 la2 = log(f21a - 2) log.lik = null.lik ymy.current = -1 k.current = -1 intconstinv = f21a - 2 f21o = .f21_4hyperg(N, K, f21a) gprior.info$lprobcalc <- list(just.loglik = function(ymy, k, ...) { if (k == 0) { return(null.lik) } ymy.current <<- ymy k.current <<- k intconstinv <<- { k + f21a - 2 }/f21o[["calcit"]](1 - ymy/yty, k) if (intconstinv < 0) { intconstinv <<- k + f21a - 2 } log.lik <<- null.lik + la2 - log(intconstinv) return(log.lik) }, lprob.all = function(ymy, k, bhat, diag.inverse, ...) { if (k == 0) { return(list(lprob = null.lik, b1new = numeric(0), b2new = numeric(0), otherstats = c(2/f21a, 8/f21a/(f21a + 2)))) } N3 = N - 3 ka2 = k + f21a - 2 R2 = 1 - ymy/yty if ((ymy != ymy.current) | (k != k.current)) { intconstinv <<- ka2/f21o[["calcit"]](R2, k) log.lik <<- null.lik + la2 - log(intconstinv) } g2hyper = { intconstinv - ka2 + N3 * R2 }/{ R2 * { N3 - ka2 } } gbetavar = { { 1 + 2/N3 * R2/{ 1 - R2 } } * intconstinv + { N3 - 2 } * R2 - ka2 } * N3 * { 1 - R2 }/{ N3 - ka2 }/{ N3 - ka2 - 2 }/R2 * yty/N3 * diag.inverse if (return.g.stats) { ka = ka2 + 2 Eg22 = { { { N3 - 2 } * R2 - ka } * intconstinv + { N3 * R2 - ka2 }^2 - 2 * { N3 * R2^2 - ka2 } }/R2^2/{ N3 - ka2 }/{ N3 - ka } gmoments = c(g2hyper, Eg22) } return(list(lprob = log.lik, b1new = g2hyper * bhat, b2new = gbetavar + g2hyper^2 * bhat^2, otherstats = gmoments)) }) class(gprior.info) <- c("gprior", class(gprior.info)) return(gprior.info) } .hexcode.binvec.convert <- function (length.of.binvec) { if (length(length.of.binvec) > 1) length.of.binvec = length(length.of.binvec) addpositions = 4 - length.of.binvec%%4 positionsby4 = (length.of.binvec + addpositions)/4 hexvec = c(0:9, "a", "b", "c", "d", "e", "f") hexcodelist = list(`0` = numeric(4), `1` = c(0, 0, 0, 1), `2` = c(0, 0, 1, 0), `3` = c(0, 0, 1, 1), `4` = c(0, 1, 0, 0), `5` = c(0, 1, 0, 1), `6` = c(0, 1, 1, 0), `7` = c(0, 1, 1, 1), `8` = c(1, 0, 0, 0), `9` = c(1, 0, 0, 1), a = c(1, 0, 1, 0), b = c(1, 0, 1, 1), c = c(1, 1, 0, 0), d = c(1, 1, 0, 1), e = c(1, 1, 1, 0), f = c(1, 1, 1, 1)) return(list(as.hexcode = function(binvec) { incl = c(numeric(addpositions), binvec) dim(incl) = c(4, positionsby4) return(paste(hexvec[crossprod(incl, 2L^(3:0)) + 1], collapse = "")) }, as.binvec = function(hexcode) { return(unlist(hexcodelist[unlist(strsplit(hexcode, "", fixed = TRUE), recursive = FALSE, use.names = FALSE)], recursive = FALSE, use.names = FALSE)[-(1:addpositions)]) })) } .index.bma <- function (x, i, ...) { x$topmod <- x$topmod[i] return(x) } .index.topmod <- function (x, i, ...) { tm = x idx = i if (any(is.na(suppressWarnings(as.integer(idx))))) idx = 1:length(tm$lik()) if (length(tm$betas_raw()) > 1) { bbeta = TRUE bet = as.vector(tm$betas()[, idx]) bet = bet[bet != 0] } else { bbeta = FALSE bet = numeric(0) } if (length(tm$betas2_raw()) > 1) { bbeta2 = TRUE bet2 = as.vector(tm$betas2()[, idx]) bet2 = bet2[bet2 != 0] } else { bbeta2 = FALSE bet2 = numeric(0) } fixvec = tm$fixed_vector() if (!length(as.vector(fixvec))) fixvec = numeric(0) else fixvec = as.vector(t(fixvec[, idx])) .top10(nmaxregressors = tm$nregs, nbmodels = tm$nbmodels, bbeta = bbeta, lengthfixedvec = nrow(tm$fixed_vector()), bbeta2 = bbeta2, inivec_lik = tm$lik()[idx], inivec_bool = tm$bool()[idx], inivec_count = tm$ncount()[idx], inivec_vbeta = bet, inivec_vbeta2 = bet2, inivec_veck = tm$kvec_raw()[idx], inivec_fixvec = fixvec) } .iterenum <- function (molddraw = numeric(0), K = length(molddraw), ...) { even.lead1 = { 1:K }[!{ cumsum(molddraw)%%2 }] i = even.lead1[length(even.lead1)] molddraw[i] = !molddraw[i] addi = molddraw[i] * i dropi = { !molddraw[i] } * i return(list(mnewdraw = molddraw, positionnew = { 1:K }[as.logical(molddraw)], addi = addi, dropi = dropi)) } .iterenum.bone <- function (molddraw = numeric(0), maxk = Inf) { even.lead1 = ((1:length(molddraw))[!(cumsum(molddraw)%%2)]) i = even.lead1[length(even.lead1)] molddraw[i] = !molddraw[i] if (sum(molddraw) > maxk) return(.iterenum.bone(molddraw, maxk)) else return(molddraw) } .iterenum.KgtN <- function (molddraw = numeric(0), maxk = Inf, oldk = 0, ...) { mnewdraw = .iterenum.bone(molddraw = molddraw, maxk) addi = (1:length(mnewdraw))[molddraw < mnewdraw] if (length(addi) == 0) addi = 0 dropi = (1:length(mnewdraw))[molddraw > mnewdraw] if (length(dropi) == 0) dropi = 0 return(list(mnewdraw = mnewdraw, positionnew = (1:length(mnewdraw))[as.logical(mnewdraw)], addi = addi, dropi = dropi)) } .lprob.constg.init <- function (...) { gpo = .gprior.constg.init(...) return(gpo$lprobcalc) } .lprob.eblocal.init <- function (...) { gpo = .gprior.eblocal.init(...) return(gpo$lprobcalc) } .lprob.hyperg.init <- function (...) { gpo = .gprior.hyperg.init(...) return(gpo$lprobcalc) } .mprior.customk.init <- function (K, mpparam, ...) { if (any(is.na(mpparam))) mpparam = rep(0.5, K) if (!is.numeric(mpparam)) stop("For custom model size priors, you need to provide a K+1 vector with positive elements for argument 'mprior.size'.") mpparam = as.vector(mpparam) if (!((length(mpparam) == (K + 1)) & all(mpparam > 0))) { stop("For custom model size priors, you need to provide a K+1 vector with positive elements for argument 'mprior.size'.") } mpkvec = log(mpparam) return(list(mp.mode = "custom", mp.msize = sum(choose(K, 0:K) * mpparam * { 0:K })/sum(choose(K, 0:K) * mpparam), pmp = function(ki, ...) { return(mpkvec[[ki + 1]]) }, mp.Kdist = choose(K, 0:K) * mpparam/sum(choose(K, 0:K) * mpparam))) } .mprior.fixedt.init <- function (K, mpparam, ...) { if (is.na(mpparam[1])) mpparam <- K/2 if ((mpparam[[1]] >= K) & (length(mpparam) == 1)) { warning("Submitted prior model size is >= than the nr. of regressors\n, used K/2 instead\n\n") mpparam <- K/2 } m = mpparam[[1]] return(list(mp.mode = "fixed", mp.msize = m, pmp = function(ki, ...) { post.odds1 = ki * log(m/K) + { K - ki } * log(1 - m/K) return(post.odds1) }, mp.Kdist = dbinom(x = 0:K, size = K, prob = m/K, log = FALSE))) } .mprior.pip.init <- function (K, mpparam, ...) { if (any(is.na(mpparam))) mpparam = rep(0.5, K) if (!is.numeric(mpparam)) stop("For prior inclusion probabilites, you need to provide a K vector with elements between 0 and 1 for argument 'mprior.size'.") mpparam = as.vector(mpparam) if (!((length(mpparam) == K) & all(mpparam > 0) & all(mpparam <= 1))) stop("For prior inclusion probabilites, you need to provide a K vector with elements between 0 and 1 for argument 'mprior.size'.") if (any(mpparam == 1L)) warning("Prior Inclsuion Prob. = 1 are impractical. Try using the argument fixed.reg") inclfacts = log(mpparam/(1 - mpparam)) return(list(mp.mode = "pip", mp.msize = sum(mpparam), pmp = function(mdraw, ...) { return(sum(inclfacts[as.logical(mdraw)])) }, mp.Kdist = .getpolycoefs(mpparam/{ 1 - mpparam }) * prod(1 - mpparam))) } .mprior.randomt.init <- function (K, mpparam, ...) { if (is.na(mpparam[1])) mpparam <- K/2 if ((mpparam[[1]] >= K) & (length(mpparam) == 1)) { warning("Submitted prior model size is >= than the nr. of regressors\n, used K/2 instead\n\n") mpparam <- K/2 } m = mpparam[[1]] vecofpriors = lgamma(1 + 0:K) + lgamma({ K - m }/m + K - 0:K) beta.bin = function(a = 1, b = (K - m)/m, K = K, w = 0:K) { lgamma(a + b) - { lgamma(a) + lgamma(b) + lgamma(a + b + K) } + log(choose(K, w)) + lgamma(a + w) + lgamma(b + K - w) } return(list(mp.mode = "random", mp.msize = m, pmp = function(ki, ...) { return(vecofpriors[[ki + 1]]) }, mp.Kdist = exp(beta.bin(a = 1, b = { K - m }/m, K = K, w = 0:K)))) } .mprior.uniform.init <- function (K, ...) { return(list(mp.mode = "uniform", mp.msize = K/2, pmp = function(...) return(0), mp.Kdist = exp(lchoose(K, 0:K) - K * log(2)))) } .ols.terms2 <- function (positions, yty, k = NULL, N = N, K = K, XtX.big = XtX.big, Xty.big = Xty.big, ...) { syminv <- function(symmat, ndim = ncol(symmat)) { if (!is.matrix(symmat)) { symmat = as.matrix(symmat) } return(chol2inv(chol(symmat), size = ndim)) } if (is.null(k)) k = length(positions) XtXinv.return = numeric(0) if (sum(k) == 0) { Xty = numeric(0) XtXinv = matrix(0, 0, 0) bhat = numeric(0) ymy = yty positions = 0 } else { XtX <- XtX.big[positions, positions, drop = FALSE] Xty <- Xty.big[positions] XtXinv <- syminv(XtX, ndim = k) bhat <- crossprod(XtXinv, Xty) ymy <- yty - crossprod(Xty, bhat)[[1]] } return(list(full.results = function() { return(list(ymy = ymy, bhat = bhat, diag.inverse = XtXinv[1:k + 0:(k - 1) * k])) }, child.ymy = function(addix = 0, dropix = 0, ...) { if (!any(as.logical(c(addix, dropix)))) { return(ymy) } if (all(as.logical(c(addix, dropix)))) { jhere = { 1:k }[positions == dropix] poshere = positions[-jhere] Xj = XtXinv[, jhere] Xtxi = XtX.big[poshere, addix] bxlessj = crossprod(XtXinv, XtX.big[positions, addix]) - Xj * XtX.big[addix, dropix] bhatx = bxlessj[-jhere] - Xj[-jhere] * bxlessj[jhere]/Xj[jhere] child.ymy = ymy + bhat[jhere]^2/Xj[jhere] - { Xty.big[addix] - crossprod(Xty.big[poshere], bhatx)[[1]] }^2/{ XtX.big[addix, addix] - crossprod(bhatx, Xtxi)[[1]] } return(child.ymy) } else { if (addix == 0) { jhere = { 1:k }[positions == dropix] child.ymy = ymy + bhat[jhere]^2/XtXinv[jhere, jhere] return(child.ymy) } else { Xtxi = XtX.big[positions, addix] bhatx = crossprod(XtXinv, Xtxi)[, 1] child.ymy = ymy - { Xty.big[addix] - crossprod(bhatx, Xty)[[1]] }^2/{ XtX.big[addix, addix] - crossprod(bhatx, Xtxi)[[1]] } return(child.ymy) } } }, mutate = function(addix = 0, dropix = 0, newpos = numeric(0), newk = 0, ...) { if (newk == 0) { XtXinv <<- matrix(0, 0, 0) Xty <<- numeric(0) } else { if (newk < 7 | addix[[1]] != 0 | length(c(dropix, addix)) > 2) { Xty <<- Xty.big[newpos] XtXinv <<- syminv(XtX.big[newpos, newpos, drop = FALSE], ndim = newk) } else { if (dropix[1] > 0) { jhere = sum(positions <= dropix) Xty <<- Xty[-jhere] Xj = XtXinv[, jhere] XtXinv <<- { XtXinv - tcrossprod(Xj/Xj[jhere], Xj) }[-jhere, -jhere] } else { jhere = sum(positions < addix) + 1 Xtxx = XtX.big[addix, newpos] Xtx = Xtxx[-jhere] Xty <<- Xty.big[newpos] bhatx = crossprod(XtXinv, Xtx)[, 1] bhatxadj = c(bhatx[0:(jhere - 1)], -1, bhatx[jhere:k]) if (jhere == newk) bhatxadj = bhatxadj[-(jhere + 1:2)] newinv = tcrossprod(bhatxadj, bhatxadj/(Xtxx[jhere] - crossprod(Xtx, bhatx)[[1]])) newinv[-jhere, -jhere] = newinv[-jhere, -jhere] + XtXinv XtXinv <<- newinv } } } positions <<- newpos k <<- newk bhat <<- crossprod(XtXinv, Xty)[, 1] ymy <<- yty - crossprod(Xty, bhat)[[1]] return(list(ymy = ymy, bhat = bhat, diag.inverse = XtXinv[1:k + 0:{ k - 1 } * k])) }, return.inverse = function() XtXinv, ymy = ymy, bhat = bhat, diag.inverse = XtXinv[1:k + 0:{ k - 1 } * k])) } .post.beta.draws <- function (topmods, reg.names, moment2 = FALSE) { if (moment2) beta.draws = as.matrix(topmods$betas2()) else beta.draws = as.matrix(topmods$betas()) if (sum(beta.draws) == 0) { stop("The tompod object provided does not have saved betas. cf. bbeta argument in function topmod") } if (nrow(beta.draws) != length(reg.names)) { rownames(beta.draws) = c(reg.names, "W-Index") } else { rownames(beta.draws) = c(reg.names) } beta.names = topmods$bool() if (length(which(beta.names == "0")) > 0) { colnames(beta.draws) = beta.names[-c(which(beta.names == "0"))] } else { colnames(beta.draws) = beta.names } return(beta.draws) } .post.calc <- function (gprior.info, add.otherstats, k.vec, null.count, X.data, topmods, b1mo, b2mo, iter, burn, inccount, models.visited, K, N, msize, timed, cumsumweights = NA, mcmc = "bd", possign = NA) { postad.k.vec <- function(k.vec, null.count) c(null.count, k.vec) postad.gprior.info <- function(gprior.info, add.otherstats = numeric(0), cumsumweights = 1) { if (gprior.info$return.g.stats) { if (length(add.otherstats) > 0) { gprior.info$shrinkage.moments = add.otherstats/cumsumweights } else { gprior.info$shrinkage.moments = 1/(1 + 1/gprior.info$g) } } return(gprior.info) } postad.reg.names <- function(X.data) { if (is.null(colnames(X.data)[-1]) || colnames(X.data)[-1] == "") { reg.names <- paste("beta", 1:K) } else { reg.names = colnames(X.data)[-1] } return(reg.names) } gprior.info = postad.gprior.info(gprior.info, add.otherstats, cumsumweights) k.vec = postad.k.vec(k.vec, null.count) cons = .post.constant(X.data, b1mo/cumsumweights) pmp.10 = pmp.bma(topmods, oldstyle = TRUE) if (nrow(pmp.10) == 1 | suppressWarnings(length(grep("error", class(try(cor(pmp.10[, 1], pmp.10[, 2]), silent = TRUE)))))) { corr.pmp = NA } else { if (var(pmp.10[, 2]) == 0) corr.pmp = NA else corr.pmp = cor(pmp.10[, 1], pmp.10[, 2]) } if (is.na(possign[[1]])) possign = numeric(K) info.object = list(iter = iter, burn = burn, inccount = inccount, models.visited = models.visited, b1mo = b1mo, b2mo = b2mo, add.otherstats = add.otherstats, cumsumweights = cumsumweights, K = K, N = N, corr.pmp = corr.pmp, msize = msize, timed = timed, k.vec = k.vec, cons = cons, pos.sign = possign) reg.names = postad.reg.names(X.data) return(list(info = info.object, k.vec = k.vec, cons = cons, gprior.info = gprior.info, pmp.10 = pmp.10, reg.names = reg.names)) } .post.constant <- function (X.data, Ebeta) { Xmeans = colMeans(X.data) cons = Xmeans[1] - crossprod(Ebeta, Xmeans[-1]) return(as.vector(cons)) } .post.estimates <- function (b1mo = NULL, b2mo = NULL, cumsumweights = NULL, inccount = NULL, topmods = NULL, X.data = NULL, reg.names = NULL, pos.sign = NULL, exact = FALSE, order.by.pip = TRUE, include.constant = FALSE, incl.possign = TRUE, std.coefs = FALSE, condi.coef = FALSE) { idx = 1:(length(b1mo)) if (exact) { lt1 = topmods$lik() - max(topmods$lik()) exact.pmp = as.vector(exp(lt1)/sum(exp(lt1))) pip = as.vector(topmods$bool_binary() %*% exact.pmp) idx = 1:(length(pip)) betas = topmods$betas() betas2 = topmods$betas2() K = nrow(betas) Eb1 = tcrossprod(betas, t(exact.pmp))[, 1] Eb2 = tcrossprod(betas2, t(exact.pmp))[, 1] Ebsd = sqrt(Eb2 - Eb1^2) possign = round(tcrossprod((betas > 0), t(exact.pmp))[, 1]/pip, 8) possign[is.nan(possign)] = NA } else { pip = inccount/cumsumweights Eb1 = b1mo/cumsumweights Eb2 = b2mo/cumsumweights Ebsd = sqrt(Eb2 - Eb1^2) possign = round(pos.sign/inccount, 8) possign[is.nan(possign)] = NA } if (include.constant) constterm = .post.constant(X.data, Eb1) if (condi.coef) { Eb1 = Eb1/pip Eb2 = Eb2/pip Ebsd = sqrt(Eb2 - Eb1^2) Eb1[is.nan(Eb1)] = 0 Ebsd[is.nan(Ebsd)] = 0 } if (std.coefs) { sddata = apply(as.matrix(X.data), 2, stats::sd) Eb1 = Eb1/sddata[1] * sddata[-1] Ebsd = Ebsd/sddata[1] * sddata[-1] if (include.constant) constterm = constterm/sddata[1] } if (incl.possign) { post.mean <- cbind(pip, Eb1, Ebsd, possign, idx) rownames(post.mean) <- reg.names colnames(post.mean) <- c("PIP", "Post Mean", "Post SD", "Cond.Pos.Sign", "Idx") } else { post.mean <- cbind(pip, Eb1, Ebsd, idx) rownames(post.mean) <- reg.names colnames(post.mean) <- c("PIP", "Post Mean", "Post SD", "Idx") } if (order.by.pip) { post.mean <- post.mean[order(-post.mean[, 1]), ] } if (include.constant) { constrow = matrix(c(1, constterm, NA, rep(NA, incl.possign), 0), 1) rownames(constrow) = "(Intercept)" post.mean = rbind(post.mean, constrow) } return(post.mean) } .post.topmod.bma <- function (topmods, reg.names = numeric(0)) { pmps = pmp.bma(topmods) if (is.bma(topmods)) { reg.names = topmods$reg.names topmods = topmods$topmod } rbind(.post.topmod.includes(topmods, reg.names), t(pmps)) } .post.topmod.includes <- function (topmods, reg.names) { topmod = topmods$bool_binary() colnames(topmod) <- topmods$bool() rownames(topmod) = reg.names return(topmod) } .quantile.density <- function (x, probs = seq(0.25, 0.75, 0.25), names = TRUE, normalize = TRUE, ...) { my.quantile.density = function(x, probs, names, normalize, ...) { ycs = (cumsum(x$y) - (x$y - x$y[[1]])/2) * diff(x$x[1:2]) if (normalize) ycs = ycs/(ycs[[length(ycs)]]) xin = x$x maxi = length(ycs) qqs = sapply(as.list(probs), function(qu) { iii = sum(ycs <= qu) if (iii == maxi) return(Inf) else if (iii == 0L) return(-Inf) else { return(xin[[iii + 1]] + ((ycs[[iii + 1]] - qu)/(ycs[[iii + 1]] - ycs[[iii]])) * (xin[[iii]] - xin[[iii + 1]])) } }) if (as.logical(names)) names(qqs) = paste(format(100 * probs, trim = TRUE, digits = max(2L, getOption("digits"))), "%", sep = "") return(qqs) } probs = as.vector(probs) if (is.element("density", class(x))) return(my.quantile.density(x = x, probs = probs, names = names, normalize = normalize)) if (!all(sapply(x, function(dd) is.element("density", class(dd))))) stop("x needs to be a density or list of densities") if (length(x) == 1L) return(my.quantile.density(x = x[[1]], probs = probs, names = names, normalize = normalize)) qout = sapply(x, my.quantile.density, probs = probs, names = FALSE, normalize = normalize) if (!is.matrix(qout)) { if (length(probs) > 1) return(qout) qout = as.matrix(qout) } else qout = t(qout) if (as.logical(names)) colnames(qout) = paste(format(100 * probs, trim = TRUE, digits = max(2L, getOption("digits"))), "%", sep = "") return(qout) } .rev.jump <- function (molddraw = molddraw, K = K, ..., maxk = Inf, oldk = 0) { rev.idx = ceiling(runif(1, 0, 2)) if (rev.idx == 1) { birth.death = .fls.samp(molddraw = molddraw, K = K, maxk = maxk, oldk = oldk) mnewdraw = birth.death[["mnewdraw"]] positionnew = birth.death[["positionnew"]] addvar = birth.death[["addi"]] dropvar = birth.death[["dropi"]] } if (rev.idx == 2) { var.in = (1:K)[as.logical(molddraw)] var.out = (1:K)[!as.logical(molddraw)] var.in.rand = ceiling(length(var.in) * runif(1, 0, 1)) addvar = var.out[ceiling(length(var.out) * runif(1, 0, 1))] dropvar = var.in[var.in.rand] mnewdraw = molddraw mnewdraw[addvar] = 1 mnewdraw[dropvar] = 0 positionnew = (1:K)[as.logical(mnewdraw)] dropvar = max(dropvar, 0) addvar = max(addvar, 0) } return(list(mnewdraw = mnewdraw, positionnew = positionnew, addi = addvar, dropi = dropvar)) } .rev.jump.int <- function (molddraw = molddraw, K = K, mPlus = mPlus, maxk = Inf, oldk = 0) { rev.idx = floor(runif(1, 0, 1) * 2) if ((rev.idx) | oldk == 0) { birth.death = .fls.samp.int(molddraw = molddraw, K = K, mPlus = mPlus, maxk, oldk) mnewdraw = birth.death$mnewdraw positionnew = birth.death$positionnew addvar = birth.death$addi dropvar = birth.death$dropi } else { var.in = (1:K)[as.logical(molddraw)] var.out = (1:K)[!as.logical(molddraw)] mnewdraw = (molddraw > mPlus[, var.in[ceiling(length(var.in) * runif(1, 0, 1))]]) mnewdraw = mnewdraw | mPlus[var.out[ceiling(length(var.out) * runif(1, 0, 1))], ] positionnew = (1:K)[mnewdraw] addvar = (1:K)[molddraw < mnewdraw] dropvar = (1:K)[molddraw > mnewdraw] if (length(dropvar) == 0) dropvar = 0 if (length(addvar) == 0) addvar = 0 } if (length(positionnew) > maxk) { return(.rev.jump.int(molddraw = molddraw, K = K, mPlus = mPlus, maxk, oldk)) } else { return(list(mnewdraw = as.numeric(mnewdraw), positionnew = positionnew, addi = addvar, dropi = dropvar)) } } .starter <- function (K, start.value, y, N = N, XtX.big = XtX.big, Xty.big = Xty.big, X = X, fixed.pos = numeric(0)) { if (is.na(start.value[1])) { start.value = min((N - 3), K) } if (any(start.value < 0) | !(is.numeric(start.value) | is.logical(start.value))) { start.value = min((N - 3), K) warning("Argument 'start.value' did not conform to required format. start.value has been changed to default - min(N-3,K)") } if (length(start.value) == 0) { start.value = numeric(K) } if (length(start.value) == 1) { if (start.value == 0) { start.value = numeric(K) } } if (length(start.value) > 1 && any(start.value > 1)) { sv = numeric(K) sv[start.value] = 1 start.value = sv rm(sv) } if (length(start.value) == 1) { if (start.value > min((N - 3), K)) { cat("Submitted Start value is too large, used\n min(N-3,K) as starting model size instead\n\n") start.value = min((N - 3), K) } sorter = runif(K) start.position = order(sorter, seq(1:K))[1:start.value] XtX.start <- XtX.big[start.position, start.position] XtXinv.start <- chol2inv(chol(XtX.start)) bhat = XtXinv.start %*% Xty.big[start.position] e = y - X[, start.position] %*% bhat sse = crossprod(e) s2 = as.numeric(sse/(N - length(start.position))) bcov = s2 * XtXinv.start bt = bhat/sqrt(diag(bcov)) molddraw = rep(0, K) goodguy = as.numeric(abs(bt) > 0.2) molddraw[start.position] = goodguy start.position = (1:K)[as.logical(molddraw)] outstart = list(molddraw = molddraw, bhat = bhat, start.position = start.position) } if (length(start.value) > 1 && sum(start.value) == 0) { outstart = list(molddraw = rep(0, K), bhat = rep(0, K), start.position = integer(0)) } if (length(start.value) > 1 && sum(start.value) > 0) { if (length(start.value) != K) { stop("Starting Model contains unequal to K regressors,please respecify") } start.position = which(as.logical(start.value)) XtX.start <- XtX.big[start.position, start.position] XtXinv.start <- chol2inv(chol(XtX.start)) bhat = XtXinv.start %*% Xty.big[start.position] molddraw = rep(0, K) molddraw[start.position] = 1 outstart = list(molddraw = molddraw, bhat = bhat, start.position = start.position) } fixed.pos = (1:K)[fixed.pos] if (length(fixed.pos) > 0) { outstart$molddraw[fixed.pos] = 1 outstart$start.position = (1:K)[as.logical(outstart$molddraw)] } return(outstart) } .top10 <- function (nmaxregressors = 10, nbmodels = 10, bbeta = FALSE, lengthfixedvec = 0, bbeta2 = FALSE, ..., inivec_lik = numeric(0), inivec_bool = character(0), inivec_count = numeric(0), inivec_vbeta = numeric(0), inivec_vbeta2 = numeric(0), inivec_veck = 0, inivec_fixvec = numeric(0)) { findex = function() { seq_incl = seq_len(nbmodel) if (nbmodel == nbmodels) { seq_incl[indices] = seq_incl } else { truncindex = indices truncindex[(nbmodel + 1):nbmodels] = 0L seq_incl[truncindex] = seq_incl } return(seq_incl) } betamat = function(top10_betavec) { bins = (sapply(as.list(top10_bool[findex()]), hexobject$as.binvec)) betamatx = matrix(0, nmaxregressors, nbmodel) if (length(top10_betavec) > 0) { betamatx[which(bins == 1)] = top10_betavec } else betamatx = betamatx[, 1] return(betamatx) } hexobject <- .hexcode.binvec.convert(nmaxregressors) if (nbmodels < 0) { nbmodels = 0 } indices = integer(nbmodels) top10_lik = rep(-Inf, nbmodels) top10_bool = character(nbmodels) top10_count = integer(nbmodels) top10_fixvec = numeric(lengthfixedvec * nbmodels) if (bbeta) lbetas = vector("list", nbmodels) if (bbeta2) lbetas2 = vector("list", nbmodels) seq_nbmodel = seq_len(nbmodels) ix_of_mybool = logical(nbmodels) nbmodel = length(inivec_lik) top10_lik[seq_len(nbmodel)] = inivec_lik top10_count[seq_len(nbmodel)] = inivec_count if (is.character(inivec_bool)) { top10_bool[seq_len(nbmodel)] = inivec_bool } else { if (is.vector(inivec_bool) & (length(inivec_bool) == nmaxregressors)) { top10_bool[seq_len(nbmodel)] = hexobject$as.hexcode(inivec_bool) } else if (is.list(inivec_bool)) { top10_bool[seq_len(nbmodel)] = sapply(inivec_bool, hexobject$as.hexcode) } else if (is.matrix(inivec_bool)) { top10_bool[seq_len(nbmodel)] = sapply(as.list(as.data.frame(inivec_bool)), hexobject$as.hexcode) } else stop("inivec_bool is wrong format!") } top10_fixvec = inivec_fixvec if (is.na(inivec_veck[1])) { inivec_veck = 0 } if (bbeta | bbeta2) { veck_ix = c(0, cumsum(inivec_veck)) veckix_aux = as.list(seq_len(nbmodel)) veckix_aux = lapply(veckix_aux, function(x) { if (veck_ix[[x]] == veck_ix[[x + 1]]) c(0, 0) else c(veck_ix[[x]] + 1, veck_ix[[x + 1]]) }) } if (bbeta) { lbetas[seq_len(nbmodel)] = lapply(veckix_aux, function(x) inivec_vbeta[x[[1]]:x[[2]]]) } else lbetas = list(numeric(0)) if (bbeta2) { lbetas2[seq_len(nbmodel)] = lapply(veckix_aux, function(x) inivec_vbeta2[x[[1]]:x[[2]]]) } else lbetas2 = list(numeric(0)) lastvec01 = integer(nmaxregressors) modidx = length(top10_lik) indices[seq_len(nbmodel)] = order(inivec_lik, decreasing = TRUE) min.index = which.max(indices) if (length(min.index) > 0) { min.top10_lik = top10_lik[[min.index]] } else { if (nbmodels > 0) min.top10_lik = -Inf else min.top10_lik = Inf } index.of.mybool = function(mybool) { ix_of_mybool <<- (mybool == top10_bool) } check4dupl = index.of.mybool dupl.possible = TRUE retlist = list(addmodel = function(mylik, vec01, vbeta = numeric(0), vbeta2 = numeric(0), fixedvec = numeric(0)) { if (mylik >= min.top10_lik | nbmodel < nbmodels) { if (identical(lastvec01, vec01)) { top10_count[[modidx]] <<- top10_count[[modidx]] + 1 } else { lastvec01 <<- vec01 mybool = hexobject$as.hexcode(vec01) check4dupl(mybool) if (!any(ix_of_mybool)) { if (nbmodel < nbmodels) { nbmodel <<- nbmodel + 1 modidx <<- nbmodel } else { modidx <<- min.index } ltmylik = (top10_lik <= mylik) indices <<- indices + ltmylik indices[[modidx]] <<- nbmodels - sum(ltmylik) + 1 top10_lik[[modidx]] <<- mylik top10_bool[[modidx]] <<- mybool top10_count[[modidx]] <<- 1 min.index <<- which.max(indices) min.top10_lik <<- top10_lik[[min.index]] if (lengthfixedvec > 0) { top10_fixvec[(modidx - 1) * lengthfixedvec + seq_len(lengthfixedvec)] <<- fixedvec } if (bbeta) { lbetas[[modidx]] <<- vbeta } if (bbeta2) { lbetas2[[modidx]] <<- vbeta2 } } else { modidx <<- seq_nbmodel[ix_of_mybool] top10_count[[modidx]] <<- top10_count[[modidx]] + 1 } } } }, lik = function() { return(top10_lik[findex()]) }, bool = function() { return(top10_bool[findex()]) }, ncount = function() { return(top10_count[findex()]) }, nbmodels = nbmodels, nregs = nmaxregressors, betas_raw = function() { return(unlist(lbetas[findex()])) }, betas2_raw = function() { return(unlist(lbetas2[findex()])) }, kvec_raw = function() { return(sapply(lbetas, length)[findex()]) }, bool_binary = function() { return(sapply(as.list(top10_bool[findex()]), hexobject$as.binvec)) }, betas = function() { betamat(unlist(lbetas[findex()])) }, betas2 = function() { betamat(unlist(lbetas2[findex()])) }, fixed_vector = function() { if (lengthfixedvec <= 0) { return(matrix(0, 0, 0)) } else { findex_base = (findex() - 1) * lengthfixedvec findex_fixvec = numeric(0) for (xx in 1:lengthfixedvec) findex_fixvec = rbind(findex_fixvec, findex_base + xx) return(matrix(top10_fixvec[c(findex_fixvec)], lengthfixedvec)) } }, duplicates_possible = function(possible = NULL) { if (!is.logical(possible)) return(dupl.possible) if (possible) { check4dupl <<- index.of.mybool dupl.possible <<- TRUE ix_of_mybool <<- logical(nbmodels) } else { check4dupl <<- function(mybool) { } dupl.possible <<- FALSE ix_of_mybool <<- FALSE } }) class(retlist) = "topmod" return(retlist) } .topmod.as.bbetaT <- function (tm, gprior.info = NULL, yXdata = NULL, addr2 = FALSE) { is.bmao = FALSE if (is.bma(tm)) { is.bmao = TRUE bmao = tm yXdata = bmao$X.data gprior.info = bmao$gprior.info tm = bmao$topmod } yXdata = as.matrix(yXdata) N = nrow(yXdata) K = ncol(yXdata) - 1 yXdata = yXdata - matrix(colMeans(yXdata), N, K + 1, byrow = TRUE) if (length(tm$lik()) < 1) { if (is.bmao) return(bmao) else return(tm) } if (!addr2) if ((length(tm$betas_raw()) > 0) & (ncol(as.matrix(tm$betas())) == length(tm$lik()))) { if (is.bmao) return(bmao) else return(tm) } bools = (tm$bool_binary()) yty = c(crossprod(yXdata[, 1])) positions = lapply(lapply(as.list(as.data.frame(bools)), as.logical), which) olsmodels = lapply(lapply(positions, .ols.terms2, yty = yty, N = N, K = K, XtX.big = crossprod(yXdata[, -1]), Xty.big = c(crossprod(yXdata[, -1], yXdata[, 1]))), function(x) x$full.results()) lprobo = gprior.info$lprobcalc lpl = lapply(olsmodels, function(x) lprobo$lprob(x$ymy, length(x$bhat), x$bhat, x$diag.inverse)) veck = as.vector(unlist(lapply(lapply(lpl, "[[", "b1new"), length))) b1raw = as.vector(unlist(lapply(lpl, "[[", "b1new"))) b2raw = as.vector(unlist(lapply(lpl, "[[", "b2new"))) fixedvecmat = tm$fixed_vector() if (addr2) { r2 = 1 - sapply(olsmodels, function(x) x$ymy)/yty if (nrow(fixedvecmat) == 0) { fixedvecmat = matrix(0, 0, length(veck)) } else if (mean(abs(r2 - fixedvecmat[1, ])) < 1e-17) { fixedvecmat = fixedvecmat[-1, , drop = FALSE] } fixedvecmat = rbind(r2, fixedvecmat) } lengthfixedvec = nrow(fixedvecmat) tm <- .top10(nmaxregressors = tm$nregs, nbmodels = tm$nbmodels, bbeta = TRUE, lengthfixedvec = lengthfixedvec, bbeta2 = TRUE, inivec_lik = tm$lik(), inivec_bool = tm$bool(), inivec_count = tm$ncount(), inivec_vbeta = b1raw, inivec_vbeta2 = b2raw, inivec_veck = veck, inivec_fixvec = c(fixedvecmat)) if (is.bmao) { bmao$topmod <- tm return(bmao) } return(tm) } BMS/R/print.topmod.R0000644000175100001440000000216512624725513013705 0ustar hornikusersprint.topmod <- function (x, ...) { tm = x if (length(tm$lik()) == 1) { infomat = c(tm$bool(), tm$lik(), tm$ncount()) names(infomat) = c("Model Index", "Marg.Log.Lik.", "Sampled Freq.") print(infomat) betamat = cbind(as.vector(tm$betas_raw()), sqrt(as.vector(tm$betas2_raw()) - as.vector(tm$betas_raw())^2)) if (nrow(betamat) != 0) { if (ncol(betamat) == 1) { colnames(betamat) = "Coef." } else { colnames(betamat) = c("Coef.", "Std.Dev.") } rownames(betamat) = which(as.logical(as.vector(tm$bool_binary()))) cat("\nEstimates:\n") print(betamat) } bin = as.vector(tm$bool_binary()) names(bin) = 1:length(bin) cat("\nIncluded Covariates:\n") print(bin) cat("\nAdditional Statistics:\n") print(as.vector(tm$fixed_vector())) } else { mout = cbind(tm$lik(), tm$ncount()) colnames(mout) = c("Marg.Log.Lik", "MCMC Freq") rownames(mout) = tm$bool() print(mout, ...) } } BMS/R/pred.density.R0000644000175100001440000003716212624725513013665 0ustar hornikuserspred.density <- function (object, newdata = NULL, n = 300, hnbsteps = 30, ...) { dtcm = function(x, df, ncp, varp) { sqvarp = sqrt(varp) dt((x - ncp)/sqvarp, df = df)/sqvarp } dsgivenykernel <- function(sf, kpa, N, z) { (kpa - 2)/2 * (1 - sf)^((kpa - 4)/2) * (1 - sf * z)^(-(N - 1)/2) } nbsteps = max(hnbsteps, 2) n = max(ceiling(n), 1) is.hyper = (object$gprior.info$gtype == "hyper") if (is.hyper) f21a = object$gprior.info$hyper.parameter if (is.bma(object)) { K = object$info$K N = object$info$N yXdata = as.matrix(object$X.data) tmo <- object$topmod } else if (is(object, "zlm")) { yXdata = as.matrix(object$model) K = ncol(yXdata) - 1 N = nrow(yXdata) tmo <- topmod(1, nmaxregressors = K, bbeta = TRUE, liks = object$marg.lik, ncounts = 1, modelbinaries = matrix(rep(1, K), K, 1), betas = matrix(as.vector(object$coefficients[-1]), K), betas2 = matrix(as.vector(object$coef2moments[-1]), K)) } else stop("argument 'object' requires class 'bma' or 'zlm'") rm(object) if (missing(newdata)) { stop("You must provide the argument newdata") } else { newX = as.matrix(newdata) if (!is.numeric(newX)) stop("newdata must be numeric!") if (is.vector(newdata)) newX = matrix(newdata, 1) if (ncol(newX) != K) { if (ncol(newX) == K + 1) { newX = newX[, -1, drop = FALSE] } else { stop("newdata must be a matrix or data.frame with ", K, " columns.") } } orinames = colnames(yXdata[, -1, drop = FALSE]) if (!is.null(colnames(newX)) && !is.null(orinames)) { if (all(orinames %in% colnames(newX)) && !all(orinames == colnames(newX))) { warning("argument newdata had to be reordered according to its column names. Consider submitting the columns of newdata in the right order.") newX = newX[, orinames, drop = FALSE] } } } if (!is.null(rownames(newX))) { newXnames = rownames(newX) } else { newXnames = as.character(1:nrow(newX)) } rnew = nrow(newX) y.mean = mean(yXdata[, 1]) y <- yXdata[, 1] - matrix(y.mean, N, 1, byrow = TRUE) X <- yXdata[, -1, drop = FALSE] - matrix(colMeans(yXdata[, -1, drop = FALSE]), N, K, byrow = TRUE) XtX.big = crossprod(X) Xty.big = as.vector(crossprod(X, y)) yty = crossprod(y)[[1]] newXdm = newX - matrix(colMeans(yXdata[, -1, drop = FALSE]), rnew, K, byrow = TRUE) hexobject <- .hexcode.binvec.convert(K) make_xfxxxf = function(hex) { syminv <- function(symmat, ndim = ncol(symmat)) { if (!is.matrix(symmat)) { symmat = as.matrix(symmat) } if (dim(symmat)[[1]] == 0) return(matrix(numeric(0), 0, 0)) return(chol2inv(chol(symmat), size = ndim)) } boolvec = as.logical(hexobject$as.binvec(hex)) if (!any(boolvec)) return(c(numeric(rnew), numeric(rnew), Inf, Inf, 0)) newXsub = newXdm[, boolvec, drop = FALSE] xtxinv = syminv(XtX.big[boolvec, boolvec, drop = FALSE]) xty = Xty.big[boolvec] betas = as.vector(crossprod(xtxinv, xty), mode = "numeric") r2 = crossprod(xty, betas)[[1]]/yty xtxinv_xf = tcrossprod(xtxinv, newXsub) xf_xx_xf = unlist(lapply(1:nrow(newXsub), function(x) { crossprod(newXsub[x, ], xtxinv_xf[, x])[[1L]] })) xf_bhat = as.vector(newXsub %*% betas) return(c(xf_xx_xf, xf_bhat, xtxinv[[1L]], betas[[1L]], r2)) } pmps = pmp.bma(tmo, oldstyle = TRUE)[, 1, drop = TRUE] bools = tmo$bool() nmodel = length(bools) linvres = lapply(bools, make_xfxxxf) mat_xfxxxf = array(unlist(lapply(linvres, "[", 1:rnew)), dim = c(rnew, nmodel)) mat_xfbhat = array(unlist(lapply(linvres, "[", rnew + (1:rnew))), dim = c(rnew, nmodel)) xtxinv_elem1 = unlist(lapply(linvres, "[[", rnew * 2 + 1)) betahat_elem1 = unlist(lapply(linvres, "[[", rnew * 2 + 2)) r2 = unlist(lapply(linvres, "[[", rnew * 2 + 3)) kvec = tmo$kvec_raw() kvec_cs = c(1, cumsum(kvec) + 1) kvec_cs = kvec_cs[-length(kvec_cs)] firstbetas = tmo$betas_raw()[kvec_cs] firstbetas2 = tmo$betas2_raw()[kvec_cs] Es = firstbetas/betahat_elem1 varmult = (firstbetas2 - firstbetas^2)/xtxinv_elem1 if (is.hyper) { first_factor = yty/(N - 3) * (N + 1)/N * (1 + 2/(N - kvec - f21a - 1) - r2 * Es) } else { first_factor = yty/(N - 3) * (1 - Es * r2) * (N + 1)/N } Sigmas = (matrix((N - 3)/(N - 1) * first_factor, rnew, nmodel, byrow = TRUE) + t(t(mat_xfxxxf) * ((N - 3)/(N - 1) * varmult))) Evals_minusy = t(t(mat_xfbhat) * Es) Eyf = as.vector(Evals_minusy %*% pmps + y.mean) Varyf = as.vector(Sigmas %*% pmps) * (N - 1)/(N - 3) premultfactor = yty/(N - 1) interceptfactor = (N + 1)/N calcdensvec = function(xf_index, seqy, m_index) { sss = function(lbound, uboundp1, nbsteps, seqs, xf.index) { s.seq = seq(lbound, uboundp1, (uboundp1 - lbound)/nbsteps)[-nbsteps] tmat = array(unlist(lapply(as.list(s.seq), function(ss) { dtcm(seqs, N - 1, y.mean + ss * myev, premultfactor * (1 - ss * myr2) * (interceptfactor + ss * myxfxxxf)) })), dim = c(length(seqs), nbsteps)) smat = sapply(as.list(s.seq), dsgivenykernel, kpa = myk + f21a, N = N, z = myr2) if (any(is.infinite(smat))) smat[is.infinite(smat)] = 0 intconst = (4 * sum(smat[c(FALSE, TRUE)]) + 2 * sum(smat[c(TRUE, FALSE)]) - 3 * smat[nbsteps] - smat[1]) * (s.seq[nbsteps] - s.seq[1])/nbsteps/3 return(list(dv = c(4 * tmat[, c(FALSE, TRUE)] %*% smat[c(FALSE, TRUE)] + 2 * tmat[, c(TRUE, FALSE)] %*% smat[c(TRUE, FALSE)] - 3 * tmat[, nbsteps] * smat[nbsteps] - tmat[, 1] * smat[1]) * (s.seq[nbsteps] - s.seq[1])/nbsteps/3, ic = intconst)) } if (any(is.na(newX[xf_index, ]))) { densvec = numeric(0) } if (is.hyper) { myev = mat_xfbhat[xf_index, m_index] myxfxxxf = mat_xfxxxf[xf_index, m_index] myk = kvec[[m_index]] myr2 = r2[[m_index]] midpoint = 1 - (1 - Es[[m_index]]) * 4 if (midpoint < 0.5) { dvl = sss(1e-04, 0.9999999, nbsteps * 2, seqy, xf_index) densvec = dvl$dv/dvl$ic } else { dvl1 = sss(1e-04, midpoint, nbsteps, seqy, xf_index) dvl2 = sss(midpoint, 1, nbsteps, seqy, xf_index) densvec = (dvl1$dv + dvl2$dv)/(dvl1$ic + dvl2$ic) } } else { densvec = dtcm(seqy, N - 1, Evals_minusy[xf_index, m_index] + y.mean, Sigmas[xf_index, m_index]) } return(densvec) } dens_yf = function(yfr, xf_indices = NULL) { if (is.null(xf_indices)) xf_indices = seq_len(rnew) yfdens = array(NA, dim = dim(yfr)) for (myxf in 1:length(xf_indices)) { allm_dens = sapply(seq_len(nmodel), function(x) calcdensvec(xf_indices[[myxf]], yfr[myxf, ], x)) yfdens[myxf, ] = as.vector(allm_dens %*% pmps) } yfdens[!is.finite(yfdens)] = NA if (ncol(yfdens) == 1) dim(yfdens) <- NULL return(yfdens) } emptydens = list(x = numeric(0), y = numeric(0), bw = NULL, n = 0, has.na = TRUE) class(emptydens) = "density" dlist = lapply(vector("list", nrow(newX)), function(x) emptydens) densities_calculated <- FALSE calc_alldens = function() { if (densities_calculated) return(NULL) for (xf.index in 1:rnew) { if (!any(is.na(newX[xf.index, ]))) { lbound = Eyf[[xf.index]] - sqrt(Varyf[[xf.index]]) * 4 ubound = Eyf[[xf.index]] + sqrt(Varyf[[xf.index]]) * 4 seqs = seq(lbound, ubound, (ubound - lbound)/(n - 1)) allm_dens = sapply(seq_len(nmodel), function(x) calcdensvec(xf.index, seqs, x)) myy = as.vector(tcrossprod(t(as.matrix(pmps)), allm_dens)) mydens = list(x = seqs, y = myy, bw = NULL, n = n, has.na = FALSE) class(mydens) = "density" dlist[[xf.index]] <<- mydens } } densities_calculated <<- TRUE } consistent.yf = function(yf, xf.indices = NULL) { xf_series = seq_len(rnew) wasnull = FALSE if (is.null(xf.indices)) { wasnull = TRUE xf.indices = xf_series } else { if (!all(xf.indices %in% xf_series)) stop(paste("predict_index needs to be an integer between 1 and ", rnew, "!", sep = "")) } if (!is.numeric(yf)) stop("realized.y must be a numeric matrix or vector!") if (!is.matrix(yf)) yf <- as.matrix(yf) if ((length(xf.indices) == 1) & (nrow(yf) > 1) & (ncol(yf) == 1)) yf <- t(yf) if (nrow(newX[xf.indices, , drop = FALSE]) != nrow(yf)) { if (wasnull) stop(paste("realized.y must have", rnew, "elements/rows corresponding to newdata")) else stop("The number of rows/elements in realized.y must have the same length as predict_index!") } return(yf) } consistent_predict_index = function(pix) { if (is.character(pix)) { if (all(pix %in% newXnames)) { return(match(pix, newXnames)) } else { stop("Forecast IDs provided in predict_index do not conform to rownames of predicted data") } } else return(pix) } plot.preddens = function(xf.index = 1, addons = "eslz", yf.addons = NULL, predict_index = NULL, addons.lwd = 1.5, ...) { dotargs = match.call(expand.dots = FALSE)$... if (rnew > 1) { main_default <- paste("Predictive Density Obs ", newXnames[[xf.index]], " (", nmodel, " Models)", sep = "") } else { main_default <- paste("Predictive Density", " (", nmodel, " Models)", sep = "") } dotargs = .adjustdots(dotargs, xlab = "Response variable", main = main_default, col = 4, zero.line = FALSE) thingy = dlist[[xf.index]] eval(as.call(c(list(as.name("plot"), as.name("thingy")), as.list(dotargs)))) leg.col = numeric(0) leg.lty = numeric(0) leg.legend = character(0) if (any(grep("g", addons, ignore.case = TRUE))) { grid() } if (any(grep("e", addons, ignore.case = FALSE))) { abline(v = fit[[xf.index]], col = 2, lwd = addons.lwd) leg.col = c(leg.col, 2) leg.lty = c(leg.lty, 1) leg.legend = c(leg.legend, "Exp. Value") } if (any(grep("s", addons, ignore.case = FALSE))) { abline(v = fit[[xf.index]] - 2 * stderrs[[xf.index]], col = 2, lty = 2, lwd = addons.lwd) abline(v = fit[[xf.index]] + 2 * stderrs[[xf.index]], col = 2, lty = 2, lwd = addons.lwd) leg.col = c(leg.col, 2) leg.lty = c(leg.lty, 2) leg.legend = c(leg.legend, "2x Std.Errs") } if (any(grep("z", addons, ignore.case = TRUE))) { abline(h = 0, col = "gray", lwd = addons.lwd) } if (!is.null(yf.addons) && is.numeric(yf.addons)) { yfs = as.vector(yf.addons) if (!is.na(yfs[[xf.index]])) { abline(v = yfs[[xf.index]], col = 1, lwd = addons.lwd, lty = 2) leg.col = c(leg.col, 1) leg.lty = c(leg.lty, 2) leg.legend = c(leg.legend, "Realized y") } else warning("yf.addons must be a vector with the same number of elements as rows in newdata!") } if (any(grep("l", addons, ignore.case = TRUE)) & (length(leg.col) > 0)) { legend(x = "topright", lty = leg.lty, col = leg.col, legend = leg.legend, box.lwd = 0, bty = "n", lwd = addons.lwd) } } fit = Eyf names(fit) = newXnames stderrs = sqrt(Varyf) names(stderrs) = newXnames reslist = list() reslist$densities = function() { calc_alldens() return(dlist) } reslist$fit = fit reslist$std.err = stderrs reslist$dyf = function(realized.y, predict_index = NULL) { predict_index = consistent_predict_index(predict_index) if (missing(realized.y)) { stop("You must provide a realization of the dependent variable in realized.y") } return(dens_yf(consistent.yf(realized.y, predict_index), predict_index)) } reslist$lps = function(realized.y, predict_index = NULL) { predict_index = consistent_predict_index(predict_index) if (missing(realized.y)) { stop("You must provide a realization of the dependent variable in realized.y") } yf = consistent.yf(realized.y, predict_index) if (ncol(yf) != 1) stop("realized.y must have only one column!") yf.dens = dens_yf(yf, predict_index) return(-sum(log(yf.dens[!is.na(yf.dens)]))/length(yf)) } reslist$plot = function(predict_index = NULL, addons = "eslz", realized.y = NULL, addons.lwd = 1.5, ...) { dotargs = match.call(expand.dots = FALSE)$... xf_series = seq_len(rnew) predict_index = consistent_predict_index(predict_index) if (is.null(predict_index)) { predict_index = xf_series } else if (!all(predict_index %in% xf_series)) stop(paste("predict_index needs to be an integer between 1 and ", rnew, "!", sep = "")) if (!(is.null(realized.y))) { if (length(realized.y) != length(predict_index)) { stop("realized.y must be a vector with the same number of elements as rows in newdata (or predict_index)!") } } if (!is.null(realized.y)) realized.y <- consistent.yf(realized.y, predict_index) calc_alldens() oldask = par()$ask plotnb = 0 for (xf_index in predict_index) { doplot = !dlist[[xf_index]]$has.na plotnb = plotnb + doplot if (plotnb == 2) par(ask = TRUE) dotargs = .adjustdots(dotargs, main = NULL, col = "steelblue4", xlab = "Response variable") if (doplot) { eval(as.call(c(list(as.name("plot.preddens"), as.name("xf_index"), addons = as.name("addons"), yf.addons = as.name("realized.y"), addons.lwd = as.name("addons.lwd")), as.list(dotargs)))) } } par(ask = oldask) } reslist$n = n reslist$nmodel = nmodel reslist$call = sys.call(0) class(reslist) = "pred.density" rm(betahat_elem1, bools, emptydens, firstbetas, firstbetas2, linvres) return(reslist) } BMS/R/variable.names.zlm.R0000644000175100001440000000025712624725513014740 0ustar hornikusersvariable.names.zlm <- function (object, ...) { if (!is(object, "zlm")) stop("argument 'object' needs to be zlm object") return(names(object$coefficients)) } BMS/R/quantile.coef.density.R0000644000175100001440000000047612624725513015466 0ustar hornikusersquantile.coef.density <- function (x, probs = seq(0.25, 0.75, 0.25), names = TRUE, ...) { quout = .quantile.density(x, probs = probs, names = names, normalize = TRUE) if (is.matrix(quout) && as.logical(names)) rownames(quout) <- sapply(x, function(lx) lx[["data.name"]]) return(quout) } BMS/R/topmod.R0000644000175100001440000001054012624725513012546 0ustar hornikuserstopmod <- function (nbmodels, nmaxregressors = NA, bbeta = FALSE, lengthfixedvec = 0, liks = numeric(0), ncounts = numeric(0), modelbinaries = matrix(0, 0, 0), betas = matrix(0, 0, 0), betas2 = matrix(0, 0, 0), fixed_vector = matrix(0, 0, 0)) { if (!is.numeric(nbmodels)) stop("argument 'nbmodels' needs to be an integer>0") nbmodels = floor(nbmodels[[1]]) if (nbmodels[[1]] < 0) stop("argument 'nbmodels' needs to be an integer>0") if (bbeta > 0) bbeta2 = TRUE else bbeta2 = FALSE bbeta = as.logical(bbeta) if (!bbeta & (length(betas) > 0)) bbeta = TRUE if (!bbeta2 & (length(betas2) > 0)) bbeta2 = TRUE if (is.na(lengthfixedvec[1])) lengthfixedvec = 0 if ((lengthfixedvec == 0) & length(fixed_vector) > 0) { lengthfixedvec = nrow(fixed_vector) } if (length(liks) > nbmodels) stop("liks longer than nbmodels allows") if (length(ncounts) > nbmodels) stop("ncounts longer than nbmodels allows") if ((length(modelbinaries) == 0) & (length(betas) > 0)) { modelbinaries = as.logical(betas) dim(modelbinaries) = dim(betas) } if (ncol(modelbinaries) > nbmodels) stop("modelbinaries has more columns than than nbmodels allows") bindim = dim(modelbinaries) modelbinaries = as.logical(modelbinaries) dim(modelbinaries) = bindim if ((is.na(nmaxregressors[1])) & (length(modelbinaries) > 0)) { nmaxregressors = nrow(modelbinaries) } if (is.na(nmaxregressors)) stop("argument 'nmaxregressors' is missing") nmaxregressors = floor(nmaxregressors[[1]]) if (nmaxregressors <= 0) stop("argument 'nmaxregressors' needs to be a positive integer") if ((length(ncounts) == 0) & (length(liks) > 0)) { ncounts = rep(1, length(liks)) } if (length(modelbinaries) > 0) if (nmaxregressors != nrow(modelbinaries)) stop("nrow() of modelbinaries does not match nmaxregressors") if (bbeta & (length(betas) > 0)) if (nmaxregressors != nrow(betas)) stop("nrow() of betas does not match nmaxregressors") if (bbeta2 & (length(betas2) > 0)) if (nmaxregressors != nrow(betas2)) stop("nrow() of betas2 does not match nmaxregressors") N = length(liks) if (length(ncounts) != length(liks)) stop("lengths of arguments 'liks' and 'ncounts' do not conform") if (ncol(modelbinaries) != length(liks)) stop("nrow of argument 'modelbinaries' does not conform to length of argument 'liks'") if (bbeta) if (ncol(betas) != length(liks)) stop("nrow of argument 'betas' does not conform to length of argument 'liks'") if (bbeta2) if (ncol(betas2) != length(liks)) stop("nrow of argument 'betas2' does not conform to length of argument 'liks'") if (lengthfixedvec) if (ncol(fixed_vector) != length(liks)) stop("nrow of argument 'fixed_vector' does not conform to length of argument 'liks'") morder = order(liks, decreasing = TRUE) liks = liks[morder] modelbinaries = modelbinaries[, morder, drop = FALSE] ncounts = ncounts[morder] if (bbeta) { betas = betas[, morder, drop = FALSE] } if (bbeta2) { betas2 = betas2[, morder, drop = FALSE] } if (lengthfixedvec) { fixed_vector = fixed_vector[, morder, drop = FALSE] } hexobj = .hexcode.binvec.convert(nmaxregressors) bools = as.vector(sapply(as.list(as.data.frame(modelbinaries)), hexobj$as.hexcode)) if (length(bools) == 0) { bools = character(0) } veck = numeric(0) betas_raw = numeric(0) betas2_raw = numeric(0) if (bbeta & (length(bbeta) > 0)) { veck = colSums(modelbinaries) betas_raw = as.vector(betas)[as.vector(modelbinaries)] } if (bbeta2 & (length(bbeta2) > 0)) { veck = colSums(modelbinaries) betas2_raw = as.vector(betas2)[as.vector(modelbinaries)] } fixedvec = as.vector(fixed_vector) .top10(nmaxregressors = nmaxregressors, nbmodels = nbmodels, bbeta = bbeta, lengthfixedvec = lengthfixedvec, bbeta2 = bbeta2, inivec_lik = liks, inivec_bool = bools, inivec_count = ncounts, inivec_vbeta = betas_raw, inivec_vbeta2 = betas2_raw, inivec_veck = veck, inivec_fixvec = fixedvec) } BMS/R/deviance.bma.R0000644000175100001440000000131712624725513013562 0ustar hornikusersdeviance.bma <- function (object, exact = FALSE, ...) { if (is.bma(object)) { xx = as.matrix(object$X.data) ebeta = estimates.bma(object, order.by.pip = FALSE, exact = exact)[, 2, drop = TRUE] } else if (is(object, "lm")) { xx = as.matrix(object$model) ebeta = coef(object) if (length(ebeta) == ncol(xx)) ebeta = ebeta[-1] } else stop("Required input is an object of class 'bma' or 'lm'/'zlm'.") xx = xx - matrix(colMeans(xx), nrow(xx), ncol(xx), byrow = TRUE) ess = as.vector(crossprod(ebeta, as.vector(crossprod(xx[, -1, drop = FALSE], xx[, 1])))) return((as.vector(crossprod(xx[, 1, drop = TRUE])) - ess)) } BMS/R/deviance.zlm.R0000644000175100001440000000007512624725513013625 0ustar hornikusersdeviance.zlm <- function (object, ...) deviance.bma(object) BMS/R/z[.bma.R0000644000175100001440000000011712624725513012405 0ustar hornikusers`[.bma` <- function (x, i, ...) { x$topmod <- x$topmod[i] return(x) } BMS/R/logLik.zlm.R0000644000175100001440000000044512624725513013271 0ustar hornikuserslogLik.zlm <- function (object, ...) { if (!is(object, "zlm")) stop("argument 'formula' needs to be zlm object") ret = object$marg.lik attr(ret, "df") = object$rank + 1 attr(ret, "nbobs") = object$rank + object$df.residual class(ret) = "logLik" return(ret) } BMS/R/estimates.bma.R0000644000175100001440000000137012624725513014001 0ustar hornikusersestimates.bma <- function (object, exact = FALSE, order.by.pip = TRUE, include.constant = FALSE, incl.possign = TRUE, std.coefs = FALSE, condi.coef = FALSE) { bmao = object rm(object) if (!is.bma(bmao)) { stop("you need to provide a BMA object") return() } if (exact) { if (bmao$topmod$nbmodels == 0) stop("exact=TRUE needs at least one 'top model': Run estimation again and set nmodel>0") } bmaest = .post.estimates(bmao$info$b1mo, bmao$info$b2mo, bmao$info$cumsumweights, bmao$info$inccount, bmao$topmod, bmao$X.data, bmao$reg.names, bmao$info$pos.sign, exact, order.by.pip, include.constant, incl.possign, std.coefs, condi.coef) return(bmaest) } BMS/R/plotModelsize.R0000644000175100001440000000741012624725513014100 0ustar hornikusersplotModelsize <- function (bmao, exact = FALSE, ksubset = NULL, include.legend = TRUE, do.grid = TRUE, ...) { dotargs = match.call(expand.dots = FALSE)$... if (length(exact) > 1) { topmodidx = exact exact = TRUE } else { topmodidx = NA } K = bmao$info$K if (is.element("mprior.info", names(bmao))) m = bmao$mprior.info$mp.msize else m = bmao$arguments$prior.msize pmp.10 = pmp.bma(bmao$topmod[topmodidx], oldstyle = TRUE) if (exact) { modelSmean = sum(apply(.post.topmod.bma(bmao$topmod[topmodidx]), 2, function(x) length(which(x == 1))) * pmp.10[, 1]) modelS.var = sum(apply(.post.topmod.bma(bmao$topmod[topmodidx]), 2, function(x) length(which(x == 1)))^2 * pmp.10[, 1]) - modelSmean^2 x = apply(.post.topmod.bma(bmao$topmod[topmodidx]), 2, function(x) length(which(x == 1))) y = pmp.10[, 1] result = c() for (i in sort(unique(x))) result = c(result, sum(y[which(x == i)])) names(result) = sort(unique(x)) kvec = rep(0, (K + 1)) kvec[(as.numeric(names(result)) + 1)] = result } else { k.vec = bmao$info$k.vec summi = sum(k.vec) modelSmean = sum((1:length(k.vec)) * (k.vec/summi)) - 1 kvec = k.vec/sum(k.vec) modelSmean.sq = sum(((1:length(k.vec))^2) * (k.vec/summi)) modelS.var = modelSmean.sq - modelSmean^2 } upper = min(ceiling(modelSmean + 5 * modelS.var), K) lower = max(floor(modelSmean - 5 * modelS.var), 0) if (is.element("mp.Kdist", names(bmao$mprior.info))) { prior = bmao$mprior.info$mp.Kdist } else if (is.element("theta", names(bmao$arguments))) { theta = bmao$arguments$theta if (theta == "random") { beta.bin = function(a = 1, b = (K - m)/m, K = K, w = 0:K) { return(lgamma(a + b) - (lgamma(a) + lgamma(b) + lgamma(a + b + K)) + log(choose(K, w)) + lgamma(a + w) + lgamma(b + K - w)) } prior = exp(beta.bin(a = 1, b = (K - m)/m, K = K, w = 0:K)) } if (theta != "random") { prior = dbinom(x = 0:K, size = K, prob = m/K, log = FALSE) } } else { prior = rep(NA, length(kvec)) } mat = cbind(kvec, prior) upper.ylim = max(kvec, prior, na.rm = TRUE) if (is.null(ksubset)) { ksubset = (lower:upper) } dotargs = .adjustdots(dotargs, type = "l", ylim = c(0, 1.1 * upper.ylim), lwd = 1.5, xaxt = "n", col = c("steelblue3", "tomato"), main = paste("Posterior Model Size Distribution", "\n", "Mean:", round(modelSmean, 4)), cex.main = 0.8, xlab = "Model Size", ylab = "", lty = 1:2, pch = 4, cex.axis = 0.9) matsubset = mat[ksubset + 1, ] eval(as.call(c(list(as.name("matplot"), as.name("matsubset")), as.list(dotargs)))) if (as.logical(do.grid)) grid() points(kvec[ksubset + 1], cex = 0.8, pch = eval(dotargs$pch)) axis(1, las = 1, at = 1:length(ksubset), labels = ksubset, cex.axis = eval(dotargs$cex.axis)) if (include.legend) { if (is.null(prior) || all(is.na(prior))) { legend(x = "topright", lty = eval(dotargs$lty), legend = c("Posterior"), col = eval(dotargs$col), ncol = 1, bty = "n", lwd = eval(dotargs$lwd)) } else { legend(x = "topright", lty = eval(dotargs$lty), legend = c("Posterior", "Prior"), col = eval(dotargs$col), ncol = 2, bty = "n", lwd = eval(dotargs$lwd)) } } return(invisible(list(mean = modelSmean, var = modelS.var, dens = kvec))) } BMS/R/print.bma.R0000644000175100001440000000031312624725513013133 0ustar hornikusersprint.bma <- function (x, ...) { if (!is.bma(x)) { return(print(x)) } print(estimates.bma(x), include.constant = TRUE, ...) cat("\n") print(info.bma(x), ...) cat("\n") } BMS/R/plot.bma.R0000644000175100001440000000055512624725513012765 0ustar hornikusersplot.bma <- function (x, ...) { if (!is.bma(x)) stop("Need to provide object of class 'bma'!") if (x$arguments$nmodel < 3) { try(plotModelsize(x, ...), silent = TRUE) } else { layout(matrix(1:2, 2, 1)) try(plotModelsize(x, ...), silent = TRUE) try(plotConv(x, ...), silent = TRUE) layout(1) } } BMS/R/summary.bma.R0000644000175100001440000000010012624725513013466 0ustar hornikuserssummary.bma <- function (object, ...) { info.bma(object) } BMS/R/density.bma.R0000644000175100001440000002477712624725513013502 0ustar hornikusersdensity.bma <- function (x, reg = NULL, addons = "lemsz", std.coefs = FALSE, n = 300, plot = TRUE, hnbsteps = 30, addons.lwd = 1.5, ...) { dtcm = function(x, df, ncp, varp) { sqvarp = sqrt(varp) dt((x - ncp)/sqvarp, df = df)/sqvarp } dsgivenykernel <- function(sf, kpa, N, z) { (kpa - 2)/2 * (1 - sf)^((kpa - 4)/2) * (1 - sf * z)^(-(N - 1)/2) } dotargs = match.call(expand.dots = FALSE)$... bmao = x if (!is.bma(bmao)) stop("Argument bmao needs to be a bma object") if (hnbsteps%%2) stop("Argument nbsteps needs to be an even integer") nbsteps = max(hnbsteps, 2) n = max(ceiling(n), 1) N = bmao$info$N K = bmao$info$K if (is.null(reg)) reg = 1:K nameix = 1:K names(nameix) = bmao$reg.names reg = nameix[reg] ishyper = (bmao$gprior$gtype == "hyper") tm = bmao$topmod bools = (tm$bool_binary()) betas = tm$betas() betas2 = tm$betas2() if (std.coefs) { sddata = apply(as.matrix(bmao$X.data), 2, stats::sd) betas = diag(sddata[-1]) %*% betas/sddata[1] betas2 = diag(sddata[-1]^2) %*% betas2/sddata[1]^2 } sigmadiag = (betas2 - betas^2) * (N - 3)/(N - 1) pmps = pmp.bma(bmao$topmod, oldstyle = TRUE)[, 1] pips = c(tcrossprod(bools, t(pmps))) Eb1 = c(tcrossprod(betas, t(pmps)))/pips Ebsd = sqrt(c(tcrossprod(betas2, t(pmps)))/pips - Eb1^2) Ebsd[is.nan(Ebsd)] = 0 Eb1[is.nan(Eb1)] = 0 Eball = cbind(Eb1, Ebsd) if ((any(grep("E", addons, ignore.case = FALSE))) | (any(grep("S", addons, ignore.case = FALSE)))) { Eb1.mcmc = bmao$info$b1mo/bmao$info$inccount Ebsd.mcmc = sqrt(bmao$info$b2mo/bmao$info$inccount - Eb1.mcmc^2) if (std.coefs) { sddata = apply(as.matrix(bmao$X.data), 2, stats::sd) Eb1.mcmc = Eb1.mcmc * sddata[-1]/sddata[1] Ebsd.mcmc = Ebsd.mcmc * sddata[-1]/sddata[1] } } if (ishyper) { yXdata = as.matrix(bmao$X.data) yXdata = yXdata - matrix(colMeans(yXdata), N, K + 1, byrow = TRUE) if (std.coefs) yXdata = yXdata %*% diag(1/sddata) yty = c(crossprod(yXdata[, 1])) positions = lapply(lapply(as.list(as.data.frame(bools)), as.logical), which) olsmodels = lapply(lapply(positions, .ols.terms2, yty = yty, N = N, K = K, XtX.big = crossprod(yXdata[, -1]), Xty.big = c(crossprod(yXdata[, -1], yXdata[, 1]))), function(x) x$full.results()) f21a = bmao$gprior.info$hyper.parameter } plotndens <- function(ix, doplot = FALSE) { sss = function(lbound, uboundp1, nbsteps) { s.seq = seq(lbound, uboundp1, (uboundp1 - lbound)/nbsteps)[-nbsteps] tmat = sapply(as.list(s.seq), function(ss) { dtcm(seqs, N - 1, ss * bhati, invdiagi * ss * (1 - ss * z)/(N - 1) * yty) }) smat = sapply(as.list(s.seq), dsgivenykernel, kpa = k + f21a, N = N, z = z) if (any(is.infinite(smat))) smat[is.infinite(smat)] = 0 intconst = (4 * sum(smat[c(FALSE, TRUE)]) + 2 * sum(smat[c(TRUE, FALSE)]) - 3 * smat[nbsteps] - smat[1]) * (s.seq[nbsteps] - s.seq[1])/nbsteps/3 return(list(dv = c(4 * tmat[, c(FALSE, TRUE)] %*% smat[c(FALSE, TRUE)] + 2 * tmat[, c(TRUE, FALSE)] %*% smat[c(TRUE, FALSE)] - 3 * tmat[, nbsteps] * smat[nbsteps] - tmat[, 1] * smat[1]) * (s.seq[nbsteps] - s.seq[1])/nbsteps/3, ic = intconst)) } if (pips[ix] == 0) { reslist = list(x = numeric(n), y = numeric(n), n = n, call = sys.call(), data.name = names(nameix)[ix], has.na = FALSE) class(reslist) = c("density", "coef.density") return(reslist) } lbound = min(betas[ix, as.logical(bools[ix, ])]) - 3 * Eball[ix, 2] ubound = max(betas[ix, as.logical(bools[ix, ])]) + 3 * Eball[ix, 2] seqs = seq(lbound, ubound, (ubound - lbound)/(n - 1)) densvec = numeric(length(seqs)) for (m in 1:length(pmps)) { if (bools[ix, m]) { if (ishyper) { ixadj = sum(bools[1:ix, m]) bhati = olsmodels[[m]]$bhat[[ixadj]] invdiagi = olsmodels[[m]]$diag.inverse[[ixadj]] k = sum(bools[, m]) Esf = betas[ix, m]/bhati z = 1 - olsmodels[[m]]$ymy/yty midpoint = 1 - (1 - Esf) * 4 if (midpoint < 0.5) { dvl = sss(1e-04, 0.9999999, nbsteps * 2) addvec = dvl$dv/dvl$ic } else { dvl1 = sss(1e-04, midpoint, nbsteps) dvl2 = sss(midpoint, 1, nbsteps) addvec = (dvl1$dv + dvl2$dv)/(dvl1$ic + dvl2$ic) } } else { addvec = dtcm(seqs, N - 1, betas[ix, m], sigmadiag[ix, m]) } densvec = densvec + pmps[m] * addvec } } reslist = list(x = seqs, y = densvec, bw = NULL, n = n, call = sys.call(), data.name = names(nameix)[ix], has.na = FALSE) class(reslist) = "density" if (!doplot) { return(reslist) } main_default = paste("Marginal Density:", names(nameix)[ix], "(PIP", round(c(crossprod(pmps, bools[ix, ])) * 100, 2), "%)") if (any(grep("p", addons, ignore.case = TRUE))) { decr = 0.12 parplt = par()$plt parplt_temp = parplt parplt_temp[4] = (1 - decr) * parplt[4] + decr * parplt[3] par(plt = parplt_temp) main_temp = main_default main_default = NULL } dotargs = .adjustdots(dotargs, type = "l", col = "steelblue4", main = main_default, xlab = if (std.coefs) "Standardized Coefficient" else "Coefficient", ylab = "Density") eval(as.call(c(list(as.name("plot"), x = as.name("seqs"), y = as.name("densvec")), as.list(dotargs)))) leg.col = numeric(0) leg.lty = numeric(0) leg.legend = character(0) if (any(grep("g", addons, ignore.case = TRUE))) { grid() } if (any(grep("b", addons, ignore.case = TRUE))) { for (m in 1:length(pmps)) { Ebm = betas[ix, m] if (as.logical(Ebm)) { Ebheight = min(densvec[max(sum(seqs < Ebm), 1)], densvec[sum(seqs < Ebm) + 1]) lines(x = rep(Ebm, 2), y = c(0, Ebheight), col = 8) } } leg.col = c(leg.col, 8) leg.lty = c(leg.lty, 1) leg.legend = c(leg.legend, "EV Models") } if (any(grep("e", addons, ignore.case = FALSE))) { abline(v = Eball[ix, 1], col = 2, lwd = addons.lwd) leg.col = c(leg.col, 2) leg.lty = c(leg.lty, 1) leg.legend = c(leg.legend, "Cond. EV") } if (any(grep("s", addons, ignore.case = FALSE))) { abline(v = Eball[ix, 1] - 2 * Eball[ix, 2], col = 2, lty = 2, lwd = addons.lwd) abline(v = Eball[ix, 1] + 2 * Eball[ix, 2], col = 2, lty = 2, lwd = addons.lwd) leg.col = c(leg.col, 2) leg.lty = c(leg.lty, 2) leg.legend = c(leg.legend, "2x Cond. SD") } if (any(grep("m", addons, ignore.case = TRUE))) { median_index = sum(cumsum(densvec) < sum(densvec)/2) abline(v = (seqs[median_index] + seqs[median_index + 1])/2, col = 3, lwd = addons.lwd) leg.col = c(leg.col, 3) leg.lty = c(leg.lty, 1) leg.legend = c(leg.legend, "Median") } if (any(grep("z", addons, ignore.case = TRUE))) { abline(h = 0, col = "gray", lwd = addons.lwd) } if (any(grep("E", addons, ignore.case = FALSE))) { abline(v = Eb1.mcmc[ix], col = 4, lwd = addons.lwd) leg.col = c(leg.col, 4) leg.lty = c(leg.lty, 1) leg.legend = c(leg.legend, "Cond. EV (MCMC)") } if (any(grep("S", addons, ignore.case = FALSE))) { abline(v = Eb1.mcmc[ix] - 2 * Ebsd.mcmc[ix], col = 4, lty = 2, lwd = addons.lwd) abline(v = Eb1.mcmc[ix] + 2 * Ebsd.mcmc[ix], col = 4, lty = 2, lwd = addons.lwd) leg.col = c(leg.col, 4) leg.lty = c(leg.lty, 2) leg.legend = c(leg.legend, "2x SD (MCMC)") } if (any(grep("l", addons, ignore.case = TRUE)) & (length(leg.col) > 0)) { leg.pos = "topright" if (Eball[ix, 1] > seqs[floor(n/2)]) leg.pos = "topleft" legend(x = leg.pos, lty = leg.lty, col = leg.col, legend = leg.legend, box.lwd = 0, bty = "n", lwd = addons.lwd) } if (any(grep("p", addons, ignore.case = TRUE))) { pusr = par()$usr rect(pusr[1], pusr[4] * (1 + decr * 0.2), pusr[2], pusr[4] * (1 + decr), xpd = TRUE, col = 8) rect(pusr[1], pusr[4] * (1 + decr * 0.2), pips[ix] * pusr[2] + (1 - pips[ix]) * pusr[1], pusr[4] * (1 + decr), xpd = TRUE, col = 9) mtext("PIP:", side = 2, las = 2, line = 1, at = pusr[4] * (1 + decr * 0.6)) par(plt = parplt) title(main_temp) } return(reslist) } densres = list() oldask = par()$ask plots = 0 for (vbl in 1:length(reg)) { doplot = (if (as.logical(pips[reg[vbl]])) plot else FALSE) plots = plots + doplot if (plots == 2) { par(ask = TRUE) } densres[[nameix[vbl]]] = plotndens(reg[vbl], doplot) densres[[nameix[vbl]]]$call = sys.call() } par(ask = oldask) if (length(densres) == 1) densres = densres[[1]] else class(densres) = c("coef.density", class(densres)) if (!plot) return(densres) if (plot & (plots == 0)) { warning("No plot produced as PIPs of provided variables are zero under 'exact' estimation.") } return(invisible(densres)) } BMS/R/quantile.pred.density.R0000644000175100001440000000045612624725513015502 0ustar hornikusersquantile.pred.density <- function (x, probs = seq(0.25, 0.75, 0.25), names = TRUE, ...) { quout = .quantile.density(x$densities(), probs = probs, names = names, normalize = FALSE) if (is.matrix(quout) && as.logical(names)) rownames(quout) <- names(x$fit) return(quout) } BMS/R/c.bma.R0000644000175100001440000000030712624725513012224 0ustar hornikusersc.bma <- function (..., recursive = FALSE) { if (!missing(recursive)) warning("note that argument recursive has no meaning and is retained for compatibility") combine_chains(...) } BMS/R/summary.zlm.R0000644000175100001440000000253512624725513013547 0ustar hornikuserssummary.zlm <- function (object, printout = TRUE, ...) { betas = object$coefficients betas2 = object$coef2moments sds = sqrt(betas2 - betas^2) ests = cbind(betas, sds) gi = object$gprior.info gi.choice = gi$gtype if (gi$gtype == "hyper") { gi.choice = paste(gi$gtype, " (a=", 2 + signif(gi$hyper.parameter - 2, digits = 4), ")", sep = "") } gi.sd = -1 gi.sdtext = "" if (length(gi$shrinkage.moments) > 1) { gi.sd = sqrt(gi$shrinkage.moments[[2]] - gi$shrinkage.moments[[1]]^2) gi.sdtext = paste(" St.Dev.:", round(gi.sd, 3)) } rownames(ests) = c("(Intercept)", attr(object$terms, "term.labels")) colnames(ests) = c("Exp.Val.", "St.Dev.") cat("Coefficients\n") print(ests) cat("\n Log Marginal Likelihood:\n") cat(object$marg.lik) cat(paste("\n g-Prior:", gi.choice, "\n")) cat(paste("Shrinkage Factor", ifelse(gi$is.constant, ": ", " Exp.Val: "), round(gi$shrinkage.moments[[1]], 3), gi.sdtext, "\n", sep = "")) res = list() res$residuals <- object$residuals res$coefficients <- object$coefficients res$coef.sd <- sds res$gprior <- gi.choice res$E.shrinkage <- gi$shrinkage.moments[[1]] if (gi.sd > -1) { res$SD.shrinkage <- gi.sd } res$log.lik <- object$marg.lik return(invisible(res)) } BMS/R/plotComp.R0000644000175100001440000000735012624725513013046 0ustar hornikusersplotComp <- function (..., varNr = NULL, comp = "PIP", exact = FALSE, include.legend = TRUE, add.grid = TRUE, do.par = TRUE, cex.xaxis = 0.8) { col_default = c("#1B9E77", "#D95F02", "#7570B3", "#E7298A", "#66A61E", "#E6AB02", "#A6761D", "#666666") bmaList = list(...) bmaix = sapply(bmaList, is.bma) bmaList = bmaList[bmaix] bmaNr = length(bmaList) if (!all(sapply(bmaList, is.bma))) { stop("Submit only bma objects to compare results (no other objects)") } dotargs = match.call(expand.dots = FALSE)$... dotargs = .adjustdots(dotargs, ylab = paste(comp), pch = 1:bmaNr, col = col_default, type = "p", lty = 1:5, lwd = 1.5, xlab = "", xaxt = "n") dotargs = dotargs[!c(bmaix, logical(length(dotargs) - length(bmaix)))] xMat = lapply(bmaList, function(x) rownames(estimates.bma(x, exact = exact))) xNames = xMat[[1]] ind = as.numeric(unlist(lapply(xMat, function(x) length(x)))) if (length(unique(ind) > 1)) { smallestSet = which.min(ind) indMat = array(0:0, dim = c(length(xMat[[smallestSet]]), length(ind))) for (i in 1:length(ind)) { indMat[, i] = as.numeric(xMat[[smallestSet]] %in% xMat[[i]]) } xNamesInd = which(rowSums(indMat) == bmaNr) xNames = xMat[[smallestSet]][xNamesInd] } compNames = c(colnames(estimates.bma(bmaList[[1]])), "Std Mean", "Std Coef") if (is.null(xNames)) { stop("the bma objects have to have (the same) rownames attached to them") } if (!(comp %in% compNames)) { stop("Please specify comp as one of PIP, Post Mean, Post SD, Std Mean, or Std Coef") } if (comp == "Std Mean") { compMatrix = sapply(bmaList, function(x) estimates.bma(x, std.coefs = TRUE, exact = exact)[xNames, "Post Mean"]) comp = "Standardized Coefficients" } else if (comp == "Std SD") { compMatrix = sapply(bmaList, function(x) estimates.bma(x, std.coefs = TRUE, exact = exact)[xNames, "Post SD"]) comp = "Standardized SD" } else { compMatrix = sapply(bmaList, function(x) estimates.bma(x, exact = exact)[xNames, comp]) } bmaNames = names(list(...))[bmaix] colnames(compMatrix) = paste("Model", 1:bmaNr) if (!is.null(bmaNames) && (length(bmaNames) == ncol(compMatrix))) { for (bix in 1:bmaNr) { colnames(compMatrix)[[bix]] <- ifelse(bmaNames[[bix]] == "", paste("Model", bix), bmaNames[[bix]]) } } if (!is.null(varNr)) { compMatrix = compMatrix[varNr, , drop = FALSE] } if (as.logical(do.par)) { oldmar = par()$mar spaceforxaxis = strwidth(rownames(compMatrix)[which.max(nchar(rownames(compMatrix)))], units = "inches", cex = cex.xaxis) * (par("mar")/par("mai"))[[2]] tempmar = oldmar tempmar[1] = min(max(oldmar[1], spaceforxaxis + oldmar[1]/3), 0.5 * par("fin")[[2]] * (par("mar")/par("mai"))[[1]]) par(mar = tempmar) } eval(as.call(c(list(as.name("matplot"), as.name("compMatrix")), as.list(dotargs)))) if (as.logical(include.legend)) { extractfromdotargs = function(...) { dal = list(...) return(list(col = dal$col, pch = dal$pch)) } myargs = eval(as.call(c(list(as.name("extractfromdotargs")), as.list(dotargs)))) legend("topright", colnames(compMatrix), pch = myargs$pch, col = myargs$col, bty = "n") } if (as.logical(add.grid)) grid() axis(1, las = 2, at = 1:nrow(compMatrix), labels = rownames(compMatrix), cex.axis = cex.xaxis) if (as.logical(do.par)) par(mar = oldmar) } BMS/R/predict.zlm.R0000644000175100001440000000551512624725513013505 0ustar hornikuserspredict.zlm <- function (object, newdata = NULL, se.fit = FALSE, ...) { if (!is(object, "zlm")) { stop("you need to provide a zlm object") return() } betas = object$coefficients[-1, drop = FALSE] alpha = object$coefficients[[1]] if (is.null(newdata)) { newX <- as.matrix(object$model[, -1, drop = FALSE]) } else { newX = as.matrix(newdata) if (!is.numeric(newX)) stop("newdata must be numeric!") if (is.vector(newdata)) newX = matrix(newdata, 1) if (ncol(newX) != length(betas)) { if (ncol(newX) == length(betas) + 1) { newX = newX[, -1, drop = FALSE] } else { stop("newdata must be a matrix or data.frame with ", length(betas), " columns.") } } } if (!se.fit) return(as.vector(newX %*% betas) + alpha) yXdata <- as.matrix(object$model) oldXraw <- yXdata[, -1, drop = FALSE] if (!is.null(colnames(newX)) && !is.null(colnames(oldXraw))) { if (all(colnames(oldXraw) %in% colnames(newX)) && !all(colnames(oldXraw) == colnames(newX))) { warning("argument newdata had to be reordered according to its column names. Consider submitting the columns of newdata in the right order.") newX = newX[, colnames(oldXraw), drop = FALSE] } } yraw <- yXdata[, 1, drop = TRUE] N <- length(yraw) k <- ncol(oldXraw) oldXmeans <- colMeans(oldXraw) oldXdm <- oldXraw - matrix(oldXmeans, N, k, byrow = TRUE) newXdm <- newX - matrix(oldXmeans, nrow(newX), k, byrow = TRUE) xtxinv = chol2inv(chol(crossprod(oldXdm))) xtxinv_xf = tcrossprod(xtxinv, newXdm) xf_xx_xf = unlist(lapply(1:nrow(newXdm), function(x) { crossprod(newXdm[x, ], xtxinv_xf[, x])[[1L]] })) bvar = object$coef2moments[-1] - object$coefficients[-1]^2 bvar_factor = bvar[[1L]]/xtxinv[[1L]] yty = as.vector(crossprod(yraw) - N * mean(yraw)^2) r2 = 1 - object$olsres$ymy/yty if (object$gprior.info$gtype == "hyper") { f21a = object$gprior.info$hyper.parameter f21_recover = exp((object$marg.lik) + (N - 1)/2 * log(yty) + log((k + f21a - 2)/(f21a - 2))) res_scale = yty/(N - 3)/(N - 1 - k - f21a) * ((N - 3) * (1 - r2) - (k + f21a - 2)/f21_recover) svar_woscale = res_scale/N + bvar_factor * xf_xx_xf } else { sf = object$gprior.info$shrinkage.moments[[1]] res_scale = (1 - sf * r2) * yty/(N - 3) svar_woscale = res_scale/N + bvar_factor * xf_xx_xf } reslist = list() reslist$fit <- as.vector(newX %*% betas) + alpha reslist$std.err <- sqrt(svar_woscale + res_scale) reslist$se.fit <- sqrt(svar_woscale) reslist$residual.scale <- sqrt(res_scale) return(reslist) } BMS/R/coef.bma.R0000644000175100001440000000056612624725513012725 0ustar hornikuserscoef.bma <- function (object, exact = FALSE, order.by.pip = TRUE, include.constant = FALSE, incl.possign = TRUE, std.coefs = FALSE, condi.coef = FALSE, ...) { estimates.bma(object, exact = exact, order.by.pip = order.by.pip, include.constant = include.constant, incl.possign = incl.possign, std.coefs = std.coefs, condi.coef = condi.coef) } BMS/R/post.pr2.R0000644000175100001440000000046612624725513012741 0ustar hornikuserspost.pr2 <- function (object, exact = FALSE) { if (!(is.bma(object) | is(object, "lm"))) stop("Required input is an object of class 'bma' or 'lm'/'zlm'.") od = deviance(object, exact = exact) oy = model.frame(object)[, 1, drop = TRUE] return(1 - (od/crossprod(oy - mean(oy))[[1]])) } BMS/R/plot.pred.density.R0000644000175100001440000000047412624725513014636 0ustar hornikusersplot.pred.density <- function (x, predict_index = NULL, addons = "eslz", realized.y = NULL, addons.lwd = 1.5, ...) { if (!is(x, "pred.density")) stop("x must be of class 'pred.density'!") x$plot(predict_index, realized.y = realized.y, addons = addons, addons.lwd = addons.lwd, ...) } BMS/R/pmpmodel.R0000644000175100001440000000656612624725513013076 0ustar hornikuserspmpmodel <- function (bmao, model = numeric(0), exact = TRUE) { if (!is.bma(bmao)) stop("bmao needs to be a bma object") if (!is.vector(model)) stop("model needs to be vector denoting a single model.") K = bmao$info$K was.enum = (bmao$arguments$mcmc == "enum") emptyindex = logical(K) modelhex = "" if (length(model) == 0L) model = numeric(0) if ((is.character(model)) && (all(model %in% bmao$reg.names))) { mix = match(model, bmao$reg.names) if (any(is.na(mix))) stop("Provided variable names do not conform to bma object") emptyindex[mix] = TRUE model = emptyindex } else if ((length(model) == 1L) && all(is.character(model))) { modelhex = model model = as.logical(hex2bin(model)) if (length(model) > K) model = model[-(1:(length(model) - K))] } else if (is.logical(model) || ((length(model) == K) && (is.numeric(model) && max(model) < 2))) { if (length(model) > K) model = model[-(1:(length(model) - K))] model = as.logical(model) } else if (is.numeric(model)) { emptyindex[model] = TRUE model = emptyindex } else stop("model needs to be an integer, logical or character model index representation (hexcode or variable names)") if (any(is.na(model))) stop("Provided model index does not seem to exist.") if (modelhex == "") modelhex = bin2hex(model) fixed.pos = bmao$mprior.info$fixed.pos if (is.null(fixed.pos)) fixed.pos = numeric(0) if (any(model[fixed.pos] != TRUE)) stop("Such a model was excluded by bmao's argument fixed.reg") bools = bmao$topmod$bool() liks = bmao$topmod$lik() ncounts = bmao$topmod$ncount() cumsumweights = bmao$info$cumsumweights yty = as.vector(crossprod(bmao$X.data[, 1, drop = TRUE] - mean(bmao$X.data[, 1, drop = TRUE]))) log.null.lik = bmao$gprior.info$lprobcalc$just.loglik(ymy = yty, k = 0) mix = match(modelhex, bools) if ((!exact) && (!was.enum)) { if (!is.na(mix)) { return(ncounts[[mix]]/cumsumweights) } else if (!any(model) || all(model)) { return(bmao$info$k.vec[sum(model) + 1]/cumsumweights) } else { stop("Model MCMC-based PMP cannot be found. Try exact=TRUE .") } } if (!is.na(mix)) { loglik = liks[mix] } else if (was.enum && (!any(model) || all(model))) { loglik = log(bmao$info$k.vec[sum(model) + 1]) + log.null.lik } else { if (!was.enum && (length(liks) == 0L)) stop("bmao needs to contain more than 0 top models to provide an estimate for your model index.") if (sum(model) == 0L) { loglik = log.null.lik + bmao$mprior.info$pmp(ki = 0, mdraw = rep(0, K), ymy = yty) } else { zz = zlm(bmao$X.data[, c(TRUE, model), drop = FALSE], g = bmao$gprior.info) loglik = zz$marg.lik + bmao$mprior.info$pmp(ki = sum(model), mdraw = as.numeric(model), ymy = zz$olsres$ymy) } } if (was.enum) { return(exp(loglik - log.null.lik)/cumsumweights) } pmp_withintop = exp(loglik - log.null.lik)/sum(exp(liks - log.null.lik)) return(pmp_withintop * sum(ncounts)/cumsumweights) } BMS/R/topmodels.bma.R0000644000175100001440000000023112624725513014004 0ustar hornikuserstopmodels.bma <- function (bmao) { if (!is.bma(bmao)) { stop("you need to provide a bma object") } return(.post.topmod.bma(bmao)) } BMS/R/hex2bin.R0000644000175100001440000000042412624725513012603 0ustar hornikusershex2bin <- function (hexcode) { if (!is.character(hexcode)) stop("please input a character like '0af34c'") hexcode <- paste("0", tolower(hexcode), sep = "") hexobj <- .hexcode.binvec.convert(length(hexcode) * 16L) return(hexobj$as.binvec(hexcode)) } BMS/R/density.zlm.R0000644000175100001440000000225012624725513013523 0ustar hornikusersdensity.zlm <- function (x, reg = NULL, addons = "lesz", std.coefs = FALSE, n = 300, plot = TRUE, hnbsteps = 30, addons.lwd = 1.5, ...) { addons = gsub("E", "", addons, ignore.case = FALSE) addons = gsub("S", "", addons, ignore.case = FALSE) addons = gsub("b", "", addons, ignore.case = FALSE) addons = gsub("m", "", addons, ignore.case = FALSE) addons = gsub("p", "", addons, ignore.case = FALSE) N = length(x$residuals) K = length(x$coefficients) - 1 tmo = topmod(1, nmaxregressors = K, bbeta = TRUE, liks = x$marg.lik, ncounts = 1, modelbinaries = matrix(rep(1, K), K, 1), betas = matrix(as.vector(x$coefficients[-1]), K), betas2 = matrix(as.vector(x$coef2moments[-1]), K)) tokenbma = list(info = list(K = K, N = N), arguments = list(), topmod = tmo, start.pos = integer(0), gprior.info = x$gprior.info, X.data = x$model, reg.names = names(x$coefficients)[-1], bms.call = new("call")) class(tokenbma) = "bma" return(density.bma(tokenbma, reg = reg, addons = addons, std.coefs = std.coefs, n = n, plot = plot, hnbsteps = hnbsteps, addons.lwd = addons.lwd, ...)) } BMS/R/vcov.zlm.R0000644000175100001440000000131712624725513013024 0ustar hornikusersvcov.zlm <- function (object, include.const = FALSE, ...) { Xmat = as.matrix(model.frame(object)[, -1, drop = FALSE]) if (ncol(Xmat) < 1) stop("Needs at least one non-constant regressor") regnames = colnames(Xmat) Xmat = Xmat - matrix(colMeans(Xmat), nrow(Xmat), ncol(Xmat), byrow = TRUE) xxinv = chol2inv(chol(crossprod(Xmat))) outmat = ((object$coef2moments[[2]] - object$coefficients[[2]]^2)/xxinv[[1]]) * xxinv if (include.const) { outmat = rbind(rep(NA, nrow(outmat) + 1), cbind(rep(NA, ncol(outmat)), outmat)) regnames = c("(Intercept)", regnames) } colnames(outmat) <- rownames(outmat) <- regnames return(outmat) } BMS/R/variable.names.bma.R0000644000175100001440000000026612624725513014675 0ustar hornikusersvariable.names.bma <- function (object, ...) { if (!is.bma(object)) stop("argument 'object' needs to be a bma object") return(c("(Intercept)", object$reg.names)) } BMS/R/zzz.R0000644000175100001440000000315512624725513012105 0ustar hornikuserssetOldClass("topmod") #,representation(addmodel="function", lik="function", bool="function", ncount="function", nbmodels="function", nregs="function", betas_raw="function", betas2_raw="function", kvec_raw="function", bool_binary="function", betas="function", betas2="function", fixed_vector="function")) setOldClass("bma") #,representation(info="list",arguments="list",topmod="topmod",start.pos="integer",gprior.info="list",mprior.info="list",X.data="data.frame",reg.names="character",bms.call="call")) setOldClass("zlm") #,representation(coefficients="numeric",residuals="numeric",rank="numeric",fitted.values="numeric",df.residual="numeric",call="call",terms="formula",model="data.frame",coef2moments="numeric",marg.lik="numeric",gprior.info="list")) #setMethod("[","bma",.index.bma) #setMethod("c","bma",c.bma) #setMethod("coef","bma",coef.bma) #setMethod("density","bma",density.bma) #setMethod("deviance","bma",deviance.bma) #setMethod("image","bma",image.bma) #setMethod("model.frame","bma",model.frame.bma) #setMethod("plot","bma",plot.bma) #setMethod("predict","bma",predict.bma) #setMethod("print","bma",print.bma) #setMethod("summary","bma",info.bma) #setMethod("variable.names","bma",variable.names.bma) #zlm Methods #setMethod("density","zlm",density.zlm) #setMethod("deviance","zlm",deviance.zlm) #setMethod("logLik","zlm",logLik.zlm) #setMethod("predict","zlm",predict.zlm) #setMethod("summary","zlm",summary.zlm) #setMethod("variable.names","zlm",variable.names.zlm) #setMethod("vcov","zlm",vcov.zlm) #topmod methods #setMethod("print","topmod",print.topmod) #setMethod("[","topmod",.index.topmod)BMS/R/combine_chains.R0000644000175100001440000001573412624725513014217 0ustar hornikuserscombine_chains <- function (...) { combine_topmods <- function(topmodobj1, topmodobj2) { nregs1 = topmodobj1$nregs nregs2 = topmodobj2$nregs if (nregs1 != nregs2) { stop("The number of regressors in both BMA chains has to be the same!") } k1 = length(topmodobj1$ncount()) k2 = length(topmodobj2$ncount()) nbmodels1 = topmodobj1$nbmodels nbmodels2 = topmodobj2$nbmodels ncount1 = topmodobj1$ncount() ncount2 = topmodobj2$ncount() lik1 = topmodobj1$lik() lik2 = topmodobj2$lik() bool1 = topmodobj1$bool() bool2 = topmodobj2$bool() betas1 = topmodobj1$betas() betas2 = topmodobj2$betas() betas2_1 = topmodobj1$betas2() betas2_2 = topmodobj2$betas2() fv1 = topmodobj1$fixed_vector() fv2 = topmodobj2$fixed_vector() if (all(betas1 == 0) | all(betas2 == 0)) { dobetas = FALSE } else { dobetas = TRUE } if (all(betas2_1 == 0) | all(betas2_2 == 0)) { dobetas2 = FALSE } else { dobetas2 = TRUE } idxin2_boolof1in2 = match(bool1, bool2) idxin1_boolof1in2 = which(!is.na(idxin2_boolof1in2)) idxin2_boolof1in2 = idxin2_boolof1in2[!is.na(idxin2_boolof1in2)] ncount2[idxin2_boolof1in2] = ncount2[idxin2_boolof1in2] + ncount1[idxin1_boolof1in2] if (any(idxin1_boolof1in2)) { ncount1 = ncount1[-idxin1_boolof1in2] lik1 = lik1[-idxin1_boolof1in2] bool1 = bool1[-idxin1_boolof1in2] } lika = c(lik2, lik1) orderlika = order(lika, decreasing = TRUE) lika = lika[orderlika] ncounta = c(ncount2, ncount1)[orderlika] boola = c(bool2, bool1)[orderlika] if (dobetas) { if (any(idxin1_boolof1in2)) betas1 = betas1[, -idxin1_boolof1in2] betasa = cbind(betas2, betas1)[, orderlika] betasa_not0 = betasa != 0 vecka = colSums(betasa_not0) vbetaa = as.vector(betasa[as.vector(betasa_not0)]) } else { vecka = 0 vbetaa = numeric(0) } if (dobetas2) { if (any(idxin1_boolof1in2)) betas2_1 = betas2_1[, -idxin1_boolof1in2] betasa2 = cbind(betas2_2, betas2_1)[, orderlika] vbetaa2 = as.vector(betasa2[as.vector(betasa_not0)]) } else { vbetaa2 = numeric(0) } fva = numeric(0) lfv = 0 if ((nrow(fv1) == nrow(fv2)) & ((nrow(fv1) > 0) & (nrow(fv2) > 0))) { if (any(idxin1_boolof1in2)) fv1 = fv1[, -idxin1_boolof1in2] if (!is.matrix(fv1)) fv1 = t(fv1) fva = as.vector(cbind(fv2, fv1)[, orderlika]) lfv = nrow(fv1) } return(.top10(nmaxregressors = nregs1, nbmodels = length(lika), bbeta = dobetas, lengthfixedvec = lfv, bbeta2 = dobetas2, inivec_lik = lika, inivec_bool = boola, inivec_count = ncounta, inivec_vbeta = vbetaa, inivec_vbeta2 = vbetaa2, inivec_veck = vecka, inivec_fixvec = fva)) } combine_2chains <- function(flso1, flso2) { topmod.combi = combine_topmods(flso1$topmod, flso2$topmod) gpi <- flso1$gprior.info gpi$shrinkage.moments = numeric(length(gpi$shrinkage.moments)) io1 = flso1$info io2 = flso2$info obj.combi = .post.calc(gprior.info = gpi, add.otherstats = io1$add.otherstats + io2$add.otherstats, k.vec = (io1$k.vec[-1] + io2$k.vec[-1]), null.count = (io1$k.vec[1] + io2$k.vec[1]), flso1$X.data, topmods = topmod.combi, b1mo = io1$b1mo + io2$b1mo, b2mo = io1$b2mo + io2$b2mo, iter = io1$iter + io2$iter, burn = io1$burn + io2$burn, inccount = io1$inccount + io2$inccount, models.visited = io1$models.visited + io2$models.visited, K = io1$K, N = io1$N, msize = io1$msize + io2$msize, timed = io1$timed + io2$timed, cumsumweights = io1$cumsumweights + io2$cumsumweights, mcmc = flso1$arguments$mcmc, possign = io1$pos.sign + io2$pos.sign) stpos1 = as.matrix(flso1$start.pos) stpos2 = as.matrix(flso2$start.pos) startpos.combi = cbind(rbind(stpos1, matrix(0, max(0, nrow(stpos2) - nrow(stpos1)), ncol(stpos1))), rbind(stpos2, matrix(0, max(0, nrow(stpos1) - nrow(stpos2)), ncol(stpos2)))) call.combi = c(flso1$bms.call, flso2$bms.call) args.combi = flso1$arguments args2 = flso2$arguments args.combi$burn = args.combi$burn + args2$burn args.combi$iter = args.combi$iter + args2$iter if ((length(args.combi$mprior.size) == 1) | (length(args.combi$mprior.size) == 1)) { args.combi$mprior.size = mean(c(args.combi$mprior.size, args2$mprior.size)) } args.combi$nmodel = topmod.combi$nbmodels args.combi$user.int = (args.combi$user.int & args2$user.int) args.combi$g.stats = (args.combi$g.stats & args2$g.stats) mp1 = flso1$mprior.info mp2 = flso2$mprior.info if (mp1$mp.mode != mp2$mp.mode) { mpall = list() } else { mpall = mp1 mpall$mp.msize = 0.5 * mp1$mp.msize + 0.5 * mp2$mp.msize mpall$origargs$mpparam = 0.5 * mp1$origargs$mpparam + 0.5 * mp2$origargs$mpparam mpall$mp.Kdist = 0.5 * mp1$mp.Kdist + 0.5 * mp2$mp.Kdist } result = list(info = obj.combi$info, arguments = args.combi, topmod = topmod.combi, start.pos = startpos.combi, gprior.info = obj.combi$gprior.info, mprior.info = mpall, X.data = flso1$arguments$X.data, reg.names = obj.combi$reg.names, bms.call = call.combi) class(result) = "bma" return(result) } arglist = list(...) if (!all(unlist(lapply(arglist, is.bma)))) stop("All of the input arguments must be BMA objects!") if (!all(lapply(arglist, function(xx) xx$info$K) == arglist[[1]]$info$K)) stop("All of the input BMA objects must have an equal number of max regressors (i.e. equal (X.data))!") if (!all(lapply(arglist, function(xx) xx$info$N) == arglist[[1]]$info$N)) stop("All of the input BMA objects must have equal X.data!") if (!all(lapply(arglist, function(xx) xx$gprior.info$gtype) == arglist[[1]]$gprior.info$gtype)) stop("All of the input BMA objects must have the same type of g-prior (bms-argument g)") if (length(arglist) == 1) return(arglist[[1]]) combined_output <- combine_2chains(arglist[[1]], arglist[[2]]) if (nargs() > 2) { for (inarg in 3:nargs()) { combined_output <- combine_2chains(arglist[[inarg]], combined_output) } } return(combined_output) } BMS/vignettes/0000755000175100001440000000000012624725744012736 5ustar hornikusersBMS/vignettes/bms.Rnw0000644000175100001440000017550612624725513014217 0ustar hornikusers\documentclass[a4paper]{article} \title{Bayesian Model Averaging with BMS\\ \normalsize{for BMS Version 0.3.4}} \author{Stefan Zeugner} \usepackage{natbib} \usepackage{vmargin} \setpapersize{A4} % \VignetteIndexEntry{Bayesian Model Averaging with BMS} \begin{document} \maketitle \abstract{This manual is a brief introduction to applied Bayesian Model Averaging with the R package \verb+BMS+. The manual is structured as a hands-on tutorial for readers with few experience with BMA. Readers from a more technical background are advised to consult the table of contents for formal representations of the concepts used in BMS.\\ For other tutorials and more information, please refer to \mbox{ \texttt{http://bms.zeugner.eu}.} } \tableofcontents \clearpage <>= options(width=75) @ \section{A Brief Introduction to Bayesian Model Averaging} This section reiterates some basic concepts, and introduces some notation for readers with limited knowledge of BMA. Readers with more experience in BMA should skip this chapter and directly go to section \ref{sec:example}. For a more thorough introduction to BMA, consult \citet{Hoetingetal99}. \subsection{Bayesian Model Averaging} Bayesian Model Averaging (BMA) addresses model uncertainty in a canonical regression problem. Suppose a linear model structure, with $y$ being the dependent variable, $\alpha_\gamma$ a constant, $\beta_\gamma$ the coefficients, and $\varepsilon$ a normal IID error term with variance $\sigma^2$: \begin{equation} y= \alpha_\gamma + X_\gamma \beta_\gamma + \varepsilon \qquad \varepsilon \sim N(0, \sigma^2 I) \label{eq:lm} \end{equation} A problem arises when there are many potential explanatory variables in a matrix $X$: Which variables $X_\gamma \in \{X\}$ should be then included in the model? And how important are they? The direct approach to do inference on a single linear model that includes all variables is inefficient or even infeasible with a limited number of observations. BMA tackles the problem by estimating models for all possible combinations of $\{X\}$ and constructing a weighted average over all of them. If $X$ contains $K$ potential variables, this means estimating $2^K$ variable combinations and thus $2^K$ models. The model weights for this averaging stem from posterior model probabilities that arise from Bayes' theorem: \begin{equation} p(M_\gamma | y, X) \; = \; \frac{p(y |M_\gamma, X) p(M_\gamma)}{p(y|X)} \; = \frac{p(y |M_\gamma, X) p(M_\gamma) }{\sum_{s=1}^{2^K} p(y| M_s, X) p(M_s)} \label{eq:bf} \end{equation} Here, $p(y|X)$ denotes the \emph{integrated} likelihood which is constant over all models and is thus simply a multiplicative term. Therefore, the posterior model probability (PMP) $p(M_\gamma|y,X)$ is proportional to\footnote{ Proportionality is expressed with the sign $\propto$: i.e. $p(M_\gamma | y, X) \; \propto \; p(y |M_\gamma, X) p(M_\gamma)$ } the marginal likelihood of the model $p(y |M_\gamma, X) $ (the probability of the data given the model $M_\gamma$) times a prior model probability $p(M_\gamma)$ -- that is, how probable the researcher thinks model $M_\gamma$ before looking at the data. Renormalization then leads to the PMPs and thus the model weighted posterior distribution for any statistic $\theta$ (e.g. the coefficients $\beta$): $$ p(\theta| y, X) = \sum_{\gamma=1}^{2^K } p(\theta | M_\gamma, y, X) p(M_\gamma| X, y) $$ The model prior $p(M_\gamma)$ has to be elicited by the researcher and should reflect prior beliefs. A popular choice is to set a uniform prior probability for each model $p(M_\gamma) \propto 1$ to represent the lack of prior knowledge. Further model prior options will be explored in section \ref{sec:mpriors}. \subsection{Bayesian Linear Models and Zellner's $g$ prior}\label{ssec:zg} The specific expressions for marginal likelihoods $p(M_\gamma|y,X)$ and posterior distributions $p(\theta | M_\gamma, y, X)$ depend on the chosen estimation framework. The literature standard is to use a 'Bayesian regression' linear model with a specific prior structure called 'Zellner's g prior' as will be outlined in this section.\footnote{Note that the presented framework is very similar to the natural normal-gamma-conjugate model - which employs proper priors for $\alpha$ and $\sigma$. Nonetheless, the resulting posterior statistics are virtually identical.}\\ For each individual model $M_\gamma$ suppose a normal error structure as in (\ref{eq:lm}). The need to obtain posterior distributions requires to specify the priors on the model parameters. Here, we place 'improper' priors on the constant and error variance, which means they are evenly distributed over their domain: $p(\alpha_\gamma) \propto 1$, i.e. complete prior uncertainty where the prior is located. Similarly, set $p(\sigma) \propto \sigma^{-1}$. The crucial prior is the one on regression coefficients $\beta_\gamma$: Before looking into the data $(y,X)$, the researcher formulates her prior beliefs on coefficients into a normal distribution with a specified mean and variance. It is common to assume a conservative prior mean of zero for the coefficients to reflect that not much is known about them. Their variance structure is defined according to Zellner's g: $\sigma^2 ( \frac{1}{g} X_\gamma'X_\gamma )^{-1}$: $$ \beta_\gamma | g \sim N \left( 0,\sigma^2 \left( \frac{1}{g} X_\gamma'X_\gamma \right)^{-1}\right) $$ This means that the researcher thinks coefficients are zero, and that their variance-covariance structure is broadly in line with that of the data $X_\gamma$. The hyperparameter $g$ embodies how certain the researcher is that coefficients are indeed zero: A small $g$ means few prior coefficient variance and therefore implies the researcher is quite certain (or conservative) that the coefficients are indeed zero. In contrast, a large $g$ means that the researcher is very uncertain that coefficients are zero. The posterior distribution of coefficients reflects prior uncertainty: Given $g$, it follows a t-distribution with expected value $E(\beta_\gamma|y,X,g,M_\gamma) = \frac{g}{1+g} \hat{\beta}_\gamma$, where $\hat{\beta}_\gamma$ is the standard OLS estimator for model $\gamma$. The expected value of coefficients is thus a convex combination of OLS estimator and prior mean (zero). The more conservative (smaller) $g$, the more important is the prior, and the more the expected value of coefficients is shrunk toward the prior mean zero. As $g \rightarrow \infty$, the coefficient estimator approaches the OLS estimator. Similarly, the posterior variance of $\beta_\gamma$ is affected by the choice of $g$:\footnote{here, $N$ denotes sample size, and $\bar{y}$ the sample mean of the response variable} $$ Cov(\beta_\gamma|y,X,g,M_\gamma) = \frac{(y-\bar{y})'(y-\bar{y})}{N-3} \frac{g}{1+g} \left(1-\frac{g}{1+g} R_\gamma^2\right) (X_\gamma'X_\gamma)^{-1} $$ I.e. the posterior covariance is similar to that of the OLS estimator, times a factor that includes $g$ and $R^2_\gamma$, the OLS R-squared for model $\gamma$. The appendix shows how to apply the function \texttt{zlm} in order to estimate such models out of the BMA context. For BMA, this prior framwork results into a very simple marginal likelihood $p(y|M_\gamma,X,g)$, that is related to the R-squared and includes a size penalty factor adjusting for model size $k_\gamma$: $$ p(y|M_\gamma,X,g) \propto (y-\bar{y})'(y-\bar{y})^{-\frac{N-1}{2} } (1+g)^{-\frac{k_\gamma}{2}} \left( 1- \frac{g}{1+g} \right)^{-\frac{N-1}{2}} $$ The crucial choice here concerns the form of the hyperparameter $g$. A popular 'default' approach is the 'unit information prior' (UIP), which sets $g=N$ commonly for all models and thus attributes about the same information to the prior as is contained in one observation. (Please refer to section \ref{sec:gprior} for a discussion of other $g$-priors.)\footnote{Note that BMS is, in principle not restricted to Zellner's $g$-priors, as quite different coefficient priors might be defined by R-savy users.} \section{A BMA Example: Attitude Data}\label{sec:example} This section shows how to perform basic BMA with a small data set and how to obtain posterior coefficient and model statistics. \subsection{Model Sampling} Equipped with this basic framework, let us explore one of the data sets built into R: The 'attitude' dataset describes the overall satisfaction rating of a large organization's employees, as well as several specific factors such as \verb+complaints+, the way of handling complaints within the organization (for more information type \verb+help(attitude)+). The data includes 6 variables, which means $2^6=64$ model combinations. Let us stick with the UIP g-prior (in this case $g=N=30$). Moreover, assume uniform model priors (which means that our expected prior model parameter size is $K/2=3$). First load the data set by typing <<>>= data(attitude) @ In order to perform BMA you have to load the BMS library first, via the command: <<>>= library(BMS) @ Now perform Bayesian model sampling via the function \verb+bms+, and write results into the variable \verb+att+. <<>>= att = bms(attitude, mprior = "uniform", g="UIP", user.int=F) @ \verb+mprior = "uniform"+ means to assign a uniform model prior, \verb+g="UIP"+, the unit information prior on Zellner's $g$. The option \verb+user.int=F+ is used to suppress user-interactive output for the moment.\footnote{Note that the argument \texttt{g="UIP"} is actually redundant, as this is the default option for \texttt{bms}. The default model prior is somewhat different but does not matter very much with this data. Therefore, the command \texttt{att = bms(attitude)} gives broadly similar results.} The first argument is the data frame \verb+attitude+, and \verb+bms+ assumes that its first column is the response variable.\footnote{The specification of data can be supplied in different manners, e.g. in 'formulas'. Type \texttt{help(lm)} for a comparable function.} \subsection{Coefficient Results} The coefficient results can be obtained via <<>>= coef(att) @ The above matrix shows the variable names and corresponding statistics: The second column \verb+Post Mean+ displays the coefficients averaged over all models, including the models wherein the variable was not contained (implying that the coefficient is zero in this case). The covariate \verb+complaints+ has a comparatively large coefficient and seems to be most important. The importance of the variables in explaining the data is given in the first column \verb+PIP+ which represents posterior inclusion probabilities - i.e. the sum of PMPs for all models wherein a covariate was included. We see that with $99.9\%$, virtually all of posterior model mass rests on models that include \verb+complaints+. In contrast, \verb+learning+ has an intermediate PIP of $40.6\%$, while the other covariates do not seem to matter much. Consequently their (unconditional) coefficients\footnote{Unconditional coefficients are defined as $E(\beta|y,X)=\sum_{\gamma=1}^{2^K} p(\beta_\gamma|, y,X, M_\gamma) p(M_\gamma|y,X)$ i.e. a weighted average over all models, including those where this particular coeffiecnt was restricted to zero. A conditional coeffienct in contrast, is 'conditional on inclusion', i.e. a weighted average only over those models where its regressor was included. Conditional coefficients may be obtained with the command \mbox{\texttt{coef(att, condi.coef =TRUE)}}.} are quite low, since the results quite often include models where these coefficients are zero. The coefficients' posterior standard deviations (\verb+Post SD+) reflect further evidence: \verb+complaints+ is certainly positive, while \verb+advance+ is most likely negative. In fact, the coefficient sign can also be inferred from the fourth column \verb+Cond.Pos.Sign+, the 'posterior probability of a positive coefficient expected value conditional on inclusion', respectively 'sign certainty'. Here, we see that in all encountered models containing this variables, the (expected values of) coefficients for \verb+complaints+ and \verb+learning+ were positive. In contrast, the corresponding number for \verb+privileges+ is near to zero, i.e. in virtually all models that include \verb+privileges+, its coefficient sign is negative. Finally, the last column \verb+idx+ denotes the index of the variables' appearance in the original data set, as our results are obviously sorted by PIP. Further inferring about the importance of our variables, it might be really more interesting to look at their standardized coefficients.\footnote{Standardized coefficients arise if both the response $y$ and the regressors $X$ are normalized to mean zero and variance one -- thus effectively bringing the data down to same order of magnitude.} Type: <<>>= coef(att, std.coefs=T, order.by.pip=F, include.constant=T) @ The standardized coefficients reveal similar importance as discussed above, but one sees that \verb+learning+ actually does not matter much in terms of magnitude. Note that \verb+order.by.pip=F+ represents covariates in their original order. The argument \verb+include.constant=T+ also prints out a (standardized) constant. \subsection{Other Results} Other basic information about the sampling procedure can be obtained via \footnote{Note that the command \texttt{print(att)} is equivalent to \texttt{coef(att); summary(att)}}. <<>>= summary(att) @ It reiterates some of the facts we already know, but adds some additional information such as \verb+Mean no. regressors+, posterior expected model size (cf. section \ref{sec:mpriors}). Finally, let's look into which models actually perform best: The function \verb+topmodels.bma+ prints out binary representations for all models included, but for the sake of illustration let us focus on the best three:\footnote{\texttt{topmodel.bma} results in a matrix in which each row corresponds to a covariate and each column to a model (ordered left-to-right by their PMP). The best three models are therefore in the three leftmost columns resulting from \texttt{topmodel.bma}, which are extracted via index assignment \texttt{[, 1:3]}.} <<>>= topmodels.bma(att)[,1:3] @ \label{topmodcall}We see that the output also includes the posterior model probability for each model.\footnote{To access the PMP for any model, consider the function \texttt{pmpmodel} -- cf. \texttt{help(pmpmodel)} . } The best model, with 29\% posterior model probability,\footnote{The differentiation between \texttt{PMP (Exact)} and \texttt{PMP (MCMC)} is of importance if an MCMC sampler was used -- cf. section \ref{ssec:anavsmcmc} } is the one that only includes \verb+complaints+. However the second best model includes \verb+learning+ in addition and has a PMP of 16\%. Use the command \verb+beta.draws.bma(att)+ to obtain the actual (expected values of) posterior coefficient estimates for each of these models. In order to get a more comprehensive overview over the models, use the command <>= image(att) @ Here, blue color corresponds to a positive coefficient, red to a negative coefficient, and white to non-inclusion (a zero coefficient). On the horizontal axis it shows the best models, scaled by their PMPs. We see again that the best model with most mass only includes \verb+complaints+. Moreover we see that complaints is included in virtually all model mass, and unanimously with a positive coefficient. In contrast, \verb+raises+ is included very little, and its coefficient sign changes according to the model. (Use \verb+image(att,yprop2pip=T)+ for another illustrating variant of this chart.) \section{Model Size and Model Priors}\label{sec:mpriors} Invoking the command \verb+summary(att)+ yielded the important posterior statistic \verb+Mean no. regressors+, the posterior expected model size (i.e. the average number of included regressors), which in our case was $2.11$. Note that the posterior expected model size is equal to the sum of PIPs -- verify via <<>>= sum(coef(att)[,1]) @ This value contrasts with the prior expected model size implictely used in our model sampling: With $2^K$ possible variable combinations, a uniform model prior means a common prior model probability of $p(M_\gamma)=2^{-K}$. However, this implies a prior expected model size of $\sum_{k=0}^K{ {K \choose k} k 2^{-K}}=K/2$. Moreover, since there are more possible models of size 3 than e.g. of size 1 or 5, the uniform model prior puts more mass on intermediate model sizes -- e.g. expecting a model size of $k_\gamma=3$ with ${6 \choose 3} 2^{-K} = 31\%$ probability. In order to examine how far the posterior model size distribution matches up to this prior, type: <>= plotModelsize(att) @ We see that while the model prior implies a symmetric distribution around $K/2=3$, updating it with the data yields a posterior that puts more importance on parsimonious models. In order to illustrate the impact of the uniform model prior assumption, we might consider other popular model priors that allow more freedom in choosing prior expected model size and other factors. \subsection{Binomial Model Prior} The binomial model prior constitutes a simple and popular alternative to the uniform prior we just employed. It starts from the covariates' viewpoint, placing a common and fixed inclusion probability $\theta$ on each regressor. The prior probability of a model of size $k$ is therefore the product of inclusion and exclusion probabilities: $$ p(M_\gamma) = \theta^{k_\gamma} (1-\theta)^{K-k_\gamma} $$ Since expected model size is $\bar{m}= K \theta$, the researcher's prior choice reduces to eliciting a prior expected model size $\bar{m}$ (which defines $\theta$ via the relation $\theta=\bar{m}/K$). Choosing a prior model size of $K/2$ yields $\theta=\frac{1}{2}$ and thus exactly the uniform model prior $p(M_\gamma)=2^{-K}$. Therefore, putting prior model size at a value $<\frac{1}{2}$ tilts the prior distribution toward smaller model sizes and vice versa. For instance, let's impose this fixed inclusion probability prior such that prior model size equals $\bar{m}=2$: Here, the option \verb+user.int=T+ directly prints out the results as from \verb+coef+ and \verb+summary+.\footnote{The command \texttt{g="UIP"} was omitted here since \texttt{bms} sets this by default anyway.} <<>>= att_fixed = bms(attitude, mprior="fixed", mprior.size=2, user.int=T) @ As seen in \verb+Mean no. regressors+, the posterior model size is now $1.61$ which is somewhat smaller than with uniform model priors. Since posterior model size equals the sum of PIPs, many of them have also become smaller than under \verb+att+ But interestingly, the PIP of \verb+complaints+ has remained at near 100\%. \subsection{Custom Prior Inclusion Probabilities} In view of the pervasive impact of \verb+complaints+, one might wonder whether its importance would also remain robust to a greatly unfair prior. For instance, one could define a prior inclusion probability of only $\theta=0.01$ for the \verb+complaints+ while setting a 'standard' prior inclusion probability of $\theta=0.5$ for all other variables. Such a prior might be submitted to \verb+bms+ by assigning a vector of prior inclusion probabilities via its \verb+mprior.size+ argument:\footnote{This implies a prior model size of $\bar{m}= 0.01 + 5 \times 0.5 = 2.51$} <<>>= att_pip = bms(attitude, mprior="pip", mprior.size=c(.01,.5,.5,.5,.5,.5), user.int=F) @ But the results (obtained with \verb+coef(att_pip)+) show that \verb+complaints+ still retains its PIP of near 100\%. Instead, posterior model size decreases (as evidenced in a call to \newline\mbox{\texttt{plotModelsize(att\_pip)}}), and all other variables obtain a far smaller PIP. \subsection{Beta-Binomial Model Priors} Like the uniform prior, the fixed common $\theta$ in the binomial prior centers the mass of of its distribution near the prior model size. A look on the prior model distribution with the following command shows that the prior model size distribution is quite concentrated around its mode. <<>>= plotModelsize(att_fixed) @ This feature is sometimes criticized, in particular by \citet{ls08}: They note that to reflect prior uncertainty about model size, one should rather impose a prior that is less tight around prior expected model size. Therefore, \citet{ls08} propose to put a \emph{hyperprior} on the inclusion probability $\theta$, effectively drawing it from a Beta distribution. In terms of researcher input, this prior again only requires to choose the prior expected model size. However, the resulting prior distribution is considerably less tight and should thus reduce the risk of unintended consequences from imposing a particular prior model size.\footnote{Therefore, the beta-binomial model prior with random theta is implemented as the default choice in \texttt{bms}.} For example, take the beta-binomial prior with prior model size $K/2$\footnote{Note that the arguments here are actually the default values of \texttt{bms}, therefore this command is equivalent to \texttt{att\_random=bms(attitude)}.} -- and compare this to the results from \verb+att+ (which is equivalent to a fixed $\theta$ model prior of prior model size $K/2$.) <>= att_random = bms(attitude, mprior="random", mprior.size=3, user.int=F) plotModelsize(att_random) @ With the beta-binomial specification and prior model size $\bar{m}=K/2$, the model prior is completely flat over model sizes, while the posterior model size turns out to be $1.73$. In terms of coefficient and posterior model size distribution, the results are very similar to those of \verb+att_fixed+, even though the latter approach involved a tighter model prior. Concluding, a decrease of prior importance by the use of the beta-binomial framework supports the results found in \verb+att_fixed+. We can compare the PIPs from the four approaches presented so far with the following command:\footnote{This is equivalent to the command \texttt{plotComp(att, att\_fixed, att\_pip, att\_random)}} <>= plotComp(Uniform=att, Fixed=att_fixed, PIP=att_pip, Random=att_random) @ <>= plotComp(Uniform=att, Fixed=att_fixed, PIP=att_pip, Random=att_random, cex=2) @ Here as well, \verb+att_fixed+ (Fixed) and \verb+att_random+ (Random) display similar results with PIPs plainly smaller than those of \verb+att+ (Uniform). Note that the appendix contains an overview of the built-in model priors available in BMS. Moreover, BMS allows the user to define any custom model prior herself and straightforwardly use it in \texttt{bms} - for examples, check \mbox{\texttt{http://bms.zeugner.eu/custompriors.php}}. Another concept relating to model priors is to keep fixed regressors to be included in every sampled model: Section \ref{ssec:fixreg} provides some examples. \section{MCMC Samplers and More Variables}\label{sec:mcmc} \subsection{MCMC Samplers}\label{ssec:mcmc} With a small number of variables, it is straightforward to enumerate all potential variable combinations to obtain posterior results. For a larger number of covariates, this becomes more time intensive: enumerating all models for 25 covariates takes about 3 hours on a modern PC, and doing a bit more already becomes infeasible: With 50 covariates for instance, there are more than a quadrillion ($\approx 10^{15}$) potential models to consider. % In such a case, MCMC samplers gather results on the most important part of the posterior model distribution and thus approximate it as closely as possible. BMA mostly relies on the Metropolis-Hastings algorithm, which 'walks' through the model space as follows: At step i, the sampler stands at a certain 'current' model $M_i$ with PMP $p(M_i|y,X)$. In step $i+1$ a candidate model $M_j$ is proposed. The sampler switches from the current model to model $M_j$ with probability $p_{i,j}$: $$p_{i,j} = \min(1, p(M_j|y,X)/p(M_i|y,x) )$$ In case model $M_j$ is rejected, the sampler moves to the next step and proposes a new model $M_k$ against $M_i$. In case model $M_j$ is accepted, it becomes the current model and has to survive against further candidate models in the next step. In this manner, the number of times each model is kept will converge to the distribution of posterior model probabilities $p(M_i|y,X)$. In addition to enumerating all models, BMS implements two MCMC samplers that differ in the way they propose candidate models: \begin{itemize} \item \emph{Birth-death sampler} (\verb+bd+): This is the standard model sampler used in most BMA routines. One of the $K$ potential covariates is randomly chosen; if the chosen covariate forms already part of the current model $M_i$, then the candidate model $M_j$ will have the same set of covariates as $M_i$ but for the chosen variable ('dropping' a variable). If the chosen covariate is not contained in $M_i$, then the candidate model will contain all the variables from $M_i$ plus the chosen covariate ('adding' a variable). \item \emph{Reversible-jump sampler} (\verb+rev.jump+): Adapted to BMA by \citet{mad95} this sampler either draws a candidate by the birth-death method with 50\% probability. In the other case (chosen with 50\% probability) a 'swap' is proposed, i.e. the candidate model $M_j$ randomly drops one covariate with respect to $M_i$ and randomly adds one chosen at random from the potential covariates that were not included in model $M_i$. \item \emph{Enumeration} (\verb+enum+): Up to fourteen covariates, complete enumeration of all models is the default option: This means that instead of an approximation by means of the aforementioned MCMC sampling schemes \textit{all} possible models are evaluated. As enumeration becomes quite time-consuming or infeasible for many variables, the default option is \verb+mcmc="bd"+ in case of $K>14$, though enumeration can still be invoked with the command \verb+mcmc="enumerate"+. \end{itemize} The quality of an MCMC approximation to the actual posterior distribution depends on the number of draws the MCMC sampler runs through. In particular, the sampler has to start out from some model\footnote{\texttt{bms} has some simple algorithms implemented to choose 'good' starting models -- consult the option \texttt{start.value} under \texttt{help(bms)} for more information.} that might not be a 'good' one. Hence the first batch of iterations will typically not draw models with high PMPs as the sampler will only after a while converge to spheres of models with the largest marginal likelihoods. Therefore, this first set of iterations (the 'burn-ins') is to be omitted from the computation of results. In \verb+bms+, the argument \verb+burn+ specifies the number of burn-ins, and the argument \verb+iter+ the number of subsequent iterations to be retained. \subsection{An Example: Economic Growth}\label{ssec:fls} In one of the most prominent applications of BMA, \citet{fls:ccg} analyze the importance of 41 explanatory variables on long-term term economic growth in 72 countries by the means of BMA. The data set is built into BMS, a short description is available via \verb+help(datafls)+. They employ a uniform model prior and the birth-death MCMC sampler. Their $g$ prior is set to $g=\max(N,K^2)$, a mechanism such that PMPs asymptotically either behave like the Bayesian information criterion (with $g=N$) or the risk inflation criterion ($g=K^2$) -- in \verb+bms+ this prior is assigned via the argument \verb+g="BRIC"+. Moreover \citet{fls:ccg} employ more than 200 million number of iterations after a substantial number of burn-ins. Since this would take quite a time, the following example reenacts their setting with only 50,000 burn-ins and 100,000 draws and will take about 30 seconds on a modern PC: <<>>= data(datafls) fls1 = bms(datafls, burn=50000, iter=100000, g="BRIC", mprior="uniform", nmodel=2000, mcmc="bd", user.int=F) @ Before looking at the coefficients, check convergence by invoking the \verb+summary+ command:\label{sumfls1}\footnote{Since MCMC sampling chains are never completely equal, the results presented here might differ from what you get on your machine.} <<>>= summary(fls1) @ Under \verb+Corr PMP+, we find the correlation between iteration counts and analytical PMPs for the 2000 best models (the number 2000 was specified with the \verb+nmodel=2000+ argument). At \Sexpr{summary(fls1)["Corr PMP"]}, this correlation is far from perfect but already indicates a good degree of convergence. For a closer look at convergence between analytical and MCMC PMPs, compare the actual distribution of both concepts: <>= plotConv(fls1) @ The chart presents the best 2,000 models encountered ordered by their analytical PMP (the red line), and plots their MCMC iteration counts (the blue line). For an even closer look, one might just check the corresponding image for just the best 100 models with the following command:\footnote{With \texttt{bma} objects such as \texttt{fls1}, the indexing parentheses \texttt{[]} are used to select subsets of the (ranked) best models retained in the object. For instance, while \texttt{fls1} contains 2,000 models, \texttt{fls1[1:100]} only contains the 100 best models among them. Correspondingly, \texttt{fls1[37]} would only contain the 37th-best model. Cf. \texttt{help('[.bma')}} <>= plotConv(fls1[1:100]) @ \subsection{Analytical vs. MCMC likelihoods}\label{ssec:anavsmcmc} The example above already achieved a decent level of correlation among analytical likelihoods and iteration counts with a comparatively small number of sampling draws. In general, the more complicated the distribution of marginal likelihoods, the more difficulties the sampler will meet before converging to a good approximation of PMPs. The quality of approximation may be inferred from the number of times a model got drawn vs. their actual marginal likelihoods. Partly for this reason, \verb+bms+ retains a pre-specified number of models with the highest PMPs encountered during MCMC sampling, for which PMPs and draw counts are stored. Their respective distributions and their correlation indicate how well the sampler has converged. However, due to RAM limits, the sampling chain can hardly retain more than a few 100,000 of these models. Instead, it computes aggregate statistics on-the-fly, taking iteration counts as model weights. For model convergence and some posterior statistics \verb+bms+ retains only the 'top' (highest PMP) \verb+nmodel+ models it encounters during iteration. Since the time for updating the iteration counts for the 'top' models grows in line with their number, the sampler becomes considerably slower the more 'top' models are to be kept. Still, if they are sufficiently numerous, those best models can already cover most of posterior model mass - in this case it is feasible to base posterior statistics on analytical likelihoods instead of MCMC frequencies, just as in the enumeration case from section \ref{sec:example}. From \verb+bms+ results, the PMPs of 'top' models may be displayed with the command \verb+pmp.bma+. For instance, one could display the PMPs of the best five models for \verb+fls1+ as follows:\footnote{\texttt{pmp.bma} returns a matrix with two columns and one row for each model. Consequently \texttt{pmp.bma(fls1)[1:5,]} extracts the first five rows and all columns of this matrix.} <<>>= pmp.bma(fls1)[1:5,] @ The numbers in the left-hand column represent analytical PMPs (\texttt{PMP (Exact)}) while the right-hand side displays MCMC-based PMPs (\texttt{PMP (MCMC)}). Both decline in roughly the same fashion, however sometimes the values for analytical PMPs differ considerably from the MCMC-based ones. This comes from the fact that MCMC-based PMPs derive from the number of iteration counts, while the 'exact' PMPs are calculated from comparing the analytical likelihoods of the best models -- cf. equation (\ref{eq:bf}).\footnote{In the call to \texttt{topmodels.bma} on page \pageref{topmodcall}, the PMPs under 'MCMC' and analytical ('exact') concepts were equal since 1) enumeration bases both 'top' model calculation and aggregate on-the-fly results on analytical PMPs and 2) because all possible models were retained in the object \texttt{att}.} In order to see the importance of all 'top models' with respect to the full model space, we can thus sum up their MCMC-based PMPs as follows: <<>>= colSums(pmp.bma(fls1)) @ Both columns sum up to the same number and show that in total, the top 2,000 models account for ca. \Sexpr{round(colSums(pmp.bma(fls1))[[2]],2)*100}\% of posterior model mass.\footnote{Note that this share was already provided in column \texttt{\% Topmodels} resulting from the \texttt{summary} command on page \pageref{sumfls1}.} They should thus provide a rough approximation of posterior results that might or might not be better than the MCMC-based results. For this purpose, compare the best 5 covariates in terms of PIP by analytical and MCMC methods: \verb+coef(fls1)+ will display the results based on MCMC counts. <<>>= coef(fls1)[1:5,] @ In contrast, the results based on analytical PMPs will be invoked with the \verb+exact+ argument: <<>>= coef(fls1,exact=TRUE)[1:5,] @ The ordering of covariates in terms of PIP as well as the coefficients are roughly similar. However, the PIPs under \verb+exact = TRUE+ are somewhat larger than with MCMC results. Closer inspection will also show that the analytical results downgrade the PIPs of the worst variables with respect to MCMC-PIPs. This stems from the fact that analytical results do not take into account the many 'bad' models that include 'worse' covariates and are factored into MCMC results. Whether to prefer analytical or MCMC results is a matter of taste -- however the literature prefers coefficients the analytical way: \citet{fls:ccg}, for instance, retain 5,000 models and report results based on them. \subsection{Combining Sampling Chains} The MCMC samplers described in section \ref{ssec:mcmc} need to discard the first batch of draws (the burn-ins) since they start out from some peculiar start model and may reach the altitudes of 'high' PMPs only after many iterations. Here, choosing an appropriate start model may help to speed up convergence. By default \verb+bms+ selects its start model as follows: from the full model\footnote{actually, a model with randomly drawn $\min(K,N-3)$ variables}, all covariates with OLS t-statistics $>0.2$ are kept and included in the start model. Other start models may be assigned outright or chosen according to a similar mechanism (cf. argument \verb+start.value+ in \verb+help(bms)+). However, in order to improve the sampler's convergence to the PMP distribution, one might actually start from several different start models. This could by particularly helpful if the models with high PMPs are clustered in distant 'regions'. For instance, one could set up the \citet{fls:ccg} example above to get iteration chains from different starting values and combine them subsequently. Start e.g. a shorter chain from the null model (the model containing just an intercept), and use the 'reversible jump' MCMC sampler: <<>>= fls2= bms(datafls, burn=20000, iter=50000, g="BRIC", mprior="uniform", mcmc="rev.jump", start.value=0, user.int=F) summary(fls2) @ With \Sexpr{round(cor(pmp.bma(fls2))[2,1],2)}, the correlation between analytical and MCMC PMPs is a bit smaller than the \Sexpr{round(cor(pmp.bma(fls1))[2,1],2)} from the \verb+fls1+ example in section \ref{ssec:anavsmcmc}. However, the results of this sampling run may be combined to yield more iterations and thus a better representation of the PMP distribution. <<>>= fls_combi = c(fls1,fls2) summary(fls_combi) @ With \Sexpr{round(cor(pmp.bma(fls_combi))[2,1],2)}, the PMP correlation from the combined results is broadly better than either of its two constituent chains \verb+fls1+ and \verb+fls2+. Still, the PIPs and coefficients do not change much with respect to \verb+fls1+ -- as evidenced e.g. by \verb+plotComp(fls1, fls_combi, comp="Std Mean")+. \section{Alternative Formulations for Zellner's g Prior}\label{sec:gprior} \subsection{Alternative Fixed g-Priors} Virtually all BMA applications rely on the presented framework with Zellner's $g$ prior, and the bulk of them relies on specifying a fixed $g$. As mentioned in section \ref{ssec:zg}, the value of $g$ corresponds to the degree of prior uncertainty: A low $g$ renders the prior coefficient distribution tight around a zero mean, while a large $g$ implies large prior coefficient variance and thus decreases the importance of the coefficient prior. While some popular default elicitation mechanisms for the $g$ prior (we have seen UIP and BRIC) are quite popular, they are also subject to severe criticism. Some (e.g \citealt{fls:bmp}) advocate a comparatively large $g$ prior to minimize prior impact on the results, stay close to OLS coefficients, and represent the absolute lack of prior knowledge. Others (e.g. \citealt{cic08}) demonstrate that such a large $g$ may not be robust to noise innovations and risks over-fitting -- in particular if the the noise component plays a substantial role in the data. Again others \citep{eichi07} advocate intermediate fixed values for the $g$ priors or present alternative default specifications \citep{liang:mgp}.\footnote{Note however, that $g$ should in general be monotonously increasing in $N$: \citet{fls:bmp} prove that this sufficient for 'consistency', i.e. if there is one single linear model as in equation (\ref{eq:lm}), than its PMP asymptotically reaches 100\% as sample size $N \rightarrow \infty$.} In BMS, any fixed $g$-prior may be specified directly by submitting its value to the \verb+bms+ function argument \verb+g+. For instance, compare the results for the \citet{fls:ccg} setting when a more conservative prior such as $g=5$ is employed (and far too few iterations are performed): <<>>= fls_g5 = bms(datafls, burn=20000, iter=50000, g=5, mprior="uniform", user.int=F) coef(fls_g5)[1:5,] summary(fls_g5) @ The PIPs and coefficients for the best five covariates are comparable to the results from section \ref{ssec:fls} but considerably smaller, due to a tight shrinkage factor of $\frac{g}{1+g}=\frac{5}{6}$ (cf. section \ref{ssec:zg}). More important, the posterior expected model size \Sexpr{round(sum(coef(fls_g5)[,1]),1)} exceeds that of \verb+fls_combi+ by a large amount. This stems from the less severe size penalty imposed by eliciting a small $g$. Finally, with \Sexpr{round(cor(pmp.bma(fls_g5))[2,1],2)}, the correlation between analytical and MCMC PMPs means that the MCMC sampler has not at all converged yet. \citet{fz:superM} show that the smaller the $g$ prior, the less concentrated is the PMP distribution, and therefore the harder it is for the MCMC sampler to provide a reasonable approximation to the actual PMP distribution. Hence the above command should actually be run with many more iterations in order to achieve meaningful results. \subsection{Model-specific g-Priors} Eliciting a fixed $g$-prior common to all models can be fraught with difficulties and unintended consequences. Several authors have therefore proposed to rely on model-specific priors (cf. \citealt{liang:mgp} for an overview), of which the following allow for closed-form solutions and are implemented in BMS: \begin{itemize} \item Empirical Bayes $g$ -- local (\verb+EBL+): $g_\gamma=arg max_g \; p(y|M_\gamma,X,g)$. Authors such as \citet{george00} or \citet{hansen01} advocate an 'Empirical Bayes' approach by using information contained in the data $(y,X)$ to elicit $g$ via maximum likelihood. This amounts to setting $g_\gamma=\max(0,F^{OLS}_\gamma-1)$ where $F^{OLS}_\gamma$ is the standard OLS F-statistic for model $M_\gamma$. Apart from obvious advantages discussed below, the \verb+EBL+ prior is not so popular since it involves 'peeking' at the data in prior formulation. Moreover, asymptotic 'consistency' of BMA is not guaranteed in this case. \item Hyper-$g$ prior (\verb+hyper+): \citet{liang:mgp} propose putting a hyper-prior $g$; In order to arrive at closed-form solutions, they suggest a Beta prior on the shrinkage factor of the form $\frac{g}{1+g} \sim Beta \left(1, \frac{a}{2}-1 \right)$, where $a$ is a parameter in the range $2 < a \leq 4$. Then, the prior expected value of the shrinkage factor is $E(\frac{g}{1+g})=\frac{2}{a}$. Moreover, setting $a=4$ corresponds to uniform prior distribution of $\frac{g}{1+g}$ over the interval $[0,1]$, while $a \rightarrow 2$ concentrates prior mass very close to unity (thus corresponding to $g\rightarrow \infty$). (\verb+bms+ allows to set $a$ via the argument \verb+g="hyper=x"+, where \verb+x+ denotes the $a$ parameter.) The virtue of the hyper-prior is that it allows for prior assumptions about $g$, but relies on Bayesian updating to adjust it. This limits the risk of unintended consequences on the posterior results, while retaining the theoretical advantages of a fixed $g$. Therefore \citet{fz:superM} prefer the use of hyper-$g$ over other available $g$-prior frameworks. \end{itemize} Both model-specific $g$ priors adapt to the data: The better the signal-to-noise ratio, the closer the (expected) posterior shrinkage factor will be to one, and vice versa. Therefore average statistics on the shrinkage factor offer the interpretation as a 'goodness-of-fit' indicator (\citet{fz:superM} show that both EBL and hyper-$g$ can be interpreted in terms of the OLS F-statistic). Consider, for instance, the \citet{fls:ccg} example under an Empirical Bayes prior: <<>>= fls_ebl = bms(datafls, burn=20000, iter=50000, g="EBL", mprior="uniform", nmodel=1000, user.int=F) summary(fls_ebl) @ The result \verb+Shrinkage-Stats+ reports a posterior average EBL shrinkage factor of \Sexpr{round(as.numeric(strsplit(summary(fls_ebl)[13],"=")[[1]][[2]]),3)}, which corresponds to a shrinkage factor $\frac{g}{1+g}$ under $g\approx $ \Sexpr{round(1/(1-as.numeric(strsplit(summary(fls_ebl)[13],"=")[[1]][[2]]))-1,-0)}. Consequently, posterior model size is considerably larger than under \verb+fls_combi+, and the sampler has had a harder time to converge, as evidenced in a quite low \verb+Corr PMP+. Both conclusions can also be drawn from performing the \verb+plot(fls_ebl)+ command that combines the \verb+plotModelsize+ and \verb+plotConv+ functions: <>= plot(fls_ebl) @ The upper chart shows that posterior model size distribution remains very close to the model prior; The lower part displays the discord between iteration count frequencies and analytical PMPs. The above results show that using a flexible and model-specific prior on \citet{fls:ccg} data results in rather small posterior estimates of $\frac{g}{1+g}$, thus indicating that the \verb+g="BRIC"+ prior used in \verb+fls_combi+ may be set too far from zero. This interacts with the uniform model prior to concentrate posterior model mass on quite large models. However, imposing a uniform model prior means to expect a model size of $K/2=20.5$, which may seem overblown. Instead, try to impose smaller model size through a corresponding model prior -- e.g. impose a prior model size of 7 as in \citet{bace04}. This can be combined with a hyper-$g$ prior, where the argument \verb+g="hyper=UIP"+ imposes an $a$ parameter such that the prior expected value of $g$ corresponds to the unit information prior ($g=N$).\footnote{This is the default hyper-g prior and may therefore be as well obtained with \texttt{g=\textquotedbl hyper \textquotedbl}. } <<>>= fls_hyper = bms(datafls, burn=20000, iter=50000, g="hyper=UIP", mprior="random", mprior.size=7, nmodel=1000, user.int=F) summary(fls_hyper) @ From \verb+Shrinkage-Stats+, posterior expected shrinkage is \Sexpr{round(fls_hyper$gprior.info$shrinkage.moments[[1]],3) }, with rather tight standard deviation bounds. Similar to the EBL case before, the data thus indicates that shrinkage should be rather small (corresponding to a fixed g of $g \approx$ \Sexpr{round(1/(1-as.numeric(fls_hyper$gprior.info$shrinkage.moments[[1]]))-1,-0)}) and not vary too much from its expected value. Since the hyper-g prior induces a proper posterior distribution for the shrinkage factor, it might be helpful to plot its density with the command below. The chart confirms that posterior shrinkage is tightly concentrated above \Sexpr{ round(fls_hyper$gprior.info$shrinkage.moments[[1]]-as.numeric(strsplit(summary(fls_hyper)[13],"=")[[1]][[3]]),2)}. <>= gdensity(fls_hyper) @ While the hyper-g prior had an effect similar to the EBL case \verb+fls_ebl+, the model prior now employed leaves the data more leeway to adjust posterior model size. The results depart from the expected prior model size and point to an intermediate size of ca. \Sexpr{round(sum(estimates.bma(fls_hyper)[,1]),0)}. The focus on smaller models is evidenced by charting the best 1,000 models with the \verb+image+ command: <>= image(fls_hyper) @ In a broad sense, the coefficient results correspond to those of \verb+fls_combi+, at least in expected values. However, the results from \verb+fls_hyper+ were obtained under more sophisticated priors that were specifically designed to avoid unintended influence from prior parameters: By construction, the large shrinkage factor under \verb+fls_combi+ induced a quite small posterior model size of \Sexpr{round(as.numeric(summary(fls_combi)[[1]]),1)} and concentrated posterior mass tightly on the best models encountered (they make up \Sexpr{round(as.numeric(summary(fls_combi)[[8]]),0)}\% of the entire model mass). In contrast, the hyper-g prior employed for \verb+fls_hyper+ indicated a rather low posterior shrinkage factor and consequently resulted in higher posterior model size (\Sexpr{round(as.numeric(summary(fls_hyper)[[1]]),1)}) and less model mass concentration (\Sexpr{round(as.numeric(summary(fls_hyper)[[8]]),0)}\%). \subsection{Posterior Coefficient Densities} In order to compare more than just coefficient expected values, it is advisable to consult the entire posterior distribution of coefficients. For instance, consult the posterior density of the coefficient for \verb+Muslim+, a variable with a PIP of \Sexpr{round(estimates.bma(fls_combi)["Muslim",1],3)*100}\%: The \verb+density+ method produces marginal densities of posterior coefficient distributions and plots them, where the argument \verb+reg+ specifies the variable to be analyzed. <>= density(fls_combi,reg="Muslim") @ We see that the coefficient is neatly above zero, but somewhat skewed. The integral of this density will add up to \Sexpr{round(estimates.bma(fls_combi, exact=T)["Muslim",1],3)}, conforming to the analytical PIP of \verb+Muslim+. The vertical bars correspond to the analytical coefficient conditional on inclusion from \verb+fls_combi+ as in <<>>= coef(fls_combi,exact=T,condi.coef=T)["Muslim",] @ Note that the posterior marginal density is actually a model-weighted mixture of posterior densities for each model and can this be calculated only for the top models contained in \verb+fls_combi+ (here \Sexpr{length(fls_combi[["topmod"]][["lik"]]())}). Now let us compare this density with the results under the hyper-$g$ prior:\footnote{Since for the hyper-$g$ prior, the marginal posterior coefficient distribution derive from quite complicated expressions, executing this command could take a few seconds.} <>= dmuslim=density(fls_hyper,reg="Muslim",addons="Eebl") @ Here, the \verb+addons+ argument assigns the vertical bars to be drawn: the expected conditional coefficient from MCMC (\verb+E+) results should be indicated in contrast to the expected coefficient based on analytical PMPs (\verb+e+). In addition the expected coefficients under the individual models are plotted (\verb+b+) and a legend is included (\verb+l+). The density seems more symmetric than before and the analytical results seem to be only just smaller than what could be expected from MCMC results. Nonetheless, even though \verb+fls_hyper+ and \verb+fls_combi+ applied very different $g$ and model priors, the results for the \verb+Muslim+ covariate are broadly similar: It is unanimously positive, with a conditional expected value somewhat above $0.01$. In fact 95\% of the posterior coefficient mass seems to be concentrated between \Sexpr{round(quantile.coef.density(dmuslim,.025),3)} and \Sexpr{round(quantile.coef.density(dmuslim,.975),3)}: <<>>= quantile(dmuslim, c(0.025, 0.975)) @ \section{Predictive Densities} Of course, BMA lends itself not only to inference, but also to prediction. The employed 'Bayesian Regression' models naturally give rise to predictive densities, whose mixture yields the BMA predictive density -- a procedure very similar to the coefficient densities explored in the previous section. Let us, for instance, use the information from the first 70 countries contained in \texttt{datafls} to forecast economic growth for the latter two, namely Zambia (identifier \texttt{ZM}) and Zimbabwe (identifier \texttt{ZW}). We then can use the function \texttt{pred.density} on the BMA object \texttt{fcstbma} to form predictions based on the explanatory variables for Zambia and Zimbabwe (which are in \verb+datafls[71:72,]+). <<>>= fcstbma= bms(datafls[1:70,], mprior="uniform", burn=20000, iter=50000, user.int=FALSE) pdens = pred.density(fcstbma, newdata=datafls[71:72,]) @ The resulting object \texttt{pdens} holds the distribution of the forecast for the two countries, conditional on what we know from other countries, and the explanatory data from Zambia and Zimbabwe. The expected value of this growth forecast is very similar to the classical point forecast and can be accessed with \verb+pdens$fit+.\footnote{Note that this is equivalent to \texttt{predict(fcstbma, datafls[71:72, ])} .} Likewise the standard deviations of the predictive distribution correspond to classical standard errors and are returned by \verb+pdens$std.err+. But the predictive density for the growth in e.g. Zimbabwe might be as well visualized with the following command:\footnote{Here, 2 means to plot for the second forecasted observation, in this case \texttt{ZW}, the 72-th row of \texttt{datafls}.} <>= plot(pdens, 2) @ Here, we see that conditional on Zimbabwe's explanatory data, we expect growth to be concentrated around \Sexpr{round(pdens[['fit']][2],2)}. And the actual value in \verb+datafls[72,1]+ with $0.0046$ is not too far off from that prediction. A closer look at both our densities with the function \texttt{quantile} shows that for Zimbabwe, any growth rate between \Sexpr{ round(quantile(pdens,c(.05,.95))[2,1], 2) } and \Sexpr{ round(quantile(pdens,c(.05,.95))[2,2], 2) } is quite likely. <<>>= quantile(pdens, c(0.05, 0.95)) @ For Zambia (\texttt{ZM}), though, the explanatory variables suggest that positive economic growth should be expected. But over our evaluation period, Zambian growth has been even worse than in Zimbabwe (with \Sexpr{ round(datafls[71,1], 2) } as from \verb+datafls["ZM",1]+).\footnote{Note that since \texttt{ZM} is the rowname of the 71-st row of \texttt{datafls}, this is equivalent to calling \texttt{datafls[71, ]}.} Under the predictive density for Zambia, this actual outcome seems quite unlikely. To compare the BMA prediction performs with actual outcomes, we could look e.g. at the forecast error \verb+pdens$fit - datafls[71:72,1]+. However it would be better to take standard errors into account, and even better follow the 'Bayesian way' and evaluate the predictive density of the outcomes as follows: <<>>= pdens$dyf(datafls[71:72,1]) @ The density for Zimbabwe is quite high (similar to the mode of predictive density as seen in the chart above), whereas the one for Zambia is quite low. In order to visualize how bad the forecast for Zambia was, compare a plot of predictive density to the actual outcome, which is situated far to the left. <>= plot(pdens, "ZM", realized.y=datafls["ZM",1]) @ The results for Zambia suggest either that it is an outlier or that our forecast model might not perform that well. One could try out other prior settings or data, and compare the differing models in their joint predictions for Zambia and Zimbabwe (or even more countries). A standard approach to evaluate the goodness of forecasts would be to e.g. look at root mean squared errors. However Bayesians (as e.g \citealt{fls:bmp}) often prefer to look at densities of the outcome variables and combine them in a 'log-predictive score' (LPS). It is defined as follows, where $p(y^f_i | X, y, X^f_i)$ denotes predictive density for $y^f_i$ (Zambian growth) based on the model information $(y, X)$ (the first 70 countries) and the explanatory variables for the forecast observation (Zambian investment, schooling, etc.). $$ - \sum_i \log(p(y^f_i | X, y, X^f_i)) $$ The log-predictive score can be accessed with \verb+lps.bma+. <<>>= lps.bma(pdens, datafls[71:72,1]) @ Note however, that the LPS is only meaningful when comparing different forecast settings. \addcontentsline{toc}{section}{References} \bibliography{bmasmall} %\bibliography{C:/Programme/LatexLibs/bma} \bibliographystyle{apalike} \clearpage \appendix \section{Appendix} \subsection{Available Model Priors -- Synopsis}\label{ssec:mpriorsyn} The following provides an overview over the model priors available in \verb+bms+. Default is \verb+mprior="random"+. For details and examples on built-in priors, consult \verb+help(bms)+. For defining different, custom $g$-priors, consult \verb+help(gprior)+ or \texttt{http://bms.zeugner.eu/custompriors.php}. \subsubsection*{Uniform Model Prior} \begin{itemize} \item \emph{Argument}: \verb+mprior="uniform"+ \item \emph{Parameter}: none \item \emph{Concept}: $p(M_\gamma) \propto 1$ \item \emph{Reference}: none \end{itemize} \subsubsection*{Binomial Model Prior} \begin{itemize} \item \emph{Argument}: \verb+mprior="fixed"+ \item \emph{Parameter} (\verb+mprior.size+): prior model size $\bar{m}$ (scalar); Default is $\bar{m}=K/2$ \item \emph{Concept}: $p(M_\gamma) \propto \left(\frac{\bar{m}}{K}\right)^{k_\gamma} \left(1-\frac{\bar{m}}{K}\right)^{K-k_\gamma}$ \item \emph{Reference}: \citet{bace04} \end{itemize} \subsubsection*{Beta-Binomial Model Prior} \begin{itemize} \item \emph{Argument}: \verb+mprior="random"+ \item \emph{Parameter} (\verb+mprior.size+): prior model size $\bar{m}$ (scalar) \item \emph{Concept}: $p(M_\gamma) \propto \Gamma(1+k_\gamma) \Gamma( \frac{K-m}{m} + K-k_\gamma)$; Default is $\bar{m}=K/2$ \item \emph{Reference}: \citet{ls08} \end{itemize} \subsubsection*{Custom Prior Inclusion Probabilities} \begin{itemize} \item \emph{Argument}: \verb+mprior="pip"+ \item \emph{Parameter} (\verb+mprior.size+): A vector of size $K$, detailing $K$ prior inclusion probabilities $\pi_i$: $0<\pi<1 \; \forall i$ \item \emph{Concept}: $p(M_\gamma) \propto \prod_{i \in \gamma} \pi_i \; \prod_{j \notin \gamma} (1-\pi_j) $ \item \emph{Reference}: none \end{itemize} \subsubsection*{Custom Model Size Prior} \begin{itemize} \item \emph{Argument}: \verb+mprior="customk"+ \item \emph{Parameter} (\verb+mprior.size+): A vector of size $K+1$, detailing prior $\theta_j$ for 0 to K size models: any real >0 admissible \item \emph{Concept}: $p(M_\gamma) \propto \theta_{k_\gamma}$ \item \emph{Reference}: none \end{itemize} \subsection{Available g-Priors -- Synopsis} The following provides an overview over the $g$-priors available in \verb+bms+. Default is \verb+g="UIP"+. For implementation details and examples, consult \verb+help(bms)+. For defining different, custom $g$-priors, consult \verb+help(gprior)+ or \texttt{http://bms.zeugner.eu/custompriors.php}. \subsubsection*{Fixed $g$} \begin{itemize} \item \emph{Argument}: \verb+g=x+ where \verb+x+ is a positive real scalar; \item \emph{Concept}: Fixed $g$ common to all models \item \emph{Reference}: \citet{fls:bmp} \item \emph{Sub-options}: Unit information prior \verb+g="UIP"+ sets $g=N$; \verb+g="BRIC"+ sets $g=\max(N,K^2)$, a combination of BIC and RIC. (Note these two options guarantee asymptotic consistency.) Other options include \verb+g="RIC"+ for $g=K^2$ and \verb+g="HQ"'+ for the Hannan-Quinn setting $g=\log(N)^3$. \end{itemize} \subsubsection*{Empirical Bayes (Local) $g$} \begin{itemize} \item \emph{Argument}: \verb+g="EBL"+ \item \emph{Concept}: Model-specific $g_\gamma$ estimated via maximum likelihood: amounts to $g_\gamma=\max(0,F_\gamma-1)$, where $F_\gamma \equiv \frac{R^2_\gamma (N-1-k_\gamma)}{(1-R^2_\gamma) k_\gamma}$ and $R^2_\gamma$ is the OLS R-squared of model $M_\gamma$. \item \emph{Reference}: \citet{george00}; \citet{liang:mgp} \item \emph{Sub-options}: none \end{itemize} \subsubsection*{Hyper-$g$ prior} \begin{itemize} \item \emph{Argument}: \verb+g="hyper"+ \item \emph{Concept}: A Beta prior on the shrinkage factor with $p(\frac{g}{1+g}) = B(1,\frac{a}{2}-1)$. Parameter $a$ ($2 < a \leq 4$) represents prior beliefs: $a=4$ implies prior shrinkage to be uniformly distributed over $[0,1]$, $a \rightarrow 2$ concentrates mass close to unity. Note that prior expected value of the shrinkage facor is $E(\frac{g}{1+g}) = \frac{2}{a}$. \item \emph{Reference}: \citet{liang:mgp}; \citet{fz:superM} \item \emph{Sub-options}: \verb+g="hyper=x"+ with \verb+x+ defining the parameter $a$ (e.g. \verb+g="hyper=3"+ sets $a=3$). \verb+g="hyper"+ resp. \verb+g="hyper=UIP"+ sets the prior expected shrinkage factor equivalent to the UIP prior $E(\frac{g}{1+g})=\frac{N}{1+N}$; \verb+g="hyper=BRIC"+ sets the prior expected shrinkage factor equivalent to the BRIC prior. Note that the latter two options guarantee asymptotic consistency. \end{itemize} \subsection{'Bayesian Regression' with Zellner's $g$ -- Bayesian Model Selection}\label{ssec:zlm} The linear model presented in section \ref{ssec:zg} using Zellner's $g$ prior is implemented under the function \verb+zlm+. For instance, we might consider the attitude data from section \ref{sec:example} and estimate just the full model containing all 6 variables. For this purpose, first load the built-in data set with the command <<>>= data(attitude) @ The full model is obtained by applying the function \texttt{zlm} on the data set and storing the estimation into \texttt{att\_full}. Zellner's $g$ prior is estimated by the argument \texttt{g} just in the same way as in section \ref{sec:gprior}.\footnote{Likewise, most methods applicable to \texttt{bms}, such as \texttt{density}, \texttt{predict} or \texttt{coef}, work analogously for \texttt{zlm}.} <<>>= att_full = zlm(attitude,g="UIP") @ The results can then be displayed by using e.g. the \verb+summary+ method. <<>>= summary(att_full) @ The results are very similar to those resulting from OLS (which can be obtained via \verb+summary(lm(attitude))+). The less conservative, i.e. the larger $g$ becomes, the closer the results get to OLS. But remember that the full model was not the best model from the BMA application in section \ref{sec:example}. In order to extract the best encountered model, use the function \verb+as.zlm+ to extract this single model for further analysis (with the argument \verb+model+ specifying the rank-order of the model to be extracted). The following command reads the best model from the BMA results in section into the variable \verb+att_best+. <<>>= att_best = as.zlm(att,model=1) summary(att_best) @ As suspected, the best model according to BMA is the on including only \verb+complaints+ and the intercept, as it has the highest log-marginal likelihood (\verb+logLik(att_best)+). In such a way, the command \texttt{as.zlm} can be combined with \texttt{bms} for 'Bayesian Model Selection', i.e. using the model prior and posterior framework to focus on teh model with highest posterior mass. Via the utility \texttt{model.frame}, this best model can be straightforwardly converted into a standard OLS model: <<>>= att_bestlm = lm(model.frame(as.zlm(att))) summary(att_bestlm) @ \subsection{BMA when Keeping a Fixed Set of Regressors}\label{ssec:fixreg} While BMA should usually compare as many models as possible, some considerations might dictate the restriction to a subspace of the $2^K$ models. For complicated settings one might employ a customly designed model prior (cf. section \ref{ssec:mpriorsyn}). The by far most common setting, though, is to keep some regressors fixed in the model setting, and apply Bayesian Model uncertainty only to a subset of regressors. Suppose, for instance, that prior research tells us that any meaningful model for \texttt{attitude} (as in section \ref{sec:example}) must include the variables \texttt{complaints} and \texttt{learning}. The only question is whether the additional four variables matter (which reduces the potential model space to $2^4=16$). We thus sample over these models while keeping \texttt{complaints} and \texttt{learning} as fixed regressors: <<>>= att_learn = bms(attitude,mprior="uniform", fixed.reg=c("complaints", "learning") ) @ The results show that the PIP and the coefficients for the remaining variables increase a bit compared to \texttt{att}. The higher PIPs are related to the fact that the posterior model size (as in \verb+sum(coef(att_learn)[,1])+) is quite larger as under \texttt{att}. This follows naturally from our model prior: putting a uniform prior on all models between parameter size $2$ (the base model) and $6$ (the full model) implies a prior expected model size of $4$ for \texttt{att\_learn} instead of the $3$ for \texttt{att}.\footnote{ The command \texttt{ att\_learn2 = bms(attitude, mprior='fixed', mprior.size=3, fixed.reg=c('complaints', 'learning') ) } produces coefficients that are much more similar to \texttt{att}.} So to achieve comparable results, one needs to take the number of fixed regressors into account when setting the model prior parameter \texttt{mprior.size}. Consider another example: Suppose we would like to sample the importance and coefficients for the cultural dummies in the dataset \texttt{datafls}, conditional on information from the remaining 'hard' variables. This implies keeping 27 fixed regressors, while sampling over the 14 cultural dummies. Since model uncertainty thus applies only to $2^{14}=16,384$ models, we resort to full enumeration of the model space. <<>>= fls_culture = bms(datafls,fixed.reg=c(1,8:16,24,26:41), mprior="random", mprior.size=28, mcmc="enumeration", user.int=F) @ Here, the vector \texttt{c(1,8:16,24,26:41)} denotes the indices of the regressors in \texttt{datafls} to be kept fixed.\footnote{Here, indices start from the first regressor, i.e. they do not take the dependent variable into account. The fixed data used above therefore corresponds to \texttt{datafls[ ,c(1,8:16,24,26:41) $+$ 1]}.} Moreover, we use the beta-binomial ('random') model prior. The prior model size of $30$ embodies our prior expectation that on average $1$ out of the $14$ cultural dummies should be included in the true model. As we only care about those 14 variables, let us just display the results for the 14 variables with the least PIP: <<>>= coef(fls_culture)[28:41, ] @ As before, we find that \texttt{Confucian} (with positive sign) as well as \texttt{Hindu} and \texttt{SubSahara} (negative signs) have the most important impact conditional on 'hard' information. Moreover, the data seems to attribute more importance to cultural dummies as we expectd with our model prior: Comparing prior and posterior model size with the following command shows how much importance is attributed to the dummies. <>= plotModelsize(fls_culture, ksubset=27:41) @ Expected posterior model size is close to \Sexpr{ round(sum(coef(fls_culture)[,1]),0) }, which means that \Sexpr{ round(sum(coef(fls_culture)[,1]),0) -27 } of the cultural dummies should actually be included in a 'true' model. \end{document}BMS/vignettes/bmasmall.bib0000644000175100001440000000657612624725513015214 0ustar hornikusers@ARTICLE{Hoetingetal99, author = {Hoeting, Jennifer A. and Madigan, David and Raftery, Adrian E and Volinsky,Chris T.}, title = {{Bayesian Model Averaging: A Tutorial}}, journal = {Statistical Science}, year = {1999}, volume = {14, No. 4}, pages = {382-417} } @ARTICLE{ls08, author = {Ley, Eduardo and Steel, Mark F.J}, title = {{On the Effect of Prior Assumptions in Bayesian Model Averaging with Applications to Growth Regressions}}, journal = {Journal of Applied Econometrics}, year = {2009}, volume = {24:4}, pages = {651-674} } @ARTICLE{mad95, author = {Madigan, D. and York, J.}, title = {{Bayesian graphical models for discrete data}}, journal = {International Statistical Review}, year = {1995}, volume = {63.}, pages = {215-232}, timestamp = {2010.01.12} } @ARTICLE{fls:ccg, author = {{Fern{\'a}ndez}, Carmen and Ley, Eduardo and Steel, Mark F.J.}, title = {{Model Uncertainty in Cross-Country Growth Regressions}}, journal = {Journal of Applied Econometrics}, year = {2001}, volume = {16}, pages = {563-576}, timestamp = {2009.03.01} } @ARTICLE{fls:bmp, author = {{Fern{\'a}ndez}, Carmen and Ley, Eduardo and Steel, Mark F.J.}, title = {{Benchmark Priors for Bayesian Model Averaging}}, journal = {Journal of Econometrics}, year = {2001}, volume = {100}, pages = {381-427} } @ARTICLE{cic08, author = {Ciccone, Antonio and Jaroci\'{n}ski, Marek}, title = {{Determinants of Economic Growth: Will Data Tell?}}, journal = {American Economic Journal: Macroeconomics}, year = {2010}, volume = {forthcoming} } @ARTICLE{eichi07, author = {Eicher, T. and Papageorgiou, C. and Raftery, A.E.}, title = {{Determining growth determinants: default priors and predictive performance in Bayesian model averaging}}, journal = {Journal of Applied Econometrics, forthcoming}, year = {2009} } @ARTICLE{liang:mgp, author = {Liang, Feng and Paulo, Rui and Molina, German and Clyde, Merlise A. and Berger, Jim O.}, title = {{Mixtures of g Priors for Bayesian Variable Selection}}, journal = {Journal of the American Statistical Association}, year = {2008}, volume = {103}, pages = {410-423} } @ARTICLE{fz:superM, author = {Feldkircher, Martin and Zeugner, Stefan}, title = {{Benchmark Priors Revisited: On Adaptive Shrinkage and the Supermodel Effect in Bayesian Model Averaging}}, journal = {IMF Working Paper}, year = {2009}, volume = {WP/09/202}, timestamp = {2009.09.13} } @ARTICLE{george00, author = {George, E.I. and Foster, D.P.}, title = {{Calibration and empirical Bayes variable selection}}, journal = {Biometrika}, year = {2000}, volume = {87}, pages = {731--747}, number = {4}, publisher = {Biometrika Trust} } @ARTICLE{hansen01, author = {Hansen, M.H. and Yu, B.}, title = {{Model selection and the principle of minimum description length}}, journal = {Journal of the American Statistical Association}, year = {2001}, volume = {96}, pages = {746--774}, number = {454}, publisher = {ASA} } @ARTICLE{bace04, author = {{Sala-i-Martin}, Xavier and Doppelhofer, Gernot and Miller, Ronald I.}, title = {{Determinants of Long-Term Growth: A Bayesian Averaging of Classical Estimates (BACE) Approach}}, journal = {American Economic Review}, year = {2004}, volume = {94}, pages = {813-835} } BMS/MD50000644000175100001440000001265312625003706011231 0ustar hornikusersfab131f5c56bf7b448234ef28c0126d9 *DESCRIPTION 738d308fbc05650ac8aaef13e5d2ff16 *NAMESPACE 42350035769379cacb6c69fc48c5b495 *NEWS 0e7277ab7761972c501c9f555f4f12d3 *R/BMS-internal.R 01eeea06e1e9d9dcb90999f9967d65b5 *R/as.zlm.R 13c083e40f55a6bf54366d26f5d20b0a *R/beta.draws.bma.R a12e8dab15f8dbcff271b6c41f848676 *R/bin2hex.R 5f81759318409506e29c3377a6dc3692 *R/bms.R 30c0acbca78e5acd69260b2e05c3a69c *R/c.bma.R 9dd072c871ec072ef9e792ce9943f8d0 *R/coef.bma.R 4180c3c6becd3b21a71887b818651c39 *R/combine_chains.R 64c3c2098bd0ea72553f5eeada3a9e98 *R/density.bma.R 6d0da0158b66ee828bb9bd28f3fa46c3 *R/density.zlm.R bab8938b960305978501e7c4573bdab7 *R/deviance.bma.R ded894851329df4e9e8ea14af6d84e94 *R/deviance.zlm.R ae535db80e4addbd317e8fe9e63f1dd6 *R/estimates.bma.R 17d80629e8b391d120d5b34c3df56e76 *R/f21hyper.R ae44ce31b7cf363cee1cf785948f879e *R/fullmodel.ssq.R 10730b4f2ccbd71f57b153c4a7de520a *R/gdensity.R 38205982f760898a315b583d0396d214 *R/hex2bin.R 15cdbf9db0bbd5c5c5c254eda0113d1a *R/image.bma.R 06586d0a0c8010db7aaae06706b3414e *R/info.bma.R a114d5c1f2eb97f7890a8d7f298305b4 *R/is.bma.R 396ac2ad2f76980bc2f41168ec445337 *R/is.topmod.R f522be9fa4556589172f8b134e41c232 *R/logLik.zlm.R f8aa58fd542ac050c7147694461a1ee6 *R/lps.bma.R cccee7125ca26597a31a234bada1b559 *R/model.frame.bma.R 46058ea0e3b669e627031fd15ba9d120 *R/plot.bma.R bca015b29b7eb0bb508c2fcf10d36c46 *R/plot.pred.density.R 7a1583d809f3c2f38a916c33b6ee7cfb *R/plotComp.R cb7d5b2fa386ded94c8ea8335af0b428 *R/plotConv.R c945cad078c29930d8798b1ce4f6e84e *R/plotModelsize.R 5ebb5ce30bb76dce6d83c3537c060f69 *R/pmp.bma.R bc4b7e40ff5194626f1faee087c24533 *R/pmpmodel.R 2d0eabaff395e4e3aef2a06dee6ed71b *R/post.pr2.R ea4607a8565da1bbfad994fe4f0d6708 *R/post.var.R e3dfdaa1f3b3aa9eca649c0f4b74aad6 *R/pred.density.R 015e48cfbd6e3aa075cd9223aa4e1f14 *R/predict.bma.R 0d45769bb10f30c8a58a4a12db1b3e36 *R/predict.zlm.R 7758d0520dde2a7b486a9145c9e6a4e7 *R/print.bma.R a082b5532fc7daa5dddabae3484b55d8 *R/print.pred.density.R 469c138d73cef68a0321bf53796d2a75 *R/print.topmod.R 4a47af45728a8c54ff7ea6a989a4e67c *R/quantile.coef.density.R dac9d88c75eebdbc93d33a94f78a9b86 *R/quantile.density.R 9024a7fcfcff5f164922d0a852976ef6 *R/quantile.pred.density.R 78f916d97e68c1c4dbd06a7e797f21b9 *R/summary.bma.R 752df67d8847ecb81d74ca532fabf452 *R/summary.zlm.R af372e58d2ccfabcf8e0765f5034c8ad *R/topmod.R 654c2f36312d842d25a290acf18c207a *R/topmodels.bma.R 3984efaa6459ec47adc4e1436bbff1bf *R/variable.names.bma.R d5de9a7d28f03c763c3f2c36a07a8646 *R/variable.names.zlm.R 950e3ded42fc693caa0a524549737f35 *R/vcov.zlm.R a3023e6ab67055569856219799453664 *R/z[.bma.R 5f8730253189486ef99b3600ac919406 *R/z[.topmod.R 42625c9df092e33a510440f87b7b308d *R/zlm.R 07549455acab10fe9e0554b3272b4393 *R/zzz.R d3139c30684ee42c0e9636317b4beff3 *build/vignette.rds a3e267dbb9769ce544fd7953fa44e1cf *data/datafls.rda e897eab610bd16c7e9276863bd45e0a6 *demo/00Index 5d9a0b9eabe9d1d95b50e72145580566 *demo/BMS.growth.R c0573bc6965e6273c866692d5f779f21 *inst/CITATION 5bb3d5ca62769a200b3d8492c8660f36 *inst/doc/bmasmall.bib 0aa308124cf4f335f6f4195680028e56 *inst/doc/bms.R 103a14b7fd91cec183781eb1c35d74b9 *inst/doc/bms.Rnw 910bfe0b614ca18c6d7a3635ab2e2895 *inst/doc/bms.pdf b3f451993e9213d4c2d2df7852f488f6 *man/BMS-internal.Rd 3f3249acd2f28af5a66c2a5f92422db2 *man/BMS-package.Rd 47118e44cf67641313072655a383b87b *man/as.zlm.Rd bb4d0992da96dd5ba3306fb84b8cdc34 *man/beta.draws.bma.Rd d5c51d0b01b1fcc4c2742d2f9d88e421 *man/bin2hex.Rd 8a676aada24841e9cc8ad72ee8638e03 *man/bma-class.Rd f6af3400f81954a480729fdfe21bea76 *man/bms.Rd e2b2dc477e81ca72f71fcf69e6672fc5 *man/c.bma.Rd 6ef78bcfb5a5dde0c0e6ddfe27689641 *man/coef.bma.Rd 7535d6961bdfe7b4858e32f3cc54ae8e *man/datafls.Rd a9efbf4b4a777d46d4297436854ae346 *man/density.bma.Rd da4ca8e9ed272db8988f0d335bb69e46 *man/f21hyper.Rd b4e0fe12b49e2764e39c705237f936ac *man/fullmodel.ssq.Rd d31f16ea483906c21f4717ce35ed347e *man/gdensity.Rd b46a24b7832dda455d4af6634c2c94a8 *man/gprior-class.Rd 774dd4558145e2ab83bae700fa3e8a99 *man/image.bma.Rd e4724bdb1bc3d59617a33b4c6e967b1e *man/is.bma.Rd 0bef60adf0f63e3eb957a7c0191dcd85 *man/lps.bma.Rd ae0e237633f5eef8fde464bef1ee6105 *man/mprior-class.Rd 5697a6155f63f08f69aac2c28c60aab3 *man/plot.bma.Rd 8eeae0c6df366a1201ecb101969f79e2 *man/plot.pred.density.Rd 15bb36f500f0d5297cefaa315e6d1053 *man/plotComp.Rd 6cf74926929b5a56dc8bd2e02c214962 *man/plotConv.Rd ad7669e40109f7af73de67e53b649ee9 *man/plotModelsize.Rd d4009c372cb2cd7392cef2c7d2f91417 *man/pmp.bma.Rd 655232189cc1090b5f3262873040053f *man/pmpmodel.Rd 67dea7b1a1b92d174b58fb38531257fb *man/post.var.Rd b84b4977dc87bf0fcfc6bb377d6c65ce *man/pred.density.Rd d9db92b8d695305150d74872e88cb498 *man/predict.bma.Rd ae0f0b479760de38858ab31a9480ffef *man/predict.zlm.Rd c4ea5bfc745ba730e29bfd3baccf5e62 *man/print.bma.Rd 16e86fd913c7117410e007855a2d181f *man/print.topmod.Rd 1e1c391f24d2e046a48dfcaefe15e56b *man/quantile.pred.density.Rd a6eefdc174ab99e91171e62de08aac68 *man/summary.bma.Rd 4405d9a68aa6984adea5543c2d8af0e8 *man/summary.zlm.Rd c7468c0e11f8e6690521dd22773d3030 *man/topmod-class.Rd 7152c19248c3ac3cdfbc9f3cfcda3120 *man/topmod.Rd cff9f56696286a925ce4f80a812faaed *man/topmodels.bma.Rd 4325c83e7d25c96cf1eb123474fac19b *man/variable.names.bma.Rd 25c587c90c16d045d6281e290c7fa125 *man/variable.names.zlm.Rd 4e7a369d23dea7e0def5d2afcf45c8e4 *man/z[.bma.Rd d0f26acd5cc456305062f51797de5d8c *man/zlm-class.Rd 1994745cbf2c0b0e83c04dcc60a25214 *man/zlm.Rd 5bb3d5ca62769a200b3d8492c8660f36 *vignettes/bmasmall.bib 103a14b7fd91cec183781eb1c35d74b9 *vignettes/bms.Rnw BMS/build/0000755000175100001440000000000012624725744012025 5ustar hornikusersBMS/build/vignette.rds0000644000175100001440000000033012624725744014360 0ustar hornikusersb```b`b&f YH320pibr4aE<DzԢ̼t̒ '`l :C,&dEy楀aM wjey~L6̜T!%ps QY_/( @hrNb1GRKҊA4hBMS/DESCRIPTION0000644000175100001440000000173012625003705012420 0ustar hornikusersPackage: BMS Type: Package Title: Bayesian Model Averaging Library Version: 0.3.4 Date: 2015-11-23 Author: Martin Feldkircher and Stefan Zeugner Maintainer: Stefan Zeugner Depends: R (>= 2.5) Imports: graphics, methods, stats Description: Bayesian model averaging for linear models with a wide choice of (customizable) priors. Built-in priors include coefficient priors (fixed, flexible and hyper-g priors), 5 kinds of model priors, moreover model sampling by enumeration or various MCMC approaches. Post-processing functions allow for inferring posterior inclusion and model probabilities, various moments, coefficient and predictive densities. Plotting functions available for posterior model size, MCMC convergence, predictive and coefficient densities, best models representation, BMA comparison. License: Artistic-2.0 URL: http://bms.zeugner.eu/ Packaged: 2015-11-24 00:14:28 UTC; root NeedsCompilation: no Repository: CRAN Date/Publication: 2015-11-24 07:46:29 BMS/man/0000755000175100001440000000000012624725744011501 5ustar hornikusersBMS/man/beta.draws.bma.Rd0000644000175100001440000000355112624725513014556 0ustar hornikusers\name{beta.draws.bma} \alias{beta.draws.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Coefficients of the Best Models } \description{ Returns a matrix whose columns are the (expected value or standard deviations of) coefficients for the best models in a bma object. } \usage{ beta.draws.bma(bmao,stdev=FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{bmao}{ a 'bma' object (as e.g. resulting from \code{\link{bms}}) } \item{stdev}{if \code{stdev=FALSE} then \code{beta.draws.bma} returns the (conditional) posterior expected values of the coefficients (i.e. 'Bayesian coefficients'). If \code{stdev=TRUE} it returns their posterior standard deviations. } } \value{ Each column presents the coefficients for the model indicated by its column name. The zero coefficients are the excluded covariates per model. Note that the coefficients returned are only those of the best (100) models encountered by the \code{bma} object (cf. argument \code{nmodels} of \code{\link{bms}}). For aggregate coefficients please refer to \code{\link{coef.bma}}. } \author{ Martin Feldkircher and Stefan Zeugner} \note{ Note that the elements of \code{beta.draws.bma(bmao)} correspond to \code{bmao$topmood$betas()} } \seealso{ \code{\link{bms}} for creating bms objects, \code{\link{coef.bma}} for aggregate coefficients Check \url{http://bms.zeugner.eu} for additional help.} \examples{ #sample a bma object: data(datafls) mm=bms(datafls,burn=500,iter=5000,nmodel=20) #coefficients for all beta.draws.bma(mm) #standard deviations for the fourth- to eight best models beta.draws.bma(mm[4:8],TRUE); } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/bin2hex.Rd0000644000175100001440000000344512624725513013327 0ustar hornikusers\name{bin2hex} \alias{bin2hex} \alias{hex2bin} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Converting Binary Code to and from Hexadecimal Code } \description{ A simple-to-use function for converting a logical ('binary') vector into hex code and reverse. } \usage{ bin2hex(binvec) hex2bin(hexcode) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{binvec}{a logical vector (alternatively a vector coercible into logical)} \item{hexcode}{a single-element character denoting an integer in hexcode (admissible character: 0 to 9, ato f)} } \details{ The argument is an integer in binary form (such as "101"), provided as a logical (\code{c(T,F,T)}) or numeric vector (\code{c(1,0,1)}).\cr \code{bin2hex} then returns a character denoting this number in hexcode (in this case "5"). The function \code{hex2bin} does the reverse operation, e.g. \code{hex2bin("5")} gives (\code{c(1,0,1)}). } \value{ \code{bin2hex} returns a single element character; \code{hex2bin} returns a numeric vector equivalent to a logical vector } \author{ Martin Feldkircher and Stefan Zeugner } %\note{ Note that both functions preserve leading zeroes: for instance \code{bin2hex(c(0,1))} returns a result different from \code{bin2hex(c(rep(0,8),1))}, and \code{hex2bin("0b")} differs from \code{hex2bin("b")} } \seealso{ \code{\link{hex2bin}} for converting hexcode into binary vectors, \code{\link{format.hexmode}} for a related R function. Check \url{http://bms.zeugner.eu} for additional help.} \examples{ bin2hex(c(TRUE,FALSE,TRUE,FALSE,TRUE,TRUE)) bin2hex(c(1,0,1,0,1,1)) hex2bin("b8a") bin2hex(hex2bin("b8a")) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{arith} BMS/man/bms.Rd0000644000175100001440000004550512624725513012554 0ustar hornikusers\name{bms} \alias{bms} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Bayesian Model Sampling and Averaging } \description{ Given data and prior information, this function samples all possible model combinations via MC3 or enumeration and returns aggregate results. } \usage{ bms(X.data, burn = 1000, iter = NA, nmodel = 500, mcmc = "bd", g = "UIP", mprior = "random", mprior.size = NA, user.int = TRUE, start.value = NA, g.stats = TRUE, logfile = FALSE, logstep = 10000, force.full.ols = FALSE, fixed.reg = numeric(0), data = NULL, randomizeTimer = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{X.data}{ a data frame or a matrix, with the dependent variable in the first column, followed by the covariates.\cr Alternatively, \code{X.data} can also be provided as a \code{\link{formula}}. In that case, it may advisable to provide the data in argument \code{data}.). Note that \code{bms} automatically estimates a constant, therefore including constant terms is not necessary. } \item{burn}{ The (positive integer) number of burn-in draws for the MC3 sampler, defaults to 1000. (Not taken into account if mcmc="enumerate")} \item{iter}{ If mcmc is set to an MC3 sampler, then this is the number of iteration draws to be sampled (ex burn-ins), default 3000 draws. \cr If \code{mcmc="enumerate"}, then iter is the number of models to be sampled, starting from 0 (defaults to \eqn{2^K-1}) - cf. \code{start.value}.} \item{nmodel}{ the number of best models for which information is stored (default 500). Best models are used for convergence analysis between likelihoods and MCMC frequencies, as well as likelihood-based inference.\cr Note that a very high value for \code{nmodel} slows down the sampler significantly. Set nmodel=0 to speed up sampling (if best model information is not needed).} \item{mcmc}{ a character denoting the model sampler to be used.\cr The MC3 sampler \code{mcmc="bd"} corresponds to a birth/death MCMC algogrithm. \code{mcmc="rev.jump"} enacts a reversible jump algorithm adding a "swap" step to the birth / death steps from "bd".\cr Alternatively, the entire model space may be fully enumerated by setting \code{mcmc="enumerate"} which will iterate all possible regressor combinations (Note: consider that this means \eqn{2^K} iterations, where K is the number of covariates.)\cr Default is full enumeration (\code{mcmc="enumerate"}) with less then 15 covariates, and the birth-death MC3 sampler (\code{mcmc="bd"}) with 15 covariates or more. Cf. section 'Details' for more options. } \item{g}{ the hyperparameter on Zellner's g-prior for the regression coefficients.\cr \code{g="UIP"} corresponds to \eqn{g=N}, the number of observations (default);\cr \code{g="BRIC"} corresponds to the benchmark prior suggested by Fernandez, Ley and Steel (2001), i.e \eqn{g=max(N, K^2)}, where K is the total number of covariates;\cr \code{g="RIC"} sets \eqn{g=K^2} and conforms to the risk inflation criterion by George and Foster (1994)\cr \code{g="HQ"} sets \eqn{g=log(N)^3} and asymptotically mimics the Hannan-Quinn criterion with \eqn{C_{HQ}=3} (cf. Fernandez, Ley and Steel, 2001, p.395)\cr \code{g="EBL"} estimates a local empirical Bayes g-parameter (as in Liang et al. (2008));\cr \code{g="hyper"} takes the 'hyper-g' prior distribution (as in Liang et al., 2008) with the default hyper-parameter \eqn{a} set such that the prior expected shrinkage factor conforms to 'UIP';\cr This hyperparameter \eqn{a} can be adjusted (between \eqn{20.2.\cr The default value \code{start.value=NA} corresponds to \code{start.value=min(ncol(X.data),nrow(X.data)-3)}. Note that \code{start.value=0} or \code{start.value=NULL} starts from the null model.\cr If \code{mcmc="enumerate"} then \code{start.value} is the index to start the iteration (default: 0, the null model) . Any number between 0 and \eqn{K^2-1} is admissible. } % \item{beta.save}{ if \code{beta.save=TRUE} (default) then the respective regression coefficients are saved along with the \code{nmodel} best models. % If \code{beta.save=FALSE}, the best models are saved without their coefficients, allowing for faster iteration, but limited functionality. % (Note: if beta.save<0 then regression coefficients are saved for top models, but not the corresponding standard deviations). % } \item{g.stats}{\code{TRUE} if statistics on the shrinkage factor g/(1+g) should be collected, defaulting to TRUE (Note: set \code{g.stats=FALSE} for faster iteration.) } \item{logfile}{ setting \code{logfile=TRUE} produces a logfile named \code{"test.log"} in your current working directory, in order to keep track of the sampling procedure. \code{logfile} equal to some filepath (like \code{logfile="subfolder/log.txt"}) puts the logfile into that specified position. (default: \code{logfile=FALSE}). Note that \code{logfile=""} implies log printouts on the console. } \item{logstep}{ specifies at which number of posterior draws information is written to the log file; default: 10 000 iterations } \item{force.full.ols}{ default \code{FALSE}. If \code{force.full.ols=TRUE}, the OLS estimation part of the sampling procedure relies on slower matrix inversion, instead of streamlined routines. \code{force.full.ols=TRUE} can slow down sampling but may deal better with highly collinear data} \item{fixed.reg}{ indices or variable names of \code{X.data} that are fixed regressors to be always included in every sampled model. Note: the parameter \code{mprior.size} refers to prior model size including these fixed regressors. } \item{data}{ an optional \code{\link{data.frame}} (or one that can be coerced to that class such as a \code{\link{matrix}}: cf. \code{\link{lm}}) containing the variables in the model. If not found in \code{data}, the variables are taken from \code{environment(formula)}, typically the environment from which \code{bms} is called.} \item{randomizeTimer}{ default \code{TRUE} makes a call to \code{\link{set.seed}} in order to generate random numbers for the MCMC sampler. In laymen's terms: If set to default \code{FALSE}, then there the sampler will always parse to exactly the same random numbers. } %\item{exact}{ deprecated } %\item{int}{ deprecated } %\item{printRes}{ deprecated } %\item{ask.set}{ deprecated } %\item{return.g.stats}{ deprecated } %\item{theta}{ deprecated } %\item{prior.msize}{ deprecated } } \details{ Ad \code{mcmc}: \cr Interaction sampler: adding an ".int" to an MC3 sampler (e.g. "mcmc="bd.int") provides for special treatment of interaction terms. Interaction terms will only be sampled along with their component variables: In the colnumn names of X.data, interaction terms need to be denominated by names consisting of the base terms separated by \code{#} (e.g. an interaction term of base variables \code{"A"}, \code{"B"} and \code{"C"} needs column name \code{"A#B#C"}). Then variable \code{"A#B#C"} will only be included in a model if all of the component variables ("A", "B", and "C") are included. The MC3 samplers "\code{bd}", "\code{rev.jump}", "\code{bd.int}" and "\code{rev.jump.int}", iterate away from a starting model by adding, dropping or swapping (only in the case of rev.jump) covariates. In an MCMC fashion, they thus randomly draw a candidate model and then move to it in case its marginal likelihood (marg.lik.) is superior to the marg.lik. of the current model. In case the candidate's marg.lik is inferior, it is randomly accepted or rejected according to a probability formed by the ratio of candidate marg.lik over current marg.lik. Over time, the sampler should thus converge to a sensible distribution. For aggregate results based on these MC3 frequencies, the first few iterations are typically disregarded (the 'burn-ins'). Ad \code{g} and the hyper-g prior: The hyper-g prior introduced by Liang et al. (2008) puts a prior distribution on the shrinkage factor \eqn{g/(1+g)}, namely a Beta distribution \eqn{ Beta(1, 1/2-1)} that is governed by the parameter \eqn{a}. \eqn{a=4} means a uniform prior distribution of the shrinkage factor, while \eqn{a>2} close to 2 concentrates the prior shrinkage factor close to one. \cr The prior expected value is \eqn{E(g/1+g)) = 2/a}. In this sense \code{g="hyper=UIP"} and \code{g="hyper=BRIC"} set the prior expected shrinkage such that it conforms to a fixed UIP-g (eqn{g=N}) or BRIC-g (\eqn{g=max(K^2,N)} ). } \value{ A list of class \code{bma}, that may be displayed using e.g. \code{\link{summary.bma}} or \code{\link{coef.bma}}. The list contains the following elements: \item{info}{a list of aggregate statistics: \code{iter} is the number of iterations, \code{burn} the number of burn-ins.\cr The following have to be divided by \code{cumsumweights} to get posterior expected values: \code{inccount} are the posterior inclusion probabilities, \code{b1mo} and \code{b2mo} the first and second moment of coefficients, \code{add.otherstats} other statistics of interest (typically the moments of the shrinkage factor), \code{msize} is the post. expected model size, \code{k.vec} the posterior model size distribution, \code{pos.sign} the unconditional post. probability of positive coefficients, \code{corr.pmp} is the correlation between the best models' MCMC frequencies and their marg. likelihoods.\cr \code{timed} is the time that was needed for MCMC sampling, \code{cons} is the posterior expected value of the constant. \code{K} and \code{N} are the maximum number of covariates and the sample size, respectively.} \item{arguments}{a list of the evaluated function arguments provided to \code{bms} (see above)} \item{topmod}{a 'topmod' object containing the best drawn models. see \code{\link{topmod}} for more details} \item{start.pos}{the positions of the starting model. If bmao is a'bma' object this corresponds to covariates bmao$reg.names[bmao$start.pos]. If bmao is a chain that resulted from several starting models (cf. \code{\link{c.bma}}, then \code{start.pos} is a list detailing all of them.} \item{gprior.info}{a list of class \code{\link{gprior-class}}, detailing information on the g-prior: \code{gtype} corresponds to argument \code{g} above, \code{is.constant} is FALSE if \code{gtype} is either "hyper" or "EBL", \code{return.g.stats} corresponds to argument \code{g.stats} above, \code{shrinkage.moments} contains the first and second moments of the shrinkage factor (only if \code{return.g.stats==TRUE}), \code{g} details the fixed g (if \code{is.constant==TRUE}), \code{hyper.parameter} corresponds to the hyper-g parameter \eqn{a} as in Liang et al. (2008) } \item{mprior.info}{a list of class \code{\link{mprior-class}}, detailing information on the model prior: \code{origargs} lists the original arguments to \code{mprior} and \code{mprior.size} above; \code{mp.msize} denotes the prior mode size; \code{mp.Kdist} is a (K+1) vector with the prior model size distribution from 0 to K} \item{X.data}{data.frame or matrix similar to \code{\link{model.frame}}: corresponds to argument \code{X.data} above, possibly cleaned for NAs} \item{reg.names}{character vector: the covariate names to be used for X.data (corresponds to \code{\link{variable.names.bma}} } \item{bms.call}{the original call to the \code{bms} function} } \references{ Feldkircher, M. and S. Zeugner (2009): Benchmark Priors Revisited: On Adaptive Shrinkage and the Supermodel Effect in Bayesian Model Averaging, IMF Working Paper 09/202. Fernandez, C. E. Ley and M. Steel (2001): Benchmark priors for Bayesian model averaging. Journal of Econometrics 100(2), 381--427 Ley, E. and M. Steel (2008): On the Effect of Prior Assumptions in Bayesian Model Averaging with Applications to Growth Regressions. working paper Liang, F., Paulo, R., Molina, G., Clyde, M. A., and Berger, J. O. (2008). Mixtures of g Priors for Bayesian Variable Selection. Journal of the American Statistical Association 103, 410-423. Sala-i-Martin, X. and G. Doppelhofer and R.I. Miller (2004): Determinants of long-term growth: a Bayesian averaging of classical estimates (BACE) approach. American Economic Review 94(4), 813--835 } \author{Martin Feldkircher and Stefan Zeugner} \note{ There are several ways to speed-up sampling: \code{nmodel=10} saves only the ten best models, at most a marginal improvement. \code{nmodels=0} does not save the best (500) models, however then posterior convergence and likelihood-based inference are not possible. %\code{beta.save=FALSE} saves the best models, but not their coefficients, which renders the use of \code{image.bma} and the paramer \code{exact=TRUE} in functions such as \code{coef.bma} infeasible. \code{g.stats=FALSE} saves some time by not retaining the shrinkage factors for the MC3 chain (and the best models). \code{force.fullobject=TRUE} in contrast, slows sampling down significantly if \code{mcmc="enumerate"}. } \section{Theoretical background}{ The models analyzed are Bayesian normal-gamma conjugate models with improper constant and variance priors akin to Fernandez, Ley and Steel (2001): A model \eqn{M} can be described as follows, with \eqn{\epsilon} ~ \eqn{N(0,\sigma^2 I)}: \deqn{latex}{ y= \alpha + X \beta + \epsilon} \deqn{f(\beta | \sigma, M, g) ~ N(0, g \sigma^2 (X'X)^-1) } Moreover, the (improper) prior on the constant \eqn{f(\alpha)} is put proportional to 1. Similarly, the variance prior \eqn{f(\sigma)} is proportional to \eqn{1/\sigma}. } \seealso{ \code{\link{coef.bma}}, \code{\link{plotModelsize}} and \code{\link{density.bma}} for some operations on the resulting 'bma' object, \code{\link{c.bma}} for integrating separate MC3 chains and splitting of sampling over several runs. Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) #estimating a standard MC3 chain with 1000 burn-ins and 2000 iterations and uniform model priors bma1 = bms(datafls,burn=1000, iter=2000, mprior="uniform") ##standard coefficients based on exact likelihoods of the 100 best models: coef(bma1,exact=TRUE, std.coefs=TRUE) #suppressing user-interactive output, using a customized starting value, and not saving the best # ...models for only 19 observations (but 41 covariates) bma2 = bms(datafls[20:39,],burn=1000, iter=2000, nmodel=0, start.value=c(1,4,7,30), user.int=FALSE) coef(bma2) #MC3 chain with a hyper-g prior (custom coefficient a=2.1), saving only the 20 best models, # ...and an alternative sampling procedure; putting a log entry to console every 1000th step bma3 = bms(datafls,burn=1000, iter=5000, nmodel=20, g="hyper=2.1", mcmc="rev.jump", logfile="",logstep=1000) image(bma3) #showing the coefficient signs of the 20 best models #enumerating with 10 covariates (= 1024 models), keeping the shrinkage factors # ...of the best 200 models bma4 = bms(datafls[,1:11],mcmc="enumerate",nmodel=200,g.stats=TRUE) #another enumeration example: with less than 15 covariates, enumeration is the default # ...of the best 200 models data(attitude) bma4b = bms(attitude) bma4c = bms(rating ~complaints + privileges + raises, data = attitude) #using an interaction sampler for two interaction terms dataint=datafls dataint=cbind(datafls,datafls$LifeExp*datafls$Abslat/1000, datafls$Protestants*datafls$Brit-datafls$Muslim) names(dataint)[ncol(dataint)-1]="LifeExp#Abslat" names(dataint)[ncol(dataint)]="Protestants#Brit#Muslim" bma5 = bms(X.data=dataint,burn=1000,iter=9000,start.value=0,mcmc="bd.int") density(bma5,reg="English") # plot posterior density for covariate "English" # a matrix as X.data argument bms(matrix(rnorm(1000),100,10)) # keeping a set of fixed regressors: bms(datafls, mprior.size=7, fixed.reg = c("PrScEnroll", "LifeExp", "GDP60")) # Note that mprior.size=7 means prior model size of 3 fixed to 4 'uncertain' regressors } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/print.topmod.Rd0000644000175100001440000000501412624725513014417 0ustar hornikusers\name{print.topmod} \alias{print.topmod} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Printing topmod Objects } \description{ Print method for objects of class 'topmod', typically the best models stored in a 'bma' object } \usage{ \method{print}{topmod}(x, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an object of class 'topmod' - see \code{\link{topmod}} } \item{\dots}{ additional arguments passed to \code{link{print}} } } \details{ See \code{\link{pmp.bma}} for an explanation of likelihood vs. MCMC frequency concepts } \value{ if \code{x} contains more than one model, then the function returns a 2-column matrix: \item{Row Names}{show the model binaries in hexcode (cf. \code{\link{topmodels.bma}})} \item{Column 'Marg.Log.Lik'}{shows the marginal log-likelihoods of the models in \code{x}} \item{Column 'MCMC Freq'}{shows the MCMC frequencies of the models in \code{x}} if \code{x} contains only one model, then more detailed information is shown for this model: \item{first line}{'Model Index' provides the model binary in hexcode, 'Marg.Log.Lik' its marginal log likelhood, 'Sampled Freq.' how often it was accepted (function \code{ncount()} in \code{\link{topmod}})} \item{Estimates}{first column: covariate indices included in the model, second column: posterior expected value of the coefficients, third column: their posterior standard deviations (excluded if no coefficients were stored in the topmod object - cf. argument \code{bbeta} in \code{\link{topmod}}) } \item{Included Covariates}{the model binary} \item{Additional Statistics}{any custom additional statistics saved with the model} } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{topmod}} for creating topmod objects, \code{\link{bms}} for their typical use, \code{\link{pmp.bma}} for comparing posterior model probabilities Check \url{http://bms.zeugner.eu} for additional help.} \examples{ # do some small-scale BMA for demonstration data(datafls) mm=bms(datafls[,1:10],nmodel=20) #print info on the best 20 models print(mm$topmod) print(mm$topmod,digits=10) #equivalent: cbind(mm$topmod$lik(),mm$topmod$ncount()) #now print info only for the second-best model: print(mm$topmod[2]) #compare 'Included Covariates' to: topmodels.bma(mm[2]) #and to as.vector(mm$topmod[2]$bool_binary()) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{print}BMS/man/pmp.bma.Rd0000644000175100001440000001201012624725513013306 0ustar hornikusers\name{pmp.bma} \alias{pmp.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Posterior Model Probabilities } \description{ Returns the posterior model probabilites for the best models encountered by a 'bma' object } \usage{ pmp.bma(bmao, oldstyle = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{bmao}{ A bma object (see argument \code{nmodel} in \code{\link{bms}}), alternatively an object of class \code{\link{topmod}} } \item{oldstyle}{ For normal use, leave this at \code{FALSE}. It is an argument for compatibility with older BMS versions - see section 'Notes' } } \value{ the result is a matrix, its row names describe the model binaries\cr There are two columns in the matrix: \item{PMP (Exact)}{posterior model probabilities based on the posterior likelihoods of the best models in \code{bmao} } \item{PMP (MCMC)}{posterior model probabilities of the best models in \code{bmao} based on their MCMC frequencies, relative to all models encountered by \code{bmao} - see 'Details' } } \details{ A call to bms with an MCMC sampler (e.g. \code{bms(datafls,mcmc="bd",nmodel=100)} uses a Metropolis-Hastings algorithm to sample through the model space - and the frequency of how often models are drawn converges to the distribution of their posterior marginal likelihoods. While sampling, each 'bma' object stores the best models encountered by its sampling chain with their marginal likelihood and their MCMC frequencies. \code{pmp.bma} then allows for comparing the posterior model probabilities (PMPs) for the two different methods, similar to \code{\link{plotConv}}. It calculates the PMPs based on marginal likelihoods (first column) and the PMPs based on MCMC frequencies (second column) for the best x models stored in the bma object. The correlation of the two columns is an indicator of how well the MCMC sampler has converged to the actual PMP distribution - it is therefore also given in the output of \code{\link{summary.bma}}. The second column is slightly different in case the \code{\link{bms}} argument \code{mcmc} was set to \code{mcmc="enumeration"}: In this case, the second column is also based on marginal likelihoods. The correlation between the two columns is therefore one. } %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner } \note{ The second column thus shows the PMPs of the best models relative to all models the call to \code{\link{bms}} has sampled through (therefore typically the second column adds up to less than one). The first column relates to the likelihoods of the best models, therefore it would add up to 1. In order estimate for their marginal likelihoods with respect to the other models (the ones not retained in the best models), these PMP aadding up to one are multiplied with the sum of PMP of the best models accroding to MCMC frequencies. Therefore, the two columns have the same column sum. CAUTION: In package versions up to \code{BMS 0.2.5}, the first column was indeed set always equal to one. This behaviour can still be mimicked by setting \code{oldstyle=TRUE}. } \seealso{ \code{\link{plotConv}} for plotting \code{pmp.bma}, \code{\link{pmpmodel}} to obtain the PMP for any individual model, \code{\link{bms}} for sampling bma objects Check \url{http://bms.zeugner.eu} for additional help.} \examples{ ## sample BMA for growth dataset, MCMC sampler data(datafls) mm=bms(datafls[,1:10],nmodel=20, mcmc="bd") ## mmodel likelihoods and MCMC frequencies of best 20 models print(mm$topmod) pmp.bma(mm) #first column: posterior model prob based on model likelihoods, # relative to best models in 'mm' #second column: posterior model prob based MCMC frequencies, # relative to all models encountered by 'mm' #consequently, first column adds up to one #second column shows how much of the sampled model space is # contained in the best models colSums(pmp.bma(mm)) #correlation betwwen the two shows how well the sampler converged cor(pmp.bma(mm)[,1],pmp.bma(mm)[,2]) #is the same as given in summary.bma summary(mm)["Corr PMP"] #plot the two model probabilites plotConv(mm) #equivalent to the following chart plot(pmp.bma(mm)[,2], type="s") lines(pmp.bma(mm)[,1],col=2) #moreover, note how the first column is constructed liks=exp(mm$top$lik()) liks/sum(liks) pmp.bma(mm)[,1] #these two are equivalent #the example above does not converge well, #too few iterations and best models # this is already better, but also not good mm=bms(datafls[,1:10],burn=2000,iter=5000,nmodel=200) # in case the sampler has been 'enumeration' instead of MCMC, # then both matrix columns are of course equivalent mm=bms(datafls[,1:10],nmodel=512,mcmc="enumeration") cor(pmp.bma(mm)[,1],pmp.bma(mm)[,2]) colSums(pmp.bma(mm)) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/bma-class.Rd0000644000175100001440000001006412624725513013625 0ustar hornikusers\name{bma-class} \docType{class} \alias{bma-class} \title{Class "bma"} \description{ A list holding results from a BMA iteration chain } \section{Objects from the Class}{ Objects can be created via calls to \code{\link{bms}}, but indirectly also via \code{\link{c.bma}}\cr A \code{bma} object is a list whose elements hold information on input and output for a Bayesian Model Averaging iteration chain, such as from a call to \code{\link{bms}}: } \section{Slots}{ \describe{ \item{\code{.S3Class}:}{Object of class \code{"list"}, elements are: \describe{ \item{\code{info}:}{An object of class \code{"list"} holding aggregate statistics: \code{iter} is the number of iterations, \code{burn} the number of burn-ins. \cr The following have to be divided by \code{cumsumweights} to get posterior expected values: \code{inccount} are the posterior inclusion probabilities, \code{b1mo} and \code{b2mo} the first and second moment of coefficients, \code{add.otherstats} other statistics of interest (typically the moments of the shrinkage factor), \code{msize} is the post. expected model size, \code{k.vec} the posterior model size distribution, \code{pos.sign} the unconditional post. probability of positive coefficients, \code{corr.pmp} is the correlation between the best models' MCMC frequencies and their marg. likelihoods. \cr \code{timed} is the time that was needed for MCMC sampling, \code{cons} is the posterior expected value of the constant. \code{K} and \code{N} are the maximum number of covariates and the sample size, respectively. } \item{\code{arguments}:}{An object of class \code{"list"} holding the evaluated function arguments provided to \code{\link{bms}} } \item{\code{topmod}:}{An object of class \code{\linkS4class{topmod}} containing the best drawn models. see \code{\link{topmod}} for more details } \item{\code{start.pos}:}{the positions of the starting model. If bmao is a \code{bma} object this corresponds to covariates \code{bmao$reg.names[bmao$start.pos]}. If bmao is a chain that resulted from several starting models (cf. \code{\link{c.bma}}, then \code{start.pos} is a list detailing all of them.} \item{\code{gprior.info}:}{a list of class \code{\link{gprior-class}}, detailing information on the g-prior: \code{gtype} corresponds to argument \code{g} above, \code{is.constant} is FALSE if \code{gtype} is either "hyper" or "EBL", \code{return.g.stats} corresponds to argument \code{g.stats} above, \code{shrinkage.moments} contains the first and second moments of the shrinkage factor (only if \code{return.g.stats==TRUE}), \code{g} details the fixed g (if \code{is.constant==TRUE}), \code{hyper.parameter} corresponds to the hyper-g parameter \eqn{a} as in Liang et al. (2008).} \item{\code{mprior.info}:}{a list of class \code{\link{mprior-class}}, detailing information on the model prior: \code{origargs} lists the original arguments to \code{mprior} and \code{mprior.size} above; \code{mp.msize} denotes the prior mode size; \code{mp.Kdist} is a (K+1) vector with the prior model size distribution from 0 to K} \item{\code{X.data}:}{Object of class \code{"data.frame"} or class \code{"matrix"}, matrix: corresponds to argument \code{X.data} in \code{\link{bms}}, possibly cleaned for NAs } \item{\code{reg.names}:}{Vector of class \code{"character"}: the covariate names to be used for \code{X.data} in \code{\link{bms}} } \item{\code{bms.call}:}{Object of class \code{"call"}: the original call to the \code{\link{bms}} function } }} } } \section{Methods}{ \code{\link{summary.bma}}, \code{\link{print.bma}}, \code{\link{coef.bma}}, \code{\link{density.bma}}, \code{\link{image.bma}}, \code{\link{plot.bma}} } \references{ \url{http://bms.zeugner.eu} } \author{Martin Feldkircher and Stefan Zeugner} \seealso{ \code{\link{bms}} for creating \code{bma} objects,\cr or \code{\linkS4class{topmod}} for the topmod object } \examples{ data(datafls) mm=bms(datafls) #show posterior model size print(mm$info$msize/mm$info$cumsumweights) #is the same number as in summary(mm) } \keyword{classes} BMS/man/predict.bma.Rd0000644000175100001440000000440312624725513014153 0ustar hornikusers\name{predict.bma} \alias{predict.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Predict Method for bma Objects } \description{ Expected value of prediction based on 'bma' object } \usage{ \method{predict}{bma}(object, newdata = NULL, exact = FALSE, topmodels = NULL, ...)} %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ a bma object - see \code{\link{bms}} } \item{newdata}{An optional data.frame, matrix or vector containing variables with which to predict. If omitted, then (the expected values of) the fitted values are returned.} \item{exact}{If \code{FALSE} (default), then prediction is based on all models (i.e. on their MCMC frequencies in case the \code{\link{bms}} parameter \code{mcmc} was set to an mcmc sampler.\cr If \code{TRUE}, then prediction is based on analytical likelihoods of the best models retained in \code{object} - cf. \code{\link{bms}} parameter \code{nmodel}.} \item{topmodels}{index of the models with whom to predict: for instance, \code{topmodels=1} predicts based solely on the best model, whereas \code{topmodels=1:5} predicts based on a combination of the five best models.\cr Note that setting \code{topmodels} triggers \code{exact=TRUE}. } \item{\dots}{further arguments passed to or from other methods.} } \value{ A vector with (expected values of) fitted values. } %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{coef.bma}} for obtaining coefficients, \code{\link{bms}} for creating bma objects, \code{\link{predict.lm}} for a comparable function Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls,user.int=FALSE) predict(mm) #fitted values based on MCM frequencies predict(mm, exact=TRUE) #fitted values based on best models predict(mm, newdata=1:41) #prediction based on MCMC frequencies predict(mm, newdata=datafls[1,], exact=TRUE) #prediction based on a data.frame # the following two are equivalent: predict(mm, topmodels=1:10) predict(mm[1:10], exact=TRUE) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} BMS/man/z[.bma.Rd0000644000175100001440000000357612624725513013137 0ustar hornikusers\name{[.bma} \alias{[.bma} \alias{[.topmod} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Extract Parts of a topmod Object } \description{ returns a bma (or topmod) object whose } \usage{ \method{[}{bma}(x, i, ...) \method{[}{topmod}(x, i, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an object of class 'bma' or of class \code{\link{topmod}} } \item{i}{ index of the best models to be retained } \item{\ldots}{ arguments such as 'drop' will not have an effect } } \details{ Both functions are equivalent: they serve to select a subset of the best models in a bma object. } \value{ If \code{x} is a topmod object (see \code{\link{topmod}}), then \code{x[i]} returns a topmod object that only retains the models specified by \code{i} if \code{x} is an object of class bma (see \code{\link{bms}}), \code{x[i]} returns a bma object whose topmod object (i.e. \code{x$topmod} has been adjusted accordingly) } \author{ Martin Feldkircher and Stefan Zeugner } \note{ Note that the method parameter \code{drop} is of no importance here. Moreover the corresponding assignment operator \code{\link{[<-}} is of no use.} \seealso{ \code{\link{[}} for the default method, \code{\link{bms}} for crating bma objects Check \url{http://bms.zeugner.eu} for additional help.} \examples{ #sample some BMA data(datafls) mm=bms(datafls[,1:11]) #plotConv for all models plotConv(mm) #plotConv for the best 20 models plotConv(mm[1:20]) #model binary for the second best model topmodels.bma(mm[2]) #similar: as.vector(mm$topmod[2]$bool_binary()) #exactly the same as.vector(mm[2]$topmod$bool_binary()) #print stats for second best model print(mm$topmod[2]) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} BMS/man/is.bma.Rd0000644000175100001440000000164012624725513013134 0ustar hornikusers\name{is.bma} \alias{is.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Tests for a 'bma' Object } \description{ tests for objects of class "bma" } \usage{ is.bma(bmao) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{bmao}{ a 'bma' object: see 'value' } } %\details{~~ If necessary, more details than the description above ~~} \value{ Returns \code{TRUE} if bmao is of class 'bma', \code{FALSE} otherwise. } \author{ Martin Feldkircher and Stefan Zeugner} \seealso{ 'Output' in \code{\link{bms}} for the structure of a 'bma' object Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls,burn=1000, iter=4000) is.bma(mm) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{classes} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/print.bma.Rd0000644000175100001440000000205212624725513013653 0ustar hornikusers\name{print.bma} \alias{print.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Printing bma Objects } \description{ Print method for objects of class 'bma' } \usage{ \method{print}{bma}(x, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ a bma object - see \code{\link{bms}} } \item{\dots}{ additional arguments to \code{\link{print}} } } \value{ prints calls to \code{coef.bma{x}} and \code{summary.bma(x)} } %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{coef.bma}} and \code{\link{summary.bma}} for the underlying functions, \code{\link{bms}} for creating bma objects, \code{\link{print}} Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls,user.int=FALSE) print(mm) ## similar: coef(mm) summary(mm) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{print} BMS/man/plot.bma.Rd0000644000175100001440000000232612624725513013501 0ustar hornikusers\name{plot.bma} \alias{plot.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Plot Posterior Model Size and Model Probabilities } \description{ Produces a combined plot: upper row shows prior and posterior model size distribution, lower row shows posterior model probabilities for the best models } \usage{ \method{plot}{bma}(x, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an object of class 'bma' } \item{\dots}{ additional arguments for \code{\link{matplot}} } } \value{ combines the plotting functions \code{\link{plotModelsize}} and \code{\link{plotConv}} } \author{ Martin Feldkircher and Stefan Zeugner } \note{ The upper plot shows the prior and posterior distribution of model sizes (\code{\link{plotModelsize}}).\cr The lower plot is an indicator of how well the bma object has converged (\code{\link{plotConv}}). } \seealso{ \code{\link{plotModelsize}} and \code{\link{plotConv}} Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls,user.int=FALSE) plot(mm) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{hplot} BMS/man/zlm-class.Rd0000644000175100001440000000464112624725513013674 0ustar hornikusers\name{zlm-class} \docType{class} \alias{zlm-class} \title{Class \code{"zlm"}} \description{ A list holding output from the Bayesian Linar Model under Zellner's g prior akin to class 'lm' } \section{Objects from the Class}{ Objects can be created via calls to \code{\link{zlm}}, but indirectly also via \code{\link{as.zlm}}.\cr \code{\link{zlm}} estimates a Bayesian Linear Model under Zellner's g prior - its output is very similar to objects of class \code{\link{lm}} (cf. section 'Value') } \section{Slots}{ \describe{ \item{\code{.S3Class}:}{Object of class \code{"list"}, elements are: \describe{ \item{\code{coefficients}:}{A named vector of class \code{"numeric"}: holds the posterior expected values of 'regression' coefficients. The first element always holds the intercept} \item{\code{residuals}:}{Vector of class \code{"numeric"}: the residuals, that is the response variable minus fitted values } \item{\code{rank}:}{Scalar integer class \code{"numeric"}: the number of estimated parameters} \item{\code{fitted.values}:}{The (posterior expected values of the) fitted values} \item{\code{df.residual}:}{Scalar integer of class \code{"numeric"}: the residual degrees of freedom } \item{\code{call}:}{Object of class \code{"call"}: the matched call to \code{\link{zlm}} that created the object} \item{\code{terms}:}{Object of class \code{"formula"}: the \code{\link{terms}} object used} \item{\code{model}:}{Object of class \code{"data.frame"}: the model frame used } \item{\code{coef2moments}:}{Named vector of class \code{"numeric"}: coefficient posterior second moments } \item{\code{marg.lik}:}{Scalar integer of class \code{"numeric"}: the log marginal likelihood of the model } \item{\code{gprior.info}:}{An object of class \code{"list"} detailing information on the g-prior, cf. output value \code{gprior.info} in \code{\link{bms}} } }} } } \section{Extends}{ Class \code{"\linkS4class{oldClass}"}, directly. } \section{Methods}{ No methods defined with class "zlm" in the signature. } \references{ \url{http://bms.zeugner.eu} } \author{Martin Feldkircher and Stefan Zeugner} \seealso{ \code{\link{zlm}} and \code{\link{as.zlm}} for creating \code{zlm} objects,\cr \code{\link{density.zlm}}, \code{\link{predict.zlm}} and \code{\link{summary.zlm}} for other posterior results } %\examples{ %showClass("zlm") %} \keyword{classes} BMS/man/topmodels.bma.Rd0000644000175100001440000000404112624725513014525 0ustar hornikusers\name{topmodels.bma} \alias{topmodels.bma} \title{Model Binaries and their Posterior model Probabilities} %- Also NEED an '\alias' for EACH other topic documented here. \description{ Returns a matrix whose columns show which covariates were included in the best models in a 'bma' object. The last two columns detail posterior model probabilities. } \usage{ topmodels.bma(bmao) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{bmao}{ an object of class 'bma' - see \code{\link{bms}} } } %\details{} \value{ Each column in the resulting matrix corresponds to one of the 'best' models in \code{bmao}: the first column for the best model, the second for the second-best model, etc. The model binaries have elements 1 if the regressor given by the row name was included in the respective models, and 0 otherwise. The second-last row shows the model's posterior model probability based on marginal likelihoods (i.e. its marginal likelihood over the sum of likelihoods of all best models) The last row shows the model's posterior model probability based on MCMC frequencies (i.e. how often the model was accepted vs sum of acceptance of all models) } %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner } \note{ Note that the column names are hexcode representations of the model binaries (e.g. "03" for \code{c(0,0,0,1,0,0)}) } \seealso{ \code{\link{topmod}} for accessing model binaries, \code{\link{pmp.bma}} for posterior model probabilities Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) #sample with a limited data set for demonstration mm=bms(datafls[,1:12],nmodel=20) #show binaries for all topmodels.bma(mm) #show binaries for 2nd and 3rd best model, without the model probs topmodels.bma(mm[2:3])[1:11,] #access model binaries directly mm$topmod$bool_binary() } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} BMS/man/topmod.Rd0000644000175100001440000001560112624725513013267 0ustar hornikusers\name{topmod} \alias{topmod} \alias{is.topmod} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Topmodel Object} \description{ Create or use an updateable list keeping the best x models it encounters (for advanced users) } \usage{ topmod(nbmodels, nmaxregressors = NA, bbeta = FALSE, lengthfixedvec = 0, liks = numeric(0), ncounts = numeric(0), modelbinaries = matrix(0, 0, 0), betas = matrix(0, 0, 0), betas2 = matrix(0, 0, 0), fixed_vector = matrix(0, 0, 0)) is.topmod(tmo) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{nbmodels}{ The maximum number of models to be retained by the topmod object } \item{nmaxregressors}{ The maximum number of covariates the models in the topmod object are allowed to have } \item{bbeta}{ if \code{bbeta=TRUE}, then first and second moments of model coefficients are stored in addition to basic model statistics (Note: if \code{bbeta<0} then only the first moments are saved) } \item{lengthfixedvec}{ The length of an optional fixed vector adhering to each model (for instance R-squared, etc). If \code{lengthfixedvec=0} then no additonal fixed vector will be stored. } \item{liks}{ optional vector of log-likelihoods to initialize topmod object with (length must be \code{<=nbmodels}) - see example below } \item{ncounts}{ optional vector of MCMC frequencies to initialize topmod object with (same length as \code{liks}) - see example below } \item{modelbinaries}{ optional matrix whose columns detail model binaries to initialize topmod object with (same nb columns as \code{liks}, nb rows as \code{nmaxregressors}) - see example below } \item{betas}{ optional matrix whose columns are coefficients to initialize topmod object with (same dimensions as \code{modelbinaries}) - see example below} \item{betas2}{ optional matrix whose columns are coefficients' second moments to initialize topmod object with (same dimensions as \code{modelbinaries}) - see example below } \item{fixed_vector}{ optional matrix whose columns are a fixed vector initialize topmod object with (same \code{ncol} as \code{modelbinaries}) - see example below } \item{tmo}{A 'topmod' object, as e.g. created by topmod, or as element of the result of \code{\link{bms}}} } \details{ A 'topmod' object (as created by \code{topmod}) holds three basic vectors: \code{lik} (for the (log) likelihood of models or similar), \code{bool()} for a hexcode presentation of the model binaries (cf. \code{\link{bin2hex}}) and ncount() for the times the models have been drawn.\cr All these vectors are sorted descendantly by \code{lik}, and are of the same length. The maximum length is limited by the argument \code{nbmodels}. If \code{tmo} is a topmod object, then a call to \code{tmo$addmodel} (e.g. \code{tmo$addmodel(mylik=4,vec01=c(T,F,F,T))} updates the object \code{tmo} by a model represented by \code{vec01} (here the one including the first and fourth regressor) and the marginal (log) likelihood \code{lik} (here: 4). If this model is already part of \code{tmo}, then its respective \code{ncount} entry is incremented by one; else it is inserted into a position according to the ranking of \code{lik}. In addition, there is the possibility to save (the first moments of) coefficients of a model (\code{betas}) and their second moments (\code{betas2}), as well as an arbitrary vector of statistics per model (\code{fixed_vector}). \code{is.topmod} returns \code{TRUE} if the argument is of class 'topmod' } \value{ a call to \code{topmod} returns a list of class "topmod" with the following elements: \item{addmodel(mylik,vec01,vbeta=numeric(0),vbeta2=numeric(0),fixedvec=numeric(0))}{function that adjusts the list of models in the 'topmod' object (see Details). \code{mylik} is the basic selection criterion (usually log likelihood), \code{vec01} is the model binary (logical or numeric) indicating which regressors are included.\cr \code{vbeta} is a vector of length equal to \code{sum(vec01)}, contianing only the non-zero coefficients (only accounted for if \code{bbeta!=FALSE}). \code{vbeta2} is a similar vector of second moments etc. (only accounted for if \code{bbeta=TRUE}); \code{fixedvec} is an arbitrary vector of length \code{lengthfixedvec} (see above)} \item{lik()}{A numeric vector of the best models (log) likelihoods, in decreasing order} \item{bool()}{A character vector of hexmode expressions for the model binaries (cf. \code{\link{bin2hex}}), sorted by \code{lik()} } \item{ncount()}{A numeric vector of MCMC frequencies for the best models (i.e. how often the respective model was introduced by \code{addmodel})} \item{nbmodels}{Returns the argument \code{nbmodel}} \item{nregs}{Returns the argument \code{nmaxregressors}} \item{bool_binary()}{Returns a matrix whose columns present the models conforming to \code{lik()} in binary form} \item{betas()}{a matrix whose columns are the coefficients conforming to \code{bool_binary()} (Note that these include zero coefficients due to non-inclusion of covariates); Note: if \code{bbeta=FALSE} this returns an empty matrix} \item{betas2()}{similar to \code{betas} , for the second moments of coefficients Note: if \code{bbeta<=0}, this returns an empty matrix} \item{fixed_vector()}{The columns of this matrix return the \code{fixed_vector} statistics conforming to \code{lik()} (see Details); Note: if \code{lengthfixedvec=0} this returns an empty matrix} } %\references{ ~put references to the literature/web site here ~ } \author{Martin Feldkircher and Stefan Zeugner} \note{ \code{topmod} is rather intended as a building block for programming; it has no direct application for a user of the BMS package.} \seealso{ the object resulting from \code{\link{bms}} includes an element of class 'topmod' Check \url{http://bms.zeugner.eu} for additional help.} \examples{ #standard use tm= topmod(2,4,TRUE,0) #should keep a maximum two models tm$addmodel(-2.3,c(1,1,1,1),1:4,5:8) #update with some model tm$addmodel(-2.2,c(0,1,1,1),1:3,5:7) #add another model tm$addmodel(-2.2,c(0,1,1,1),1:3,5:7) #add it again -> adjust ncount tm$addmodel(-2.5,c(1,0,0,1),1:2,5:6) #add another model #read out tm$lik() tm$ncount() tm$bool_binary() tm$betas() is.topmod(tm) #extract a topmod oobject only containing the second best model tm2=tm[2] #advanced: should return the same result as #initialize tm2= topmod(2,4,TRUE,0, liks = c(-2.2,-2.3), ncounts = c(2,1), modelbinaries = cbind(c(0,1,1,1),c(1,1,1,1)), betas = cbind(0:3,1:4), betas2 = cbind(c(0,5:7),5:8)) #update tm$addmodel(-2.5,c(1,0,0,1),1:2,5:6) #add another model #read out tm$lik() tm$ncount() tm$bool_binary() tm$betas() } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per lineBMS/man/datafls.Rd0000644000175100001440000000645712624725513013414 0ustar hornikusers\name{datafls} \alias{datafls} \docType{data} \title{FLS (2001) growth data} \description{ The economic growth data set from Fernandez, Ley and Steel, Journal of Applied Econometrics 2001 } \usage{data(datafls)} \format{ A data frame with 72 observations on the following 42 variables. \describe{ \item{\code{y}}{numeric: Economic growth 1960-1992 as from the Penn World Tables Rev 6.0} \item{\code{Abslat}}{numeric: Absolute latitude} \item{\code{Spanish}}{numeric: Spanish colony dummy} \item{\code{French}}{numeric: French colony dummy} \item{\code{Brit}}{numeric: British colony dummy} \item{\code{WarDummy}}{numeric: War dummy} \item{\code{LatAmerica}}{numeric: Latin America dummy} \item{\code{SubSahara}}{numeric; Sub-Sahara dummy} \item{\code{OutwarOr}}{numeric: Outward Orientation} \item{\code{Area}}{numeric: Area surface} \item{\code{PrScEnroll}}{numeric: Primary school enrolment} \item{\code{LifeExp}}{numeric: Life expectancy} \item{\code{GDP60}}{numeric: Initial GDP in 1960} \item{\code{Mining}}{numeric: Fraction of GDP in mining} \item{\code{EcoOrg}}{numeric: Degree of capitalism} \item{\code{YrsOpen}}{numeric: Number of years having an open economy} \item{\code{Age}}{numeric: Age} \item{\code{Buddha}}{numeric: Fraction Buddhist} \item{\code{Catholic}}{numeric: Fraction Catholic} \item{\code{Confucian}}{numeric: Fraction Confucian} \item{\code{EthnoL}}{numeric: Ethnolinguistic fractionalization} \item{\code{Hindu}}{numeric: Fraction Hindu} \item{\code{Jewish}}{numeric: Fraction Jewish} \item{\code{Muslim}}{numeric: Fraction Muslim} \item{\code{PrExports}}{numeric: Primary exports 1970} \item{\code{Protestants}}{numeric: Fraction Protestants} \item{\code{RuleofLaw}}{numeric: Rule of law} \item{\code{Popg}}{numeric: Population growth} \item{\code{WorkPop}}{numeric: workers per inhabitant} \item{\code{LabForce}}{numeric: Size of labor force} \item{\code{HighEnroll}}{numeric: Higher education enrolment} \item{\code{PublEdupct}}{numeric: Public education share} \item{\code{RevnCoup}}{numeric: Revolutions and coups} \item{\code{PolRights}}{numeric: Political rights} \item{\code{CivlLib}}{numeric: Civil liberties} \item{\code{English}}{numeric: Fraction speaking English} \item{\code{Foreign}}{numeric: Fraction speaking foreign language} \item{\code{RFEXDist}}{numeric: Exchange rate distortions} \item{\code{EquipInv}}{numeric: Equipment investment} \item{\code{NequipInv}}{numeric: Non-equipment investment} \item{\code{stdBMP}}{numeric: stand. dev. of black market premium} \item{\code{BlMktPm}}{numeric: black market premium} } } \source{ Fernandez, C., Ley, E., and Steel, M. F. (2001b). Model Uncertainty in Cross-Country Growth Regressions. Journal of Applied Econometrics, 16:563-576. } \references{ Data set from \url{http://www2.warwick.ac.uk/fac/sci/statistics/staff/academic/steel/steel_homepage/software} A working paper version of Fernandez, Ley and Steel (2001) is available at \url{http://www2.warwick.ac.uk/fac/sci/statistics/staff/academic/steel/steel_homepage/software/fls3fin.pdf} } \examples{ data(datafls) ## maybe str(datafls) ; plot(datafls) ... } \keyword{datasets} BMS/man/pred.density.Rd0000644000175100001440000000777712624725513014414 0ustar hornikusers\name{pred.density} \alias{pred.density} \alias{pred.density-class} \alias{print.pred.density} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Predictive Densities for bma Objects } \description{ Predictive densities for conditional forecasts } \usage{ pred.density(object, newdata = NULL, n = 300, hnbsteps = 30, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ a bma object - see \code{\link{bms}}, alternativel a \code{\link{zlm}} object } \item{newdata}{A data.frame, matrix or vector containing variables with which to predict. } \item{n}{ The integer number of equally spaced points at which the density is to be estimated. } \item{hnbsteps}{The number of numerical integration steps to be used in case of a hyper-g prior (cf. argument \code{g} in \code{\link{bms}}). Increase this number to increase accuracy. Must be an even integer. } \item{\dots}{arguments to be passed on to \code{\link{plot.density}}. } } \value{ \code{pred.density} returns a list of class \code{pred.density} with the following elements \item{densities()}{a list whose elements each contain the estimated density for each forecasted observation} \item{fit}{a vector with the expected values of the predictions (the 'point forecasts')} \item{std.err}{a vector with the standard deviations of the predictions (the 'standard errors')} \item{dyf(realized.y, predict_index=NULL)}{Returns the densities of realized response variables provided in \code{realized.y}. \cr If \code{realized.y} is a matrix, then each row corresponds to a forecast observation in \code{newdata}\cr if not left empty, \code{predict.index} specifies to which observations in newdata the realized.y should apply} \item{lps(realized.y, predict_index=NULL)}{Computes the log predictive score for the response varaible provided in \code{realized.y} (cf. \code{\link{lps.bma}}) -\cr Note that the LPS equals minus the mean of the logarithmized results from \code{dyf}) } \item{plot((x, predict_index = NULL, addons = "eslz", realized.y = NULL, addons.lwd = 1.5, ...)}{the same as \code{\link{plot.pred.density}}} \item{n}{The number of equally spaced points for which the density (under \code{densities()} was computed.} \item{nmodel}{The number of best models predictive densities are based upon.} \item{call}{the call that created this \code{pred.density} object} } \details{The predictive density is a mixture density based on the \code{nmodels} best models in a \code{bma} object (cf. \code{nmodel} in \code{\link{bms}}).\cr The number of 'best models' to retain is therefore vital and should be set quite high for accuracy.} %\references{ ~put references to the literature/web site here ~ } \note{ In BMS version 0.3.0, \code{pred.density} may only cope with built-in \code{gprior}s, not with any user-defined priors. } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{predict.bma}} for simple point forecasts, \code{\link{plot.pred.density}} for plotting predictive densities, \code{\link{lps.bma}} for calculating the log predictive score independently, \code{\link{quantile.pred.density}} for extracting quantiles Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls,user.int=FALSE) #predictive densityfor two 'new' data points pd=pred.density(mm,newdata=datafls[1:2,]) #fitted values based on best models, same as predict(mm, exact=TRUE) pd$fit #plot the density for the first forecast observation plot(pd,1) # the same plot ' naked' plot(pd$densities()[[1]]) #predict density for the first forecast observation if the dep. variable is 0 pd$dyf(0,1) #predict densities for both forecasts for the realizations 0 and 0.5 pd$dyf(rbind(c(0,.5),c(0,.5))) # calc. Log Predictive Score if both forecasts are realized at 0: lps.bma(pd,c(0,0)) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} BMS/man/plotModelsize.Rd0000644000175100001440000000503112624725513014613 0ustar hornikusers\name{plotModelsize} \alias{plotModelsize} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Plot Model Size Distribution} \description{ Plots posterior and prior model size distribution } \usage{ plotModelsize(bmao, exact = FALSE, ksubset = NULL, include.legend = TRUE, do.grid = TRUE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{bmao}{ a 'bma' object (cf. \code{\link{bms}}) } \item{exact}{ if \code{TRUE}, then the posterior model distribution is based on the best models of \code{bmao} and their marginal likelihoods;\cr if \code{FALSE} (default) then the distribution is based on all encountered models and their MCMC frequencies (cf. 'Details' in \code{\link{coef.bma}}) } \item{ksubset}{ integer vector detailing for which model sizes the plot should be done } \item{include.legend}{ if \code{TRUE}, a small legend is included via the low-level command \code{\link{legend}} } \item{do.grid}{ if \code{TRUE}, a \code{\link{grid}} is added to the plot (with a simple \code{grid()}). } \item{\dots}{ parameters passed on to \code{\link{matplot}} with sensible defaults } } %\details{} \value{ As a default, \code{plotModelsize} plots the posterior model size distribution as a blue line, and the prior model distribution as a dashed red line.\cr In addition, it returns a list with the following elements: \item{mean}{The posterior expected value of model size} \item{var}{The variance of the posterior model size distribution} \item{dens}{A vector detailing the posterior model size distribution from model size \eqn{0} (the first element) to \eqn{K} (the last element)} } %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ See also \code{\link{bms}}, \code{\link{image.bma}}, \code{\link{density.bma}}, \code{\link{plotConv}} Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls,burn=1500, iter=5000, nmodel=200,mprior="fixed",mprior.size=6) #plot Nb.1 based on aggregate results postdist= plotModelsize(mm) #plot based only on 30 best models plotModelsize(mm[1:30],exact=TRUE,include.legend=FALSE) #plot based on all best models, but showing distribution only for model sizes 1 to 20 plotModelsize(mm,exact=TRUE,ksubset=1:20) # create a plot similar to plot Nb. 1 plot(postdist$dens,type="l") lines(mm$mprior.info$mp.Kdist) } \keyword{hplot} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/zlm.Rd0000644000175100001440000001027612624725513012572 0ustar hornikusers\name{zlm} \alias{zlm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Bayesian Linear Model with Zellner's g} \description{ Used to fit the Bayesian normal-conjugate linear model with Zellner's g prior and mean zero coefficient priors. Provides an object similar to the \code{\link{lm}} class. } \usage{ zlm(formula, data = NULL, subset = NULL, g = "UIP") } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ an object of class "formula" (or one that can be coerced to that class), such as a data.frame - cf. \code{\link{lm}} } \item{data}{ an optional \code{\link{data.frame}} (or one that can be coerced to that class): cf. \code{\link{lm}} } \item{subset}{ an optional vector specifying a subset of observations to be used in the fitting process.} \item{g}{ specifies the hyperparameter on Zellner's g-prior for the regression coefficients.\cr \code{g="UIP"} corresponds to \eqn{g=N}, the number of observations (default); \code{g="BRIC"} corresponds to the benchmark prior suggested by Fernandez, Ley and Steel (2001), i.e \eqn{g=max(N, K^2)}, where K is the total number of covariates;\cr \code{g="EBL"} estimates a local empirical Bayes g-parameter (as in Liang et al. (2008));\cr \code{g="hyper"} takes the 'hyper-g' prior distribution (as in Liang et al., 2008) with the default hyper-parameter \eqn{a=3}; This hyperparameter can be adjusted (between \eqn{2 } \references{ Feldkircher, M. and S. Zeugner (2009): Benchmark Priors Revisited: On Adaptive Shrinkage and the Supermodel Effect in Bayesian Model Averaging; IMF Working Paper 09-202 } %~~ Optionally other standard keywords, one per line, from file KEYWORDS in ~~ %~~ the R documentation directory ~~ \keyword{ package } \seealso{ \url{http://bms.zeugner.eu} } \examples{ data(datafls) mfls =bms(X.data=datafls,burn=1000,iter=9000,nmodel=100) info.bma(mfls) coef(mfls) coef(mfls,exact=TRUE,std.coefs=TRUE) mfls[3]$topmod image(mfls[1:20],FALSE) plotModelsize(mfls,exact=TRUE) density(mfls,"Spanish") } BMS/man/gdensity.Rd0000644000175100001440000001170012624725513013607 0ustar hornikusers\name{gdensity} \alias{gdensity} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Posterior Density of the Shrinkage Factor } \description{ Calculates the mixture marginal posterior density for the shrinkage factor (g/(1+g)) from a BMA object under the hyper-g prior and plots it } \usage{ gdensity(x, n = 512, plot = TRUE, addons = "zles", addons.lwd = 1.5, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ A bma object (see \code{\link{bms}}). } \item{n}{ The integer number of equally spaced points at which the density is to be estimated. see 'Details' below} \item{addons}{ character, defaulting to \code{"zles"}. Specifies which additional information should be added to the plot via low-level commands (see 'Details' below). } \item{plot}{ logical. If \code{TRUE} (default), the density is plotted; if \code{FALSE} then \code{gdensity} only returns the estimated posterior density without plotting. } \item{addons.lwd}{ scalar, default 1.5. Line width to be used for the low-level plotting commands specified by \code{addons}. Cf. argument \code{lwd} in \code{\link{par}}} \item{\dots}{ Additional arguments for \code{\link{plot.default}} with sensible defaults} } \details{ The function \code{gdensity} estimates and plots the posterior density for the shrinkage factor \eqn{g/(1+g)}\cr This is evidently only possible if the shrinkage factor if not fixed, i.e. if the bma object \code{x} was estimated with a hyper-g prior - cf. argument \code{g} in \code{\link{bms}}\cr The density is based only on the best models retained in the bma object \code{x}, cf. argument \code{nmodel} in \code{\link{bms}}\cr A note on argument \code{n}: The points at which the density is estimated start at \eqn{max(0,E-5*SD)}, where \eqn{E} and \eqn{SD} are the expected value and standard deviation of the shrinkage factor, respectively. For plotting the entire domain \eqn{(0,1)} use \code{xlim=c(0,1)} as an argument for \code{gdensity}. The argument \code{addons} specifies what additional information should be added to the plot(s) via the low-level commands \code{\link{lines}} and \code{\link{legend}}:\cr \code{"e"} for the posterior expected value (EV) of the shrinkage factor,\cr \code{"s"} for 2 times posterior standard deviation (SD) bounds,\cr \code{"m"} for the posterior median,\cr \code{"f"} for posterior expected values of the individual models whom the density is averaged over,\cr \code{"z"} for a zero line, \code{"l"} for including a \code{\link{legend}}\cr The following two are only possible if the bma object collected statistics on shrinkage, cf. argument \code{g.stats} in \code{\link{bms}} \code{"E"} for posterior expected value under MCMC frequencies (see argument \code{exact} in \code{\link{coef.bma}}),\cr \code{"S"} for the corresponding 2 times standard deviation bounds (MCMC),\cr Any combination of these letters will give the desired result. Use \code{addons=""} for not using any of these. } \value{ \code{gdensity} returns an object of the class \code{\link{density}} detailing the posterior mixture density of the shrinkage factor. } %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner } \note{ The computed marginal posterior density is a Bayesian Model Averaging mixture of the marginal posterior densities of the shrinkage factor under individual models. The accuracy of the result therefore depends on the number of 'best' models contained in \code{x} (cf. argument \code{nmodel} in \code{\link{bms}}). Correspondingly, the posterior EV and SD specified by \code{addons="es"} are based on 'best' model likelihoods ('exact') and are conditional on inclusion. The low-level commands enacted by the argument \code{addons} rely on colors of the \code{\link{palette}}: color 2 for \code{"e"} and \code{"s"}, color 3 for \code{"m"}, color 8 for \code{"f"}, color 4 for \code{"E"} and \code{"S"}. The default colors may be changed by a call to \code{\link{palette}}. } \seealso{ \code{\link{density.bma}} for computing coefficient densities, \code{\link{bms}} for creating bma objects, \code{\link{density}} for the general method Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls,g="hyper=UIP") gdensity(mm) # default plotting # the grey bars represent expected shrinkage factors of the individual models gdensity(mm,addons="lzfes") # #plotting the median 'm' and the posterior mean and bounds based on MCMC results: gdensity(mm,addons="zSEm",addons.lwd=2) # plot the posterior shrinkage density only for the very best model gdensity(mm[1],addons="esz") #using the calculated density for other purposes... dd=gdensity(mm,plot=FALSE) plot(dd) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{aplot} \keyword{utilities} BMS/man/plotConv.Rd0000644000175100001440000000372412624725513013574 0ustar hornikusers\name{plotConv} \alias{plotConv} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Plot Convergence of BMA Sampler } \description{ Plots the posterior model probabilites based on 1) marginal likelihoods and 2) MCMC frequencies for the best models in a 'bma' object and details the sampler's convergence by their correlation } \usage{ plotConv(bmao, include.legend = TRUE, add.grid=TRUE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{bmao}{ an object of class 'bma' - see \code{\link{bms}} } \item{include.legend}{ whether to include a \code{\link{legend}} in the plot } \item{add.grid}{ whether to include a \code{\link{grid}} in the plot } \item{\dots}{ other parameters for \code{\link{matplot}} } } \details{ A call to bms with a MCMC sampler (e.g. \code{bms(datafls,mcmc="bd",nmodel=100)} uses a Metropolis-Hastings algorithm to sample through the model space: the frequency of how often models are drawn converges to the distribution of their posterior marginal likelihoods.\cr While sampling, each 'bma' object stores the best models encountered by its sampling chain with their marginal likelihood and their MCMC frequencies.\cr \code{plotConv} compares the MCMC frequencies to marginal likelihoods, and thus visualizes how well the sampler has converged. } \note{ \code{plotConv} is also used by \code{\link{plot.bma}} } %\references{ ~put references to the literature/web site here ~ } \author{Martin Feldkircher and Stefan Zeugner} \seealso{ \code{\link{pmp.bma}} for posterior model probabilites based on the two concepts, \code{\link{bms}} for creating objects of class 'bma' Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls[,1:12],user.int=FALSE) plotConv(mm) #is similar to matplot(pmp.bma(mm),type="l") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{aplot} BMS/man/mprior-class.Rd0000644000175100001440000000443412624725513014402 0ustar hornikusers\name{mprior-class} \docType{class} \alias{mprior-class} \title{Class "mprior"} \description{ An object pertaining to a BMA model prior} \section{Objects from the Class}{ An \code{mprior} object holds descriptions and subfunctions pertaining to model priors. The BMA functions \code{\link{bms}} and post-processing functions rely on this class. \cr There are currently five model prior structures built into the BMS package, generated by the following functions (cf. the appendix of \code{vignette(BMS)}): \cr \code{mprior.uniform.init}: creates a uniform model prior object.\cr \code{mprior.fixedt.init}: creates the popular binomial model prior object with common inclusion probabilities.\cr \code{mprior.randomt.init}: creates a beta-binomial model prior object.\cr \code{mprior.pip.init}: creates a binomial model prior object that allows for defining individual prior inclusion probabilities.\cr \code{mprior.customk.init}: creates a model prior object that allows for defining a custom prior for each model parameter size.\cr The following describes the necessary slots: } \section{Slots}{ \describe{ \item{\code{mp.mode}:}{A string with a human-readable identifier of the prior.} \item{\code{mp.msize}:}{A scalar holding the prior model size} \item{\code{mp.Kdist}:}{A vector holding the prior probabilities for each parameter size, from \code{0} to \code{K}. (Not necessary for \code{\link{bms}}, but for some post-processing functions.} \item{\code{pmp(ki, molddraw, ...):}}{A sub-function returning log-prior model probability depending on \code{molddraw} (a logical/numeric indicating the positions of regressors included in the model) and model size \code{k} (equivalent to \code{sum(molddraw)}.} } } \section{Methods}{ As for now, there are no methods defined with class "mprior" in the signature. } \author{Martin Feldkircher and Stefan Zeugner} \seealso{ \code{\link{bms}} for creating \code{bma} objects. \cr Check the appendix of \code{vignette(BMS)} for a more detailed description of built-in priors.\cr Check \url{http://bms.zeugner.eu/custompriors.php} for examples. } %\examples{ %data(datafls) %mm1=bms(datafls[,1:10], g="EBL") %gg=mm1$gprior.info # is the g-prior object, augmented with some posterior statistics %} \keyword{classes} BMS/man/fullmodel.ssq.Rd0000644000175100001440000000300012624725513014543 0ustar hornikusers\name{fullmodel.ssq} \alias{fullmodel.ssq} %- Also NEED an '\alias' for EACH other topic documented here. \title{ OLS Statistics for the Full Model Including All Potential Covariates } \description{ A utility function for reference: Returns a list with R2 and sum of squares for the OLS model encompassing all potential covariates that are included in a bma object. } \usage{ fullmodel.ssq(yX.data) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{yX.data}{ a bma object (cf. \code{\link{bms}}) - alternatively a \link{data.frame} or \link{matrix} whose first column is the dependent variable} } \value{ Returns a list with some basic OLS statistics \item{R2}{The R-squared of the full model} \item{ymy}{The sum of squares of residuals of the full model} \item{ypy}{The explained sum of squares of the full model} \item{yty}{The sum of squares of the (demeaned) dependent variable} \item{Fstat}{The F-statistic of the full model} } \author{ Martin Feldkircher and Stefan Zeugner } \note{ This function is just for quick comparison; for proper OLS estimation consider \code{\link{lm}} } \seealso{ \code{\link{bms}} for creating bma objects, \code{\link{lm}} for OLS estimation Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls) fullmodel.ssq(mm) #equivalent: fullmodel.ssq(mm$X.data) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} BMS/man/lps.bma.Rd0000644000175100001440000000434612624725513013325 0ustar hornikusers\name{lps.bma} \alias{lps.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Log Predictive Score } \description{ Computes the Log Predictive Score to evaluate a forecast based on a bma object } \usage{ lps.bma(object, realized.y, newdata = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ an object of class \code{\link{pred.density}}, or class \code{bma} (cf. \code{\link{bms}}), or class \code{\link{zlm}} } \item{realized.y}{a vector with realized values of the dependent variables to be plotted in addition to the predictive density, must have its length conforming to \code{newdata}} \item{newdata}{ Needs to be provided if \code{object} is not of class \code{\link{pred.density}}: a data.frame, matrix or vector containing variables with which to predict. } } \value{ A scalar denoting the log predictive score } \details{ The log predictive score is an indicator for the likelihood of several forecasts.\cr It is defined as minus the arithmethic mean of the logarithms of the point densities for \code{realized.y} given \code{newdata}.\cr Note that in most cases is more efficient to first compute the predictive density object via a call to \code{\link{pred.density}} and only then pass the result on to \code{lps.bma}. } %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{pred.density}} for constructing predictive densities, \code{\link{bms}} for creating \code{bma} objects, \code{\link{density.bma}} for plotting coefficient densities Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls,user.int=FALSE,nmodel=100) #LPS for actual values under the used data (static forecast) lps.bma(mm, realized.y=datafls[,1] , newdata=datafls[,-1]) #the same result via predicitve.density pd=pred.density(mm, newdata=datafls[,-1]) lps.bma(pd,realized.y=datafls[,1]) # similarly for a linear model (not BMA) zz = zlm(datafls) lps.bma(zz, realized.y=datafls[,1] , newdata=datafls[,-1]) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} BMS/man/post.var.Rd0000644000175100001440000000401612624725513013537 0ustar hornikusers\name{post.var} \alias{post.var} \alias{post.pr2} \alias{deviance.bma} \alias{deviance.zlm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Posterior Variance and Deviance } \description{ Returns posterior residual variance, deviance, or pseudo R-squared, according to the chosen prior structure } \usage{ post.var(object, exact = FALSE) post.pr2(object, exact = FALSE) \method{deviance}{bma}(object, exact = FALSE, ...) \method{deviance}{zlm}(object, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ A \code{bma} object (as produced by \code{\link{bms}}) or a \code{\link{zlm}} object.} \item{exact}{ When \code{exact=FALSE}, then \code{deviance} will be based on MCMC frequencies, if \code{exact=TRUE} then it will be based on\cr analytical posterior model probabilities - cf. argument \code{exact} in \code{\link{coef.bma}}.} \item{\ldots}{further arguments passed to or from other methods } } \details{ \code{post.var}: Posterior residual variance as according to the prior definitions contained in \code{object} \cr \code{post.pr2}: A pseudo-R-squared corresponding to unity minus posterior variance over dependent variance. \cr \code{deviance.bma}: returns the \code{\link{deviance}} of a \code{bma} model as returned from \code{\link{bms}}. \cr \code{deviance.zlm}: returns the \code{\link{deviance}} of a \code{\link{zlm}} model. } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{bms}} for creating \code{bma} objects and priors, \code{\link{zlm}} object. Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls[,1:10]) deviance(mm)/nrow(datafls) # is equivalent to post.var(mm) post.pr2(mm) # is equivalent to 1 - post.var(mm) / ( var(datafls[,1])*(1-1/nrow(datafls)) ) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/c.bma.Rd0000644000175100001440000000521012624725513012740 0ustar hornikusers\name{c.bma} \alias{combine_chains} \alias{c.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Concatenate bma objects } \description{ Combines bma objects (resulting from \code{\link{bms}}). Can be used to split estimation over several machines, or combine the MCMC results obtained from different starting points. } \usage{ combine_chains(...) \method{c}{bma}(..., recursive = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{\dots}{ At least two 'bma' objects (cf. \code{\link{bms}}) } \item{recursive}{ retained for compatibility with \code{\link{c}} method } } \details{ Aggregates the information obtained from several chains. The result is a 'bma' object (cf. 'Values' in \code{\link{bms}}) that can be used just as a standard 'bma' object.\cr Note that \code{combine_chains} helps in particular to paralllelize the enumeration of the total model space: A model with \eqn{K} regressors has \eqn{2^K} potential covariate combinations: With \eqn{K} large (more than 25), this can be pretty time intensive. With the \code{\link{bms}} arguments \code{start.value} and \code{iter}, sampling can be done in steps: cf. example 'enumeration' below. } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{bms}} for creating bma objects Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) #MCMC case ############################ model1=bms(datafls,burn=1000,iter=4000,mcmc="bd",start.value=c(20,30,35)) model2=bms(datafls,burn=1500,iter=7000,mcmc="bd",start.value=c(1,10,15)) model_all=c(model1,model2) coef(model_all) plot(model_all) #splitting enumeration ######################## #standard case with 12 covariates (4096 differnt combinations): enum0=bms(datafls[,1:13],mcmc="enumerate") # now split the task: # enum1 does everything from model zero (the first model) to model 1999 enum1=bms(datafls[,1:13],mcmc="enumerate",start.value=0,iter=1999) # enum2 does models from index 2000 to the index 3000 (in total 1001 models) enum2=bms(datafls[,1:13],mcmc="enumerate",start.value=2000,iter=1000) # enum3 does models from index 3001 to the end enum3=bms(datafls[,1:13],mcmc="enumerate",start.value=3001) enum_combi=c(enum1,enum2,enum3) coef(enum_combi) coef(enum0) #both enum_combi and enum0 have exactly the same results #(one difference: enum_combi has more 'top models' (1500 instead of 500)) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/f21hyper.Rd0000644000175100001440000000415712624725513013431 0ustar hornikusers\name{f21hyper} \alias{f21hyper} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Gaussian Hypergeometric Function F(a,b,c,z)} \description{ Computes the value of a Gaussian hypergeometric function \eqn{ F(a,b,c,z) } for \eqn{-1 \leq z \leq 1} and \eqn{a,b,c \geq 0} } \usage{ f21hyper(a, b, c, z) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{a}{ The parameter \code{a} of the Gaussian hypergeometric function, must be a positive scalar here } \item{b}{ The parameter \code{b} of the Gaussian hypergeometric function, must be a positive scalar here } \item{c}{ The parameter \code{c} of the Gaussian hypergeometric function, must be a positive scalar here } \item{z}{ The parameter \code{z} of the Gaussian hypergeometric function, must be between -1 and 1 here } } \details{ The function \code{f21hyper} complements the analysis of the 'hyper-g prior' introduced by Liang et al. (2008).\cr For parameter values, compare cf. \url{http://en.wikipedia.org/wiki/Hypergeometric_function#The_series_2F1}. } \value{ The value of the Gaussian hypergeometric function \eqn{ F(a,b,c,z) } } \references{ Liang F., Paulo R., Molina G., Clyde M., Berger J.(2008): Mixtures of g-priors for Bayesian variable selection. J. Am. Statist. Assoc. 103, p. 410-423 \url{http://en.wikipedia.org/wiki/Hypergeometric_function#The_series_2F1} } \author{ Martin Feldkircher and Stefan Zeugner } \note{ This function is a simple wrapper function of sped-up code that is intended for sporadic application by the user; it is neither efficient nor general; for a more general version cf. the package '\code{hypergeo}'} \seealso{ package \code{hypergeo} for a more proficient implementation. Check \url{http://bms.zeugner.eu} for additional help.} \examples{ f21hyper(30,1,20,.8) #returns about 165.8197 f21hyper(30,10,20,0) #returns one f21hyper(10,15,20,-0.1) # returns about 0.4872972 } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/variable.names.bma.Rd0000644000175100001440000000255012624725513015411 0ustar hornikusers\name{variable.names.bma} \alias{variable.names.bma} \alias{model.frame.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Variable names and design matrix } \description{ Simple utilities retrieving variable names and design matrix from a bma object } \usage{ \method{variable.names}{bma}(object,...) \method{model.frame}{bma}(formula,...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ A \code{bma} object (as produced by \code{\link{bms}}) } \item{formula}{ A \code{bma} object (as produced by \code{\link{bms}}) } \item{\ldots}{further arguments passed to or from other methods } } \details{ All functions are \code{bma}-functions for the generic methods \code{\link{variable.names}}, \code{\link{deviance}}, and \code{\link{model.frame}}. } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{bms}} for creating bma objects Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) bma_enum=bms(datafls[1:20,1:10]) model.frame(bma_enum) # similar to bma_enum$X.data variable.names(bma_enum)[-1] # is equivalent to bma_enum$reg.names } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/image.bma.Rd0000644000175100001440000000531612624725513013607 0ustar hornikusers\name{image.bma} \alias{image.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Plot Signs of Best Models } \description{ Plots a grid with signs and inclusion of coefficients vs. posterior model probabilities for the best models in a 'bma' object: } \usage{ \method{image}{bma}(x, yprop2pip = FALSE, order.by.pip = TRUE, do.par = TRUE, do.grid = TRUE, do.axis = TRUE, cex.axis = 1, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{a list of class bma (cf. \code{\link{bms}} for further details) } \item{yprop2pip}{ if \code{yprop2pip=TRUE} then the grid lines on the vertical axis are scaled according to the coefficients' inclusion probabilites.\cr If \code{yprop2pip=FALSE} (default) then the grid lines on the vertical axis are equidistant. } \item{order.by.pip}{ with \code{order.by.pip=TRUE} (default), coefficients are sorted according to their posterior inclusion probabilites along the vertical axis. If \code{order.by.pip=FALSE} they are ordered as they were provided to \code{\link{bms}}.} \item{do.par}{ Defaults to \code{do.par=TRUE}, which adjusts \code{\link{par}()$mar} for optimal positioning. Set \code{do.par=FALSE} for customizing \code{par} yourself.} \item{do.grid}{ \code{do.grid=TRUE} (default) plots grid lines among the chart's boxes, akin to the low level command \code{\link{grid}}. \code{do.grid=FALSE} omits the grid lines.} \item{do.axis}{ \code{do.axis=TRUE} (default) plots axis tick marks and labels (cf. \code{\link{axis}}). \code{do.axis=FALSE} omits them. } \item{cex.axis}{ font size for the axes (cf. \code{\link{axis}}), defaults to 1 } \item{\dots}{ Parameters to be passed on to \code{\link{image.default}}.} } \details{ Under default settings, blue corresponds to positive sign, red to a negative sign, white to non-inclusion. } %\value{ % ~Describe the value returned %} %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner} %\note{ ~~further notes~~ %~Make other sections like Warning with \section{Warning }{....} ~ %} \seealso{ \link{coef.bma} for the coefficients in matrix form, \link{bms} for creating 'bma' objects. Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) model=bms(datafls,nmodel=200) #plot all models image(model,order.by.pip=FALSE) image(model,order.by.pip=TRUE,cex.axis=.8) #plot best 7 models, with other colors image(model[1:7],yprop2pip=TRUE,col=c("black","lightgrey")) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{hplot} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/variable.names.zlm.Rd0000644000175100001440000000323712624725513015457 0ustar hornikusers\name{variable.names.zlm} \alias{variable.names.zlm} \alias{vcov.zlm} \alias{logLik.zlm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Variable names and design matrix } \description{ Simple utilities retrieving variable names and design matrix from a bma object } \usage{ \method{variable.names}{zlm}(object,...) \method{vcov}{zlm}(object, include.const = FALSE, ...) \method{logLik}{zlm}(object, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ A \code{bma} object (as produced by \code{\link{bms}}) } \item{include.const}{ Whether the variance-covariance matrix returned by \code{vcov.zlm} should also include a line and row for the intercept (which will be NA for most priors) } \item{\ldots}{further arguments passed to or from other methods } } \details{ \code{variable.names.zlm}: method \code{\link{variable.names}} for a \code{\link{zlm}} model. \cr \code{vcov.zlm}: the posterior variance-covariance matrix of the coefficients of a \code{\link{zlm}} model - cf. \code{\link{vcov}} \cr \code{logLik.zlm}: a \code{\link{zlm}} model's log-likelihood \code{p(y|M)} according to the implementation of the respective coefficent prior \cr } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{zlm}} for creating \code{zlm} objects Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) zz=zlm(datafls) variable.names(zz) vcov(zz) logLik(zz) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line BMS/man/as.zlm.Rd0000644000175100001440000000420512624725513013167 0ustar hornikusers\name{as.zlm} \alias{as.zlm} %- Also NEED an '\alias' for EACH other topic documented here. \title{Extract a Model from a bma Object} \description{Extracts a model out of a \code{bma} object's saved models and converts it to a \code{\link{zlm}} linear model} \usage{ as.zlm(bmao, model = 1) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{bmao}{ A \code{bma} object, e.g. resulting from a call to \code{\link{bms}}} \item{model}{ The model index, in one of the following forms:\cr An integer, denoting the rank of the model (1 for best, 2 for second-best, ...)\cr A numeric or logical vector of length K describing which covariates are contained in the model\cr A hexcode character describing which covariates are contained in the model } } \details{ A bma object stores several 'best' models it encounters (cf. argument \code{nmodel} in \code{\link{bms}}). \code{as.zlm} extracts a single model and converts it to an object of class \code{\link{zlm}}, which represents a linear model estimated under Zellner's g prior.\cr The utility \code{\link{model.frame}} allows to transfrom a \code{zlm} model into an OLS model of class \code{\link{lm}}.} \value{ a list of class \code{\link{zlm}}} \author{ Stefan Zeugner } \seealso{ \code{\link{bms}} for creating \code{bma} objects, \code{\link{zlm}} for creating \code{zlm} objects, \code{\link{topmodels.bma}} and \code{\link{pmp.bma}} for displaying the topmodels in a \code{bma} object Check \url{http://bms.zeugner.eu} for additional help. } \examples{ data(datafls) mm=bms(datafls[,1:6],mcmc="enumeration") # do a small BMA chain topmodels.bma(mm)[,1:5] #display the best 5 models m2a=as.zlm(mm,4) #extract the fourth best model summary(m2a) # Bayesian Model Selection: # transform the best model into an OLS model: lm(model.frame(as.zlm(mm))) # extract the model only containing the 5th regressor m2b=as.zlm(mm,c(0,0,0,0,1)) # extract the model only containing the 5th regressor in hexcode print(bin2hex(c(0,0,0,0,1))) m2c=as.zlm(mm,"01") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} BMS/man/topmod-class.Rd0000644000175100001440000001131212624725513014365 0ustar hornikusers\name{topmod-class} \docType{class} \alias{topmod-class} \title{Class "topmod"} \description{ An updateable list keeping the best x models it encounters in any kind of model iteration } \section{Objects from the Class}{ Objects can be created by calls to \code{\link{topmod}}, or indirectly by calls to \code{\link{bms}}.\cr A 'topmod' object (as created by \code{topmod}) holds three basic vectors: \code{lik} (for the (log) likelihood of models or similar), \code{bool()} for a hexcode presentation of the model binaries (cf. \code{\link{bin2hex}}) and ncount() for the times the models have been drawn.\cr All these vectors are sorted descendantly by \code{lik}, and are of the same length. The maximum length is limited by the argument \code{nbmodels}. If \code{tmo} is a topmod object, then a call to \code{tmo$addmodel} (e.g. \code{tmo$addmodel(mylik=4,vec01=c(T,F,F,T))} updates the object \code{tmo} by a model represented by \code{vec01} (here the one including the first and fourth regressor) and the marginal (log) likelihood \code{lik} (here: 4).\cr If this model is already part of \code{tmo}, then its respective \code{ncount} entry is incremented by one; else it is inserted into a position according to the ranking of \code{lik}.\cr In addition, there is the possibility to save (the first moments of) coefficients of a model (\code{betas}) and their second moments (\code{betas2}), as well as an arbitrary vector of statistics per model (\code{fixed_vector}).\cr } \section{Slots}{ \describe{ \item{\code{.S3Class}:}{Object of class \code{"list"}, elements are: \describe{ \item{\code{addmodel}:}{function that adjusts the list of models in the 'topmod' object (see Details). \code{mylik} is the basic selection criterion (usually log likelihood), \code{vec01} is the model binary (logical or numeric) indicating which regressors are included - cf. \code{\link{topmod}} } \item{\code{lik}:}{the function \code{lik()} returns a numeric vector of the best models (log) likelihoods, in decreasing order} \item{\code{bool}:}{the function \code{bool()} returns a character vector of hexmode expressions for the model binaries (cf. \code{\link{bin2hex}}), sorted by \code{lik()} } \item{\code{ncount}:}{the function \code{ncount()} returns a numeric vector of MCMC frequencies for the best models (i.e. how often the respective model was introduced by \code{addmodel})} \item{\code{nbmodels}:}{the function \code{nbmodels()} returns the argument \code{nbmodel} to function \code{\link{topmod}} } \item{\code{nregs}:}{the function \code{nregs()} returns the argument \code{nmaxregressors} to \code{\link{bms}} } \item{\code{betas_raw}:}{ the function \code{betas_raw()} returns a vector containing the coefficients in \code{betas} (see below) without the zero entries } \item{\code{betas2_raw}:}{ the function \code{betas2_raw()} returns a vector containing the coefficient second moments in \code{betas2} (see below) without the zero entries } \item{\code{kvec_raw}:}{ the function \code{kvec_raw()} returns a vector with model sizes (integers) for the models denoted in \code{bool} } \item{\code{bool_binary}:}{the function \code{bool_binary()} returns a matrix whose columns present the models conforming to \code{lik()} in binary form } \item{\code{betas}:}{ the function \code{betas()} returns a matrix whose columns are the cofficents conforming to \code{bool_binary()} (Note that these include zero coefficents due to non-inclusion of covariates); Note: may be an empty matrix } \item{\code{betas2}:}{ the function \code{betas2()} returns a matrix similar to \code{betas()}, but with the coeffficents second moments (Note: can be empty) } \item{\code{fixed_vector}:}{the function \code{fixed_vector()} returns a matrix whose columns bear the \code{fixed_vector} statistics conforming to \code{lik()} (see Details); Note: if \code{lengthfixedvec=0} in \link{topmod} this returns an empty matrix } }} } } \section{Methods}{ \code{\link{print.topmod}} } \references{ \url{http://bms.zeugner.eu} } \author{Martin Feldkircher and Stefan Zeugner} \seealso{ \code{\link{topmod}} to create \code{topmod} objects and a more detailed description,\cr \code{\link{[.topmod}} for subselections, \code{\link{is.topmod}} to test for this class } \examples{ tm= topmod(2,4,TRUE,0) #should keep a maximum two models tm$addmodel(-2.3,c(1,1,1,1),1:4,5:8) #update with some model tm$addmodel(-2.2,c(0,1,1,1),1:3,5:7) #add another model tm$addmodel(-2.2,c(0,1,1,1),1:3,5:7) #add it again -> adjust ncount tm$addmodel(-2.5,c(1,0,0,1),1:2,5:6) #add another model #read out tm$lik() tm$ncount() tm$bool_binary() tm$betas() } \keyword{classes} BMS/man/coef.bma.Rd0000644000175100001440000001343312624725513013440 0ustar hornikusers\name{coef.bma} \alias{estimates.bma} \alias{coef.bma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Posterior Inclusion Probabilities and Coefficients from a 'bma' Object} \description{ Returns a matrix with aggregate covariate-specific Bayesian model Averaging: posterior inclusion probabilites (PIP), post. expected values and standard deviations of coefficients, as well as sign probabilites } \usage{ \method{coef}{bma}(object, exact = FALSE, order.by.pip = TRUE, include.constant = FALSE, incl.possign = TRUE, std.coefs = FALSE, condi.coef = FALSE, ...) #equivalent: estimates.bma(object, exact = FALSE, order.by.pip = TRUE, include.constant = FALSE, incl.possign = TRUE, std.coefs = FALSE, condi.coef = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ a 'bma' object (cf. \code{\link{bms}}) } \item{exact}{ if \code{exact=FALSE}, then PIPs, coefficients, etc. will be based on aggregate information from the sampling chain with posterior model distributions based on MCMC frequencies (except in case of enumeration - cf. 'Details');\cr if \code{exact=TRUE}, estimates will be based on the \code{\link[=bms]{nmodel}} best models encountered by the sampling chain, with the posterior model distribution based on their \emph{exact} marginal likelihoods - cf. 'Details' below. } \item{order.by.pip}{ \code{order.by.pip=TRUE} orders the resulting matrix according to posterior inclusion probabilites, \code{order.by.pip=FALSE} ranks them according to the original data (order of the covariates as in provided in \code{X.data} to \code{\link{bms}}), default \code{TRUE}} \item{include.constant}{ If \code{include.constant=TRUE} then the resulting matrix includes the expected value of the constant in its last row. Default \code{FALSE} } \item{incl.possign}{ If \code{incl.possign=FALSE}, then the sign probabilites column (cf. 'Values' below) is omitted from the result. Default \code{TRUE} } \item{std.coefs}{ If \code{std.coefs=TRUE} then the expected values and standard deviations are returned in standardized form, i.e. as if the original data all had mean zero and variance 1. If \code{std.coefs=FALSE} (default) then both expected values and standard deviations are returned 'as is'. } \item{condi.coef}{ If \code{condi.coef=FALSE} (default) then coefficients \eqn{\beta_i} and standard deviations are unconditional posterior expected values, as in standard model averaging; if \code{condi.coef=FALSE} then they are given as conditional on inclusion (equivalent to \eqn{\beta_i / PIP_i}). } \item{...}{ further arguments for other \code{\link{coef}} methods } } \details{ More on the argument \code{exact}: \cr In case the argument \code{exact=TRUE}, the PIPs, coefficient statistics and conditional sign probabilities are computed on the basis of the (500) best models the sampling chain encountered (cf. argument \code{nmodel} in \code{\link{bms}}). Here, the weights for Bayesian model averaging (BMA) are the posterior marginal likelihoods of these best models. \cr In case \code{exact=FALSE}, then these statistics are based on all accepted models (except burn-ins): If \code{mcmc="enumerate"} then this are simply all models of the traversed model space, with their marginal likelihoods providing the weights for BMA.\cr If, however, the bma object \code{bmao} was based on an MCMC sampler (e.g. when \code{\link{bms}} argument \code{mcmc="bd"}), then BMA statistics are computed differently: In contrast to above, the weights for BMA are MCMC frequencies, i.e. how often the respective models were encountered by the MCMC sampler. (cf. a comparison of MCMC frequencies and marginal likelihoods for the best models via the function \code{\link{pmp.bma}}). } \value{ A matrix with five columns (or four if \code{incl.possign=FALSE}) \item{Column 'PIP'}{Posterior inclusion probabilities \eqn{\sum p(\gamma|i \in \gamma, Y) / sum p(\gamma|Y) }} \item{Column 'Post Mean'}{posterior expected value of coefficients, unconditional \eqn{E(\beta|Y)=\sum p(\gamma|Y) E(\beta|\gamma,Y)}, where \eqn{E(\beta_i|\gamma,i \notin \gamma, Y)=0} if \code{condi.coef=FALSE}, or conditional on inclusion (\eqn{E(\beta|Y) / \sum p(\gamma|Y, i \in \gamma) } ) if \code{condi.coef=TRUE}} \item{Column 'Post SD'}{posterior standard deviation of coefficients, unconditional or conditional on inclusion, depending on \code{condi.coef}} \item{Column 'Cond.Pos.Sign'}{The ratio of how often the coefficients' expected values were positive conditional on inclusion. (over all visited models in case \code{exact=FALSE}, over the best models in case \code{exact=TRUE})} \item{Column 'Idx'}{the original order of covariates as the were used for sampling. (if included, the constant has index 0)} } %\references{ \url{http://bms.zeugner.eu} } \author{ Martin Feldkircher and Stefan Zeugner } %\note{ } \seealso{ \code{\link{bms}} for creating bma objects, \code{\link{pmp.bma}} for comparing MCMC frequencies and marginal likelihoods. Check \url{http://bms.zeugner.eu} for additional help.} \examples{ #sample, with keeping the best 200 models: data(datafls) mm=bms(datafls,burn=1000,iter=5000,nmodel=200) #standard BMA PIPs and coefficients from the MCMC sampling chain, based on # ...how frequently the models were drawn coef(mm) #standardized coefficients, ordered by index coef(mm,std.coefs=TRUE,order.by.pip=FALSE) #coefficients conditional on inclusion: coef(mm,condi.coef=TRUE) #same as ests=coef(mm,condi.coef=FALSE) ests[,2]/ests[,1] #PIPs, coefficients, and signs based on the best 200 models estimates.bma(mm,exact=TRUE) #... and based on the 50 best models coef(mm[1:50],exact=TRUE) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} BMS/man/summary.zlm.Rd0000644000175100001440000000371712624725513014270 0ustar hornikusers\name{summary.zlm} \alias{summary.zlm} \title{ Summarizing Linear Models under Zellner's g} \description{summary method for class "\code{zlm}"} \usage{ \method{summary}{zlm}(object, printout = TRUE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ an object of class \code{zlm}: see "Examples" below } \item{printout}{ If \code{TRUE} (default, then information is printed to console in a neat form } \item{\dots}{ further arguments passed to or from other methods} } \details{ \code{summary.zlm} prints out coefficients expected values and their standard deviations, as well as information on the gprior and the log marginal likelihood. However, it invisibly returns a list with elements as described below: } \value{ A \code{\link{list}} with the following elements \item{residuals}{ The expected value of residuals from the model} \item{coefficients}{The posterior expected values of coefficients (including the intercept) } \item{coef.sd}{Posterior standard deviations of the coefficients (the intercept SD is \code{NA}, since an improper prior was used)} \item{gprior}{The g prior as it has been submitted to \code{object}} \item{E.shrinkage}{the shrinkage factor \eqn{g/(1+g)}, respectively its posterior expected value in case of a hyper-g prior} \item{SD.shrinkage}{(Optionally) the shrinkage factor's posterior standard deviation (in case of a hyper-g prior)} \item{log.lik}{The log marginal likelihood of the model} } \author{ Stefan Zeugner } \seealso{ \code{\link{zlm}} for creating \code{zlm} objects, \code{link{summary.lm}} for a similar function on OLS models See also \url{http://bms.zeugner.eu} for additional help. } \examples{ data(datafls) #simple example foo = zlm(datafls) summary(foo) sfoo = summary(foo,printout=FALSE) print(sfoo$E.shrinkage) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} BMS/man/plot.pred.density.Rd0000644000175100001440000000537512624725513015361 0ustar hornikusers\name{plot.pred.density} \alias{plot.pred.density} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Predictive Densities for bma Objects } \description{ Plots predictive densities for conditional forecasts of class 'pred.density' } \usage{ ## S3 method for class 'pred.density': \method{plot}{pred.density}(x, predict_index = NULL, addons = "eslz", realized.y = NULL, addons.lwd = 1.5, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an object of class \code{\link{pred.density}} } \item{predict_index}{An integer vector detailing which forecasted observations (corresponding to the argument \code{newdata} in \code{\link{pred.density}}) should be plotted.\cr Or the observation names to be plotted (as in \code{rownames(newdata)}). } \item{addons}{ character, defaulting to \code{"eslz"}. Specifies which additional information should be added to the plot via low-level commands (see 'Details' below).} \item{realized.y}{A vector with realized values of the dependent variables to be plotted in addition to the predictive density, must have its length conforming to \code{predict_index} (or \code{newdata})} \item{addons.lwd}{Line width to be used for the low-level plotting commands specified by \code{addons}. Cf. argument \code{lwd} in \code{\link{par}}.} \item{\dots}{arguments to be passed on to \code{\link{plot.density}}. } } \details{ The argument \code{addons} specifies what additional information should be added to the plot(s) via the low-level commands \code{\link{lines}} and \code{\link{legend}}:\cr "e" for the posterior expected value (EV) of the prediction,\cr "s" for 2 times its posterior standard deviation ('standard errors'),\cr "z" for a zero line, "l" for including a \code{\link{legend}}\cr Any combination of these letters will give the desired result. Use \code{addons=""} for not using any of these. } %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{pred.density}} for constructing predictive densities, \code{\link{bms}} for creating \code{bma} objects, \code{\link{density.bma}} for plotting coefficient densities Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls,user.int=FALSE) #predictive density for two 'new' data points pd=pred.density(mm,newdata=datafls[1:2,]) #plot the density for the second forecast observation plot(pd,2) #plot the density with realized dep. variable, and no standard errors plot(pd, 1, realized.y=0,addons="lzeg") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{aplot} BMS/man/quantile.pred.density.Rd0000644000175100001440000000636112624725513016221 0ustar hornikusers\name{quantile.pred.density} \alias{quantile.pred.density} \alias{quantile.coef.density} \alias{quantile.density} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Extract Quantiles from 'density' Objects } \description{ Quantiles for objects of class "density", "pred.density" or "coef.density" } \usage{ \method{quantile}{pred.density}(x, probs = seq(.25,.75,.25), names = TRUE, ...) \method{quantile}{coef.density}(x, probs = seq(.25,.75,.25), names = TRUE, ...) \method{quantile}{density}(x, probs = seq(.25,.75,.25), names = TRUE, normalize = TRUE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ a object of class \code{\link{pred.density}}, \code{coef.density}, \code{\link{density}}, or a list of densities. } \item{probs}{numeric vector of probabilities with values in [0,1] - elements very close to the boundaries return \code{Inf} or \code{-Inf} } \item{names}{logical; if \code{TRUE}, the result has a \code{names} attribute, resp. a \code{rownames} and \code{colnames} attributes. Set to \code{FALSE} for speedup with many probs. } \item{normalize}{logical; if \code{TRUE} then the values in \code{x$y} are multiplied with a factor such that their integral is equal to one. } \item{\dots}{further arguments passed to or from other methods.} } \details{ The methods \code{quantile.coef.density} and \code{quantile.pred.density} both apply \code{quantile.density} to densities nested with object of class \code{coef.density} or \code{pred.density}.\cr The function \code{quantile.density} applies generically to the built-in class \code{\link{density}} (as least for versions where there is no such method in the pre-configured packages).\cr Note that \code{quantile.density} relies on trapezoidal integration in order to compute the cumulative densities necessary for the calculation of quantiles. } \value{ If \code{x} is of class \code{density} (or a list with exactly one element), a vector with quantiles.\cr If \code{x} is a \code{\link{list}} of densities with more than one element (e.g. as resulting from \code{pred.density} or \code{coef.density}), then the output is a matrix of quantiles, with each matrix row corresponding to the respective density. } %\references{ ~put references to the literature/web site here ~ } \author{ Stefan Zeugner } \seealso{ \code{\link{quantile.default}} for a comparable function, \code{\link{pred.density}} and \code{\link{density.bma}} for the BMA-specific objects. Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm = bms(datafls[1:70,], user.int=FALSE) #predict last two observations with preceding 70 obs: pmm = pred.density(mm, newdata=datafls[71:72,], plot=FALSE) #'standard error' quantiles quantile(pmm, c(.05, .95)) #Posterior density for Coefficient of "GDP60" cmm = density(mm, reg="GDP60", plot=FALSE) quantile(cmm, probs=c(.05, .95)) #application to generic density: dd1 = density(rnorm(1000)) quantile(dd1) #application to list of densities: quantile.density( list(density(rnorm(1000)), density(rnorm(1000))) ) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{utilities} BMS/man/density.bma.Rd0000644000175100001440000001513112624725513014200 0ustar hornikusers\name{density.bma} \alias{density.bma} \alias{density.zlm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Coefficient Marginal Posterior Densities } \description{ Calculates the mixture marginal posterior densities for the coefficients from a BMA object and plots them } \usage{ \method{density}{bma}(x, reg = NULL, addons = "lemsz", std.coefs = FALSE, n = 300, plot = TRUE, hnbsteps = 30, addons.lwd = 1.5, ...) \method{density}{zlm}(x, reg = NULL, addons = "lesz", std.coefs = FALSE, n = 300, plot = TRUE, hnbsteps = 30, addons.lwd = 1.5, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ A bma object (see \code{\link{bms}}) or a \code{\link{zlm}} object. } \item{reg}{ A scalar integer or character detailing which covariate's coefficient should be plotted. If \code{reg=NULL} (default), then all regressors are plotted one after the other, waiting for user interaction. } \item{addons}{ character. Specifies which additional information should be added to the plot via low-level commands (see 'Details' below). } \item{std.coefs}{ logical. If \code{TRUE} then the posterior density is estimated for standardized coefficients (representing the case where all variables have mean zero and standard deviation 1) - default is \code{FALSE}. } \item{n}{ numeric. the number of equally spaced points at which the density is to be estimated. } \item{plot}{ logical. If \code{TRUE} (default), the density is plotted; if \code{FALSE} then \code{density.bma} only returns the estimated posterior densities without plotting. } \item{hnbsteps}{ even integer, default 30. The number of numerical integration steps to be used in case of a hyper-g prior (cf. argument \code{g} in \code{\link{bms}}). Increase this number to increase accuracy.} \item{addons.lwd}{ scalar, default 1.5. Line width to be used for the low-level plotting commands specified by \code{addons}. Cf. argument \code{lwd} in \code{\link{par}}} \item{\dots}{ Additional arguments for \code{\link{plot.default}} with sensible defaults} } \details{ The argument \code{addons} specifies what additional information should be added to the plot(s) via the low-level commands \code{\link{lines}} and \code{\link{legend}}:\cr \code{"e"} for the posterior expected value (EV) of coefficients conditional on inclusion (see argument \code{exact=TRUE} in \code{\link{coef.bma}}),\cr \code{"s"} for 2 times posterior standard deviation (SD) bounds,\cr \code{"m"} for the posterior median,\cr \code{"b"} for posterior expected values of the individual models whom the density is averaged over,\cr \code{"E"} for posterior EV under MCMC frequencies (see argument \code{exact=FALSE} in \code{\link{coef.bma}}),\cr \code{"S"} for the corresponding SD bounds (MCMC),\cr \code{"p"} for plotting the Posterior Inclusion Probability above the density plot,\cr \code{"l"} for including a \code{\link{legend}}, \code{"z"} for a zero line, \code{"g"} for adding a \code{\link{grid}} Any combination of these letters will give the desired result. Use \code{addons=""} for not using any of these.\cr In case of \code{density.zlm}, only the letters \code{e}, \code{s}, \code{l}, \code{z}, and \code{g} will have an effect. } \value{ The function returns a list containing objects of the class \code{\link{density}} detailing the marginal posterior densities for each coefficient provided in \code{reg}.\cr In case of \code{density.zlm}, simple marginal posterior coefficient densities are computed, while \code{density.bma} calculates there mixtures over models according to posterior model probabilities.\cr These densities contain only the density points apart from the origin. (see 'Note' below) As long as \code{plot=TRUE}, the densities are plotted too. Note that (for \code{density.bma}) if the posterior inclusion probability of a covariate is zero, then it will not be plotted, and the returned density will be \code{list(x=numeric(n),y=numeric(n))}. } %\references{ ~put references to the literature/web site here ~ } \author{ Martin Feldkircher and Stefan Zeugner } \note{ The computed marginal posterior densities from \code{density.bma} are a Bayesian Model Averaging mixture of the marginal posterior densities of the individual models. The accuracy of the result therefore depends on the number of 'best' models contained in \code{x} (cf. argument \code{nmodel} in \code{\link{bms}}). The marginal posterior density can be interpreted as 'conditional on inclusion': If the posterior inclusion probability of a variable is smaller than one, then some of its posterior density is Dirac at zero. Therefore the integral of the returned density vector adds up to the posterior inclusion probability, i.e. the probability that the coefficient is not zero. Correspondingly, the posterior EV and SD specified by \code{addons="es"} are based on 'best' model likelihoods ('exact') and are conditional on inclusion. They correspond to the results from command \code{coef.bma(x,exact=TRUE,condi.coef=TRUE,order.by.pip=FALSE)} (cf. the example below). The low-level commands enacted by the argument \code{addons} rely on colors of the \code{\link{palette}}: color 2 for \code{"e"} and \code{"s"}, color 3 for \code{"m"}, color 8 for \code{"b"}, color 4 for \code{"E"} and \code{"S"}. The default colors may be changed by a call to \code{\link{palette}}. Up to BMS version 0.3.0, \code{density.bma} may only cope with built-in \code{gprior}s, not with any user-defined priors. } \seealso{\code{\link{quantile.coef.density}} for extracting quantiles, \code{\link{coef.bma}} for similar concepts, \code{\link{bms}} for creating bma objects Check \url{http://bms.zeugner.eu} for additional help.} \examples{ data(datafls) mm=bms(datafls) density(mm,reg="SubSahara") density(mm,reg=7,addons="lbz") density(mm,1:9) density(mm,reg=2,addons="zgSE",addons.lwd=2,std.coefs=TRUE) # plot the posterior density only for the very best model density(mm[1],reg=1,addons="esz") #using the calculated density for other purposes... dd=density(mm,reg="SubSahara") plot(dd) dd_list=density(mm,reg=1:3,plot=FALSE,n=400) plot(dd_list[[1]]) #Note that the shown density is only the part that is not zero dd=density(mm,reg="Abslat",addons="esl") pip_Abslat=sum(dd$y)*diff(dd$x)[1] #this pip and the EV conform to what is done by the follwing command coef(mm,exact=TRUE,condi.coef=TRUE)["Abslat",] } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{aplot} \keyword{utilities} BMS/man/plotComp.Rd0000644000175100001440000000506112624725513013561 0ustar hornikusers\name{plotComp} \alias{plotComp} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Compare Two or More bma Objects } \description{ Plots a comparison of posterior inclusion probabilites, coefficients or their standard deviation between various bma objects } \usage{ plotComp(..., varNr = NULL, comp = "PIP", exact = FALSE, include.legend = TRUE, add.grid = TRUE, do.par = TRUE, cex.xaxis = 0.8) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{\dots}{ one or more objects of class 'bma' to be compared. \code{plotComp} passes on any other parameters in \code{\dots} to \code{\link{matplot}}. } \item{varNr}{ optionally, covariate indices to be included in the plot, can be either integer vector or character vector - see examples } \item{comp}{ a character denoting what should be compared: \code{comp="PIP"} (default) for posterior inclusion probabilities, \code{comp="Post Mean"} for coefficients, \code{comp="Post SD"} for their standard deviations, \code{comp="Std Mean"} or standardized coefficients, or \code{comp="Std SD"} for standardized standard deviations } \item{exact}{ if \code{FALSE}, the statistics to be compared are based on aggregate bma statistics, if \code{TRUE}, they are based solely on the best models retained in the bma objects} \item{include.legend}{ whether to include a default legend in the plot (custom legends can be added with the command \code{\link{legend}}) } \item{add.grid}{ whether to add a \code{\link{grid}} to the plot } \item{do.par}{ whether to adjust \code{par("mar")} in order to fit in the tick labels on the x-axis } \item{cex.xaxis}{ font size scaling parameter for the x-axis - cf. argument \code{cex.axis} in \code{\link{par}} } } \author{ Martin Feldkircher and Stefan Zeugner } \seealso{ \code{\link{coef.bma}} for the underlying function Check \url{http://bms.zeugner.eu} for additional help.} \examples{ ## sample two simple bma objects data(datafls) mm1=bms(datafls[,1:15]) mm2=bms(datafls[,1:15]) #compare PIPs plotComp(mm1,mm2) #compare standardized coefficeitns plotComp(mm1,mm2,comp="Std Mean") #...based on the lieklihoods of best models plotComp(mm1,mm2,comp="Std Mean",exact=TRUE) #plot only PIPs for first four covariates plotComp(mm1,mm2,varNr=1:4, col=c("black","red")) #plot only coefficients for covariates 'GDP60 ' and 'LifeExp' plotComp(mm1,mm2,varNr=c("GDP60", "LifeExp"),comp="Post Mean") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{hplot} BMS/man/BMS-internal.Rd0000644000175100001440000000354612624725513014225 0ustar hornikusers\name{BMS-internal} \title{Internal BMS objects} \alias{.addup.enum} \alias{.addup.enum.wotherstats} \alias{.addup.mcmc} \alias{.addup.mcmc.wotherstats} \alias{.adjustdots} \alias{.arglist} \alias{.arglist.matchenvir} \alias{.choose.gprior} \alias{.choose.mprior} \alias{.constr.intmat} \alias{.construct.arglist} \alias{.cor.topmod} \alias{.enum_fromindex} \alias{.f21_4hyperg} \alias{.f21simple} \alias{.fixedset.mprior} \alias{.fixedset.sampler} \alias{.fls.samp} \alias{.getpolycoefs} \alias{.hexcode.binvec.convert} \alias{.iterenum} \alias{.iterenum.bone} \alias{.iterenum.KgtN} \alias{.gprior.constg.init} \alias{.gprior.eblocal.init} \alias{.gprior.hyperg.init} \alias{.mprior.customk.init} \alias{.mprior.fixedt.init} \alias{.mprior.pip.init} \alias{.mprior.randomt.init} \alias{.mprior.uniform.init} \alias{.ols.terms2} \alias{.post.beta.draws} \alias{.post.calc} \alias{.post.constant} \alias{.post.estimates} \alias{.post.topmod.bma} \alias{.post.topmod.includes} \alias{.quantile.density} \alias{.rev.jump} \alias{.starter} \alias{.top10} \alias{.topmod.as.bbetaT} \description{Internal BMS objects.} \details{These are not to be called by the user, but may come handy for programming tasks. The \code{BMS.RData} corresponding to the package (available at \url{http://bms.zeugner.eu} contains some comments inside the functions to show how they work The functions \code{.mprior.fixedt.init} and \code{.gprior.constantg.init} are templates of functions to create objects of class \code{\link{mprior-class}} and \code{\link{gprior-class}}, which may be used to customize \code{\link{bms}} and \code{\link{zlm}}. \code{.topmod.as.bbetaT} could be of use to a programmer interested in the \code{\link{topmod}} object. \code{.ols.terms2} provides the basic OLS results on which this BMA routine is based. } \keyword{internal}