jomo/0000755000176200001440000000000014416467232011227 5ustar liggesusersjomo/NAMESPACE0000644000176200001440000000163614410321051012432 0ustar liggesusersexport(jomo.smc, jomo.smc.MCMCchain, jomo.clmm, jomo.clmm.MCMCchain, jomo.polr, jomo.polr.MCMCchain, jomo.coxph.MCMCchain, jomo.coxph, jomo.glm.MCMCchain, jomo.glm, jomo.glmer.MCMCchain, jomo.glmer, jomo.lm.MCMCchain, jomo.lm, jomo.lmer.MCMCchain,jomo.lmer, jomo.MCMCchain,jomo,jomo1.MCMCchain, jomo1, jomo1cat.MCMCchain,jomo1con.MCMCchain,jomo1mix.MCMCchain, jomo1ran.MCMCchain, jomo1rancat.MCMCchain, jomo1rancathr.MCMCchain, jomo1rancathr, jomo1rancon.MCMCchain, jomo1ranconhr.MCMCchain, jomo1ranconhr, jomo1con,jomo1cat,jomo1mix,jomo1rancon,jomo1rancat,jomo1ranmix, jomo1ran, jomo1ranmixhr.MCMCchain, jomo1ranmixhr, jomo1ranmix.MCMCchain, jomo2.MCMCchain, jomo2, jomo2com.MCMCchain, jomo2com, jomo2hr.MCMCchain, jomo2hr) useDynLib(jomo, .registration = TRUE) importFrom("graphics", "par", "plot.new", "plot.window", "rect", "text") importFrom("tibble", "is_tibble") import(stats) import(lme4) import(survival) import(MASS)jomo/data/0000755000176200001440000000000014416212532012127 5ustar liggesusersjomo/data/surdata.RData0000644000176200001440000002006614410253602014510 0ustar liggesusersśy)@ owH!)B)Cʑ BH R!H҈4!H s+ |AڐvD"]HC'?A O?A 7'?A O'?A O'?A O'?A O"'?A O'?A O@'?A O'?A '?A O'?A O'?A O'?A OⅠ'?A O'?A OO'?A O'?ه'?A O'?A O'?A O'?A O'?A O'?A O'?A O'?A O'?A O'?A O'?A O'?A O'7?3ab+$xVOh)3A1]#%n(X}{x#zXƁ7--Au鎵a`)#[˝].,Ẳx^4ѓE.^{q2N d7ks = qAԧV`ժ۬3vZ)*DZuV΍-YEV^u0.6Ҩu~Tkfqk[Mݱi`>Yoh5tžBA^RL(K΄)ǣx^UoAZ tYU UMI1e=6kj,ڦ~sÉ#;6.0au\cW:ϻW`ANq/V@'0+G5;RDܯ|ͽq-͠ΔF1/mn7ՌJ#нx4WowŎ< d g^@zv[0թ'.e3!ov#E6`!Xnn;VN_R.F7 8@ɕ.l;`>ɸar 9&Y0Έ~sE~`e֒sUф-[@oB`.pBfP;q Loik45}y⋚@*a `6j_#XV2ַ9׺eCvþ% Sa6-qMYފ>Y^yY ſLfy~g?,h9hV,Km|vNq&UcܒZ'vվB˛ 9`uqᝋc^q!Sd ('|}fm~S 2Y kebƦ;j4r(nw;Pq`]t^2~wu/ l_Q0٫/@P%`4Ӯ/l C 0xl]y0#_B0Ȼd{nw iCr)6J9voZ|DLG؄`~23AesTX v[B 1MWЫwBwف<~<^.qvFUf[Bu;HO?VwI&7O=)+SЮ;~ˠ-ޥ`$ݏA٪CwX,H>c)]c'װ]\6 ܏)3cT jt7HO4 VaeV/U٫@rE#3/E2ӘG0Ӭ'_d>{Ƅ٠\׳~\e_?l;ju:lk1ўsOGQ$>9V;H˩2Kك?P>N) TyUWEŊR) m7)VzMx'UgM!<}VLoQuFLy[^wkKsug{u]-pSj2qGwȘw\>eZ1OybYyAb 0-b#; sc6t-g_Oe^'zn+'4!`ݾ\X *{s2`m]2xl7? '![>/\k`\ '[5p.HJ}Fj`&|6̫WwI8s5,۞Ew}6/O[ؔj })>"ێb~y;F?fdžДpfp#?x JX$' sJԕzS; (΋Tֆ ̓C&ߙ!ŅǒGNu:7U +4&x> =}KY-PT\NDm4kOS:/) 46rS;9t. Uӣ@a-0|^]x[I&8Ԧ} ZAYs?xy=,^:14=3O<Ɵ D,:# #zNr#`0{XUPo)cƳq ]a`! \r"ToKa2uh\`rYB0V`s\a\52:X3]˜ AqV.)9ǂ{h:hXo A3{WAzFL9X~u7h.bAό@ 'i&doYFCPo̧&n? _$ ո$<#$s$[ةEヮqbyBө0tN1@csnVٞ3\̔۱ Mc}NpuGǦsQגMS~̞Q@{+06؜\yCt4 5xęp~pqw8_|3z(f*~'8 dK-xR_eR0{Y8M7GOF[eDkA^sɛ2ic`73eCaL k]r,[˖=] \Ÿ^29 }:Y/tZaX<-e^<DcG' K-b ,p]k<_[&0QY{V;3h7>j dy, .*g~SMRJ2ڮWMo9p]bW&צyӃyoGw4=]̈bN5,58{A&kԊ8~o?8O0)n ڂ u}$u<6JX?_ hn4< |r'_ C.|{Oz6+o?G+:_wj_g_??P(Wuj;|vq>ԋ_vq*>7u}:v8?NC(gz-+ոQӿ^ ~rStݫLՋv3iXVN}Jr_8~kUq*_qo-wa<ʍ8t{R?]2[ĸ`wZ<pG&աz%vWREyH*OY~|軱SvS+FѝMyV3ʚ]RoEs>J媟Dy>yw7p8+}.Pʲ?:JS^tčr/er0WZv~vXC*şJBa{Ļ!'KXZNө*"dj12Ԕ\^n6}k.WGgEP9#'.>:d/zbjUC7MS9e#JK>ˎlsu/v0ZNbɢ>w0Tt_S bAusoR#>lmvT~TU^Bu_jo;:sNg'nF#9\W[ΦJw_?9#^sWLd5罧ZSMl\BSy¨ܦs7B></ &.7y+Aw=+*8_krU,fQ /<CY6&gO8n`QPDWnF*kOv+ҽ135.f~|%#z(̪C7K3Ũi}Nԓfs RܑPg]YHhNtYXΊ(Od-w<ũ 6]a<,1wuȀu֢3#y2*SLf{C?,~A,Nu@^%*wPj(N>`y)3nDR8*w4"  kYGЙƏ/kfAQ_Jm9 >ׯ?г92O 3sQ5DN΄n=]dt*Ұ&QgM~hF^*IGuQyt\[l+fU~"tNmDqm>X9Yl0%G3t)jp/\g h~DF-ҵm붕l|FJ5tȦR0`f9V~`@>5KyZ~m@~Ŋ5ޟtyύOӍ#rWY*^J:1zU;+q!mE7fkm<igPGXTʦLҮ!)P>=wT3kjv::jYʰنM#f(F=٫~|#~۳˪pJ|0kMxROvc(3*/_V4N6vnP~9E^=^k P<\!.5U6Ey|?~cf{ZvF)>wc?~Jx~u2}م24ZLhQ>VG\i4k]9YtǗY6=rw%Φi.)qvCzְU8^2a@p꩞~>e؀t{`gBFy[At~.TH=a!!TR̓툈+t;{=iFW[~қN|+lB}*m|z*NQ<]@o0Q-)7rt/j5~ǟXL4p:}몱z?RЄPȢ(M}\xQ_Ȍ;eiV6^Ixx~5emN=0f2u Ak|yJ7'_o'Y| _[xo]"Kw,G\_/3S \D?jomo/data/tldata.RData0000644000176200001440000267465414410253602014342 0ustar liggesusersy4U?ʘJB);M!RI IH&J*$ !BDkT"dyykjes9i{.Ce.C.D!Q)TD#h$N_q$U}wHC(pkwwHPd.$ZҦ}/H1h #:ґq^t LtҪm }?fAEs ~\D"_s6GvfBlAAM?vsSZ<rs]bkW#y_>/-TnCGݺʹs Yp䍽1C0fxꕙCd,dܑZdomsS_ILe@1YCn>Y$sW6G#Hw.<$,e\\yϭi͆"K>LIc ZdNvZ~rE+\k=+C[IwCŝ9  r ln2^?S!!K5$Ji! >S+-L@X4}"Ǵ GZAq rZpo&!GI1{$;v< Lܩ_;&qO_ַ<ʃ kRsO ZB2QeO,|vM/8ܝ_K'ҙn;L"z&xOY\~7]{}w*{LIBBrIN!$/w>TtNR4>У U4^D;c-GnwE}GuR rO( !{Q6{!v?jθ- x$ٟY_0 pnFjw\>c%#U~3?,77oRn Y:P U@aL{dr9[ ޝBi~Ɲ .|)KMc 4ȯ(_$m/cӫȼh;2=8A~g/G}YwWw'P5JAm0bJ.AO+ef8]@jaFt|~vdJ#NJZKIq/ * 1֒ȩNXS-4))!WoA.,B*䬗BҊsslqÞRs(uGmEaj.d8=7rI})1GSSDgRߝ]s[>tC=_^C㲿y%]C{E}[9ZOC-m*_Pe7z 0Lw;:󤸤r!Wv&e= O׽f"edETĦ4^ܟKﳣ} 0*.;x*ڐG)\y\m 0qCJiɧYsueۅ\΃!qy(Lqύ#ezM}[] )E?*_W҅i t" [^z眂eTHsRG]B;$e c :~FW&6j0y3—W<5<. GN)m\(0$#o |r"ݘiu7CwF~)[9!u]'vlNCKPo2G096#ȁ3#_}Cl"Hߨ7p (ֈ]CmK\9UBuXݻ>:fͿ>HE՜^0 $lc>{A "$o`E? ]]."vl2 Iߘj3wP{9z%֣xՇy0@,1`~΁v1ӵ0n`̜[@q0}[\7&Bό!5(6s"]+a N2NF&m~uK5WOgpdeb痻3FLwI(Do{j=[% _luR0wW6q16I7Î#% c70oޚD˭CE |ϹywꜾcO_7g2̸,1umM\ 3v+"rz#]$"ʗw3ağt >"q[vie:T-Kl_u'#)9yqqŧw̤8!Һyݬ_xNsr1YRujKNX﹟!{}.2 33{r#șUaRZv.mZm1ei`Vxq'h{(w֥2,剷*JD;N_d.$O%0rL&R+RbHZ( ܷrfS?n!9u3M z:n~ݐ3埪rn Oo1| )U6mBus:{D|Τ{-BI'OlAN Q;IiNjtk%wx@#pv(۸~rԮdSVF#&0%u#0=yvB )r ~)(]﨏/'2#deSibRug[zoy(%{P~WƏ/{!ՙ[ xWB/]U t?>p>vޭ ߥ~ճ-"L B[BpvGZ8_HFΰMC\-}k5`:ȯby/.ׯFfVSnŨNP$RGu*.Cλazazq}.>})?Z:ZӐv[{#r 0>+L?+@Jrc|r}w@b_>~ Jز.2 jpZA&69s&`3O4>uQGk=slGn3@"])SIz>ǒ6݇jJ 'aҗ.wk@a;Uϋl_lhd=G ĤY Gn?}M$}\׊ L&']FC.n mȻPҷ?:-~45x$I9{ )$Uf835F. 6zg!R2xl5(p;`/vP_ f׏x<\[b7OtlŸqSa7/YCUDzWV\o8N4NyyKWv1CI<%|AHSraFmc/Hn k##AW{M,e:]2Y-Dބ%%uמG.#֓ꯌF%o@Fjm$o\{-F'r^ՔeH a,%ݿң>|(r&{)ua%Cy@ޟ[>% K 80\]B0}Ң9߂AZL c}ٷ0Sܻ_{&|sS CWKnd~fVn ˦P*X|9qL,;~HCr=ȕt?:J:E2"A@xl w3'$~L>RG^݈w!ggK?m8a]9n2fÿd}3$L =|9G|+R t l9Mʽ )+/';j4T<56 fme0j-{!&I׾Z uؒY::y)R/lGA~H)3:50hx j*1^y"=z |ޛ&Jrm~$3ל .^ GCq.=/Zv8 ^gN\ԥTъi$ =O% _"W,4s!c-͑-OL $ϿUHέZ9KX#'p|7fmC,UE3::җ-\v~'U#;_N )o^k\+&.XFjd=YfΘ)@ǧΠoŕR h g "{Z?K _sFk &L;z%g+L#E l9k1wķB!uOI {toHOt4f;:{Uk̏s_sq]\/UêS=XP*(187n(䌕rG^;#lu\z7[5o߁S8KggQtr ŝwa WtFi4^E~j䎙E_./Qx=M&^o`ϓ8 ZjZ#6kJ ,ؙx yn/8#ַ6=v]y$' {mGМ'yAjqF/b*}&#:oB޿ߜX7ÞHZm4ʟp :bߦ孧O[RUoagR{2auȭ'U{_F=mq|ƣ܆x`R\wrǏ;:z{ٍ!L$w4rU- Śs&`u):_/Pw)f!*F43)9ZQZ/{=tXѷs85jՑ!`h*.rrj`[LmNy r'㵐vr, /TaeJK >;Bk#r׸a(}9KcUq0p!W GnC4~VL~ cg7 Lv|L8Y[ e\rjLz- R<EJQ§ :3R-.d,iJVEbrC (ILW?;ьg:4_EJ({fŦ8{*z;rH cNI~\ML4~Xk,}O))<d߆73iiY?gS#t}&:`M*z,J_B[{C?/mAzԝ~bI AǶ'z>C`nnm0bp>vtX r^yNO?)J]d`\}ςS-pGzɵFIH<\'bYQнknp,λ"k R㶩t[ϡжK Y^_wvͷ=VߡUW)4~7nfөR_WVa}VwOAښ{z]sU@L|{?j|` #0e$ax,.[8 I a7Sеwcg9] R7ybŇrNi%7Bst\UJrY)O*Uڟ0МYXceIs~?x\'\ D^QlkIޠмzUVz7ah/fG3jR|sAeARqA9yfyG";[ WouP~u}'x) 8! )]rOT}^|p?F;\a65.+ _-b mbBȔ]Ip t֙iG`G7a 0S!OZI|$a}ijlj+f]r[=E~X:=F^CO?Eڷwc."]9Źhv=uG.VR:kGޓ^lde恁uH)r5ƃ>-AS{63݇T[ΥݧŁAlׇ`6j 4[/E7yH<3uSڐl13py5h_"N0l]ĺJ"Uˬ[_ A)gv#϶+1'.ܵ&h'$IQA>ݠ;mat 9Dj-KAlp>jʁK\"`כϐZ:┑>Re8pBf6wt^YW/k.8Cȫ2w=w8rZR 7k%Y`ZIdj |_ia- m 2+ybj[d *wj. N..b+gRO!,iQF"5In-7OhzF2zT$UN Sd.xgށᾴ0{bѻLɀ ᖼ#Ҷ$z@̛JQ|^$7!d XV…0}ƫR*\ԐS+5Tqڠdfx3*7)rNH59ZᏔƩHG[.}d!0}l0);@7:U>vz"x\J"GGt~V`YF)?pnѡ$|y!?vދ#Pi+HiW9v/R)Nӏ˾i5caB`'0y2 Zp9hBB9 'bi*F\-fͿ iÌ5H+2Br%‰qׯ4M~HZp2^Ÿ{KPuޥ>HZ3)Zgljx'I?6}G]ɿ П} )N+%I||-SwP7p .GmBamb :o?iE&pKS``mH5^$k6إc^0K3Z:lW.EF+G3Dw'5_CŋwYEv`*؏E?9^$ Mﯪ(G8"ҙ$ z)<x!yy{9y]:?>H.;dBݏ';msw\K6R3x< sl}< i },3_BdއJ(K}K3Apc#r|3V\Cócp/)3՟;R97݆&֗\J2_;&ـtGG2Q=d<ɖXKJ`q0@^*LzΤ}G:ˠ˥m&w  /6q_5pI4e_%Eb:cEq#R2r{6F"OdDBO5Ĝ@~nR* L)rز hWN7T ^->h;+!t%CB]ܾ,ǬCz߃0h(CQr^,\tԇ.o7 s NurHt\َSrXML9%a0B=!Zc.= SLm1FOqNd>,]>7}x݉;Pp #0bX}ƻlBPOoOt26Lw/UρWe?KTHȹGJuzk TȘ8xoWCR^ڨض=0le2rٌf[K0vˊ +Kf0 [U!CKHZ:s}IN6nd뽚oG5u-*Rߍ9IC.2ݼr>Y|r ~[\eM48l/Կ&ջՌze3g6W~"tWzyЖ%qti6U[! XVƓFjԮllETfyA]*rEkW E }ܒ㝈oT '4(X2&u"d{$Rn)%;+~4 C02gͳi֘wq>'^d^= Xz!}ڞusksY45cG.tL I~k?!=F"3ep@FT{}lڥq-NvH}pϓホp}Wˉ}(ύZf Q9XhAPF`l7z^jhw WrW%`,]pgLUAmtҬ<¶B ƥ7sZ7w3IOWFt`ۯ՚U:PsZke=aہAztK#fq w$,F١4VU7GӖݿp 6)ƀH;|]2yc/a:Bk%|ñ~0lpGG2JIE0sg/gԔ+!W[u0*g+1]O'"-Wm8CV|C*ϲT Nb{}rD{aKsz袒_C/[kpD"ٲ&+v~yyߙFbHr@ƭH>*( Tꭳ{XUeüX,kl.Z]fwcKxIcC(L ZN{kRۮe;Ŷӌ, {kooFnfq $t| mrJX)mRS0-z;sq0_{\[z~IވߓQDwuO\)ڭ f I \vN^fq;ҋ7.qOfI.+-m+0W0Z:?g0Vbԧ`:6su"ڰRC0[ޔ.)W`$,)#C>M3FG5_;#0rs4LiM(C&[?O1-`4%;"JxG\Lk7Gk}0F(zEӯ#]%H~qol #û yظ}krQ`+ Qykj.!99*.8RuxkW_un WwFPNĥf譱πU9:4XDIK-$z=K\_Kr`ZGƺ^֕0BJ:|;0C'~OJNh#C᪟Sl-_Н2=Vg-n)Caf6'-iY{ɊSa:\nK#3bVSPZɖk}:bxN ? `vKcqG?l)[0!p1׭ϡ6 յz0cq^/@i9\C˕O?uʼ}*LoJ:0kTdDܦ'0,Fq)̆\JmG]-WMEO*ܮ}oC7!~392 ѯ}AZ{i0rDl(X׶N}CoE}Jh9 I,X܀[9=1&f?_ye)LvoA)rЄIʞHg-1&L 7Lks{0 \Z8SGN:{ДТ@8*k:*[>fC{LJN`@rr- ]N }ilŸ( |28=kd5#wm>ҝg=v0&f7Ɯߺhf]_<qW{"gH-Huh2/hAؔێSt+,6$]Jj0R}:d]j o0yeFKW)`t2ۚ"hpn:M#4ھ<хLڕ B1$syd˜lfS` \L BiBէ$3kR~(d_E#Mꟓ4R~G7"W:H&:EgBw_a UBN=G5RR~~Rܕ^iC*7ΝE2\\Zi=#e\EDN10e$2%B)6RfaRhrzyBMmzZ]qH[Y:0kt3m񾟩;Vi$!sfE& h8ܔ Y5$r9qU YF:<д1z 葼j)(1[|`Xد[n,N.r_:|{QZfn 2gla8w'iX1m"◺7.ij>6b+@WR>)z>/ EV0a²?1}?R7Xoԏ8if= յ@!7>&]u9̪Wm\oh0!P0爔dn!F=}{4GmBZaA͛k`!'fHٶn'$KWD= s`}fxBc7N"mD-ɬ!)qs0n OU5zBֶh_G#/BνreLdG!OcGo~7V>S)D)_۳"px+>JABnM5T^CzisLwNi@zG+`)g5΀v!)Ģӟ}݆̣dRai4pf]ewvj!9.z.zS4 N4LC/ޭj-D>Ir+P%HZrsaH EAm ar"?-T@\D"{w痺;I~LIzpn<& V\· };xv4X?vanQwhJ/'}RS9zaOd@XqaȘŔ uľ%/S)$wAS[_s|Y& E %\u+˄N.@h8!j - YH&/)#V{ ܯAS)\µ2t(&*^R(9 L'VAr7h1АVSǃErd%ljͥf~u07O5}0V(_cSw9$0y‹u)3۟s9|_SA&\oI:|Ϥj7,C7,^/}vy@'i2}ioҏ.z V]Pv%S!;[\t;lǃ?2V"ǧofxdBc6=Y6K6ڻe7")ڎi{2iYۍaDE]7F D nC$̻D>!գ.6*q3Ksi5򐖫h+l3NM= \0~ըVY?dTniA8\}Ơ[N^_9mZ}0hQ0U^XŶ{|HY:jͮA붝t5ՆH6O%Q>[`|r5h@B>zs972/pY+H׿[6Ԣ>Ut[Ch2YLCU#1HʑrGɑk+qK . w0RoDևo3;a6& }~ӔK! 鿳F *0^ix oX$ M$iuUr/U{9CarOe_`dۥ#IG^հy0vS$Ζ'/{#U cKUmEa.'ԵKŢVn^Nݻ90,͟SI1{CWyd٘ 9VyBݯف 60v ϛnG#Ǘ jWv~W.J bt-t>P{?*D[7~>;%W4~{WoJM#YO^A0MFU8AmfMAzdEga5 6M?}kLdrKC9daQeK>=D6\9uvi$F;ӽ!|SwS6 ɏ4ڼ៽M>R\ųXo~yl g sH ێ*}+1f[&}fU+'Wv$VtlW9Z _udT&H0J6 +H2(x{3 s7/4(GXDbE%3=x!d\YvV>^uHJEa1OsQ"qgjl5SѺk(mU CS]+ՈmH2ge"`b)1֛vŝݑ٬ڋbb3:Ś:4&:|O&qecݲ1*47Ɨ20!/G(> j- Y!نq.%ÄՒklUw,%O}O_R #qH\ OM?ԅC|Svc9#CELF׹O D΄ 횠g/n0cEޅA~itfJdm-OU>[ͻD*eI e>l[@WrHp#B4uV.lpݚHO8yN?;zzkk_M=_K ֋O5 F^` lɫӑ`"?Sv5~>Rg8H_~+r//|^[`UpDa)na 0x((f`g$$)r ~R(CIn*&7GsIz sBKʮuxf(mW1#Za\?BzWJ{/6{Hz@AUz:ڗ vI MМfQmF{7=ʊ{&~ɩ QϛU=;np`›*&0vф#$=q.7.:H%6M[M^:vX>~L~]R^9} =1suaNuN!rE/[-bhoO%|S:\% ٲhl>g?vj^}b,!٢_(WBn9hiiM7]W617#U0M}ǢFɧWg_3-9[J'X}._<X- I{`0?GW#MK R,mJM铙[ԍ ߰[>fc㑻(Շ $OG!+3 o0ty;svh،.0TG2mowߴm_wa52ק%۞Se?]4aq-[eyB#QH".bſߞC6=w)$daGk)R.#H9ʻ:HewfrikąE*g2`03@a+ 934}Psl12L4mD8[Egр9r߉ۢ|~ n2|4L%E.wl{F<6긬HeCmr x.^|=mDQyµ0ݺGZcFo,[i0XTǨK߃u caU0Q肢?_.9nH[ ^4ht:)v+7V<`W6N5(ЄL^ΕH5ͬu"KD/j׃3թab pJ7?ZiY[seOy\w##Oʢ9И8ssO>* !#ϳu 991Pԙu9?}>>x@Қ5 ]v =88|fV:sIarxx;X/eۭ|iG*A`nL CQVGlii0U~X0>FV~Sf{=l<+7EaKX֗Z!3[ySoYzU -{Raֳ"{04ފsq0#{<ݳ7@^}#gӐ$4g 5wT,1[+֖ڮV{s]RmЌF@]9P7V}q/1.i`*>0hPTFn1- 5Ig$*?QS#"}yʣeȽe,m 07OVmqRз>h  ^ G,R 3 Jsy`(Ijt'ۖ>)6DAVw/)//*7&à?b?b绘?53 ,c<ϼ_1QKZLG~n}~XʖLL>vvׇwL0y-ؾrV0b-0=i-0/~[poDRV¸A|"V}б-ҏi"Iϱ7IY61{n?7%A߼:67t{31So5k3r=(ɼD#CR"}W oG.ӫ(@>ɅgQqH'w: uͧow4|LiգT\د0OR< ]+G] 0(vyh3S;,cT{fՆ̇Y1MfψX 0+Za.c D87!`pVv\( χZњ{GA)k8}Q+aT/ 8rމD; BiQG?߹r;ԝ~vTvh /tsaZ&ѽ'b:XO W:A{k5Y;&p*F?tby$}Q.A{t ]߶К%TX6ݻ^VRp[ OU=[IB5ɿsÓӑk#ab}π/K~_ADcCE[hnw16^f}a<:!tōwaP{X&y$>H"5QIḂ5.MH?rqdԼF5$Ye/AZf[ȶb rүڵR=r8wVR˰;;y&sƳl>׍ =wtvеu?Qݾ˲b M6 u'co(8 EW*BT6wA٢UH2ONi9e0r?G.*Xzu } :n]z?2l>|{BXd uR+5ǛlUƿu [ T1R3ːN2oV;m*Dȃ!o6h[}`3\J\KE}M7hQ *ZN˹@4iZ(ԉK\1J&_#1 J$uLIj!i RFnGm ;] yU6̙Gu+{'Oo !aa5[ cbtdF`Dq Yz"eycG8$p T]J.>~#b2~.t헼V$s -IفHlX߄f?`S5-ZqVm~5}^ ă~I&NiO_`Q#ȕŭD~%ڕo 7~gLLg9@E R,w Iq-ŐG91@b. uzQr_Dв?Om<0*^wQ82%Ҥd/FNe{9 3fqo0&O@:ꪦKG |a 묒T+[Ug/.ƪ\t؟-ݟ :M|i8LHSl>.`㚈KHgN ^Zߎ#&tS}.@^J/%&(˅^nRw6Y {N uw'ۑy/1ˋH2{=y)eJHJ([%l7 Ƿ5#)Ęζ87̹|)Զx M09 *nUAӟ gس'8r./ގ4*Gb[&3h& %Fa6(=u%1G|2B&ɞ4-Zl|eDHת"WΣ ?$'퓵y̮k J a$C0-LI4wCrߖe0~=${qEs]m F>*Fٔ27M(\ü8k.N!5?@P}8^^ÌfQ$ =lʈʝ@:d&KǦ?Y3sD n^gOr{7'0=buW_Aƒ~?sag֪!\ Pp f`b|r2i|r<//N1ҋD_gɯxr^./ƽWڷO-B@EdFVÔEU YՋBn_UEJp;.?-t ώIӖk m|ȼti=ݵ<)5B7 캞soǔv?%?iѯOl=5Dw-<>0g|p!DŽ;2NǙ$/| +xtQPߥ{05>7FV x#}ĨrpO6d. 5؛ӻQHY&/}\ 6KU1oW2HxC uǗA^{C!ϕΝ̅>G^'>24yz}3h-J?QB\)g Ä}Cv4R 9</"/EV094ߟB~w(0xE[8ѩ\;4_(T0I9?N8o4}"H[yZd,ML'³y8a*'"LK˚hFڇUa>Q@쯓du3I桽w=h,p!M>gn׼O,c֩^͖Ƶ-]ЮH$Mߋmo ʳ)\sV:mUէ_nbtaDlMD|2s`m̉$-[iHW1Kԯ-b~z*)0ODpRwP5{qNiϜN}>IJ?㠿+ˮps["n^ҚY;#דX>Nly[>v)wVoR"2/~ \ B(fKwʾ&0դuv {[z Dٚ˶H2 "k u**$#$(sji(̺JB 6hYR,Mك#ϊo%xʎkA旉g+ik4d:uF &_Y4_[]"nS7< lyA(^ϧ; ƍwx#BV`mY{xA$OUڱNj"Hٜ &#2-a0,Qo&3t ZH&D*vJDiroR`rSZOb)HWTc7, ꘓtL;y G?QGcЧ 06e)|1LS!Suɻ*["Ǟ߁`Fy-=iAC8Ysm0jdϷ6>i;U4^Cr0D~Y|[m. vtlnq0+esuapͼx{tJbZr>`c_OcԀdНR##U'Ivq&[;=%ﻞVz( *a`#rkΉS N'Rҡa.8֒E)Ns7m3,K&-!9PVˆ]f;hY{g:Uj{ ֬7)V.;.P^%(( $gYCY5eNL*}b=j~&GYݱ0A5Q؟zmmre76f]Voy &~ZX"⵭\jFUHD25D˖gދˆԀ`!d^M?;o"ib54K?a +8W;W SR2uБ&Umv#YSO !Ui OwK޲Hz8p.8kabhHzt:(t8I %}._즃`&BJz. &ʋc!jQb NCONF/5FzDKau5_\'m\HK .RF#Rԟ_dZz<럡MB?N.2{ظ+FӔѲ0vC^OCsh:h+ZrF t_ci8+;Șqi va?;%0[b[j{ ^lyʾ,<o/X˯-Heܻ?'ń/DZniMwARccS~~rj$kVk!W5S+oy#LJA𣛑y(S8S;_.o=+HV34VbFם9K> 2MCc2&NPӖ[cL}o&IV5N~Y w%H( sx3}o`hfmO[$_pU? ?Y`1\ Gɵ繜H?zzZI1f>8A}}럹mukrM0+v[vE]umx\ W,OBP@eerWn) LG浜f 8UXּQWB_N+ ΏD.ߧ높]$Y)r) d|Rg_`|%C`zQUk"aF_8gm7 uBwsr%d\:Yd'z76u5<5_.`Y9Nx0SutL)Z}HgRS@+/S}A  =d@cuQx~=a۫BFy,[/MRƧ!m"Cϗm7~K O;ȅzz񖐕k3I$wo\#٫, ӧ @˃0%ٕf,`>&t=[``:H$I{VCjy@ͦ|"ބ '/Ьlt MEGY@%hWA5r6A֜XX Zنtvv:v2̴2`N},4;_r.7M>¾>w$?q*gk6Bp2' ɾ=?ɭFcFȬ;rQsrF{)H|;Z_* &ཽΙ:"G}L1oxa^¯u z/yժHqjWO)5ߣ|#ﭞ3'Bry\3( `"2ƶ7A-Jkֹ:i{| ּњiʳHl܊d#soJ 9Sv0Zp <:jܢ 4M#wu{i*r3 #N:F!6eqOm^c8ozH;F)Be/zHwšOwc(7yx ' ag['8*b^:ckunGJdz3BAJ-r 5EcIa Cަ?3ڑ7@rEIP'Tl)A'K忛J!mHIޏz }B" si2B6E\8%c=Λ ރlwhXv%WI3HgYW`RlR`xv8@i_:̤Im"O zI;H':) ှ#Bw$]|ʲ#5Wǿ9C@#zRCT"tk}V{|=`;t345\*3U{gB0>#7/^6ބ+t寰:m#y6> eR)MU3}ZRZ?K b(ɪ2.3f3:#y]{X/l.'AˣJ됒'&Ru.>ie{]<|OI0};nD+hVe+ ?6>]`ڟ9\(Vݲ̂v\`\Nmb2ۑ}2OxzBrbV!iRtu-R߱ Avmh=lP- sJLLxzZ߭?! 8SgS\^d$6BԷ&QUX18=✠(7ʗ!9UGM@qib"s<ʑ<3L VDiXcS %PbaUmڸ-[Ml"%+m`4gqg|k6Wy iy.lma+B^,tܾαw5o"CԨCfV]z䞈JduHwd]ʗJ0uxf IYtO>*87a Rr,Ԡmy F\ۛlI/[BXVl&&g1wÌO89:Af1<7XGԟ-7eaօHux,]oiT"v+x BǾFp.-P>#{R`iVCUZ#"-ֵ0ֱ z~`Ķ cɳC%:|c 9) "׊d ?\m2pF}U`3Ҥ2kC?yL㰠c9l~m Z{ICeRyOaF'˂O94j]DԿ״`$iAJ?jG )';Yk}~xX!ȀlEx #{DXp:36xו{|UEc/V~rF*'Y@זlc8_$%:2v8\l-/Lje̗ĪHO<:sˆ.ތsfUBנX% _ϊX_HZ"0U{wUyS4-ejl\_s,ԅS?Kx@C\+E]@ݴ"m z"- uEHH7M^YP#M'mڍS $z}>FnFʏđUW!FNMHv<(غp{/Ilf@G?^Q*2!o½uУvegLթoriY4 OԆ-ߎcGcg[0,C$9QwFѷݠkW9:=\žbw>tii!He:2jTwB-Y#H2ڧ+}dm[BR'At_N*eBe)ЕnPVէ@6-2[5j`2p#$- f_L&:8meS w& 3!mY#EjErU[ntqAw `\Vmh+pJ&$Kf'cO^軼KaH$l!,iw~nl2^ʩS ~ۯd=Bu MKgvc̡07y I, aknM9d1MYQy`䆏/K 9N̫6WՁD x V 垂<_Yf<qtvRtVFz H/ZMg͐TOạ̈<0}2` syDPeu=YOowR3O{A' j0y}J>:AR?do&69`9.{tr%V'P׶Y-9I9[c<˅d5Ҫ-a^QwH#G M;FD3*ING)$M]Sު%75`xm;`p]f@&C~щarSrrؕkA׏Ǽ^;YnDԫ|ǧ5^ a_[ !Zzx2xYώA1GSۮ3rAPX}Vb!u|UXQ#rX$s׿ UH4;%ʼf:iϻlZ ۏo7n/=rwC3 a\.H`6 IdVX!3_a~Ç0R(_f*afճmsS\z% m xۼ9ymz4=zEI ߤ6(!yx{6axKBVn!_MI)vg@iJb35>Û7$]{`9Ҟ=L^G^=Ȑ5v ˶'@׏~{ X8}9^h {B_yR0执|3_o9x kn };`D ^ :fDߤRKH_$j{J7zdԇáAav9iSbhvTKL|@[]c޳B`3LٰoqXw,ۥ9˾kض|}oxW_:U ʯ|yG:Zx!ɋ/%3'`+QV~*N^q1G*X |e,oa+$S>P;tnH"I-qua*߶| |Qi~u~ӯJVikvfzL>~V:A7!oߤh i HlFJČ:ױ,\ =l҃7PCܺa[k/zZVYHU;B[md[\/Mա6A꿘'ujc/6<ږz#|5Cjeܞ̂ Kf zj:&3ڷ`j٠2H>v԰NMu~JFB@^x ;K^xnk]s~m@~?=TXd,a>Mr\]Y1W6.&9ebUA_vo2MuM&H:"O v֍m=9OE p;(H>yn([}L!~ϣ!߮[T׭; ~r[T'?qᩌ"= ^Nq߿Ï/Q&UoMhٝkMu?"AMp=RZeA∿wA׏;chťDZW-Fk[-w&5?쑄bA}пDKޞvYDʠc.y~k-5IES.xlbӱWZsCm PMU!2%6`c]y:6Twk$Ԗ$ jDT!Q$* B+;*duu{^g=1mUF:V<.c|t(؛ "p:l,' .n:?HyȡcGJA""`"Ԛo䲏޸C1+.0ﲀ|bXץ>kQc'^|[$ w$ֵOGy?$q3tܒo i^4s&ߕX[ߋ$`1#t%kIh ? 5?4BU1vS{gYmMb9s`DU2i{_uTP7BnIy~xG˨bp@Q]*8qL|7~̻>CoigIM) iD䟶 Yƴ${'9ض(AIC;$}荋=$nMR8q[~[|GlSC*?8 oe@8ā+O^>e_`EGbW9YZET+ull5Q$:n-d/R]. ҏ&HNx&$&wX#($j۔,֝v]5vueVC6=ly|S>s*@JW-YD7gO6sG1>2H Ñ͏n>YgwmP0'@yHMصF-dtJo%%BGͥw`H_oY h7௤9<>-ər=YRq+u65A]5\d2ږZ4BH%)*&4n}Û#J0CI0|eckeս+j0{[ gX]ruz{cq H sۛ]B 7^4[ YXj Cjsm?TX_F /LSVW >@Իx?5FڲM^ Ƴ/7 u/HA8NoAawᏩkaHV]K{ g#l  RW'̣ӠkDͽ3~4٫Ϟ\;Cחeݎ,mt9;Qd9{ ߟwxrZ9]'`h3;DҦB6'i.>jr빳}V=~/pwM?GІ*{V*PC5{sFdv4!pГo`jךgl@GȽsH D־[)U%P~btT|Egrlg-b"| $/˜؟;sh9R&Yg:`eߎZrRn x:)yYF"o'CKhY |-5(tֹC0ԑ:l[U/wٽd` iZLMYɓOINVrꡟ$z 3<doK- iޤ#.g5)pᔏͩHq}st`r{, vKy$e{M SwǨo;]L@DKLV˦nyHd8}^#cLH=P#`j햹ͺtY?"ccɺ %-NkdBBHc(u<B̕z d>^=s7f("v!LD8pGTܥ}eH nco6Dʂ[W͘uϤW'nZ{.7& EGf9"97+._C1o pQL hN5/gA{†CVOu~ _ZA]28Q9,]ȋ:V O7zi~'·!~x|}H?bͷc>]HGH >~az0˪_&7kc_wTʏC#%սm)I/~:FzI3#GGuȩWGL-#7xse(~}wr˳ ~{8].{kR/'۔  :/bcEzgX@#ƶ+%^Y gYm Yz8TFe!%a<痐 k~|F^9LMAѸuDb*XU÷_䪪cJD|):PZ&=uJWe|NGƞI-vjY.KH|Y~6ϋX ۛS!8>/kI}(}f-Nd+aّ(0dhhmN:ŵCf8џϴ(Nk)PI#["p<7 EB<9N QTݱ?8C$HEF5##Db\w$x)"?4IOZ%%րgSo\Swk, 0ųkސ\MakNMνhz Y.+1;}'@]Ke,5ru܊aQÙ{tݴ͜;eܸ_ICk. RU5`dNcj(f:awm7EF^fȷGs3׭GTBd$UVԡ=K9'pviBnKy(~_T7 DV `yRJC0וglzwpvi “=YEqw_\PkǞ i))H*?6v%ʔ12=P:9 lt;zvՃMw>M4%#IPD|ҋBA4fd(?x ~j_.0d٢}i]mPuGqQ '}WB_Vѐ l>慬~Q^ݻr:l9}Ue"}h2rUX '2"A>5μsڪKW"ٱy^ii0@Ok9? z!s-NԿHV1/јgwAuz7vE>ȸdv&z Lvpm άmDylq8xb5=ΟC?TWfJ,[}րO3VL9l6N#ſy4 |%ݲPty*ڙ=S!7(|qhVkNx8'=j dh]6gh}{0Y,CF$ؕcv6F#m|ʝ0y[U=t<b /4ۚ?Iл}뾦+:19S?'v$Uf@ޟ^(27BρIHw^y'%l ZP%#Z!|Q酣ϑdmz%ph{gh]lU s7W!Ʉ1lSYmx]wgַ e[:\""f )Ә% Z]PziA9vQ_z{lcd}Pŧz'[)('q_H*2zE 7g GX\>:\=ڡ /=FZ#qȀ jR5Q[Wn՛4EAM^,m ܔyVYE}[|`4E]7#0Z~wq9Նt"(w 2,9җ)M'||ƺTSS^t7<#k 90].w(׿?s׼~ZWArFa}Xeؙ +aE7词=<RԖnׄv_a }Ω!+r^=EFvw] C4ݠOA0i0xZ@?NɦJϐOWͨg'xk!`nO`4κK|gOj;:C\f=ϜgYk?/JvZn ros)мQ>AA0ѿ6_WWƶ?n'i՚=gUfy=1 C~4 M}uHi slxݥҟᎤ?;P6c^FY*yNt'I[*0SoRV"_t-"9? 1oOGzu}3_y(ige?R~jߊd5BPt%ˑI>RBwSN!cV#q`%jKmB曢'wǤƩXi;0 + Ð.}<k)*B`Pa?϶o J`ݳm6#j[oSN4BBzuW6 [,w?{ڣhϦ`eH3f.ou}3H15ik]"νI:` 7?_FAyk7 $Kس5)I-+`ߏ?&{КUr{H{ yUJ26wMzmwTh` - 3֡=Rǣ0XiOb<;S&0Vb-vG[r}x or_7 HoP67s0: 7숻TS,)RvT@6RϿj]ږ>| mrmiZ-/lKZ:S1ysn.Xy1Eۘ7yГqo#/>( sZIo1)4YXp#{A`}(;oхdKK>Yy:NV7֊ cՓ''=Qp68l"667NU ]e F//D. ?XOhS#٩)?{CNGR%Zш9qm҆_(UlYQ4("L9<8v|Y)0~xҏnط&:-Eu4tx^U~ FOFFs|YG`b?f<sއ0K>s7uX\r'L5=}(B~ ->ur,/ݟ#- fm31ɘ=M@]kr}d~]_Zaya 0 C~؈p/驏Wxhv*2E>ھgR)=O!w+QxRZ=-7>qKdil6hi=e>LhG~ÊĹO7 ] ˽㯐%h=hT=C}8e6FspFwtd!|,ؼq>4#r k %=)cg(l.3wxzbmvR| ՉOQ s?)3c IdUݩa,AX0\t]/ , riT)mGEveЗTw'5܈?,nyVudy$t F|_ :V% bMٍ+xqmu. s@\'R O Ju!isq`u>jtAʐSޓw=Xgsʱ*"OE92 |k<`Q^~_..89CӫNW>nj!ՇTad%b`(XcUח)t"- @c޾oi"*7(WvX͎snPep&[=3`T+`1FN]pw}*lÖGQ3ؠ)ɏT.hN#?b۰u?>X3›_Y$oq);ˡ+.Hs$^D};t!\b6 z/:vmXhG RJYlŖI|$}T\xw״׽qYJsQx,(RJe}SsWݧ.g.(?ޚ{ʾoyY Ȓv~FYL%>^(~*[^-NTyV{B 04F \x JFfq/ \.yȐ8fSF1+w('KdG!y_0;2˽^5J!3qЩv l~7"#*(0'SGnӈ .NYG&nk9Hݛv诨 {Ѫ !x'_B}_OUE[WQ7RZjn6s%z}"_25d+?"?Y%m?#/& XoM iQox߮Ҽm0(ΈVc='6yt#wYy|׉ YuJi! P`9F!(?43Nvc}ecn,0bUgJoBFCK?ᰥ>F;40Ps\cQCF_TӼY Wxߋ{nulFRuuuޢ# n ŋdP<-X/MggTBfAd(Y-:rG䦗Hû_ykxxkeagF֖k?H_Q $y )ޤ%EӼ~{Xf#3蓯7F/NYDB' ɿM;y_#-lI2" n_]k·l79I(ln7!s:}ƭ'+Э^/Xc xƴX$ D_mF{/"U)_~Wld$5Ν[sLlIrmJ^ G:A~7_C: C'uXQ%;q:⤤Gڷ㿑Ӗ<-EzYq0OtLunSssEm<;3*x9?dA[!u5;)( Gю_$".|蕦19 1Iu-Q8IcǷ(7cۑ2[PJfWW7 9a_v(L*ht;_(*h* o'?J<̢-E'PcC·?_#QƒO铱Ȭ0z>b/yw.b$BӘGasJRp wfqfNN{-׿ 'e=l(Vjδ7É8*6O<3 \\2Ë_g#Y=z7(DzgSJ<7L³7?DQgҖ>uh5B.swf?iz~F!;2>m^ ,_e$p^E壇=+LZB`uSn%;t8N'^<6V6d F/BW*Egԕ!$^яTWYyh3f)K)Pk2.`!L ,ۏBXoJmۧʙЀo96pЮ8(;*W>bs&ٿwuHw :q~ ᢐ}lȒ*ߊsVA".y.Ж מ퓀*'k/~H;S4DE f/=V34a_J%94Rڿ-<8u' #m2<4mtR$ D'L=5tI+?m<YJ[|]R'OQx_Ɯ2y+X"S=il b>|eHK(? ]ûеp<'V2B~.>N5!!Adރ̴x?3Y(D>O:;eMYٟ ZabeUq;2~ gurXH/Hh9\;!ƈ_[ޝg1Pt(&ٲ gm2Y'EfXEyvM^~6#cbJ ~|.F$Ne 9ғ(iO%֏-D=irt=#q[B$ 2^;@%soOB}aҮ0 6-<`hm~j?KaP ;Ү77tBg[$f_TŹvH=ա 9&SB_$-Lym:VHZV|~K^wxk1$?xp?tu2GG҉ӤOL_p̴ y=ix@=i^&$t6+=|8*gh? PH]r!HvNwMϡՑi{5zQR [& `pm|jppM`-PF8tNQj$3}\wOuj&0TZhZHsRz0"bC7(ʐ$M'~^ՀQCAn#Hzvߵz+s`mx&l:A0;[<+'G(`i.RM?_ wZC_[ϟZM„t{꬇~Rij'J:mo[#b> ߥ۶5T 筽XoN>piuV/+}eGE5n>X?/ZE߲N÷~9VF{keXD {OӶDxj.?<3쐬w&<Q;@Ӏ۞z)˧:E7w|_sw@2~^҆j>)?Kw.s ΐsvcyW L- ᕻb_]̆1Wgt\_yƔ~?TZ;)0=R~D:\@,_gjܾ=:Ԙ9rAA;2͘tN!E2ٍٞUAW=.qj/D4 }Zԁ]ͷl yavV73z׍|;l=zOI#y Y$(OulÁD٥9/Grxt=zEp "}+O9 Sx'2/xjar ޶n演q媱saB^B$R&"OL j/CA?Hр]`ڏ*r0IOk_8lY~ʺCT>p ]м&tnؐv/Ajw<m!n\/SsqE3WЧDȹ|ɖ+h*s[0!hi-ǝ k'1A~Sc sI"9m 8Đ%ta׎}piIKk%pTG/d!B2/&O|Q "mwG 4=A/L>,dn+BNI\Sۏt:'UN=!0qN֤0-BbD=P89J81Ob1pq0Rw O>U !9p/\ӊ4/3ߋ|}2<~s—.9?3_LyU3_'FXTGה_.@[tw֢>>0@WО}($\st_0y`cl#=dx"Ӻki;Nw'a(N'R:!C[1N [&Hi~?[/J3<0vep#L܋dʑ\$?>NtUY~V(|u㓕HMш#u?_QV5C$q*v #[V:I T0dR5aWŐW8y&^Kmy1xbB.2"  BCOlPtZwJlkz'~% xE:l-NAߩj[PTiI4Y/I_lAC=0aÿ׳0_/"Y*nX̺~ޑphxG;.I2 =aj'sΉr)B_,Ι+$0ջ` >i-](uX:*|G?xz5c8I}I;xBfWЪ!*.ɒ^ OND H:yC>7V| #| >'K;YgXmBB̐pIxJ]Ǚ-Ӽ\f*Z Ig<<|ƒN2ĝ>5׶V[3`׺ ^3~J@ORVⓝIz~bԯ63~M>_Pɢ- c FkEz{υ;,Je ]tk9uw?_Ф^O73]*/Ɋ9L";ڐs| ʒ7nS;`T$cG-EגHt` 3w>{IlY¯R,',F^Z}+ެ0QBMл=2az=rɺHoM5D!7_ QZo[9~KHܽPЮ{L>{wo#Լ+2{{~]BHJ˧ҚP~XӾw>Gx+;BX#s}\nuĹ:O}z# V+CYi{pK}HOڛy 5F>D@;7'jLS]92[GMA$}bSCMdT'yI{Rˮm|'WV#Nދ ]QH-RtAۺ+pfXJ;[9waL/=m>5*sU<بd#PпgƜw781ڤ fL~<|}\rgg~&d]2}ġV`;C+uWGs"Ǿ~w_#mֱ5?dm?(tI疈_"88z/ 9IbKI|I`!U3[͌k"aXL_}+y7%lDqvnZ}PLUWiܝ3ƗGp3S%@̗T1+ p^B(?{[zOvqOgk[R؉|4Kn?P1ew7! "_DJŖĹ0Iu5]) gFфø0м;>r+ &دOrՑQ EcJ'W ȭH0hPC3=eU$ZR\Vj~v 0qSa߻w}խֿnz7 һy\G*eiNpf8~Bޘ 0^l}tsZJaXYj{줡m}IY9(d)=ZTSt8I vlY~g~ȶPn^l޻oH0z-^m:c5n*)M23&9yxGŮH)R]c VtK$pUa_+-χa )ks$҆윞䜡_~;B\Mcxނ;񞾧<}=3?x5K(k2011I/ ƺiI'VZR#Ɲh|82fi:l/. 7wQ\@:*:vu$<(;R-{DVG0Crq?SKsye|^h[u*2ܺpR7$.]q<:b`[X<βNI HN>U)p,(f!X?wT5,lzHzw!0J~7]NWQ͙ٝ<;xi RknptJ03O 5]5ra2;x9=m'~ߝLӷd3{_ L-y8IۧN"}ki dQt=3iȸ>dO9VE'xѹ® vxnyg-)B0jh. z\;kgP!}8w=qAii7v?6"͹?q󌑦sWH X$nϾ >su< 79oϳ[Ot] YH&$?.>|=|IHk u<{ڏ#=oډ3v7Q}n/>g0|cw7 nkAyvz E~qGҶwcXOq4ps@֕Q O;NO M sܧ׽d#x QWκ#9UsK"Pt:G'dy 8v/ȦmEhLΞ5OIXLڽaUءƮntý8CD=:W8+{&Bk*a艐IfG{{Jb\sPAIw!i{7~(6rzx-QDQ'GYtzM+[)%v}Oy'GzYscXHIn0$ܺN鍯Dbxq%(fmL1[h˥c-*|Ŧ8{Xv{_x zJֳAV=Ql!X!dUMt٨xVGoɁ_s~CW02 ՗`joML)ufwHa& K2o# qax78>S<08'l55)?.Βמ:d8%pʹ,U=甬.<>('ٻ ZWIe}k7BOWNHM`seq(h#u.Ag1TVm#mNAd ةDi¿1|H;,t9::r.'"?dGvO絑8ql"^WiɏL3ڒܑP[(xc zae' \K>҅Hzˆ6O0^w!sY+P _ca"`a{4 &6H};bdtz*õ|2arC39@y9;>=:js7 6ĜVfEhPJ? JtX.3I >ך-k @~FWjh!i `Ycڢ󐼇c u-al~d~|?vߛLGA\xvU[㑃s4r?= %Jo+WYyٷLk[#Yb=ҽf붏sTRI9ڰ2JH1M_Vʻ@t* T-yv-Y\_"$8Evjv ~U3nd/?|?y%r0 @fS7궭(FR\Do!ÞB`pH%bh㈳GM[!5(2G=ˁ]v R?Dձ̐Ƨٺ&-cN*A魯\7%mvAO0e_d-Ճwg҇H4wB&aןCH̊OJ vg!I:0G-Lxz]l@:՞i15GrEU[? Fʡ{)Ȉ7^ċ-K6wۘpH6?Zd.Rf3U],@j><Y٢Qtq+6'd<0Ov.XÁ_Eޒ[Tc3RH IL]ERydvf%>C+HgX)\us ҡGײ=V.ϟ42~ g<\o ]jB熒I߇QAqe+3iǥ0y~,%_A\6}f'oʔ0JnK9FIYsyØ'Zb~׍v͍ؓ?bmH\JG>gռg!롛"ߒΉ3'ԟǥU0_H{< (w< C~pzmj9ZAw6E#2qؾݍ04ۧwF#r˝Jݐ$w+9q1"a-0K$?'4QחH i( {}V>|Ƿ{%b~U<ƶHD/+.uKƿaX@!Ė+F08ifoz-|]Ɲ7u~ T ˊ8(3yS0vIˇ<^MgCS姉 6b5?z$ibVK͎)??5P8 T\J_SPU7 _4ֽTzg1t_ ;t=I&Ghc{MH`?ɭjC!˗EB= LqcZJǾdSdmn wL::o X"LuKSxH9Gv&v;,:傴7_yxev$R\,P@ YxR t4u pCsOHSz:K{cHj߷ȷ̲JUooڀ5\#GGf{w].+`/55ln R7Cn |htן|d5]ׁB|}%g͝*|dw㻉<$a0N#t/vCGf&"`鎹H8\4h57g_6E E!oMa:@!}@&J3У .(ܶkeq'g^ \Zͩi.4$΃)Z#]v( ҅,:}&c7l*B1؆0R#_Jop Y!Κ}^&;"mI(M m/|;sX^`'Qt R{5 H&¯ \޳1 m=@\ojXc93dYߺ;˱엦xfU]"Wg3i;x޳̥(h~?˅赱XWtz7ޱB]lj2 JoA4,ϵ0apntC_8~Yz1ȧ/`M$lF! Zz۳V\}d3!s޸j]P9'w*p:=N3!ўͩ0NBoqf: <^PGw 寿-0Cƞ#, O iiHk~V_\m&<_Tc̘wRM22nɗ6/`A~})1:7gXOj9"~܍uL'7JE;6IkJV#Pul%뭦B+ -0ǵM=0_F~FZ4~b/qdvnny|wRN,)?/!yl?ŶY\c4,@V?붠P2_I ) Lv[L, vyIw_x^/ l!Omjc^F%gHg`Mez$(K~`!b7E￲RN᪵<ܽo2d|Ynv4x] Vu)MQ-CHYS # ,3 KE?^Z!OazuյU4;oF ;,TyS0dl|x\_*rRsk/,6rST(T=j_jdi?\riʛp]a2Qתy8:^.nԚlkcNy.I^aOL\{i_fl޾vi}#<\q'AsrFeyź_&(sYHjeVy'Ǩ@׭^y VH[;ȷăfa_ݹS rI)wR+ 3~F t:Inz?p%'*>?Ԅ䅎A(T/j*_P"tW+=ҝgH>#F]\ι΅^#e{3 ^psފ#}#C Kլ&T)1aOU5aZ i^lsd>gޛj^ƜsL7b;ք#(ZlkkSBʡ3UcsL/{L,~%"uE 0NfBdnu+Lʸ %7{t pG8HOh,F23o1{C5e(z{EH?,FdF 8 e^z"#p@x]>tUޟb&C&F9YL2 &}3;!o/gOaR-諝{ ܧ3M?}KE@ޏ;;>,ژj T ;Gd_p{]$=7~S=]" lg^GMbSLߔկ|^)D~\@k/AV9kynF+7l<ͷ6i[N;Ai:uhQR69yX|K;,y{ &-)6 R$ؒwb;Q8bw#sWw<=V^%p?^|o݄b~]]:%QX班 sC86 xc0@>`|~wlZd~k>?ԭ[;{%'C!W#H9b+VZ5xK>`( |+BF/=~! "NG$S',΄#-6N]UkfŰ+aiafF aNo~9*adCzx”PܭQ^\ϼ2[ko;|vEJx&yHb؊~`<1>⭿70jֻ0??>mj0\#Q}V7.Dɤ7Ͼu߹syW*#p$*w,h8u+OFzǥFGEU3yX>YhF{&&Yn;_':sH{n5vZheZnonhyՙW-Ap soo3/}$ms) b-;i7vNOy $mt'pm_ S˧CjH7=Caq4vvsu:a:w](Xuh` p4u 'yqѹS_Ps:X *>% ܚ9Y=/+Zvv&p[a'`2P<(Q M^aׄVH~uvuv 6J! iCD\ƺ&1zK_V Å̲vpGfo)GqAj-_!w}oQ^>7V|O 2-+\ j{ze=[`ꂑ H[vCJT.ڦ)Gq[إo[@s0!#}˲[+x4Oqh0~0a_J vwIHx/o6وD`)iyY:;SΉ.^ GE'3 $m 3H^ݙsnṷtj} ljIi#専FlDv0ܡT,D%*!2YTv_-c`ٷ5$|ujK*$}g6HYW`٨O sSK ' /F.v BK^G[#}7!ڶ"j-}oCM.}qn<~LJ.>RhgTN%sK'=yH@kaE2tBOZ|luC Ag#"MOx>}Sj$4_;3"HYp?SRYAp/ÿ (.\ ![i8䋰 {A5(Xaf8 Ȼ/(܋|LRs;"żQue?QHp7pTG +_&TKUQ 2"EE>FZk!(%4gG`;Wqա0L}eBE;"dDNJ0'+K C$!Dϱ+QO%߰ kЅ~ 832'Y!j'b4> h%[.Sl:7B {]En7ϣZ#ou'!+c@VZ50yF_˸ܵW<^|x\xɯЧ۳o7co"S3z..‡ZAf#90ms}2jO$xdvAMK'-;>)z"}0?9R #g&+cQD|FOʧ}Khj}C"l5/{m M8hB:?8%5VzP8EU@- .^q'{|*%mF3ѣZYk|wIWv6 z#ʖ JrXά F(zMp~rwьU9C|1oݑxYߗ, N%'v뎨/9->T귍v!D۞z5ӹ@` V$agbB3b Ĺr.eyzX=0*s:.M$ 9we?Ti;E}^[RUa'oӃWu(f/I\ C~XL:͋k(+?X0K.ɖ'1g$[ڿ vH7"]%Azj;"|8l6cEV>Ҏ;|F;Lw2|do/P} 1o@H ~3)k;-GW+M|lFÿmyT-O>*.\)Z~/Oh*s(GXd9us_1;tzQFM,hl_*ɷj{\9zDWJT3*KI1j fw&c!"` _9H%˄PtϜRhgJEzW䎺}ٵ=Z"bUX /|y?M #-1gi^fU|1"4i7u5j+DAV7tM(2>Z<7 {,"xz#}C6]y /nsCom( 00Ip6HO7|rc<1p"Gy/UXPuf7KIU+aüds\]F]%5[]%⛜Of"5^|}淋4OF-Gi{YO=@^y0Yddh LHSk%]J'F^*SQLJYKܛ.jM;tϏg[Q[+ RFqs_$\5ruR9իsvraߌfWjݝJul7FU&!Zȁ{<8KbZWolјq=?6CH`wCg¿ ͣ5sC~kD¯# bɅˠ'fe[\jKUO0fԓF}0<1~pXzYyh, (;mk|C6_00&/zk'Tㅵ^Ș׿ӝv$u:2H MSBw٭YAHٟf@UDj䱒L[dg1cN w&5V"OAs~26<\e80i|MsmU|Zg=D f Q32N!S;֕jNנ\&$̟]*շNؑ<R秗n֝ۿ"9wB$[aEOfQh|KsQ5Ha(Eo-P$eGߏ鮵οVF D|ڪP)9FN)Om_xq"M~ DZkO`]aB ,K>"髽^yYu.2,|mv#v][|^6G8!R#yF"J.ݠa)w$1]τ,0^4ꆌ;[!nvwISrJd[2QgTWo_gOf~n) yYU9_tW^2M DQXpO0p?9XKJ0t73 ' GCvgHhkS?V:~nÜTd:pߏmEdQH0>+?EyTmK}yqLU= #l h׽y'}^Ń<h/:{3Rd|؊?-KNUy߳=[CοgtD@zpz!e~M{Le‘o' nDM!Ņ{FH.l Kl49hIm;/@QD?,Ԟz3[͹f)HiCE0^z+CnF_LJFK YjTA1 53_zQ(ZG-;y$ࡅ+L78TL-dD|>.7yO~5AsMŞp.SՌX.z&$o)ju7 ;þWRatq>g4:s6e O.ϸ_/J3hۤi>w"лx#@kij4wpgr9dl|Hs2aفi>w*TyĈ`Eo(q|CVq_=/^4D>iaVg]$qq'Q#$T8j@ԫsa&8 ͕7Cѧ*ڑN6a:sg'BѼ]~ѥgj| ̷K!S׃GsNg!3$#0+'JKWՇȸ(iiT. .ȟ>LJh1= 0kx<9#nkՈhr*jBMҤ/m\oV8hxZ 䯁_/rH|ixjU7q"4J~xjƋ#E~ɔ9 I9H~R4 ܘ? ?]EaHlMG&UnZ7L|b0aXb47B?ۥ*nQžHqWjnKUDrBq2#FDFȘ"/}V 87yIvݞEA$;^`m3߰<$c7΢ߎP3FŸPV"nmү|Oc˃5 lՈy\"ͷSY+ ^* ԚAЙ=]d9R;H׾8*72EigN#2`(Zh&Uv sץauV  ?u XȤ]&|9ky \?qwoA+Cr)0∬'R^>ק6^Zj댢;?=`TMF~z9U4>hzN8.ͷ̎ ꂄ0vUHn޶nﰼqQZ; zjeZWet _dP!Fʒ}$tv߲9;ŗuϝ.4o^(&ޥwjdjd$>Z5e=Qn}f [Īat$*ZCmhE_LAeRiℰf [C)}au+<*ËR.8֯(Ov#~#sڝ\_U}GvsR=Яtik 'md>,`K/7kB'/jTb9( z126u&ű<|apcGnU !ҝcz@ܔTCSu 뱑Q zK8v4E$ܤ3{O3 5DP+VufWFWާpQ.0W1)fw˹ƩooCIo6H ھHr[+ ?=ݯŮtrBès'T!x/'ɗOʞ%#y "VF*Ä"8p"WB՗Q&}By;SvE"B_ߢV _B߲\-ȧ+GO W z < {k:.0<7kE$p*C> <=? w{yyo ^s0#O8'ŁiR4;v CYyC҂Pvr~x]#{#Br3uvΣiyz6jDp~ NCAm=G1`՝HOuy"7S{"c.̓]N󉾻oCz-g8un][EI^UԠuCY@mv"bJgYn21탷8xn=ǣIл&5p N? /L!^1G_7K1rU0ӵpv7?_]X4ݷ N;Ǭm9aɴVYޛ6C`C.V8䗃]I 2*25 >m?z}v?i?jέ>Y6;oaDxGG4$IV]jKS dD€P!p9yZlRם 2G/AnzW#L[kAu?Hg Զf0X^ҍA5W;Dz"R0kc?!rU塾 R͖|z@wﮨ?W FՓB{Jo\ ʽC؛ҠK?%x:n/ۗ ]iVE#*֡a̭M.ݏ}wbP@}\K*8pܴi.4MiS'{nz{Y,|o+SbLQgն0bcڟ⓷ebON0a?ÇL9 o,, do?̐{^|ųY0u|Jr 3-ynS2@Q5[G/;Ѭ?@ۓ 9bl8bKkͥ!*_D3|E-~&^q]HLwZ :{63"#o 0u= &3!CkW`$~ɹ/wԾLyr4K.DrJv Oom.$2S^#JcMab]W+D}ބ=}wL=Hibէap~@'9YqWwcw#(|7[H 6u\Qæ ڭEa"ufۏm=nǟni Eݹ`\Qpp> ;Od0va7_]qx2Riz^ӆ[ϡihI)E^-: Fs. ({ ~8їX;/Rh?兤Q-v~AO0x.A!-WE:ǽ4n܌ <_v dօOaXBL8FuSVB;V t5Nn Wr@TL Q<cTf3nخ_1zVHv6Y |C <`ӤySLFOnלAq9^N0űsZ(~Y!_Sa >!3|>ĝ>E_>NBw_rXjSe6Mzشe`߿7x}ƾfK(JHS!PT*&i'%Iڤ$ B !ﻱ|x~\:\~aWf-R."ؿ'δI}ODW~ ~FjS2H ?.s:86 7xׯ6쩳[`.ji2|\ػ8.=uT毸Y˧{0`aL6,'[{ )X͋g'n4`zB2GP^er7۷nz@W2Q-BʐXN>{\L{d`S#kйJoAM 1wzJ*'xOyedx" ňmHI01ڎJ3ɑ@8x ߺ[ ~5ĒP%[=YF, kj*")g+y&"F}V묷 'KKrwWʡbsn)W +Ck;j|~y8 +瓒+Fil_-F'k8+5P(-JɍiUUq#ҞA*J[/^,g@R_(Q4MnVI<i9AU} 2'_8Pe? =؇KkJ)}=SxbɛVadB_r{ĽBfͷkBDmRhxe% [[&Kf(#pOeteg5؇}&pМF˹`pBo{cڽ>։'x=E[}=| >OasNNE߂0SeT Ɯmy=Gv o , })ˠ6,Dy_{)DލFzSsK~|Dn9Y>eH =mOW`rtdDd> ~ sBY|2|Q QGn+ioIE9G4v1'.#W.{'>B:pE5%Eo0ij9?yߺ) =ӾS?FZ! Rޯ=/hxitTz;`8_p{ԋcTBu_AɅ )?y2%"Sz;ffY\."OKe>9((VC>\KJBj t>"vRO cIC^d?Q+EL*FSS@sý=E{NSgBN0dޑ=y+xxM#\;jm?U@ZG) 9yvDl%`pع~D'V4:#_?wu'uugBRT#e9F] <=5 R8Rw0zu|+Z%pb&_"s8ɤU7]修zl\<9DŎ;"ןRѡD} &sgˆIW#SIN5o/o8LcLSi uW(YI W oWR&,wB^siaa x{#I/)D>EUX>cgvV8+|#t{kc9ZYG(D=? ۺ`ؚrn0)`Kf+l]?'/~?; g䵑{{*47f PȉxRmUE3bú=?@^uF{stC`I-$Wk!xZ}g1#{eNŲ_ 7BvC75uP?UgEL:w az IͶqQ&{~8IG;ѫ8W<|9!n{æĺ(/IUs.g"{gߢ0BɫCUvuF]^gu)G\Cke#9M F #696q3bCy0܋٤s2`:}"RR]EbmoW=;#gDI 3ek%)v%R9'ZWmr2ǭ[Ef3*IϯѷYݦhStvz7}DfzI(,Sf>0Tq{flaW|=͸y³+?Otn%qfrdqPK8%ޘ.Glߒeڝ&m}CeC"~Y]k}vu2ٶ؊oF/A/NoEj_Gж6j/gZ?CB.2%O~}z @- &\ $m?C$){LZm@u?>TإL!mn| ~caiA)Ru{;ehZ2U&ߛ v9= 8۶LBBJgBq{1d}69&YOA@g̒U0xZ/sl[YDkNOwFU+5#seJФVΉ鯍;-܉<%DyiiUD}+0_D!svǷFIhr63Uñg+V#uTr R=*㋬K b0z%Iubw}N<7%v 3/ͥiz+IC7<IzN *V,;)fNAHlCa5fY(E"FA훨v0g&.QZE}!=Oy ISZ|f+^;a0Svy~A^7q=i>Q־BZ GRA,yϘaZ[[g̋a#7:a@qMۙaȠT]ڋps7Ol }#^5O?]7Bەe3@M_Ey&I.p)~~)TCiȼ'Ca<"sZa|iīqҟYLa[BbW9FrFk`XWԯv4 fׇ,4g={k;M݀W_(hAJ9d=?o t'toަ8sQu>g] S%!Ƃ<9:=uf*H[8G5]LErZcIEȷ*P!>F a͢MB"5VzP-{de$h892x.gF=՚3o̟L(CcVX˝H0mS5m/,dj޻`PZRT8#PԃX+a:Z_KO_=/ s{Q@E;*Z0g>Y> )29o34zQ8ȟ Qɟy~u=HZ5 o7V Q,% ̔C-"'}c'V-ڦwP&!Kդ2{26XjIUw'~e_gUOd1 F?=2 0W.Js&Q(?B-Gwb N@푰]BMKZ(*H*IAŊH;#ؗTIMGqVs\mhP QKw.~i_~lM[M,0xH&w>tVE q7^2ZG{?>0H˫w=tx~y{^y2>N]F4*U9,gWC)N кbsIR"$lI{62eP-K%H MxqP1g:8 Gd|j/:N۳x̹U=4ŭmE~uNP[_LIpXW|aH=Pqr%v1>ohQ90+I Fl q<̓k?&V.RD$o)FFT/Y,g!qף\{džwW:-'HnW Jʢ|J쎌L1Ɣlg/ArAeK$|:;;y?sAb3Au$_lWw(Pb@zQM-܈]5$ACHu8Tjal{׾~X\5ܫcW?~[jFvx9Yo2i݊MHy6跠X[ .1?; ؉CJs_vIV9WTugpӑ]jp$(QٞED\B6PJQS[~E2q H; L,ڋ:wo@ϿtdUS2K?F@fTƇ9H04fd[{P@KMdMd5K*7XZc)842|1B~MNȢ2/R-0PHfkkd-[$CE!3Q 0b{rN2)=@4V@} Sި_FÚg%*o)7G; ׼Y Su9W,m_ߢ BoK'E!] 3-C~َH{;C_H#o?BNKw<;kIO$vPZ Sޥdl_ޑg7D5E=Y_M㑥ex OTm_̫(xLc=?OGr.em> MNS M#dxmȄ(恉Re+ (gU0s~/#AGUCO4ul<gJUa4^(9|M20''FaW^\!uF (ATsGCd+/[8 w~^Dvi7V E=ûCHӧyCkT0ϗ uzS'&&kS9,"cMV4p8ɣ^L޳D˄q BJ5.Bcp rӖ#-,Xt#dHSʮ!'? )"9[epџ2a?1N{ .lsחY^:U$8Fe9뫑`ږ4(xO2.(viCu<=?zj3pMB4`Eb6- 1M/ %. #"O S yRmnN랒n~= }?h j6 & 4KmF੧lpod:ͻ?N`>W a=Ȥ$lE7$Zu3WY%睯@"֧.};>۔a/^F>H2*Df*ۏ rzykci< E0zd;9W#+))Dž}I{_@=oF UdQweOϨ;ğBbIIU61]=u+BD0ɔgOm4 WEE 6[V=&Ǐ a[oO8kmtLZSvY)`[ֲb/=-ut:.zt-3*TFZfH^u ~`EtoCo;:Ø_@xjv.)5S0Xgl~R? ᓒKo^iZb/ӽ;sX,rd?_ C˗NEԷQ_<<|=B=;`ط-<qEH2Ős e=2n;U!Cߤ>nVs-RE0,iyʆJQhq2eDxWC'eLF͓3]QpmaԂ\{%ߟr|=ԅC ~Wr|y|z ɻ?^ֽ"I >Z26\)_':!KtˌM?#yFd޺y6v?${E扛+R6%.%xhIOn#W*̉KPy KnqF"݆*k)6F"ZT,[o\Y'ػtAx+q#{ u# < _ pG3mwg5CU3\ઌ?Ա 'UϷ@#H9wوGڒPx)׏ǝwmc[z詮E=vuTwsZȩX6 sAY=t`2xDh)Wt)d,Ow f .+T #뎜ׅgmL$_~PzSw6D>=ǐB/~ :fEy J<~C Yf06g1I } duVaLIS+N-鿋P.bn/)5]sW~y\'ـUc0Z |w xF{o0X+rb-.XI7lb%:7^8*}x,|9*8CQ8H pi ~QF²D_93/Wљ bP5:\t)BKnj{?U+,k]9! ɯtmX Laay8@#nzuV4h|rvvoΰe9 <7}_AታsKչB홹+""Ii֋H׊_+;Fz{gPg"g猾NvnƢ5sދ"Ȭ{.:{ JR{9a6oݧk`v= 65.<vDPʖpx67;+4GD:c7./Y)K+S>!iH,5X~iEz(HWE~|vB+%T~+(:!EֱSt^w+o5͒C5W{짪ehM%d1n>L֏3ht\#M1oU>}s^>j8oFXe2%di˔)BBDQs nyL$3ONP@cђN^E N R0u-5PRkHG/μEEDG7Wv/Iqsl wQNKa#H>eAULz{=eU=aczoH SwRm|-큌}vvkߌ/5Sd!Ee@s_62yVϷ,&&;eG+ڐZ޸(rt6$ZYi&45ezȿ^p\cyrꔤ4#:QsOÿko"u]) ۇBG:=0]&gaP>|V 3}ǯtOueiC{a`RW@ĜJȷm'o.gȼ_`W'w]T?qUv=ɧxFblMwmx­\wp++2H>iܸwS$U9 ȧnRH-B#H,Dg!sdug( |W|g,#>bxb-aPZ!:i.`FjIJcJ8'{vп@Cv(P 1/nym#G@]Q?%g ~v(Rɱ&+RP~{(wQY+<q/wG_QAzJ0V/7w)䳘sI?cHem;鍌kmsc@{ˇ,9?uhY4ÈyMȈs&N{9Ӥs_ܿJhV|&9ag9bKC^/^SH:kOZ91/egՖ椅b+V9NA+BwMиWAN"Lo@kvs4*if*`ةio{wѦv}2Hw/N8 yX F'Oq͖ӣx -t[`csܛ}'tj]C;d ܕ4ŭ{?DZQG>FMD:95d?r6Y.zp25K?Ǣ7#H*%o'RUqHC=q7w5-ms6pZk+4;hlCsjðįƩ $E)d >6qHߘ!_aj&2y89ըz 2o1>-doJ$owr k^?70\(dr/]FpoE-G! qiydUN1MW2vF2G0ߒ?Ca_>& i]"l1#26vJY]CϫO]"D${W:˿Mz_f2j* EO:'-%~ޯ=|Izۊ[6w8iy߮K”SE.(Z=-ڿ7q,B!_N5sPٓ܂(ucD77{ŐoEseaq0 l|z 2r_uhJ{2dnḺނR &Ϭ]X8 cí 2oܒ}(cNƊB Q셨MH¯q\g|š}(;iYa(P﯎ɴŃe(f蘼Wis~ʔNG걩{z(v0:C*Tu E[>u u5z5JR/okBϥCFpY%@)-F1F<>_:ik~r\EQ2;+Y&2f߇ KT8)b]`rvH tEʁe:ddeu*FB""_rY89ڇ~P)[J LVѧm D֨|x-%y2xN3p P+Xoqs;t*?N}e~,ܷ )S^x[[aDl3G~H*dWc(#.WoL9QF"M/0gow$k !MO8-?~* *2F}WMAW, n%{ԴarqCHV P]'*<'( > 2 uS/.@ҫSȼ*2G\2]s^7_{4_';D49]u^GPбT3Ϳ=j%ȿvn7 {J hda7`Zi3/406`򵨬A/QA6^k̿)ZuGgaQsC wvL2 . Gu_}4W:!H}t"(-ټەOly_)Lz4? [aҌ0RQE@e|ի<\ ]+ҷlpz*sݍ = 0|ɬWQ`֐vP=LyM$fς u˝kY*L{ zG=>f*hWH2cq"kWPR#t3jWR#6!)cyHR/u.!"e# f}>"J~t ܆GJ-O`4J2_뇔gqq)ZĨYÜEHQԶ)b#V-~I<ƏX}K2zu&"caRxք eI47Dz3IH_)߻l[26+V/n t9߰dbd{;Fm5هtEIHc4h#ϲ`3NSh"m93 !5.+%M>KExxfroP-ajq HKSM?OD[ ekPĵMwa/+>ʊ9kL"W֜gDu Bֻe0"i,grr;Nԉ_=N=۫ԍ"߅ 5D豩w1|`@+-7T}l'o].B;SHf?sk![aI=Hu8'Tf a2͐VHKʻ#\B0᳎eӼ<鶀DNNGJfŬH1Q1x_O|B;gg+'[Cory-\T~QA[⭀&k>%ՈS$/w|PE˨bڲCFTb(v/[y֜\$O1o"d.R /\B+k20$ #EzT+:Ǘ%EN=L>ؾ J&9 >=YPepH]}`dT֋.GkbFs|߀>? RYϝU5Ӄl+_ |HDgb(i+]TLI~&#$Y'Tg_lE玸=d6{(H5;н!YämiJ&'۷0T`ؙZ+ eu׾'M$nUGQ%or7ᕍNo⿒Hv2 ?3kt+]b[&4_@(x:hr]C f}d̒_wzJ9<eM ?l]n$Q"w䗴x, ߱#^@z^%4u4`ӟV0(m9w1Re\eo]7)cLhBٖ.([4+I;︥/j. g֭. "=,Lje#~ϲ͑t5a0%F )|s;Ua^ Qb]_͑/&1(L!h//W9JtOⷐAB FsF _/(ڶiPc$[*<*#%Pci ku ӣ7"4u8n̪,^L>褴{f\D3E9Tg=EVQ\7c~8Tm%^Կ{UCh=ej*1$cu)$TRh_N: YyAH9ysl׉iJ|@Ó#\RtmMyUY4iiJ)?4PH(Z,,~Q('3.tÓwwgqD+ `~<9#~v=qG[jR} 0I JCc|SY5271kfّ'Eu}k?#HC+ yߣ3n}YSʣ麂(OK _ }V׆tگ2j7_kwF/&m0Eåy /! Aa=Jn.:?9^*SK={E̹oA =e%yA|CY2N`SmKHwahe"}!z.csr,rhil*Q25OOW_ggĔ֡0_ZIcoHpf_&E_aXW}~ +!(];ϧy OtE "AcoNO Z# %}9`9pnV89IܣO|QhV妗 nFfMbOK_ߞ=<;ۡp9$aۭ?/h^ZvGc2O c.vȢKy3n T{J"˷}ZG<|;Wb~Rߓy疯tK;;592*JzW.W U!şߡPPiX }_~ĊV^xlb ʷvH7:҆$Caj佣]yaKILx˾K"6f;]b5䰆)_BAy!} D%f| SO`pp?t8q8P g5{TBjs]jڇ#/rL3d;QHmEV rlGіa԰e^|aO5i!XSBUJ2iP0g LZSmH3vs;ƻm*YY;ۂgԆlل_Pyo)mV.AASГbx*"mw;OtLїן0_'~/e֏~<| 3'!`ĎX0pakǜ#>Oco>mSނWoU%y VOH h45'9glC\/,"9@wX0+Off`ȶ(dn_DہȔ`Kgr`ji/>E F҂S-.z5^.J%w~}^-@OԝH=wKHK>iie0S`0W' Ib&+Bf"o5aN(rŏi`NЙ-0tD{(.X\ۯ{dZH5 zjS}jZ{ d:nCC{wz=uH9#2}5/oȎYp-lvoV/:Cw?W8$~&><%eސ`017-xtW:pun>C[M94F^2BVm}f v+lQ\%y8g^U -OUr!GCiy h|EcI_w*@l˟$q/ d<d^2vADZů"f 2t-G@Z1t==B ~NBHt?wS6?.{бXͽOZ 'lO䞜W0t}@!\\ky+R$nl;R23PQg5j/Ɨt^bGH)k Qގ$1C+ׄQTo(~jV3S> N hp^Q QW\Xv}\2RdU# 9۶'`x_~j=~;Gs؏0:b( WC;ڎw$S*SYS=Ǎ]K$vR6sz>0>:_K"TLOnBQ҃g:}'-ɮ寮]UYLa}1p4> Ai{I>3<\wǥ&fvz~Qڲ ?szI;`"ڜmvtG^ZX>޵ƇÂZ&]=ohol|Bw"dz@򺩐bNd4=9Jx},L} oҐ8B :8q"%%0jwʱl;޴ߴƜR@ݒr 0uڨ[55W"Yѫ5|N?,4MmFyN0(]m{H w^!̳{atkq 7- ǩ]߾#eVʁЭ,z.vdTح,3Z2Y~rCRڒ6B+5Gw}YM -y0RaQw2ڱnR&џf#txq;vobwڒIr€^웱/-yYH7gu!-B =)t~Sds+&m&L{Eʟ HYÈJWO18a?|ΉOhF栀]o!5} KhCxn!9rk=P ?U]sg!m7?X0g'pWXNkRLrhպ+6i(EO<|oFCE9JPdOQ;.Ͷg?*#"^gCQsqT:D8qJ7f ñ _gbtoX?h&{g홪+:,/EɎ5UG\6rB37-aEll/ʖA>zHpہi|ʻO$UL=.i=7q&;q6Wya+HCHش#2=/`t-M/`8z(7C &1cɴ+HU,t VӚ?4AJ;H )}dj+֋g8aPU58DZR֬1N+8 *M0'/kw@p{\mxcל& ?|H;$9qaWdf-2 FcM&G~{*  8{nӡbSLԥ1zNuBZeŠ<5>#˪8\}Pt~WW+X#CK* @VΦ#ϋ}qN Ej>=Yvu ;D#>JY _Ղy(rh7D@*~7RU)< S^$g:<_ԌN=Ho Gc#Υv|VV2S'kz[ xZc-.)_*ySH.@:2^"iE|1GPgӡ(x%zwzqn$'eFھ]ڮƇVv |DJZ,$XJ5c"E(7WzÍߖZ$(CQ0vJ(& A 0{ZIo %0ZkI_α$5?`\k[&ga|}W]i9ŕ0,]yim2 'R'H,.BrLKqi^Plp~O`=wGd_Gv.Yz*9F8%QHYFmڢ_AY8. 8r܇.{H{k) ܛq4n-wͣjaPƁաd]߯r|zzrk{s`ŻD$W@6jNVzn'G[#\?O&\#/heu17A'fU<̯j&@!9%0ڕX}];^wB,K:%.Xtl(\}NEv6A]jjHzW;YwY%Nnр.)ӧ픾?y{hyB(>[F^ԬG7V'9EJ\0dH<;syUHr:?Xn#p5;hHj?Q9 >さ!7\Y(Y:Wg_Ƥ9=? &Ux`.};q8IcJz&0):kl(!KY& w]& W C1O޻2k~sͫAjQK(L2"N3>x?=[ޗmuKJ+1 =q#ʫ"U`Osk._/r٧SAN_M(LG`+(@kc5z |3*wMe?*[/4B+\LeŒ-(9uɌ5Rw,CJ)ɥPPgQ;>>)`9U?\m[4C=H{?aեeo|o/W#5Doˣ :%kDW,(Q~+[5G$]e!c2R$=lJ6;-!(0蝽n:;M/#}տHv42DӬ-׏;"}@`I(6<dՋ`b6H~'i97Yt+|2/[Pk' Dn%]"IPޝ04j>/]nn~σE; o7m:Kg.?S46ZnR>)xcg궍!nU0ɦ 1N "w+uk_dh Bᗆ4rtme #R`Q:Ԣgc}8$BY}5Gv*<}łx[ dY=Y/k M֣pA63#B%lϨ ,|.K@}5W6䳰ݚ{t\,${g(/Y ׌hIr>}jX?]sBAŁ[*8ݿiw a]Tp OFz3"ADz¤ü{.*GYc.7(}2UÞ 1(^_9 /n%#> Ϛ#|NLv So9 ܭ.=Q[QH53%LGFQ^Ռ9H YBe|!((El ~Fͧ1I Qw\47޼+\Gb'ТVurJv6pȷGWwx|y:幻 uo/UT5ZRo ZY]Y/#Qh#?c5T#}:k| uގD-wt'Hv ?ڧ T}0z{ԃ6/ny1zeJY+>lx[ϙ^!\[ @x>j1&lv9$+MQ2d]? %R'7®JIxB*30^^I 2YxW7g˜X%;'OH:qn_ ,̑IM-?맄Q F+jBW% O5rg}ȪϱD>LN^۵Iҥnp>G>Kdtl&OIҒdxri-?u7w;süN 3'C]ua}0%Yfk ՚MaTXOb+x^w &lM3E>7KQ{[\m"H<''׬ 'V$t&ǑNJ ތԨY? /o"-;D72n+TW4~7)5_&0_[z"7bY`3Qq"/-QR@;~!g`+Q:3Z diV]dyszeK EՅ\Gc*Ka$ܔHV*D#t|,2SD.>vs6eeyY( _,ҸT-}@i-;F3:.ψ祠0/cBnTMBN0pe.Si"_AJI!/U/;wO7ƀ2OSy:>zzǬ4.skI\vn. Ώm <̳g;u C/ e)d= شzuw7OrPiڌ18s엌FTmgA=< f/oI[UԝH?p/f0 ]S3 YC+uUj3;}}6 qMNu.CE)uE0R0ytZ^"@B*x Xn%5k -bOM0zZ[$>ۘswz${T> !ID|AXn^t_\] Tn}xShWe=Ȉ6h>>BM.iKN4B;&nFȋ4'p'8FlEڈ깈ͤ:o, E*&䦩8~O՞/3%2H[pld/L?Og&D2D+0q%xHq.0툴&s-8wU4$!ےLl 7F14`Cj=<ө-,&  @Qlj+![lI/Gڝ Sҿ__NQdpC@$}|en! Œ MhTx zFꩍ] +0%- ȧ2Kg"_W+Bs "Pأ=ːzBB]ݞ]{"&~z) ELv|E%H-S!eugJ>(&pTm V>|2jcwG믟wrk_~lFgiۉByϛYyAivXD,,=!ymp^`{ EjCTd ^l} r3쎹',p,I/ϿB;Mg-4#(`CG2#S 'H;o/Ӂc]^hNHa3k AvF:gҏx8t YWz}G(uyK;މy/{ǫ#A45?N$)~rD=ɫZ|9)B*2B/N%e''Ft_땠4p M)E]{Uí0)+!.vνׯ'qDxTD|oCܡ8F|»W.7&Ɠy#Y\ %C= W-dy+a d*}-aYr9{kbmw?!Vvqe Q_#fE'U[4z*乻+ M)TV BwFꙐOWி;򴙇gNdn p,uT^wˬX5ȭː${8tɼ_gx{*@k<7w[t*8ϯ O7~^"Ӌ90zHJX7rhrJImf\bl{7}9O<_jm5+fx'3 ){ݥByW&p[gH4{S4{*!I<[Sy[޺ 簛ͳ|'+ =[ud`i'(vǑ: *2Z$[qqKvJ&5T&G=߀,PؤYͧfu'^w-яy$[7EIS`r[PoɊOPXuJvvTC6w7&QZir=2.Vire×^2~H=B#$>~r'Hvmu[1{V'OSVF:2N25~zڼ+oKk&y:JA>40p5)L]UVۄ]egTO,v K%sl.!3oci; h)@jb"L, cJݐqIP!`bK͇P(C(XذI-2ŮhXtuuk~69:,3rőfrܜ˯T؄H-ks8W'YvsX2{yzmfUB<^~>qq;: ΧL<3g}R uWThѹ_} <n#۲ewcax˹}JH\&hhP*O4+](~{꺘>?ifb.qjJv"IRK%3ZJӇ IK3bf"߼v2ӊt50]g*QKxnUH;)8yt;ZNBODܘvWdv2RهzN0V#s}>yMlVI yϤ`K1hݲQ\$?N0Wzm6/ =QZ?'6Tywz*dPx|9q!wp"}ΕsW8lg>WQX q2zC/qkۑg.poߞZx`2W sݑCHxEf\!-1س1[kC܃Zt6؉B{.DE_YhEaR߮[:I~3B־Y1AwtRvOm܂dO$xʆ " &?xmH<Z[GD^~ Nah# S O;'9C(:#H/F2YT#+P?8W³jJG(2{βS(hM$'Z9d k|*=O]qpGCWx2vk9Om|4Ćq?6"+`ε^%%2;aGBN=F֠ H]wBpٯHҲR?s h.K>)w $9qk79+׳QЏQmK2W;'G,xJև}h׹T`۹!JLkzYm*Qdf$FV.]n?Y(q>iT$dYjK zi+ }d wzG^M>-ExDT+*Hԟdt%i uv[208P͉A__"rbHR{쪃ȷBYCX %RT`lH*ɳ6zD1?GEѵ"K+ Y<{ԄgH3=~YGe~ɜJHqHS^"BuiB[)Mn!zAr;2OoCq09YQL# I8KnA?,B>5{Y%AYh0^c.=&w`ρHk~UǙ:CZ<\Nvtb`:{r5nZ*sNͅ/FaH{SU'bC7%r0dXjtޔ]Fqw#e\Wy&hGʱ4/?]^HSFU~롣ı˽z:9;ƤJ#I^ mwۼ ouHə }"+x{9;~[xDrp܄$:R^8ߜ`"iaLH@goϨK p4?u6!x[̦uEH3.>{;RwyBW2?Y &|s=7N+щo}#9CH6yc8_s;|`aMݽHˎq2d=/߁LdTZ,fu5?h%~^ZcHKCzӦa`o*]| Fnxn:ػ{arO'YC*>a4sAd /Gr ) N_^C잻NH^xoxNL5X]Fs߱%G(G5V;QA#QQU17z77JWEƶY+nS_XhL/`XDz5OBZU{^f߼!i 8*u] |Eg?b~_A$U9th$i= # ܭ+ښM{k_:w e AOhIz)K=Eןs{aɦ0rnή(Lm#iphH+{g;GM)tz޿l4;j٥,JV0u:~g+] S]YLnaaw#[>/"eO%4+ hKNFjHo8Nc&ל< K KIaheL1 qM"?H]`TKB. `Nw?@y }tx)$u*L#AkdqŜAHs8~W|y$e yܬ&U#e9y&D4LԇOIc0z9AWns< Ct )w׋j'춁 Q|WFE;pQ. ?DEmeAEB|+gmoh&9~t ywF=§RfY̭#D?ki\6y"7G{Qpio/`ʨ=χ|kL/2 gaj<@#DW(Xmr gJ)E*Whf6'2 'yfAϦjC<<2GH* _ ]C؁̐߹«&;[I'vƪu atΝq$ŚoM,Vhe;){j«enS$/NCv@o)| 5}wBʧ}(tjn}t&~]#˴46%b ~x"?+;PEy_d0k`2R$IdUX]%FEf6Bpe.QCY Ho(|蠈ͅghpŚbXކ%~a T *zwP.(z*O*HGW+YBޒ{w#Kqcu Tv "](knF6tQ?_âkQX~P><t廏doaq)u>17[d?/q"Exq<7CTԖݹx`z\WlR"hɬëtEZ^m늌_Mt!YeYD }+d3EκM )w sm Jsb{rh|Xw_$k7??TVU,|Z[_F$J sD?b7[XD2ѷuOeir\# <% .wiLJ+m# `7mGcnY<BD|_['UW Rrc-&?u2q<qs](6[i\l gM!>aYO[yLA ){CwFZ2O'M5aT0s zc #E۵Ӝu02`BC$=|!e uH/@&]]Q7ޮmBb]FM= I1麇"`^^v΀\uܦ[w; )su:"v>iڡ7cA>*o }x3vW^ rAGAy F W_3ݑ!Ci ],OŶMmĒ"DDpe㮭Mg6ꄂ^H c瞧EZ?ym䈸M<I*둔|v"ͪ 6[ZR :*|:7߄u稻>HYLM"YEUѷRޏ5~N2vO|m0pr )G?˝< .6lf e' s8 ?Cŭ/:'v (yJ_r1'O޿ډ|P$6>gv"٩OiV[# #>+B#ܐKS Äl|(Rz$iNӧeжQ?`(>r]lNdߠǣ8DZ;w~lƺe]) cB&K7aWGyGh̆x-'|)F.ϯ[St]fJÌ9/4UNp͎t_a<j>y {GagС~Isd,Ш,~7j~ *)e2rY<|sK:dۼMWTs K~o9SeN(:! L\YÓAHameszdBcc5uTͽ5Eyvl(OP?Xƌ^22œMb#\Fv.<& ߌ 9(dLG0i'?o.t,MgØg:#Y?!= ٯԳiG./|U nqGSmUQx ѷ.x{vX_h?f U|#\ŗ<{ufn켶/5F8#;5@hK$MN{Je䟧{I.uP`yY$-ܖupo >_zǾ֏W7VP`[)n\<٧ݻ!n|ڳo̜=1q$Ȼ1STeWRe(|p}Ƌ,.'B70GIBfhs)6KoLZNC·fV0CvX-=;3x[/vن b>H{#>/YXr"t@ϕ~g}$RЦ,9'IMI)I(HIB%iRj$$dɾyz|=>?rs}ss撗PdB́*Tv83nܑZ[w/|ݮ8;We"ug37AEwdC8h>N4/Bݟ77gYqza'2[unqj_52kYJzn(1CQAC.~2RwG9E-j3dG>W~T+^yhV񾠈;HϷ3TadUW)ټxV*\/oFcxJzuksI!A6LP-0{Oh6J$׫."FOAOS0T?6Rs/;E۶a-a=BǫSgeqiOKSAϢcfW=on&? /wm1 l%}f=Pfe iEڒu\6[&go/Fۗ?8j |ŠIV2C.%B.-)~;FSKt=8T(`ҚHN w3'y=79!ۤ;Pp*M륏[3,Oڬ[-яBݿvLVp`XwA4=X[D 7 iksK\7[,tvMy K _g'=h2MHJQ 9+gL^BZ3A?뢀M!isܗ )[(bQ~cd͏a0~=02> :1;FD84^9xR/-ֆ8_`HE˳a$I8ãWW_ʮ]uwVIV [D-a,\5^ڗăЫ n_]!ËpH( ao"}W܉)1PsHqyexyF殃C3U^s &a:4ݾsȒvMq@"uLcURL:037d, #9FVWPk˿:mc+g/2FNOؒ-Ns%¼ a`O+[%9xe(hiOcf2H"I6P_A?-sE$-hm-꼫ɟnrU[`'Wqm[~a\G-bԾAuuw egD7G3@K(uM֊ǧ0NO&^n\JǀyD~.3/ W, g=Eof>TlA#rHђ{k< nOJK^TFVY 0`zLxoW; %N=4704-ۗ[*磍(at,YmˀcT_2XX&OK ܰ8>܎nv7!l/Pm;i^}KGʲL(JEBWSY2,_;;H}i,OCY'0_"E-It౽aΗBvl~]M(hfua$}k\)~Y> lN!/;2R9/釣,;X(qG8S!-H&NÁ%(ѕEE*lg\&+)z n#' o^?g(YH7Cyl!#:@ktR f]H[+F<hyX߻Ec~+D0aUwb%iP(!8艄RMYϭ$(es0zjp-K.WCU]X$w6F&Q[ׅM6p&v6R2 yW%.Qh=k^ G]-ÑprhckeEMuKD728o0Ax0t Wv0R Ck(:*iO٭:x0ASzΐAqpcͷ}1+.Id"yD^ SV+ %f.4LQ #Y2Cg4J/~M;qg符ː&iF%^Hw}ˉ0zo ~;2ԫD$0slXBm뉣nz^L$LT-ơ3w@ሥP‰c, 驾16(qƏ7FԹSO7 M)>j2!Y2 mZ#e7[D Օ/PHւH/LN̓}U[!gq)}AqMX*J+S݄kkN>A"cQ.ou")tGf}pC~0VnZiL,xu,[ߓZNNr*%-oǔwCEKf9?J_ڼJ)E&f"KyGݫ}0ؤ2Zh\_o<1Oxl[}>OM&ϿlvM`OfI'ƏCesFj潟ۖø{B[Z;_ʾ`O|A틻(0sz#N1޳%a4JDuFa?:C‡Ԟgk ;:xBh0XPlyrJ1Q/W>8"QhW}k@dlV+չC#HV"ics {7߷m>+'-e/ H3QQEӇnXY]#AZ }.!Ʒ9$ }M?UC3 N@:u;V-'pgEiC2nu)ۂ}I3˵lLhWolݯ0pڛ+QX-U)'z_1%d>==[]5D|BXS}%L4͝ xPe0 ֫RC!pEt p~$dFÁHUڗ-Oԡi4EqkQ6 iݞ3,~ ]yOu,͞Ο×o}-X!~.x Yhv Ygk RK^䗐,ηFjӳ|ts=#e]Hy8qG`V/C g{#P!9l< }?fO;s`tޏ RSsmPkR O~nkk@ԥ`A\2'Ku r-Z wa0a7WO v;Rx{t3O]Ͻ?FDL}0mm< kt *Q3};#TDk/[^ ]̏6l~n?2.{b*oھMh}fHyGҷ{!#%V%g}S}k\\wiu%I xks=YW-44J69/cH_OLCR&TJ'u}3hv2=sz|$7g !檎|n*.<܇ӊߣ}z{n0Jck`5'+t k׿]V/wQm!NOKѝ$Zqtɧ&\JWJzG`0򎺧 ݲމt窎-CHRhg=JiEO`3E;8k_9(JR̙?̏òг{D2ǺJkBm R՝~nq_I!WcG+9峨-~lwܡ 6[+[mzX7܅tc[ ;ڻ6#.?x !e!VS_C_驋T*Cq7B؛ҍBݿ!=9n|jC3C88a?M Ԛqb ggI$_Y#:\sd1p5Kw$Sq`Q:'rncv~sb&/;X@+%*Ygt"ͭ>Rg)EIY`z&&h~7> mr;5:sf S$t LG\*/GW&9 vU7v6z#ۥ<,4Ѩ1_{&-wCMJ {6vm=+hVOP(^t<=uw"iAypx2 E!*vWƽ-n)fkH{CO&QЯ"L FaKUY?Ft lB7N`Ď0Qul_@by{⽲5/He em$푷q- =s^BlR)}ɼ&<I5g=HJ gSL xeܯR};=wi>i)l!]~-)z OZ q'WzllU0e ~0rô~QھHy sLAl襶[tV>8iEa|OGᓣ(3@h|$eDֽqF^d[2FҞHHH_qx615] #߃]v(EZ~o6 3ҿ֠'݇ ^ q_9x`ˏ⍮Hs4Cndܶxl@99)1_>aI缗"҄z/?O7Xm{jm:UýV|ٞ8\Ԏ_wۊ*ݻ^(h"*q^~3R) }~VM}Ju7<~Pr)u#CHU_h%Q7;-7L(ONնD]*AkU9ǻF0=oy*Q˔NV<rwC۩}2ϵ!QFh9`n:1pTjܗը8ܰo1-eQX6ծ/ / W+c KC?} HwyP#Y"”] I'\m1u?r]^d]9IBF(bX#R].{&"co^_̥o_rnP޿H1.e|ϴDǏtYbd$8 Fӳ >Dd (F3I}*Ox|O'{b"YP$uZk# +z/nF;4#9Wh | |>~XH&?sE2.t"MB6ȸmUJvn@^o^H&\z8zZ"a%?9&7'Ӯ~-JH<֟4lQU~`( sJH)B؀90te=-dtU׆$_ ixL$iq܄~Awћ^b龞JOdX+Q9+OUN;P5W"QZJHu%ÀQRq4Qj:FSM{ϫVrn3:fhsci} Uq$ tj9D'_qλ}HҖR(5m(?^{ v6 wk})⋶;x1w\2G{`쓼[r{1{m[!ޏ%M0d֩s:9{  ʑ~ f.6 ݃luHa>b h>9J*bB< gS.v#ԁ 0wZ|߷|j bqZ+\/``#=%,cuһRjɰ+爼|АL[(k5}x"BfDUwf~"d} _ۃ'WuD4enB˹4T1Oۯ619xʦyמ NdN]]roߗl>b )oY/~溅"!*7)|vlc1}vI%Oca={HF(p`w硵~|DWK2:B3a#t?hxiuI󖽢,\-}l{PHZ,@<ˀE2O~b@) Y:.*] Iv0}RO[$PtWF` dmKϐy0)Gx#9=dgi "ȌXt:]Bw$"s[ۗKUELُ&S]9F.m9?.&u&q TlDdzMG*6+I孧𤮻|o]is W΅9E0i[̚ ⮕߬n#ܐ%yo;!ᲇ]J0ʱ}($%sW^%UG{3D} /nM.$"%j7/3xyݕiu{E؉xCFul=K0_fK cϭ뉤xs&.2?aw{WF$:܂jCt`M`eTjvoXJK"9re|(n i< 5bH ZI7n!Mk&K9-:W6&?b#}Wyuk@r+H*^Bǟ_/kXI~:4f=E5U{.}t;ԓ}Y)b S~ i}˂^a9dsO7/P!3۰ߝRP{)4ɇ5 UK(lvwhP:wQYN]ɡp]OGM(`4B=[Lۑ|0m^&$^Z/]"R *p}.+b#2G59+Z>WKzs/Qʚmt|x"*(}yOÿCmnY蠷>/9h>6w*ՙ !|˂Sarh0^G~߲OC0hӛ@(4&;_,wNa|9ʰY Z)fP}n x_Ţ"ԞԸ/8gv]9'ۂ5w,hHb2߉ct%0s#g- n*Y#F\eUy[`|Z?m*< WYGb-0|F]2?+xe7sQF;du`Yh$c. )Ʈ"oU9~ ]^=LFlKx@ΦPc31I!6f}I>W I;~J~7cE0<UvTO^34k!zHYO>z^<~/tӼҴsea߁.IXt`bjL%1L(^$d%CJ0JfAQkG-0" b->>E^;.Q ;aL¶дUmCj{'-<F9v|Vz8޽ҕ́/[P#sl>{rCF[Cvʂ5-軨\:R=GW+To&hȎѴvq_ҍb|x-gm7P< G .Ѐ ך%'g.ò+kf m^ى=$}ls[>#gGڥ}'_~A~jnMX-Xvb{= sH$!.Gr'gx0(׊8FRL\4RKw*|lI?|_:Lj*2Rr>Ye%dUY` +b.PI051F^MZ+aTizD;ob(sWԔ(߂A[US X`]b: V[X0tsG`#'ru2ZQCqYeBWCVڳ_^y~ß(vY zo,фA_~CPUDNLG O رv lbV.K@プTOd {VF(*'?I\ͳq+}^kmIЀ~lj5s *WWe} 1P{?Ux0vxchOW#i>xnd@]Q}G7نT8yOé~!/C )[9G! hkI6ׅ-NBD֧(G+\]"mgoΌ7aQꞣT? ɤR2$*ӫ͉>.m&&<_1*uoe׈J9n[@gUO-b͔{~>{G/vSa]TH2R/{ _XK_t?z޸Bbhvi [Tr M#!#[p$ ckW@5/XH^aΦ.ϡ]]D_HhbK%~!i.=0jD/@ [fRl+9DBi^>].,WvRl_@ /!4dG|EGcW{Ɛ([+9:ߦ\E g:Sv;s7܋ ٍ|M];1h,ͺJDzM&RvP@$ɘm>|9HgXv$@쀚[d3r՝ ?FCUP롻4 )&"5~H>h\ڙH&ɘ;COg7G 悰yko@l y^H>)9:eHz$NJi)5*f#C]ل0w\V>8gg!НdN&99pdNEB׃qnQ0lq^w"p: ' 'Z2Cv/K 5ndj+5Rlhw2'q<3I%|iwt$K/~ 72#!=Ԑ#VBHzUOݾ9E?6Х)#0R $шB Lw9p'QGN?e^|82j+|׻ȱ"<q'HzKmJ$Q%SygT]Os=$pu&>ZG Us(&m~k; 鏞иsgu0^8#?yL(yx=6 J%i&nʜyߚZtWY&lEUH$zrk%>N3COe}EAIҺܞlAR7\@9#U(鳫ޏV-ˋ3 >JښĜn֥b碑ղa#Nz{fcO{IˊivHaӿpZ#ra zm1]^\=/wIw*/qlFʾ'Vd`'o[aYubl([kAR_ M@Vѳ9HyBE2H=,gKKh6t5|{M"weXR}dtkE`xXҝlK# z6u閪&DZW7%#gs!%,%mDՎ\% ˿KJp]䜊EjYHU<9ILQ7 {BVlGwOU P{2 ,'A+CCoh=*{ &f=I&۵x>29і!+6QCYM;P,#( xTmD-jZ1R&+BO.}}˴w}υCWO;钚⮟Oܪy-H/4_D~2=K/kz0zL]#(<8Ai>R |I{u&(xɺ]p|Dh݂5ߔlD$^[7.qbL٧#^,k̍\̢ #DGٹh)~ 2%BOA?K~쾜$˸oMӎxؐ軤.UgJj}$)29cc(a疯"_2AŸ#U=)?!o$Wy2I2 =-.R{'!:uqlN i~ s=8J;=y=Yq;o'yI_E>^˜ÇwaWNp1B3`C0!NAoY4}O&>󼗋ĭz Ļ#= Sw$?AƁs!lT,L7DYxI>= 屋(졩]1B[ѩHq9zR~"}AĨvW_c[[̭Ks~x폩("f|ƾ#m"pAo2MwXbkO& {T^|#?^*^/?A↝jD'| M tlw`!YrhWWL⇂%Z0f&d($VWd>}PϮ9Cc?FO;҉X_곱@Ϝ Gae/Jsz\22n"*7("}Zu]y}ϕsr"J[^j%ڱ-Id$ws|q|M0˹)1;!B"f- OxY~gQt^1Ώ%]zOрҢݷ8Y4-iȿ؁? [wf1\>8r:+M WU3߮Fj[nZ^sYx i|*:Ǯw;'~TwD> !T:LO(#ݦ:nQ;%S _|UB6ukxQ_)!"+wzm<~x#e.;(CLMhzq$ig9jOPȾ[Sy0)! }sjTz$#gkߵBqI苝'Pu[w {.("MO9~CVc^A=2)D7 95b4z>17PDNRã<{ILtZYO."3~܇A9$>mɗɾN}Pd~| &e‘E(0^~vF.h yoXZy%/ϨW7r3a<_f2 m׍(\Iy<=3LK^͝HSJ=l0NLNM6y-w3C2c^rF1t~':ivxi+c ~ zׁ%0F/W ZO0\_}v;FzubNdK0FE9fj+td&aؑ':$k^AV x_>y~y/~h i?4.6ʙ^vm֗-3NHw} [ CdP0,31dnXN!ٗJ#IJa_S_?y<:cz<}_*#%}sap^8s_LƜvE̯U{lvϜs:!mN1e޷CRYlG(*b_tBZs}t&拉.5rJt3OS]}]֯Lp;м@J)~Wh/P2GTWx]@>r}Gy%Yu =-RQ?ƺM# i¤=b ]|s5E Д#AZ?-'3=r- 8l$Sn(~W߀9a? 9dLC8%Wy+ǟuRVP3CyFzM?6vڽDR%Wa^k ikkNC**506v5TӪKۥd`O&x{ eW*iF *DMڲZwqd; &TL@ ;6!EvЊ0f(9;{V|A1;xZzk"v ] Qokt/CFޖ%_(}>j{?{e U=p#H\aԶl%ZyDP%kd>.Wk? <? \4dld}t &ПuOuEY `I]4A6e"RkMY:{%+IZSூ窼s+cO,hCt;z1ST9;!=Z[c*޺#{;c3@{g.5~t[ax]sh$(M2|{M߬ClHS[gnw5b^ڔ_sfۗG w9H~7_b5o!{&xɯ:WCaXÕ*58$ [~%7=Qҍ$ax7.? -;*tSiqߞhl6=%]L*^=F𛾽ev߮o q {`eXH;M_zZ7"EN:$ /Q6U|J^`"D~H>'eoҤ]HK,ŀ!ZӜrMM\6,GvI'G=Pd<j Cu]aI<>R]ߦ!szߞxc{6?62yNWr+ WqS +޼DG<QtyƝMO`$nj?ЬՖ"DHeI+0~onU̷OguHF̕c0e {8YQPҫK6;NFZ 3{`TJA^\I *|-(vK?T/Yာ=u;%N"eohlɰ 'BJ.ףH}=^CFtmo~Svꐹp؀8h-?QƓ> ?KMŹ0Qbݗܨ@ ي03tV8n({ j\zBw_*w5}2b B8%3FۡoOsHg=o`fFTB!P(ooD<{TA'-.G ݏ|ik+ٓHz܉Cݙ? -RO!#%ut^EΘ0.~ԑNs!am 79$n#WQ,ٹkH[y2Iy^:g WCЭPu'&FW?*#N!{cvUHvm}LMUUp>ԟ &'`[bKdn% JۣN _)pOv 2uEl@5ۦ5D>EӸ;SȎoɎȸ|`~*.)o:$uv0XDV%K^"{n)$]|ܬ p&bdNO}6 tv2wHP{o ǑychI:TVo5B-&#ћl=f/_e\#VzYPt/K6#(S^#o!YbcAoJ~ph3f>PT MO]Ҩ0}g^$k)8XSy'HfthSUrF#F|U<BϧEu $sxS1akV턎}68%\CO*oQz(S6}|˅/'WeMnWoD=ޯz|E⻉% uV/TFj&=*1N/qZo?^L|%w}+ws@f}񬝅Hv0,A}Wx諣4ҊϑyU#3XĶKmҚu~mM(`^/'Zwد6%/pAvjw?B&w@sbd'~KR(qnk޾z՚Ǵ;!b+R֜-uFg咿5 1+rV!_MȊ@/yy#VӲH&]Ⱥ_g Iaq1/->IcawI3NsP: a \~¯>d20vx^'2m2Vl3DGZU\5(1I_O- iHrZ-/J^闕Hֺt#2& ~*ʧ!Z "^K]UIᏢ$5k &YYyGocuYn@^+!x_}|{>8Ŝݜ=c#]ק:(y&Wn`_Q$NT `TI:R~]_7) 5Xf=1_PHbw_D{6zk]|_ TXL_!%xgMf P|p6NѴ"0͏|^?)h"nNw{I#1/XȷX#N^OI[zk?N c 'eǚOBۍ RMA(q&qi|3~%mgQi 5I3<[B.*z/"e5[W+[w54Gn]{jx2LB a p !J|7b{ªk! Q<+U-K~J,O?N#QqlțtҊS#/Wו! }m Lts{7z5ĹmQh II AίgMq}M L%;,x| mf ]$n(W734S9"5w˞`:SaSho) ㉃q]$Eʴ?76!]R{#A[\:SzumKL^s7l*aa26IQ7Ed)@Zh?@ 裸Y0xF<+BG%>_t駮 ?FҢʻd+]s=xV|ۥjMJXSifx>>xluxQyzW1#F }ZB nq[Y  f^˃ {#/˩|LmQW鬛I00V* s +f¸cעO؎uj) Zx ɯo 5}Crܣ}|'9HO'wKA6z'(um)}ղq'<>{XVP?G~ ɟ5WNGn/$ۭ؇x0k?Y!+= o u WK ^u!G2@feO^ĸ-W E\aԳuWIh2wEGf(f 鲖UD=EEf3Lry ӿv8%*[KO:Pqt$1 =>w ؜s"vd,(BM8RKRAi3;vh ܼa^c*v pE9{&8<2Eʇs7< /g`hEv`yu^._2M%] p߿hÄ:B!Cew9E|mDGэ*2zZkE@BRnf.L.*!]CSܮ0.<g+v}IS[-j_ UsD!1][:h\Ȇq{u/ЯѭyY 5'(o{] NCֶΙ8á~ H2q95lYHq4z}() B)| VL4O]7 y p3:^z o/-\@u#͚FHj\?6 c}DFlPksHM .vHu* D}wMǩuCs}qRo:']dˏ(\tDŽb\].{;y]SLÃ%ʁqJ_|Oh%ŇOV1CH^xMLM (nGZUPB|"=hw)W}|VF+r&ÍW7B~yxg֙8!хGHxR,kBZl=В_来 v$;<=&_w3TJ?S6 wQPi|"/DIS^6֋^9m3/;rcI%uB^g)0~'r4֭ԙ3(c>7H\lSex9QCF2_Qx'o;7ߟX8X02l!UKfݭ _Px3=o98⭘´W "Qd`sJӛ-Hcu%_{FSS̶ƿWF\-a2ޟmN P콟? so%ytU("5Q)t3;2k;hz}w~eñ W0tY\Yh'xxV %ogк@ev[DKBJ׌ HZfY8 x"La,{?=oɹV崙R_0*75 ٜ1CמDM/R?=&%}.+70dc79 H>9N~Z2C^j(BD&+ z߽NاjBo DB֍k~Uab9v*=$,?e Y.cd #HyM) [Kفq=">~ZZ"ᇔ {"I#(;:`'@kIߩmn`0̿$hT0dܻ9X5 ٛG:sȼo^ GÿwYd|:pW hx+wƛXSieC[1' dq@ڻ=D)c٩'nٲ嵀wjwg]<'F 2;"٬ _PA;mG!%ٰێ i:o( %vFv|ˀ%ʭYHLdVG~.qrmK "f^]cs_ dH\TBju9bŞnM?Uzu$mC*b$Yw=S>ofM)?)=2/v:IF m Adi,sW=Q]Y>F6 R=G?W~A#o8ի[N]"E"phh& f|?"Uz@{{Xg(4C:*Be~ < 3*7jLU> :!uy 2 6Mᓄ}y:Q ܴB"(SN DBqۣs#0ޘt3,˨8:>ۣb"|ˡJļz vBN+HzWw6z#n:Gҋ0pfI+ĹânqjXmz.=*/>?v/d\Į1Dwwyaa ]4(ywQ!"vQ{j}fb"YJvY9k|ªzpn~g2R^_DgwCdiuC L{B*%p"ȡMk_IA8m=orϮol`X!Lm7w 1V?#7% ;!sѥ\&g< X!k;}UVAu~׆ @ZQ<(rw_ 5yLwj:QId tN$?J_7+/nM[Tŷo`_9my*\r;B6Z}D]ӉR6t87mg9@lώ`U Ff/4i g̺ej{Ȕ=/G ~/(1ۻLG9H9J _'GB)v߳|]κCR,'e?ngZ||=)C޽*vʧǠcѵȚc"#g9yBn$~RI>5;־x,5Y,e#ȕۼ *yJ`>Lۙ^[zSٿ -s|qLtT_K{c=.QBı&& +,fEVWŏyN =:?PE-}Yqs&ywbƘ%YVJ "U 'ybPzy|D91ϱ\Vͥg{׆x<4Lfm? UzL軀msA}!; ίQZ>1H}wLl)O~sJaR4kkDJnogP$@f|jfB}bXvJd sB3ֺU`#=xхT<+6 pυ)LMc0q2]7>}1 fٝ؋s%Pc i8Vh0Y3Һ齷[-kgg".C/ iR'0yZjȰ~~v{?g O ޵ jci7䲟H o*Y}eIȅX$RnGUB׋[Wgo?M oY?a7qxo;^FJOPgq]f8\|"X>v}SSf( ۖwCޅâ50B_X>/݄ MBObsO.wub\P(H`+D,5PaǫJ,^L4sBBNFB1艤0S.׿jw|J(R̕4ÑAth *sǹ5 iiY08v<'t^ۅ}aTF71ao1t M8һd3"*_׽ }HB*9|"l8l1+^JGϟT>mG֓9mkO{LhDʹݍtܜD9K%5NS`de}[tF!.IW/ [#rfGB~ubȚ[3%_PR fHXMwVzpM2΋w4/ "﯄ʉsrk>%"d%֖i75Bʯ7^ q/aF{oH;Eל2FRV:\}N/H-"+Z?YmQ@Xn2iXzBPz^?!g'H165I;^sGsĥ(r惌!/ )&>*|/b7.lǃ2e0 }=F*+k 33CHNU98 [Fgy'Ͻ=EfQT ;rM7|D'Iѩ%]6"ON’qަ:gc_\6(_ZaU7PXV8|&R1T/D jRL~˄1J X ̹*E29pFcۂ\-u|yMx}uCIH=(յ Gjpj*ՋGWe" ŢNRFRs ]YmքHU6icŷd^Ə9]u~_%141唪󺠎uKydw_o=3[qu4{6eH׶o̎+R=#zG'%wdŸZryR"+Svw(!p_0!5,f=(m'&X]0@6= F늎6B~cd %ϾXf䌤u ig{`dN֡ Ϧ#~܌:~׿.#Aap[[{i<ꪱF c;=ߧט=hф3qGO@U%W6% T+EZA´nyvV"2 _($l"r煰;4? )OI^9g˅%QLƾDyl >݃bU|Sԇv,0s2~$?._ yW߭H 9wZ2Vo!>$Ҧ On/؉BklVx߂}[PJE~ ufC Zc㕍D}۠CAV?|Cf7\1YUH:`;p )PQe9S. I7mV񊌰.A 7?$iŦ%Bo+E|"Rzä Q"@|6wmdD#x  )GW[ }|C g'H#-q.%MivoS+FFľ90mͧ+<|٪PX=|z¶5eèƽndkO"`ʲwuڝ~ƂSۢQr>1=>\c Fj rObkx _$eSU!YBq8g7HI11gP])t実 ^{</]?NA^d8jq=h}>)V(FQ Y"eIβW|Àql K^>)+V2j@ƦE>( ViLE#rMsO5h5a0#oOM,R<С-D/rY7_~/tG6OP{Ǜ+ 3ot3W}]ǟ[PlmD\"o6*-]6ÔrFbzZC§dHB;b"7/Qvp͕vx{>8PF!w"áp$qB=ܶ"c.pQEĜHʋ{b;q^Mu/Z܇Rˏ_Y!\k,M/]zӦ:=̜E}H--vkLGq'~ tH{r2dZM9ek;}!CC\~(^&jZw &n4\J*f'2*'}\lM#-&#-9y =E_ޑﭞw8m6Z?1: ~J  z49 R Gh,WΟҿBo\=MOvdhwG -ou &WqHyqqnkAptC~SI3n碎NI]3z3ĔGתswr0@U_}P[jBOc3Wo+~>tM1Bk EFϐ }oP_Yˆkqk79tq~aO׹Q ^"5,vGǐDo}6T:dy{E&$vc*x5m;w0)oJh:M]ۮiAb;9aWG3ϐM AG-YW>H,!;K]DZ1~Hߟaau4R-I'*.kfG+k9/=鰾qo<~ YSGm8J%ՂlC_$r~ˆcyeH{Ml<\7r| Ĺm4A.YP1&zgRTY.c̐H.(*j ywZfҭłz)ʳ֙Jؐ +@a„w3ľL|r9/GjS" zVXsX/9 xc|0~enҺ &4R;0yѐnhB!L0 =4 iO.z˛S`~kDz F'/pGӤ=OKZxmM{__^^=. $.@FϯEݿkޠ,!OH.II˜Nca'ձǡNK ' XC($J?-9="< SQG) 3uDx עOVA#eH>'/гg^á7"1K[΁20=z$|]a,Y{lr&ַw/wꍟZjK`PwF3d>^zjP^+ا(qgER?En5bNܐQ cX :\Zi%;_;mSW%ܝ’?nf p~N\?%C}&,Վ-#H:dSI\<|3~l >> xɿ^*8eoV/~& (3f?Ş2^ Εg Ʊouz:y$kzH A%do$f>we)Au[ûK"ԥ qƩәY$|I.?BhDE!`=ce[$Q&1ǃ׿K$osVIc9;6 %{)ބ"jg%uS`H]u0b'ma"巹AQx1W@_IF2d/ۈ/6Ǒ7=DϜACZۑCou08RjWBCcf0\vy'$gf݄̒K ľؽ[.VصI}!v? vG̻NLP\=o+27[k"+.^0fEPIVN?zylrdxDmnI5>RZnUqH~~Z 4KV:D)x7Hvk{{*K[kw]P}O\GMh}#2vM iCR&0jWÜ,)<$!noc } v~E _ UeMs-w{^3ۉԐaۉ,JI;I6Ej%Stz]jҟ^Zb0?H G ̗]sH8b /{ờٹLx{kDe?WK sUe0py_sҍb: }f?;DщthGf mHl;㿟7Ȣ?|%0=g>w0p| Ϫ[Aci.IƳ[z=+X WՊDaK$ۖu"Cv#xu"E= ~B5[è{ |#JRx$2X ՝Fv.˱>op掠ޡ&5O^3,X8~틝$(!I-4cIJh$mRQJʒTRT*h!.ٷ"d}yn?/<㜙93s"ڤphWzU =,3Bk^3u1mQMa<Di!DiǎLj: }9G`蔛yҤr" /qSB}ׇħM.nfz_ }!V+5F/~B0q{kLZVԬMK5(7PuĹ7`iHZ*CW ͱLw8E8C) Y V{:clי([$N'F/Wa+T3ss]-/'k[C׏MÃr0}B?)i7Wܾ_8<,#eyd%)W A_`E~L}>j}z'oe`bUsP_*b):\Ys>_[;Fv[]ѲCcNyY v&`ZXV;Rvxk?GWB~~7 >r0e@rV-IQU*%k&̨:]H%~}הuTzOB k1کR5axVA k|2 | ظb1{qu;|_]\wD!YV.9 Ԯg|C֓sEHnpu030bu  d?]xȷ5h ]B5unz0~$|("Xۜd~uL Yۺ3oCg?۹r","v&L4z[*yǎCxֿ#H-X䲰arH:vy92H|D߅mH9ccԨ99 n FuKY._zuz 4F1ae a[al~U8w^Ӫ>e|nzgظcPd#߾:>xUL$m=v&MrB'v硵,̳gr uayo0` #Β:^ї9yuc}*q ; E{×!xiﶟ}ŀ߃2b!a]Jn?A :u+`BPs5}^q虚wnȃ? ;YEd#gƾBϟ>n؎0 \U< ?TrJ}'HiӷB{"TPV&W R+nd=K3eOoE>cl*dE3Z܂Lz ~J6:}aV;>.Օ+d2t)l -k#yZ31 Gu~k+[m9_1+<$7'%i'SJi7޾}:5#Iw݆z08_f }_,o\, D?Ӽ |nI m,ߛ}۠` @뮿V_ܑZIE\]?5:vwcV=K`BRHCm5j#'"qdЭ;Fa@0 {UL#!E0g..}͒<]@gYm4-mWͫ*5a$L?uG~D^S|)1yN׽vE2?M$ZtG'CaH{`m*EKSW}OtX3 eӔb=JЦ.mOjCGFJK1O=y;'*B'-A"ÆPvQ@/.֊DڗgAh'ӮHzwq/D@џ.}E~RpQE: 4hǮE[\TrzObkP_j^*={Nx,<c?$\" a0o_5 찅wKR\yr;Xo^ i:'7 )-gWtq6sGNu^)L\=ś<MdRfS`/eҵ~xDnysؓ'm)ʅ_{Ԩ > $O*Ja< Sv[zRjEK_/V{8V,3zJ<q}m1 l,[̻ ni }~ !;ܲ+ퟑ`0yZ:[JI ƗęswNA&iΎ~(P#ƻ~V]:l{\[%AxGumDoZy-sN؁ mȬNˊW|pCR?wpUv㏤ K"Y] ?džSȪ2]濔$쉠MOsQ𚡛YҦ }9[lIy9(v4$Y=[ 'Ր&xo0 #m7"ME{( ԭ v!yZC:C?B\{.̊G}hd8k-,Dio!r\rE?'yBSF )0t0CU\뭊_<ug͇δFl4&7?ewDBi9ݶc(2"oOȡ #}\Oy$/̵[Sqx9q:${~I!okjD=`df4C'֩oɋZ$]]L@[vW"NݑtyFR]w`::n_22Vo BCCE<8,ڧy ҫVꗰŴOf^m_x6˪䋑^[o[oȼ )u!h<dwK:dN<G-ޡ ʓ"Os+h=>;oj"iJ?/{*<:"SF6/V}u|) ~:ߏ]G>mm+j]=+/lfP> EϦ!9B?[U\&OJ|{W`ks?uhk'ơ6 i=wryUd`!HQa#_=߷-C+#x/(1FܲW0`i3J|UWJ[uG?~$-1m cjk!{e`xD;//N~/Y{kˆځស`Dw7o ]}CZsRcQ"_4٣")sB΅i,t_$/k<yC3j}m0iL/<^7IDkVv(xFavd,) i/ߋ29.䥀C< )lib}X}"4ɋaځ3-+[foAn+`kkua͋I`teo>I!NdwyGǐw%Mߝi<{F#+'Iۛf궑/+*=< #)<r(ub3HƽHwsc ."s4 HDf[}/^4~Q$h3RcnjHWb9YȖ'6TAu?kϿ {su_EE\nВ8x1I=nW+6 Uzg0ڥYͦO-ua6%,he8 %>K8ʜJjA*r,hG;ƕM>r:?Ck޻G0ݬh ݋VDvLw PNͩ(8WiWT8#zh/gqv_8yzY' rzh4['#o>øѓċP(,?yN[:uB?OiIXՊC{<+Y?tG~iyƍ0]p1d0c%;m |oH~xճ( .nn!F3ڨ[+qw=k{eM{=L:<D UOF//PKaSķұR3OhL]s-L)ߌ4YQ%țe&? '.Bڵou}5\ ̯Kvyܭ_3%P#]V(haBۻ#UOn|>@PO x#$eއvϩA!ׇwzB'>3dg~|4sAgM3*Z:ooIZ|L*A_ [ %} 0j[07cQs2sGB} Ar=3+-\"c&D5g'ȯԇԳq٤dx@o眷 c^2rf c L?4Mi"}(vcόP604|}Lܢ5ҟ?'/x/|N`%Lo]JJ˟G Q{]H;g)nۧ. pQ0˖Y~wΟɇw/TWB95?c{%Dn0u !xفg*p.Q.h*oC.gPi8*ڬG _b`%h&>l,q2\u$5 $K wv“ H_GGǽ:`S.'FM8خyƳ%l`:j_';T|1`jg ; s5axZ9K /OིR1>!Z%W9Cu#!%:04x`2e-ZB=[m<99i;h=H}k?)Ž̶H!8ȊpBoH:8f%S U|e=.!(0%wߗLd(+Fj6^ݛZ%U`T~y(<Ȏ6?Go!3[o;RhvKϚUqho;;Iyֆr.pA˷eӗ]l2 O:sdž&hjk^EPaJ>\:Pr6͆0}|\ 3dyqi]~t iB#`Tv_!s~S"KڅAONI0/Re pÝUA<+rU)\>t9&7[vF!#(N fcq"gHD] C}q ~(%6j.S$vkYnzq, Z &CρΏ¨зkh{sakwL Pۀɯj\ybϩ׸WFBIMy64/tQֆ"RC?x&~#7+# gt7n>e /ȿ2Hu Kye [lvEڍsz.Dkҙs?I-^EKH"&t2͕SHZO3!oM+l~_KΛO F\qd5O^_2GL>Z ـL߿ Qww|Rk/CzMG߿BT0 $5ؙC>-} Ed}?! Rad'?Ok[!m\A W?0[OPȧQhINbBF9/ROl6QK:RL?|oI:'%cBis?@˖Hw],\{%5 fK߆yj#9vq ("H{Cʒw<8P>t@DtaJ.X W5#ƶnDcwuwd|"G9뇉c<`xAB dy @2ZR~:%K ̋ ^sVZN`!)F}eQ0 ڿ"T >J S2rvlsa^~E_Gnqav"vbedd)`#*s\t[5kʹ鬛$;z*{| Zvd2Sk)g|D "&X-aR6d ЈS#?}KAƴ >a㏹.]zO0h~=0|Xm0qFCWSj0VHRB49-MXq_\}"UH>H06c;x1w0" %Wrzns.Txb)yGV>tAHm{[KII{?_ Y(^%DwZ iQݴ#yc_N;ECsWBYH6s~# Y&Sؾ  ҃.8[Xmw/@]` =LLxZFrm|c&} 47,~ b^Б6'w< fߩGx)$w} (0@;%$ч޵ԖC{|wCU#㧑npk:!?#9D^5ۥT潴 t &#_TdyI4.7K:sptXSszs!UO}%|byOJ> gui ^׵ u*#>~+Bc^eTL-; ? fU]6Si\L؉&i؋O}Q۸?/~Ry . {So dQ,"*jÎ=R6ئw $/Qn}|IVk#iHY`zҶĮt7};i6yRXMPpۘ֡]P'r{Kr =ylXsn)ljG0VH%iI3 ߬mܴ%v:WbK Uc dF<sS~AC>2 q-R0'9W/Pd#'6>^&9FOVu\{^vVW7|<yM1*x]y Wo؅K=7,(?%=HW| ~InRF5p)G2¹vGg-t'n/I P\VL)LR>;Iv9dHR4ؔ5?t#,W#9~}.]Ay⩷9 / \{}Gy2~͂28-$RĖdl*~˩2T#NS]B^랼ICl^pSd=rw0Fq}[<~dO\ ͛J% `r~Pdr~vdA%asg)MVNY.Ly|m_^7Zԥы0]%ۛ< wu>م["CqѴ9Z~Ze( !|JA9[>$mLJCgJGBm ʎ{̇YeKEk*E@o#M*;y!R]]Ÿ]4nkir KI˸]_Bނo]> BKL |w1HoaKaꆕhf a"֋-S0;eu-mt(@z`Z) HC DƅNZ0*0qwh-~2> Ŏ vΎ dܹlPڇsDk%򑟯fsf#s-!3J5yOc̫[j0tMZknjG&w=Bƛw{ X<3J֎Hq痙ǀHW{vCžz^1O"xY񯷍A4UM'_f"c;u"#پSnY s 3\%al4y,ʟe~#g7$@aȂǟ)%i %M:y_7-.Iƺ+RD H?}8rxC^U"PS9$!W1 1®C L7]&LYrg/mb*>[T[w,DE vyҷ\>eT4#_#S]ѹոnDu\Ipi O"7$4ɄpcT7dqQ{܏~VG F+MyZ ˑijUv( L6f0whCUb?זM_k=zL\So{YӉ?]+VY.7%k2zxSGyQ Jfv|zr_VA4!w*b,S;n#7'OI_~8&*R <1:Odз1yuhWsG' KeFIbw@߻>}/ ^Y}$YƱ V>Ǒ~ ɒ"+Mkg8эTQ 8 rN#ɮEo{2jǐZ37u=Vք|{>2֮'ѽ~!qw^ˉ~ բWT ~~RϟÝ8繷-0 7.]]ķBsV^CeHt=S/|`xq.7"R`CaD|̃ dk뿨} ّ/"DdA!{# _I]axrؕH^~tvs)kV+:=__{>()'^5Jc{0yĦwHvXjٜ |`7=Kr?lLȓӧ__ 2K (Ԛ˿-WoT WGr+yLʴ_ԝ]G[!L}[FK &#SM O L)kiz#KUЩ D}nem&u %"sr2>O[]5_n3 リF{lϬDk+ɲ&EzF< ~ar\;zNq $g(9#o\R\W\ɁHjW;Ci)6Rm/y ]﷒ѿsShwn ݷ%x_hbZ/=ە|/a(%cذ{>y~w% jn˸A\uF~_9[tj^du4<XHj^x6q_3q^gA}9y9Ye;L}A|O᭾a~< Y7 !XH:Տ=LKQn2ӏRQ2ngNjSn Wq~NVȺ@o8WeY(GEkF:DCo !77"BuED?R8y!jAV<݄s N.'ur3mkZ-ⱂ0>QC1OR)}[\LË;}GrLQ=•TR҆§rLۑ=/j1Z eF@fسetaJ^5T|[Sϫ?QHHtiiCweHEZ5 =HhtM6W/n"l>eaAy;Tt+j.RFɻʧ@r< qO,*BuH w3 1 G4a:$bnA: ;|yir?XZ;Eb1w=_u)Ҏ7 E?K%펡0}E.ϛvUCJkuiYMV`ܲ݉X}!^ cHk8z B^M0qR_ kxDO, uRԏv3@jR^R}J 0q# &|*"WZb.X ynj!{+Dv[,̖,@rȝe0NA:2G1r Tnkb):ajQ+Ig>( I ٭v4AfW /s&R,6V~Y- ~T]f DF2Gl~:~u)_$雽>jAA뭐(Q*[ۖ W^G9µny!kd3>_~pm:q$aco:ylo1o.y#Uؼa >u|dM*^XOċ6 Ej3d0> x}tD%߷#PR;"G7Q掻f$yl hwv &#K]b->mÓVPĽRޓ9ykWמ5] Ron'/ʎ1 æw-xKyʳ']Iw"-KcxW .\Ww!IFLzif*\D";Q})O 2)g<;Lm2`@-#6wiv~f>[ zW;b_({7+|{`-|e\O\j1D? Oǀ'%HuY0 WdL9燳!5JR'KHQG"$d&i.|=u~B\3pIߗ!I$i5EAa$k2wFk^UrYh|AJHM8zHpc".szkޡ4*>}_]%/LOѰum =5>xR1^5m}Z4#3~'_.ucqIrv"n`5=g4#wNnY 'oF7|Sy5@O=H\jW'kR/Z'"Z@ e5d Mr)ߙ\¶Z ʥ# _s~Mdt]Ăi%MγD~iBϷ2 {?j<1_v?Pkm{CkFx܀ Hߵo:R_F^,G7ցi幚՗E ՞Y:b#c0o [J iSCoQ0{>$ūB_'A/;VP|A_EЯiƏ) >)Bu.}59S/epEri 4^y"ΎP[Oa`Oβ}fvs]]Eҋ#0h0a+R[~Ѡ+_Akqc$c4E0ּ9S[*Y# sީue .ng2^S`TqE6Y BZzvO!y]*D&lCYv)#Y' j P($%({{~z} ]R3U!j 5a~f1Ej1A;\х*2Km% PUV'KOuܠG~~Mu,ٰny7_/}FB:׶e. |\(@ҎвJ&D1;;|3y%2Y- W@fHwZ|,>5N^'3j; j'R}V,_V mÔO0F ߸yU_]_YzQiD>O}SU#tN0QAu%tf6˜#Ɛi/) l) ia7jŕ:zB.KP]{Y$ OW:ͿR7@+f烳ټGf]xʶt<~-&EfMuhٿ$i?Rb_e̒}Ga$vȥA"?g?Of}&uwa}jL(,?whR_ yAx?^^n[7IOX>z -x5g >kkh'jKOM}Sa30{0y+˅]N4NjxxSqnJm*v~8?f:"3p=iS;tytΟ01?zVVBOX6*NXB a0aD䩻`nόwⲫv_ގrGqf&9Se!ˡ5R1L|HR$[M$~5o_dxhɯ. +guf#3U9Ҍ-y)y^,mN˧4εo,'Bw Eo^? 1zG+/"xi4Ax}|@KwE<FhyѮ hC2ϝw t1{QF3SV=C{N:OF NH] SdOf킉{wVDOCߐboRd Z(B*3og خ:f|s52”Ys˙TtgvF%A/ᑆ<,&ZƦ?b퍡0,e㯄ܫ~x-m4aZ#=I9" : ! -SqMfH[A%rkw0Չ@_EWbL/D8+ym$=tBo1hdJܿ]*Ǖ(=.hKOa;je;ͼ$`X _M›^ GF_vjX YQE.FvxO7l{3rw )^ۢga5&m tKUC{MD~$$}&.z ~ou. kk}MH}H*BǕDzRSSx3{?}"-lK?"t&6Fj#gM|y!vFsָ7ySZ-WsCڃ fW) <#zhڿ]" /3,DAޓ'aRRC&?O[g%6zr54~Nؤe7|"xQ_H_m6/ +qq{ԦV0D:Up^!0WCf4~u 0Κ 9MD?#;h۳DL 7,{ڢ,2Ok$ŝߟ՛N9S!fOt4=mCP`cK)dŪ?"&Ź(K f$<)͉-# XSPoF<{a F3l iڊg<6:5v0$4pR>qԙܷpuloUv$}{{|NAo2>Ko&əB<0qt2=DR19ho/5x-HqSW s7H0tdbOTyM$zܽ]c5R+O tƚyԊ*f"S7Ɍ5TC({NД"5:>ei:4{k"l%34qZCk%{{]o˙ H&>W izIUGwâ:.ο&J[8Vv1+)5.Dk)еcIJ CSO7@bƁƓȲ'9Kg"y94 F%N?,.oT_$ۮH?q{qwS m{28){jnBQuH=4)9g {L#DOd;,$x6CZG$|(\HNwl7T__A䩑# C6#ᘻ;WC\{@̌xϑ_%~*($2o7{r=J< [o7AƲ:B('.{![4) xгv8hתʱJn z%CP3=Pwh{_ * s=ƊH\#.$}/&oB7ɞMR@B/^t_#}NoH] RÖ_Pcw!s ._FL0V\tWOh@~{۳ Hᙾ袃Tk&g-{nuviՖϵ+a9{ٔe"g#$a#P6Gwjߝ jeX%*#hzÏ xEDDe:u&AzGUi5|7O.vIhC?~%!i m;oO\&nNcj_#E.!A[H b2ͧF>:#yYݴJ/y]mwmɫDJ!S*vo!uթk[`FҒ0B*Uv .6ogBEu;gο@gUG"[A8QZ\蟎^l-ZWQU=sn_B;9WXOuҦ;iem5T_Ʌ)p[!+?]?qT- PQEٚ"=3.t"K+Er oНH/I-@z"uGKsg4L]gz|%}!)WH\gaE. Z K Gփ8)5o RPFRsɳCg7,F:\`qc9GIt=wdxp|Lm5 ^>^BDmdPnڴZlBuH^'>:kwW"a'r)%hS#=7+y!)Gy i2O$qOރ m39 WRUeA{dڒ{o;A].ܐwRd&kPY(iޅj{$ѿUԘz}J]oX$])Pw4UmZ?[E"ߵr3wMsKx@=&D|XȆ/`v&1{c=?k|*W2W~..rK-atP}Gh\]|Ig$y5vQ]_qcւ0 !24yZbL=<~bl'7?t!#9|į´Au~_Pշ׿(ah ?+:!Da4K$ܷ%yz<f#O>d^OvrA='uRI*z&@w],~s^ / )!kr‛ Rj.͒h6AjMHM,N/)A~CWPD9H{zո8lu%mKڅZs-Kyw[Մ$09VtR¥|BƃPH6A Z됒ړ{\ w|$an !/bZ AHM^^y:j>l=wߞ7T#/#8hv1d~$36W<+%O<ϧ$ "3Ҿ'HK`= X0k(rql _oMBAc%=NmdcUǀe\!ѪX m&aYw UJv![g}cɶDR-ɟB?RMBJn.nA=dIĥGn_Wmrty"g}G}4ҲW6u>E׫9 [Wsq&ΩRADɬI$x>T>@̃v_@j~ 7]t#I~>$=Ts:>]Y̒)QZ'>؟#<tPRE8R'w쁁Ss9ս>]]%jR G&?KFOH[!jL?a"c;*;m|OPVz Wd=cWNfS>vlbBwAaYydے/$E&n2Dʷ#sK{muH_-@xFMt)r1CZØOÀ{K8Z+鉴)nUb^\}8%It+Za6`a07<+w%rbm j·dNW|,mboS\u+Ol_z˓8)k~ĉØUP@h?KyoBOl!z\g1ܬSKrhHc+}q+>o>M"]/-+;rS PE^_C;@F$En}Yq&ΉL=rs/`5MTf_ۯgx A߲?LuAF6L?!8uV=/ԟb^p:k6 #f L?{NtD7jLe'<)|O[ƵFfYM{aB?h- bdw \遊?atIl}$<`ay';Gv?g~2$}0ҍCzaTqx/2z3 xvg 5u5R$45_I_CݽY;o:"$"l^'|aCKEw/h߾)jGUWb#=`:vvb&>YZ?/R#0 A-?7ԙ'|*[؎ӗu^|kK<.>4T"_6m|/nkCAL(ӑlG+jfD U֊@%А1'ŞZ+HM|u/+piBަ{!j.lLmwp<]$OK@n SL~".$`y'>}#R/!qz^?/'eW!.{%H߃.#-6-[~ 9ڣ%;#`芋Lh Y;~X.у6!<~%"nɖחV1U(Ik$xPFfyNM; Hv#eNr]q+>-S/G|灑bCy$ +/j2:CAu4>yQ{e0߽BG[i\ȩS}zmئ0ֵ6 Vt|;5 X?`o3\O qb[$9'0;"kή+"gGS ?[h w1%C Yï#mn~ 9П`)ϳ#N@k醼*O99- 1Ud7tΣ\?I' I\3A2xTdd0l n蓴0ÜȾ7#z?wgxya"P_"2>oF^ _mx/^?ڸ~TOPXg (lrq[ɔB7POFhUː0Z;Ï5 =|jա갨 E0"Rxds^$Ka JM.bWO[<.mzuAĀ ^׀"o?&TFCmgNw4 =F1[M`trN]r.sF9=-<-D{¬k}ܸ~zF0 Y7) vd5uŽv@`:$JzGzDi*:ЦϣpҮEf@cڶOǐyMjOnˈN;=}RQ;_mQ:r5?ZV!sO|̸wq21m656?SX5b &/I)Z2 K\';H;\:4 0-߫R[oWm*O= z$C6$8u S&3o}IxOK-sULwLoߠ<2>jpvӐn[<O ~['AOw,TqՁ-Рf`czGC27F6 nka̡LԐ>w~㡳pts(aU0$" }jODǚ$a׎CkMK!h;fC:_RwTC3rK5$=Xuo-do(]d7ӅB_QyjϿyòч"5 R0.C}vP<$:5{`H۵/Š! x"O /rn#8(7O@hI1[q,~S ($ YW3UJ0UVjS3oo@OZN6E N!c"NTt?c~{'Ry%@|{.&}#uĩXr̹|C;գU>=m^Z K螵`v۷~P}rFcRwZKquy>xaj.kT/OCԧ nW FsY݃c4␺3>Z kОT}׆<768Ds ĠlQ 08c^N;]"t?x14M6]=yɹ:ůq28y':ڍ9A!5 Lq~z|tȟ6Ԓ;O>f,j^ ?Khѳ7>d!r':8MB7e*xeR0ԋ/n8QM7HgAVs20z0 +uOa]`Bt[ϋ7P"(UՅe}>@S*-6,rݗu;Xz჎%0jVd3r:[Wm~gu-6?=1+=? .{-D#i.^lT?Jpؕ$;-q~d8h{\K"M>6L;#օo$1*q y$[pj0>.g=+D'L:=9!UI[jr"BEt!Zxv$v0:bۋDx04$\ߟb'*-F ebOߩyzqј"P򞏌cg-Ã8w|/\ε_s3 'eOy|Tgha>b5Um3~Brޥ(`b9 )5N .=m|&L=uv{d<؀0}_zͤѬz "+IHo Kk.З|hWexכ"iÀV!ϗZd65Uη w\#v% 1Y%a~,Ka|pMCT|uc_H#j<}\r)0NOv0g!o;e2uΧm3Bݲ=e62"ߛm$#2yi42^i^~R2_bqs:ܬv0OKu"P@lOh*ǞH~2{zܡu'9yTݟkz%[`qU/UY IGq) V4D+Zɀ_2eHs 8(vBr.D0)9lz͞DAZqq tG /(H<=I3ȕ˻ծc-нmE8LXO}LWvJ#i:yj~d ̹+Js=n7W60^D:{ i{Cz>A>uZ`82Ld|MHqEw̄zJ`](j?v%UOy_{_ @љ8|귘d)@?->$elL\ܧr H\YD|eK25&jfeANj*S9N?RVX xXUp"Vh0YOB~~6N"E}ׄT5='~oeygp#PӴ98<t<~ Z¸ݥ|ƽrN ?0؛O kUQV rZ @ݲeDڙ 5X,^#HʑE͂?ӜgΧ@ƈIHpYIʯ"擴%_:dRti^ɛ/C:{z!k2COB'8 \ )3Fui9n[@F uEIKV؏7%]s8y?5EZԄ_0꾃uګ?} V\u.fꤡ>u[D /J:l/R|? T0W`Oa6߼y/L ^ےuA;/i#̅mЭ!]_UP\9a/&= Cߑ-EJ@{ρ$l{z&yW/lY60?)4GCzO#3^ "eR?-<}Cmq~i6C'Rui0*ȲY 5n|LjМ+a~M,eg=5vPˏ?^9mzkP2b%S}~D~G;^8*˗vz!A6 5gwDI[drz|\ { yI܏$~M2$3z)J_''l.J9Ш֣>H9lRY3켤O>a:1Y5?#d٦epQ2L$g\U8yd$2 Nr߯3EZ/^)36y*йY8e$x@>CFӵ`XbHm!x]u749~ YQݩ$s. }l S~} <{ V@]0lGZZ21JW۔a̿IoX~"cO0 }M*gX!+[6U0_m E.Vo*}9܏ kU ;r(Mtt"`SՃوyQ|/|:Jlʉ F0yG`ĺ|~h޸Rl^ 9d]sЎ +r"W#iA \R2Q3'/dȫOwwzp}I×uKoAa{b[B׻7B~ZZ$ MÎdYk@D:mZoE3Um~ldԾ+?`5wϻ`-n7 {6LRLďgO\7_Ӟ;hC0>TktYVwlGcsA[ )wFi(D+`6-qC "[L8BVӷsx߱DuJG}[0=G`z?<ߧu?Zf=빔2c:hiHHϾ9ުvV]F,M;լrϋSw|r_#㟠Y>my"a]ˮߘy"`\OF6mR= %)ڹtpq).V~^byG έ>uuB왏QZ㊔۩ ˸v[y}$*S^- EIg 9Ibt@xer "Mؗ۸BgGzaq4T\G?zpox)PPp"0 Z(j}dς~?/{;V> V)^ZV!%W{#]OpG?̙*cii3Z$iRۊҡ/9}H~%׽i05h\5Y{QPHpPټREsQèg&\꾼F$4?f7Owz>0˺~t/na0 IjOطrJ0STsDe-[*YDILRNmH>v7]W`@෪GiH.k f[Vy0rDNwb\렣jL0W12`׵4 T?R =s/| !zgs`b|~ "t<5 Ʒj;m9 A [Zm]fY *Go#uE#UCqTn#iS["8HoW_86_jM-Sie TVW]Bxom.gs.YS~5Кs|XL>qϒ9Ḯf{)=gNDzD Ed1 ¦`='0bzr">w!  BP)kz;v[WDOoh&t ּm}+_S#MkͨV:LZ&Y.#H$_sS:O0e Y?zD_UZlP:K+xxhx6G ՅGob#-$LvWT lt5osizoStޞVkC$WKWtV (bgO R+ yd %dz[G<{~y2RJ'Csh?#$i7MO0ːy[:Fըc{5h& ?C9 E?y. |Z;o38QXi^$u*{x KT<'sFoL debztʬ\NLƜ'z Nq|){'qhV1OGI7iBhxor?fּ^~:4UFS\Eě0t~5"N#C&;Ɂf{QTyoHu#ϡ }{KHښC BivC*kn%z]iO; !Y.$Xkl 09E^Y!D<:fl9d_*2[ >}g6ʵf,`j0dŧ*߿rbJ-I`6\1/%k](]Z_]8K_y0ku ӛVo{+rTmpfX FO  B'ϟ_yBwoȺr+g2!40-tcBRزdHߛ~ޛߨ0_x'7TtcE__ʿ+Rdm"֖T"H7oErHMi&>XK<_}7HxmE2VN!_y0ؖq #OH} c*bȣ?}t*EZ@GO.iء*ʭ%ϻ4n<jOP#ͱͧ?n(ZԪK'5럥"yk6RO # /`$۝T}22ye#nPZ?_;QR=2',Y /2Ss,,DzZq5wu {|(}d=xfӒL$pgQcɣi&߂S4"Q?gN\WDFաFNq?$ qo\gf[G>?ʇl-lӧ*;"_i5oy I.{ ^su. =4BrK_ܞ=*QGz'kБb"}.-Nm_^ >Q8D-|+MUN/I ޣ=6g2@_ۂ$w;$X4^Lv3u;>nvZ\)DzBLUy9sR݀w{Taft7(J\^K/lmpyݏi_ 85О=w.9SnFtO1fس"EwC[6ڜ; ^` olIJ7 lV2l骤bKn:OnQ6LQ^d'8 Ɲ=C[Y?P{!ery[R ;: cz"N9?ðȐ8+G &C<}29rׁ+B޻C_~uwDBtpUw:0y|0?Ty$w5>B6$RdYа܇&:|yr뿏]߼m ƂY|xH5We_p^c."0zu-m:[54};M;y_&53az瑷VJcJg$9Ξj Wo)7~Brv )khNۻKfgw (_ž"xOvxvx] ~;$.^^׾BjVH-L;z^ ^&470Q }GQB-L9*[9\ؙܹ_Əms׋%/yMVKcWfG$M"!_:= kx/&ËIHQ$L٦>vLS+=32ޜ+YD#>}8_r\UFώϾ\=^}Ӊ*v' bKeIrgT+p-mPb pٚD)qs޳}c}}}lIRj&#!"I!K$$QB"$JIQTB2YS$*7O})y,suCi[Gbpd`Os?0ś?C& =uۍ m;Qѧsn>kF XGwѷsdTyb6-8P#%XRߟNb]0q?y/`S׿ϑF+ꮽ2 2Eġ=KHZ5+Q,mDf9I|_n̔$ ݍ|$& !%߱0r/j1Rk#ۯ]˷`lg~{Gʷ=eq۴X1? ^j:E-xK^n&xLy27H?iO(Kf5,χUܸfhdl6bJ®kaUղS#y;A]e[gI$x\Xpo “#dz8o7 zqBsdұĖ6nsdl:nC ܈`KB~Ef&ߏ႔}ԡQ U2/`[Tw9߾dC3|MEƕ+">.\t4a/TVǝ{$o\mR ER+;$_W88oOp }$sՋkH)f /}.__mi =5gV!շtqQ0#Տj-2}OV ٢RtZ{svbv[O>ZPu*)zID>|fD:Uj* {1M#Թ']q.fGELm ͕0nzwfҿ1!naGƀLP{UϬ3ahPP5_ 3~h!<.j1fW/zOwh_p#m_敠p7 -zVܲDFrU}$2&_@WB /ɗ2G_ 0bnQoDӿ=>) cLAwsq DZZ77]+hO$΃r;U'qWӏ3L{d*<\TlC(R|(EOȝ&Hwq߅"s$b-w##kG#?^4&RW?'J2 =Ok@w P2g #}%a 3RfWwOmu7~%c t -S?? v\O~ۥH_7`@I>w,Z\ݰD FOX0q mjbc)Rk>$pN[(ǷnX/d9‡ ׈#SFb\; uM:f0ܪUoC6fҤムy^nxh/gEu0G_㠿A(@w -t`:~J~+ O^eH<%tEƌ\7ʊYP23?z\qǂ2Ro%$a J_ #AUhn#?HD*Zn4 @j睫7E]~ [D[ۉHv O-^B!+NtE66!%rϋd{U$!%([~% -Zd%/ex¯/"wykj~qwCY\+3>]1E8x0ٷn q>;ta#yi!0{=֨"ּƋoW7(qca1]ex W$?}:hHom^F~ $i>RŴO20/2I?oA~x;Ǡӿo&2I/SCreH)NvtJvgݙ=`P+P֗0Rd4@=vpC+\I ,ϙ0$Uڇ UÈYя6By,QoD_z ;njN3 w[kdPqcRs3JJ|z_P³f]7swߚ3 %jXXQGZECCFGL>!5A'2^n2DR՟ZꪊjK"y'//dyD2qS_'/aB.63URYw]E6Zz(}^CZ6?-m}FRvU`P1cz}nwEd- js˜jSW^qWzY3RD쏮WD?i|>4_.'ˆ͋A{ mG>YAeLN*;3tGxoWҏH111i97d.YZwICz>@xo- 0sb.}xR;T p͍DMwΪ;+Vfki2g\W JNv ؎܁.d2ws^&If8.Y_(n {?\N5)~C/U\*S< ;'j} cK-?wTc7vs9=,!j0 3|?1riA9>/1/ f ;W7~!x3&Vϭ01'|5|;_ :h#)N~_߄m9kWYUVP*1U\ uw~L=qewJnkf;q?q8,"xiZNH}0䇃d騼V/{@F|HOf, ':|$lкqu;w,:_>XG"riO@,wd0F#=C{ -Q-3P|dEZ8;EI IyH|Eo BDUj)?ث$F3~F/ow1&! ֝:g@n7'?B]QF EwF1ER>ʐѿwPZeET߾S-?:11D^"SإMw=4E6Xu_֗΀-Hr"58Ej#C!( e2r$.L!"[ BRˆy\T6XWC__Pq, I~=ҽuDwprλJ*iURd:mGzzPsl}}C| 4X?gKlCa25ez$]C胏̷;}IRb.fg0fиԴ2G~}S teU" EwTT隠HU; ̋w9 sSt")Jµ7޿! '#ިw9/Edm k59gd%EHfcU(pX/ ]Bߏ;*Uх#IMM|2R=՛5o1mB~ M;+0$<z1WKIk֜Gfle 60d`)S:וH }qBپZ$THAQyHdIЗ99 Zߜ]Vkn}R s_w%Aɼ 9<#X.:S$J՛~\#fFm8&QkJA$34#Z"@Q9ꚝA2%>m_WN0;ř?5z4Ъb ¤%%؎^{O4p^3myE.(eղSA~6yaGWρEQ+T$:yWqЦ.ƒB&(@3υ`2=P3ek=$sl`E'%W/J,n/:!x潫ݟ]&ӾlB%\Mu\? ֚_4YE9|\?`bved YozKjAdTIRGA-YS-CtJk mcOFʧ&hO~ _g:;Ԡ1SGjOS/Ye&|u/&a>( KCU( WF*p9-eWZ0.D  <uNwuA49'/i3mC?B9p}Ѵu%S `rzi(=f[(儢lS+]7v]\#0|bnjq$s+Hݮ?-o{s>u!K#lf_7ߙ KaHKa={Ī~2  yxJGWYFyɘ{?*~T{y1RUx2hH/E*EƇuꞇ##M^$ umO>ף cBğ]P7ۦݢpJmn5}PfwE!*c&x ]-٬Stj?FR^ )EҫJ3{eP= v;25D]G{O3 ikCK7vՕ.]k(+1S[Wju$CY216%CH5ξ,!J1H_0ȾT+kn"Ԅ8h${e}OӺf.- j&3 n6O8urcJ%:OiMJu_dz^uq9\F:aL E_*Q|FET.dD"5$A7V9._vN`lFhsՙ9hQFSz싓sH^pğWNxUVlD?')e2v٤-=*_8,ϸč1JaiRܽ }3~Y;\usVvv|a Mf!" 2]PXnwRN*fTFrzVqz-,n+}GJq9PR.~T뉣:(5'p.\|Y Od>2WWBE_+o.M4[ c\dP?Uмž1i뉾ʻd=ݹ V:B7axZF\v"p $xo/g>>oMH.\Q~ƴ,[^ܙ'[R#VgHUutxrץUͰEZݯp'H-u3LtO{EvC{oR8th:Mb#ВV$?'TѿȰ-*()݃ *8~}Mv:s|df)P:_Eju]tU$I )1V|Q ׃~Z'a;Gd)3µH;oۮ%iO#!Yc +"k㻛4kGC7 MGEϘ)0o~YXn$f g"k"E_m؜3V˼w׬f_~(MOH{z70ؐ/|Ɨ%́|I W>Az6R y>*RNG#٩h=:.mK:tKApwzZ |౵ml]BTfu3ahHU} { ^Ѻa4Ru #Kvc+U okP|D[#CvuըqdWYs{@-9<9PqN.eVK'ctto0ҰQ/!k=O+ve <= 'FOLsZE]\m;iI=` ;8 {|]aMmeWÀWHxfPgMCҁsw".6Ϗo?OUͻɜRnw1 lp"6j^EX#\Qb?tKZ7|ᬺOBRLZA,ReТ=C#SH |:s;M-9 gZ|Hm^wRKO٢X7ˑꔥڶ|8A!{I{ vIO%'=PzO8b<S֛Qox8i̍;RQaQ8NDnVT5k܈ u:Y||zYkat}Z:Kcss[ڿ.S].C\"A$zi\WA ( >8ro;l|$bO7R9,]#k"fσ0tF:>cZr%vrPq+DA$˽j]7lJYݛ6_5Ѩu0`$v3ǙhI+@k_.H_mvLd6^^Cr&Pu|c%Zcrt]p}?*0W{T\qmsiv8k5DŽOnw1G1% nBҟCׅ"):f$}_W_?_k. Kf>Lx#n5F3K>d bK`bkegð6;;!ChĄ+ZzG&+`0"Y2mc}(% Csۖ[g|$Jky2r&!\ݍuJ0fYcUhe*Y:'f"2C fWv/ҿW-D_GH Tr.ړTXZ[~j'qԑy|9# 7!x9O~f6!MqݳqQ&sN<(um$XpSoy"es`4cuvQzzWd U+f1ჩoYrx*E6(ep)t*⋻I0Z-c㛆 ֊[QbWGo r; ҶZPVq|w;k;43;,}C8YkI_ cS֡֏tZ8R0J.0Q|"=V 1EwH1Ww7y -VW'yxܹEbXؤƝ\(P?R|2Z';>=kG:S2ϱgSFK7AZ gCS=P_Gws6|F* M8x.3^+&oU^HLDr0/mQ)Ň+z"E}KCʎP-b8oȏ?dfGQ޶nIIYu~ YAsC{qm5[ =F, oCjbL|Wh(h$gnR_G5th87@g8؞Oy*sⴊiq?ku* 2zsGvYwcEvU!/NHJ;TȏGqlsw_37Y wElQ@tғȸhUz*Wng5tLt"R,qm E\Ry# F۷i^ecO}GC7*u{q$}e,EVC|iL3rF c?u1gђ-`M}O>/U-8"I3@/?.Wl: ܤ>,80m|1z߯!&{f 3)ˆݕ \sMEMBy5Y߼#sbatb![3/ ͻG9&T6@r[ʵA=\k( CHL)yV c[ȈyV<$R썻%RXV>"1ϡC(YH\tm7Oћg;}/@ʒ rtdRn"HjO2 C8oT~e9sw'hۅ6YXY.a4$/u7o3WwpO{J' ǺD@hIFgܨ> I[ҁw_5HW P9MOpj>G⒎;VZ"e\mx- xfr _DES5؇cпѡ aFڶ$ <C݃V0 p CA7qmUލ6T\>Kj /z 3ak`U""{#rBZ7 ߺ39&B~c #v$7rB˥u?/Jz %风ua t,1֝'bcC߫21h,=~SVLNJ <#3ZA#:sk/Ӑvy:@y*8l3'x/$f ʙTS1"ψӜ^*2>6Oqq_C1үn31j8L ح[`؜O5<;ی4m?E6U N09el(/!(1Ȕ9joU硡(86Sfpy>vl"BWsqʿH x[m,vx|-᦯Y*^42J\um1Yl^5du>mrIWj9)܋tɧ#qv֒8G$}ji0Fn.@z6YMnbmھg}%dFǻs6uHI3fzW3@rU]DM{Ѓ}w+P"ȘrfzR\6|0e0be\ ÃSbEl<$cҋ,qv C**jW~Gf1Jr7d2N"lP}&٪O_[O!-qܺ:~&T;i!lLq5/<Ȃ]v7i^F=DIMo^H߅6'X^'Ȋ~["|~-h]qFԿ|-N(8=+,wt>xy])tD?%98kC e퇏˞?(yv- zX10f2H9h`opZ/}5GX/l- >^rQ$2F缼wsa<:vOK K:Y1w>>@ugHyK(63=Prّ &Y-䨣>&BaH;УkybF#,٥~GBğڔ~(qIn/PhBQxeCPؼK|ΑÛ-?ψj+Fq0sQI%JϕR0`d?J]QRMO(qg}NU'ρW}7h axH>UAO 7 sP\l9~q8qհZ&tyT-HywfRwÉ2C /.kA)-uQX/,ljJCzM' =k/Fj6V=%)`T\`;ex)g-wXl lR]ܔ. ]Sο@[?ZM)iEx{dB3쯝6_ཕ@ʵG{aT4W+\w.NS p6m&-l5U ~}>!̍OXҮ(<WX٦~ZFː۰xkTE>k!tt"Smeœ i(z=7C iYwjLQMPEX;o7_ _淀/)7ʄiHJ69cUM[(EV* ԖB1@>Hg{-Car{o?cȾDƱ3SF!0mHW! 䙆瑪t.eDi౗%TO:@Ԩ4nXk97q`쉢aHRy6b!=Zo[C #98M>Q̵0\n#b]}5C^Yd@ܺyǏwݶouk=Հk/0x \XlRs8sTxcH:X𫁏GsS`P{` RDKnyu\ 7xmISz>m ^<| :S2j,ftn%(ox#%aHy:rlh]z2{5F$;|\}欘 RG_=tgm KsF=/CvÈ]YO`bs, =n=#gt^&c,';Jd*iP 3Qb}hN7=~NӃZR־0f@C %#|7< _aab[8F4\6qEڸ֩,yIdRg bB'(zыve^zE,Sf[!{x Fgj9R˂u#ZWlz#}:]}A9A?]_Ǖ~^EVmQO2D[H$q^"^ݭH]6v_#zuHU[ZInk^{}}G:Yk68ٌN;w& Kw1 CO 9! dG@lB>ŋq3ợÑ^PCrx${Wa0Yᦋ$VY.?~+l8 ,Cs MJ?s:߷)$x<z&;ڲF-BO_G\v*˥a]s ]99ܪ ϦY[/d?Br00N l a̱evo g1>.B}ra%.)]y9S} 4x׏9/ﻻ}" +-k%Zo7Xd\'2.X3+DH//#CoƱ+R0rEt8RJ+>9{[ 0#SY0|j8on) nrHOk(|P;Ü]hmEg lr;_eo?fݒ1n]T 6ϔDZ^l5tY`=G^:}QDwoo! ~PSDyՍO亡Ʋr$廸u_zOZ,^6&e˽/ KH)QcTc]0PbO!2;oS/!HKp4B`Nuk$ePqi}8<2 ,Nh_刺ڿO@@UQx>|;!o2X|nZ q¡NCǠA"lG컑[KBNMzqzwҋ0-v SL?ԁL!k[O+jd^m+,W~\ _; }nmH{;vB$Tu??r!~(fr9I% Wn$>Y* ҁŽ0l&~ ^pkoRlJ˛N5g]B*iYQal ~$9v@V`vbNn ݋@s<`]"LN*|2Y | #ٯEӒ`OLY !!s-RYj' }-f>m|Ǖ~9ܛW6JG49:`K (LlD _* #-A8Czo|t܊ɇTe7Gj(Js9WTtfI|.2tNBmx(-Jy@fOྖ+ E5 &m G[Gy.z5E=YxF"n{ cy8,74hs4 ΍؃̀7=:Qe1k7=_r*w?\dV毯tFwkQXXXFdR\^yR{ r|e%ܬV.'楮rƪ c- ,Y@1l#rlđ&jowaD }*.o+-_],/+#CVU@R+ZjOUWBR %FJ_ gGBq(Dtű 0yD@kw^f1`Q$aڒ|ܓ^(2{i'iGG;JPe^P<0)RPžQޝ cp_t;!06?v.%\лЌy6OFB-G(0Ϲ#^}d\ݝ(27sbxdiEHR ۦov9N:[<"!\ 1{:w]Oaof A Kԧ(h]HR^l"t3}" igx PPbZG 0ŗ䑶~5Ϡ6[VQE${E+L,آ(<+E?W1E0TO42=:6-~™"T5QPb8fb-]u|t _+௻kI1_#;&W1^vWPzv~GL'H8rIǬH^yHz]Y0jl%knA痼bq :y9*$5ržYs,yJڟcEIdwW( P&)H=l|b M!#0钽hf.ا,ByW_ IkHpq9>~YƳW"a=N.,[ןLɟ߿/_GZ!ES=RwEU'UtM>)̈ϼvrga sw (jX^ n>lQdOV'hXUP(H;ɏh~m \URtC!LR"L,DAfp,[{ +'EOlOxCc{8PpY($J`[&r)ݝC>iAf}`iы'l.wiSA¢S(4~aw +ܨOCuݯrH3wL= m/7rAQ?"w)=?"c@0Jo'X^`y4g[HJ=EB=hN;3B /{oW_,F}]0GPvnh^ Ssw)яCL?>bq:Q9vЕHмQU6 PPWm3Asz`_[AU_o%/۫c8!bi(<ޙOAȱ]Hh- ;iU!<Ֆ!I mQPT"uۡ;wrY-2^j/LJ+qAlr.:~RO7@RmjS!>^=d ~tOx-MjMż:ːLm 5?{ȎՉ8x2q#dx] 7-, x&t}l;xw/6ZRGl@:SE?ě˙R0,ȁHOtA/;li+^q\~/xn vMzW'Z$U/֫;J[h'' ^]ot昮?='x8קH{"?EƄojB6IHWmdw#vOM:U_;{[A/i)Hol u1oۃbեA0=J>O3E|Cʱ H0j޻V@Pfm d.>שØIa-=Ê]{tͶ,4Nk'Q|Y'I-x$6 Q-nEQM5`+||xEIfr|M vުBO&7n뾂bݥJ`23mz8*ގ4׃'C eqg:nn{%S}>2v &'$H UHXn=+eg@>gPq:~ K[0{< \ő$,e{zwՊM'd| yG+7~CzhY"eє^/_CR 0j\?urdmBh03zyhzC؏MO#SH ֧E~Y1F'mK~@9 v"2 . ֭$}9Zf4mIvCW0~,m2_~!Kb~N;I ѷte>Z1s g4m/j[S*Rzinu5!t+&Da/b8qjxM^TFLm%Z:^V78@X;<1c55'ٯxt<.CKv",>;(I/:ZvcgscA#^~'q%8yF c? iG}Q|au0Xv6G|vbd5KOJ_tjF!IH~!mrkdjQn~ˏ |{tfC+U~ً ?T-4q?Nԕ|(,ĚQި,]*[WT ߎ# +ђ{P7v$I ?:"ٟi6kOQ+h@f;0kסPɥ~,Pߟ+ohzdp1OCi'RfqG 7Ȉ޴W+v7 #92j,',>uL6OЯ~.qMcJhNjʏ[63;U]{àw+<ղO_YGH{SuB ע9lb7|f<2$O+trMbX j!IXh1Ed\{~}YbhKEr2? Fqa &){#S&2T&ʖFSyP`ȴQ[8"Y [dJUvIB3UmF1m`5fu b_F'NMhOnƋצk^gl7,/ߌg4P od~G ҮnϤ Y)5WMb[ LQGGɯ:>]aԿI=֬DڅoA5LEc_깅Gl '}1ڀ"G?Tˆw͍H 8sv^R)^(T0鿑b{.Ȥ}`w4=}nӣ|dP#X67`HKo|.(^-oo/pX"m[U9vſH}F7xI>iZT#ܱkvG4,vcYKba>~xRىJ/ w:֧M߱mW?|^÷C9ڋ睰mb 8Y!&؊[H+:ʖT]T]@ywѣ&Ӽ?=O>ZQz7#-l$}ۯ6=l_ Voet?حgKordVHCf±MS=~5ԴxtZJD&~߳#tE[h :͙67 EBֳGz*t7{W%G@Ҧp(駍[ pt\2C rmf3QVi'̑'+: *?ojUFhX]g/S`dS;yHm>8ֹG>$Γb9BA'_Ao-`$h7@4Vd_m/0/׿˥ga4V| !З'R(柿?uì߲ȍH}>>o":  s6L['T ېnC <Ɨ;ԐC7S!߄zZ;5 }{@Gq_är!7 ZlU_OE(pj|L_[4cm`9.H٩j˶y !m@k@YpC1μuz˗ʍ¨ѩ>H᩟JA肬ks I$>N{)! 1pЎe/Șk~m,-wB#2ԍLXb)>cKق|Ѷ\mW% #]@<`N7e($?qӮ:t/t ty[MhxKouCrQh:iO-Zxd ^?"M.= Sଟ?Ll|6Җ(z°FX%#!6-Bu𾼅<.)UmTd<6_cK_,A:n.SE:TGBoi?t;i@ػH6cx7gqsBwn=bue{7cĝN{6HU~v=Z#_ˏ n-EFa_9ׅέ1;iQ;jGR8ncG禙O7c]oa"7zp WFcX1 ROjI@F等0/˕Я;u;u/ ɳ]H{rmI/ֵ" ڶB_k8>ywu1RY!gNvu+91ao;L~%?nvX:,Fc=vݍH*[SC:˱(A +G&aZCx;KaB~V.OPvn5]lu4]}z _S2ijULճ@_'R|%IVhʁ!o}{Ԇ߳N_9qHY]seo5u=|[Evx 9D?W"<N򝋛Z^ y \DʜjǠokYb>z~N="2J3}kGH(/.wCʕ9}VAw+9hٴYf0ZE랲 #+d pWNXG9 4G|qH1\pfںamDx)} nc2.BQSx3 #+Ejڽ6H5& zB]E5(^wx FMT.VC-"{ax}d{fGxHy'gFeXQ&Eo[w֍/MBGvAhod_\N:8-֭g= E/݋{O/yE{`̲ G76#}}7Ǵh'',5ۿ9YBkah#rї:mE]Y= m.ے劂'_<"EN[y!WVv_AJ1wG-LlB1ϴIhGN@%w(,>_|2>lEGA/BqfIqV\'|bP2By6z=eەfT#YQR?gx'G+(Zu YcLC`0S8??55Uf*IPU@Z8 Ϗi0acxL}3>\"_c(FVORCcNژi'L<~ϵYkȓ%VGz {zR "8$<$*$aǎ?0`cRjsz2D̞/ϜxwI_FRC"-#b._DP]A:-Z4KҔT>fUmɟE V6/uV(vð*7'.3glZں$DBW"?H 7fR+]#u:vTd~#q;KRFƻ#,ܞ~N M~|'Z:cPd,~)HeyV,C>Uˡ~zxWHxp/] ͗cu~pF΂tB+>ڲ/3~ -=ۙcOZoa)2H\;G^iiUqg|O#"smnn vY<- 97 JaB'{A)*cĹṆh̏!"~YX2߲:U :iea0=$ F.H{x(OWGh³߁+_|n;'z^m4|W@'Ku>hJ ;뎌WhM5(q ҷ<Nt4rκ-`I 0.P*n)dž}P cG5]GNL{}e0`U\F%-jT>BFfq QnR~t_^'Q k0(e TR"KQ'jfw2 7Էa$z8CiT[!+6j "dN:Kv΃]u˻'{x[uk#S.~Y=Hv lk~;5~rjxdtcfN/U9H}flr\e9eFӚ mMmm\pԕkD) ~^S˶!d0[,N"0~F O}["{v_.9iKt2pb(q(wکzQ~_Ym8ƦVr ]бThѭ3QY_m eE]$%Kudr6g)y^t?Ԅ>SQd?>/4{% ө Ʈ4:cK2X舕CyШ6L"~U^ϗiunfabsŻع?T~(v$izd26 ]>n\o f1 ކ4Jt:@߲8Dw}= Z5f~nHz?~dzIoE?F*?(l!IV/C̓V吢o4NOW5S}Q0i(Dt-ݺ Zԟ cnji}owvc0?n8g&2^}֣b^U#Vue`̓I ,Z}9ܡt{}By@hTQ4`}%!ZqSN~:ms 2!kټu){Ph%p|QU 9_Yo2-ow"6t;2zTi%)#TWgGhVP$/?S3n#-=?0dѲ!^}Vܶ0XV]}W\2B7;LyEix<;+;hBzu5շ?~j0hkPdHF/V8Ltqe(6c D*ZT +WngѤXahtlY^lԢ$ͺjVn@]q^!*ڜX7ܺ[`B^KȶMg!yC`h /B!Ov5!݇d{k-2Im}} R-(nݶ680U/l}g ]zF,őN$_9e_x ҅CM-OCE\G 'hK⃗6v#͡pv"ox䴆į^=r8^KP@?\i% NHK;Ă vrE2>[ &'9Mح X\@ȡ>ݼXM$3hxpHVSboT\9ZglV2IP5Ҥ7_KAV g%Rx]avHRTКS=z"ˑ: F06f EemTJ"޿Ԝ$*1Uz`O*2`iP.Xs%ɡ>:(T^*4̒d)_ Kn?K,yʹc]~)EFos{FE1M4;7׾^ ?դ/|Qx] w[*Xe2j/{eO1A꫸qaUR'zܸlؼOv8mN+#㧳`J xn*EÊC7i[)~ FJ\׆YU!қs$ȸP+6e,@ܶUΧ^UۉB?/^~ݎu .&@'NQנŖg0{ڋ˧0K#򤼊s[纚q\9B ~ AmmaBY\_FO䏔Tu&FoBӘSDa]RS wkiG7q7γ0rqII~B/E+ag>=.~͊En]+z+Y^(Tq}69=݇ /7x5_;+2:~[f7SWOF 4fBBUƯjH[X.LG-wnOz;Y=p>3.W*]rf kg0Ûy]>ȫ0_; GC"li cQy۩t{@(ksZ 2^MΑ]9ii\ku?|WEz@NH,FRIMy S:MzH{%n!ma{+ې”ϑ/MwїEH:|On rw nٞ{n "abksӭ0廿u޼xd ] ER~W\oh{B+dR4ilgQ+ԃ1)_^ z!mì[NȢVear!iu$s64烔_qb:ܦ_aS+HJ#C ӑSۼ/~WGq C+#:ۖlnaUKN]AZeO۱]MTk/Tnzƃ<.ٸ?IO6= k8#:-cVsLHvTBZڔĄ99u9xJ:y\z^#Yd7Bol*7hf =%G[{\c@R}9!7zִ0+y/IJ_*-bN]9~*#<_RV ]׆^ma&R_5!u"(doi*N(}y?:X6$Eb9oe;ͷѿuFm,KGUR;L[+L:EL j8ossxSŔ]A=X%w<8SyqWV=:urDgن&\:|X!w چI5~^klȃ(NܢE|Pm.^ v9qTҾ){پvÁ,.L-5~ {0vgtʁFR!/Yt[v }HZվi'wpaxmT5(npf- K>BFfEzqjי PRJpSB|b}/xح\)ǃGNBKG~CQУ(9`}&ܪ?@sM)H-b=!}~DRP܅@Hb0Yzkh>zzG$Yaގ4lZפGϙuHV[Tc+' `|^ј";֎.3CBg{$WH21 ކ{햟E199g(QQ73kq7qoaٻ˩>x[S+$,;l OΔQk8UI!0S9 Y`pH?c#2jn~ Cb?`!(P{#k K5I+w2z)TtCAH.ۘ=jQY;葠+z[NjӰd)-\ `,Zv$xqvdžr%.?s< YIuC+P^a0 :<* }[ôIƝ>2'={ Vw3@ OV.xz&v>6;<`1)V=WwivXxzQV+Fτ5^QNds&ljt"08ǎUSvBfM},OhѴu1{*)O偡Gzg$V"*Z!QgH;za X~ YKUDoJ"#2#YB+Ǿ.+o(`8az nލ#v M{}Yø}]Q&Ԯ9-O~RF@B>lB qY!iH xs;1"3ǨrSQn]<%4A>׼9rFN]'O:]xz^P?4k X̪Dqعܩm~"i٤2#l;I՗đ}V!-}] ?~JswvZ4(m65HWV'!g'dpdU!e毑^d6h_ղɹ?|8npu c3;S-s?Υ[9G#M;.uS(QR?eqEYg]wSj3Y!]^6`&NYnE 7ﵣ=R7H>ΕOƕuݏ2yvpm2¯")bμ;z-beŵC@ElZƜA6GtSx}ϥMmj7go)'0h 1I%SB&5MeSudC 1Ѕa}Y2 -Ň~6¹Y9Hb?69D!5}#U?;?9NI*e\IT%* I* !!R:HB۱}rqϮ׳O "V,G!U5Tc${-% P=z" t:\ԟTQо^c53,.L[O-D3%|jwl{д1L5.A+'"S"u܋)^1~{ &:py }|$xoDրg\8}.vQ>\d[_̯ Bn&~hd+lXP$L 7\vsEiH*;zd h9,{7}o18g YZi-͐uecwT .%C#QЬdN癫0$LonQGm}(xtw% 5ۧ{N-u. +@qvMUvw4' 0.^N{c$%w:Me'm(0npVD/.FI#9=ZP2^zq~md]A9+MХoPp}M䯚nJXIE`?ZtMTۂ֒ۿaiav[iϧ.^9Ψ V63O | S+%Rpa9sygo!S^0҉wyx&G 9S)w|⩠3K"[! \oP%%:[]+][Hk`v'M9SGK_͡(z Uo>DPU5ڧ,ߎG GvuogDŹքs2$ s^΍4d*{&# `p̑50F NBm7#;/4v:L=Gӕ_~,͆W?Dvau ]h*F$Ru8ep.^ew̏W?cp^!Hʗ3{ۊ}[{_;.⇌"U0e{ e~|jLj bySh!oB>ur.c;/$ NWGTT9#9R5ITOl/ktgڎL%frOdI Jnʇax}ev'#M ߎ? !/}:,m":"_eC*psǿicW/R|Myi r1Ǒ4wj1 g<]%fU˲/I(NЩS i 8A[gdi-S:/ }9`-oV{ltN?[:ψ.]Z\C {a`ٛ3g"h! )Nz\.a-08 -D DA.9Y"IݪÎfe8e'H$ XˮПw!.D`=vz6p22a=) kܯ.*= нJxXv4>{3;GOvA}'&CN~|B2]`7]jv ?bCI' ɵncX2.O- 943@8&s*]QWzey۲4[ij|"{XNO E&0#kzQ7/Yw jy8? gSrx!j)kO7 U9y<(.h=bTP,=6 FwH_Y #K˜A~B'ۘIkm`kЎQsyRۺ''s?HEuD2LDmg]g%„~e8z5Q(-uRʋ͜,||D/yǣ #3VoӁ1WqqH"t?aOX|gdj%(4 ܛls4ϱ (WzHкSs[tynbz%;EJFꅣvfKUo*#QjE)|(]+V6=CڪՍJR5Ww2\y0[v `hv9 m5W{hd*zKovmX?H0(-biL~SqW/VvLY}}way LzG&݄+V~]dQL%A*YJA^@~gL9s""ܟ#=5և9[p[u5H#Yg%> `tt1$n8 yJ Ӯ5PCU~vs S :^(Ȉ"I i9cI%qZXQ?xuu( `VE]mWG&#gpwy8p Yؐ⸃&Oޚt,/UQ+=s>d\^b? 7Tv@ןxfxǟx~zUVtt-5'P ɲACq*?|!RZM܂V4W$|6 \NHn;EB˳#3>&:҈~#쀯H_;$ɯ72 e=YYR ~-@j* :4 Z㉤7Ct^"J<2u yǏ|ʧ/63oH^]*i#"O5{OЗ- L‘?ObguoA҃ t9q(Յ:d2_ćfzXKֆNl%l)7;L+h> Jif> /7OWJ 7MgMHbk{WE_c"d<'aK߿3dy nX7MzvT+XyH#}ꆑkO7j93kk ]S i|Gø_ (l=o?'V ܁\!oi=SV$Wguy1oQ7W R]4+U49.윌Γ#.fb}.[U՟؇"yv}q$jO+@V~](]YÊ" KE' }:o\쐺h$/Y<=ons>!m 0Q(X-X|*.Ǘ5D>Z0Q?Eu vFw e͞|d~ 3 k$sчfH^xJ[LAҵdnDk=gJ%⌒GBGP5SyFX?"o%`y+HH):tLɫo(.^c_ rkK̕Ǔ תLd~yn[ЭsG= ( k@~r!?'P53n|o?Ѡ~wa^Wuo9B=JH O/ўK~R7̦ՐkN^w3|eu'qM 9/C >6-ȯ&(tmy jZҟqjA\n!bM+ܶė}v~pB@3t^.=Ύ[ES]hH<*7 OnT'ML˙8g4eUDl4;DBԋ]޻{@uj(SDshf6M='#U ŋ$\~*dwn\x7/ ׯb_^SN@z֯-;6lgtɰS,y{_5{h0E9m_ޖ%N #vH\rF9}Mj[3W$ W,۷~@&}n0b6"N euV8L t|V,x n)ov҇w_}G"E.#MݹKl \Vy"-\U8K{tfD/uԝ6Z78i̿ =/U IB^N~Bߥ?2V/ UD,\,k:Z}W&Φ'yǩGqMA?xs8L]x*isHq {j6h蘙z6 Fk,;,N,ǜYY#͝bgh?%_ȥо_̿݁3}FgN>~]&$["]iN }r1ӹ#'tW7:Tѻ%Q)Er =JBd܈/ր]vYGa^Ǖk #JǪ<C=2|wCS~߻ƞ=M߷`% ~i]{c2:Cf!Zkm!t%'G:-F O/Oi{/mt(2Bg`idēY0&nOӏSaNGP΃A'S<\[J~D)_0"$/sv.ٵN"]=a[S ys)Z17vFʉxۏ{fWxE̡փw`éW oxY|$ Fs䥬NJQj/9^10G5^|}FEwmq\-}.gm$OU Z1 '#rp, s_ ȹ:JR="?G2K g% Jv(#9 ?? _oeV6ƫTqtYٖEyvQvjA?n42"yT:~uh]ZIgY5))Uʓ;a*%Lvhݽ9t 2F1~k4LXBk_<\P`!gSQFn9kW!=E~'+zz5 ^8N}uF?dBe\U")SJnHȃ5Ҙ9냑)%"$_P UUIӼa[|{zwL;K4\&L>,: =id2S!D ec!UZ}},z!y/v (ZICgI0,\hpvZ nB;?p]\S0,soO 9HkʉkoJ#ŰO& rZx~NQO$]~Iεwïa#3%ve]RF&xzJ ˳7HbՆhPS0Qmti܃!b;. {L D"R`mHڼAW"/]Е3='E3HBTq~S!@[W3zHXoO?ض PY!C)AyOsv Rb{|C0:WN$_*M$shMor?#"TqpiӁi<o(xԤŅ$5zkLQEu05td@~ls ¹YǐY-p>$![P"[\?)s \sF)Wi"5Oh5 avO 2\o_qԯ BN}j&7zE&z[+}s,!BC[M"9誮kJ1ovrHn.uVoK"UUE" K,͙ k$I7nL"Q&ۧq1r+_\~1I*.$pG=2O*qFy}.e+n[aڿa0uZr+IVS _}NOc2"]^*В܁6cSJ6?/źw_pt߯Xf[hPZ`7T52IM/^d?dgnH}>|_#L\{imJNG%Og$(ҾFt-e0Tyszd<"dzS׼mTɐ,k؇}zpj4 G>(Ί[V7]^{mBjjJaq6^^>_/XkDO MRq*aLf Ml:t,2+r@ygr3Q{>o#Ur])g`[m}|AӤk%u)n7ݏ#Wv֌c?gD2l 9Ⱥ4"uQJ;.\4 [L0(i5JHQ'j6G+jȠpCue>J|"JDgwȥ6}4yLwKyɟy"[$0҆VQ hZ<@}uӿ}H5Z1rqaXʥ𴶍 7pU6@cj8X#b֙%+! {yg QvQ\{ 9\Ces3I"n#IU>P4,BPxp&nE>N w+Xi+4ml{#5256h U&S,X|,z^BZAmOQ_M;"UPPP T7Uw#Ygilt dpѨYSɪf3m꫿בU0q4p#2:.#|H«_s܄|g5lkuȕ;TI0)M:#6͋J^䎽O8 NAQ9{!zMp z}OθB>2/f3Ռg4FEzHIibΆ)o =gQy糁me@AknN'-QQ{Mj8M`&7jO95Ց~xR*K@Ck7(HzD 5Hc}KWW?0`=ݩeϺZP#l?:/!;D[F>"{,z"e`ahBB;3,&glgv=geUqTGB7 5 A1ϤEHni\WڻNPH/M6x/z 2ȨPvP"xϟX_Gڬ;N2HanRN >"_%3JYKuK }Uv^QMx^#|k |g4iynrs]Xt}:WgeZ>JVY}_3R_PCkG*D[BZ$ cam̉ˆHJ@,2 7NCƽLZsjڏOW,!X*.!SEaD~f#K>!{=*JZ8(q7>^\_1}׫^Cz3 i>7p2dwAʜڮ鈌1spq_0Oi2^3OIV6%t^?E"nӻ}Q͗ N܌ #)Ȓ>jA6CgL~H„>4)=C~)-igt}okSMzO]~FML!Ƿ{<Ze{WMn^v˯;DR՝gȸm6Ǡ1H&T*G u%ZRoҕo3 cJN%"תHWy"JYKY,Bf뚋r."|JR*ggLUIsϬXWAkQoKI09b x)k֞Hy~QD'_z0aeVp WM7q_Ed.P /fܫaw?O8'|"$a#ߏ?;EX&o_0{bb:?RtQ+Pec[/CM|E͒ۗ\͡AGoŝȲOJoGm!E[Ӽ0l喨9_zݻ#'c&,~y"ep%!^^t~zaOH^yp=oV!yգؿ^oMYdxC,1aоM_jG!خh 2EC'ᅯ@wΏ Ⱥ5dE/Y8ТP:HIuzO#xz7\ʺ :mB,mdǏ,i/} Jۗ#尥bS+u{ OP?W spx%ޟmy(xioA9oUo Y^TS8=3z O,vHܫǷyocsf`po׌z0nLd_urt樎m R}~)#ӫZhJQ3 @ YY!K85CZL}k?XoaC^ܮkH?ǫ7ep¢v$_΋]a{6oy=q;q&kc+pN$NbqI@| 489;~BRsXSpKx~tnBᄐ86g_;MƗ5@FFmGXMmq[cS ̝K#<;H>SQ;GZ?Kk>{|(w]ƌm8<#ҬD~|G*ܼ}귥Rwa~s/kBACCV >%JDڜd Bd/]wQ Atr)"-!}=yyTۙ}Tqx"R|?\yW% aRW n Ю5NG9 RAj..?>6}8Hi7mzF3'F-"ຨ8% CScxqe#%_-("n&c#U sRaȗXh!t7B1veȯEo3e"?{L蘚KO@9[f=PGV/@Zn]~5w5R4 .^9=B;2nr`ggTv14;C oـ(NF@g5ݵYggnj$2ГwzK> /W#խe4.z_d* 5rH | 8`|s(&Ly4Gu dy3goOou9RmzZS/\Eϟ/k {uQdY|o!λ:&!o)Hh?׉y^?㟊Bʩ 30#E]n7p)}&fd=R"xKY `RfPC: Vtj-p?~z YU}A;'U^𷷹㝄H/ցЊ?+=e ?w]k#dgˏQ,USB!p tސ)Xcr=;zϯwbnsgO15ss:/,p%I;[(HMI*6"I~-:3˂cK.[mE,Z%S EnگH9q:z* bWA 0eV cw 7 kDw ϿGJ `Js!!#xBvk#yLt-)Ҟ_|m}4\6&O.V[²Nz1=Ҳ*{8#O'2*(yug Xz˱Su,: o Il ,{äZS+ȟqi6}l.!4`sjE7{-ّLꅁ6H>zr:sZZڲ0S{.$<UC5'FO}w3ps8Fy7r^'E.5;PNQEI"?#͉T35WL{X EnV4$ѭ/S04 *p 9Yte{C -{B /Kۗ>V"k!Eȕ!rr"_ʳ jJgE~XI8 _͎Faq_HyQ]5ǽU2GQ\EF[  ^\)&mץ1GaMt6n{=axg͉=i*Ū~ӛG eeޓaxiЍBhM{˼?{X^Bڋ QN_>x? WzM̽zeVd\S}zo(;/"d^*!S!ftnN)I ;ܵ3`ľgu<\o{g4iU=sI1gG>X_c?Vd#Ԫ(=m.}KT-.f7ŋOI;[mŁb|mH9]h mQ8zK>ʱL&x8Y߫yc7&^DL"γP*؄O58LBNLqÂڊeJHvu/^H}, ,R3Wsa2&Q$.wN(]i$iیs"\'| ڭ`"slz%* kk#%fgmD*4Z"g[lҸJ71fp޵_q[scQͬs,g[+a˜G(p; iա>H؇ !3"+ IӠWK0R4,# ?I͔rqeDo2fŸmqH0Jy,GNJKJ_ME '`4/Yޯ.ðo¬$I^|=|OYL;k8m6Qw# mkbng@(WdC̮Bߛ ~0TEg|o8:iFK<}K(Gl3~w{AoeUҲ9A#F$<rwCll2 e.}6лU#-R˲ىMvܰÊIг鿏bPnh;qB[RiN0rB`vXݛ>- aU}{X= *v.dg8`L!&׾ߺI؟G̽ΤC/m^E!-!z0L&HYί?s ww>(n/qlT5-((yoB%_op9~hF}+A TaEN+?&Ҧ~[?  {ߛTwuGl@ǷPF\w1uu/RJ4.+*q)7>8z"u~; ZDʪ[`tϊ(t t&w3=@iqW/0Pʹ#J&UHj_K >@m4dݜ_=V.EOk|[x56ߔ]sAS%( U@o!nT$M?vwxv`>};}yxœG', 3(V= vk=O9&N>dO9 Z]QHy|$; މ3vw{dׂN1o*H 4qE9Y7gg1]e;)6ÌGo.F# 2O} NU &xK;5=6C]?i&xq u`46Ne1by+ rܺw0Qp;mjC^|Wu|gWu*D h[q=*ko#Dqyoub֭2(%9?]E~ PP_pkВCh'M¾SHJپҟ0&AMhxPm;dm-adž&{e6̘N%+/PreUxsk{ty@L5مpntMaVlmj=C%sBկj/C ?Nlw5N7v~PλuQkojk{|Q8sWͳt3̫([9TeP-)% { .mzG>yɂG{:501{A)hT= eZ:Vqcoi= eUٓ,ܩI΁㿞ʂ=q0{Hl_h([؋3iy4Iݼ %ЛlBW/< uoޗq]z7]ҩ|z%@yOD@ݰK.Cqv+7`$gb镻Ak#Т.|܍ c` $.e(Zd^uw3̴YH[` &a[ }gU4vm6[t]"Gc{ĩZ),x)z5Wg-r437!x@s?oyqIpuYPpN .1[dtU+%G <cOd%)(AEєP)RG|[f='?Ze1WXK8"I0iM?tu~ӏl/GP~H=tI/k6D|W?bVw'Q?c-9y8_"R+ayi?t{޿k7V߰Y+"#y~! խQq^|'|t=j нTV۲=Jp_u~wW c&Z u'ƍH۳UR^H7R%ËDN|<;w#J?>`Cwo|Ի[dyUL!Ư14RR6>H}O,kv.`&NPғS{aȧ8~5> igRݚ$U);6#}|INzgawaG P1|{o{R~4E:H0l~ֺFY4m.s:饖Ls .7ᕉ܎Ah6%t@70T4DyxĖxo" :;4͐jh(y~%z F| ✖/_#͐ZVviC2PZ^DmM|2Pg_7wMZ6p*%U0 bG$_22] Ƈw=Ͼ_I'h0⡢o,%7i,EꓫN\;m+m8߂mߙ(3,r>ݷBʇ/%656Ҷ0V U7m#u:'BL,lT B!4Q2wI]8 W gB%Ev,EW )Eld>3ə4D{)38۹w=??2ϚJ$!5 2aB j?"$xn'rQ$''RGjXq џb^]Eko Nmxd q?vn~CO+Ih'q7~e˙aKOΥCD_tË޹RzqȸY1FWè,@@+arEOFd{>>ϑ1| D[!}p奕'J6V&mK,saԇ<.xz`rĵ/dFV^'f`g/oT"х(-^r V 2oJoCi)E<ުXF͝ߴaBs7ċSLe EpV0Q?YyOyݢ2>"!Ҫ>"?F,= "Ǿ7톏>mS?| qV87t:$˾a6Y Ϊr_y̼^_tE'vj 4*0(CoCzB51r~${+iwގL  /Kz-&8C Mh:s, _r24_VBY+5`4 0xZ+`Ɣ>xcnľ jh v[Ͼ={a,XJ76D(Gg_b^r6:ֳ$Sal"k/ݳ=⿋| 2ae79\gIB*šZbaOgݱ3g}qű=r~';xgڸ{Uۯo[K8wY{/I'=@TYAߴ` ׷-"ODȑ0<~3']QMd+{~YoxzorVJ,p7[I J'WL-J !1;=/*##l4z#t 0&0r7 -zru*~]{;o榞|q#;NʴZ4 sgc.q΍.sZϯO^\'k:f)Cf՟Ϗ{Bc|KK# ;/g@i{[C9ݪ{/ L9}b2-hd>!u囉5u@^0*l U4.K@īBݮչ08oۛzؗgn"4'v$[m,19 --qi*qHٸhtߊ{-SWU=YN7DSŹ+F d}~Q)q[.F֡s`4lH?H9gh LiASͲ4t36yώ EFO=.gDk]8^!~WaR7ON۪gQ{VlOk 96K;CNHOv,7F=h)y]޷R L i@Õo+h0|Z\9 YWH#Ydq>-`s1?J|&b|`Pq0>BVf }yXA\~MTi~yޛ$<ع|1{2`oFy$mGJAVkwfGNgN|[zh.x!zƆ!wc#xSKK?-kúaLy//ލV}Ý&N+(8H a}9Yo(RRK߻6h@i0r:S"1ԐC?4 e'?URXJ1L?.:Ntr <~~~*ŅkwZ@֮`AE^H-,}ƽ Ye7!e 9ty޿cz%GE֚V_/v]6Wu'a<]p#o;"gK#cQ.zl=0ɤϖ6r6ck ~}sܞRv!2ee+Qz5K:煙T_ Ĝ#;BӾ#]sމ ܁sm("stDzs7+o^XT*|k'r3]&}ҷxBҟ-dEo iϖoWȝ+6$W ȁ[RU ,Hwnwxۤ][;y~&tK"Ɋ0zuP"z "6*LQKGRg/P˱sH|Sp/J|&x'[`nFf3쩴πϑա%"pЕC-$ Hr#!7 HBDIOb٨i(4zŷ3! )2a͚a0-uSlwdCi L}sJ~d x'5-hhlw?OVJC_`tٸj"6UA/Í~.R)L=2LJs?~x~?=;ZGoPY_76z5GaIE?g dx2oP"i'oRٓC fh)V;׺I%O EzzCNvd$4hC(vj#1XdҸأ&nNb|•׭#`M'Nџ9da|楋H~|4Z”pR/1*/ގ aH'cЇؾoh$%}\}NOQ#[Z?6 r}1?469 ;y w4hcbkWE)jeuVƔktٲxF= z -홮-/aq[}0E疜E"iA. ۟ &$4R_"ˇ} XTrikHcPʆO@wQJwa^s ]El#|/>gTpdp&ۧ6zй[O<[",K'㸕J%2zdOy)Еam.&L~ݖerЋАω޴\)E0mٛ&}} R_2ID30?ts`&p>PQ(W#U[)H.j6&2k|w=6expc^]~BW*_E-C`"vh[DDb̬PvP1G Êl[e$Y6FA3crY`oua ۖBfj|qPeFD y޼&3 _ϙCn7hmFvCՎّ0@QN$EΊxлc~~<\Ɯ%ڄ.Jӈ~[70)9z6\"_2a8̓Q{v$HBEoK!PuGVv$SghW| b /tl. ):ߣx`gU_!iZIo|Ov-w 0!?2Z]_IT3/:|pY_$vN>,(N ^la[%=`bnǰT-^ͯ)M pDEQtÑ?tbs}Q+p"}ǡY%Ч7KedN\GAoRB ,4-O/~YG|_ s]4s>Cf8< AGD0KjbTMSZT :a΅@?;F vt@{.ySZnAJq‘mmOІUiH_Nw¸L*Lc:+H[L :V=ZEWyZZ) c5 7FI2[W?O9̯b3&n'zA"=W( ɻ §qRoԇm}0 ߧ ˈsr(wd<:{%4 Is"eGԍZғ.m::strb^mu#g?FѪȨ)> -{5_")>@:C9^SF٠]r&;s$jچO-goUxlu+Y3F%wRޯ*^0?</C}wZA,دܬsh|. 2z侧}bk21E; sƫ0/@p@r#'Siʪ%[/~Xu)Mv^gl*7ZmtW aǠBqC0}N' 1菸f~%K;Fۖ61wп㱩1 N[0i5"*,7C9ZjmJ)ny;`Vpz ot՗FЗ!~BYS20> YTw%kVdI;F÷F_!q:+ >)H$h~:yJR=kt?i'|T}>B/k)V9oBFS^^H?M+EZ@bXKJaz RٻWg4hi9_d+ls1/kM/:wӑx+[5)' 'a3JnO;Eb_S3437lR}Qh1ĜJ!`Vד:ZH[R,9U"NgD-'[fTK G!+s{n b*E `䞼' ś'_+ VCfH״4݄GܻH *@Ɗ3G/1dmNPyu?~GjXřЇO!nS=Oc2Թ%?u%s|E~H)];t照e_|~qJ`۾fuh/tJEFy_o<2>uϲæNK6B之%=~~5h4 ?&uH3#m`q#+$!1&/ I}FaUQ0ò~z!4k0:1CNHG6 'xH] nyTyxd*LV- Gbg|xKk^_K1\$L!݋H}d9QGHYP+L_E~쭆t@~vO#o lJ,m&яH}>9&Cxu_"oWuC(b=PJex9j u?T8T q;P~od:mF=#ˮ\cKd1lǑjEnc?.ݼP*2nߙ*³[ėG!i,'{ɝ~2IU `2]g3c"=`UJE7 B361­>`]4PYKUک0zuw;L}quT@*}j@v/[GabKa7ո, Qd-^gc" }A.{̕ǐ0݌>ޅ/ _zH:@D!W~:HY5?@];YKx cȘXw~a&oMB),X{'gw̮z˩.oOawȭtܖi}M4u _^z578uys`灛򑴏Ӹnq3m(33z$*Y<|_QERC"Hfv0uy_TrжuWQ]J`;XJXÄTҊ}k5ba½RMl0Z6xxJ^æ<ڮ4@\_r.pG=(A&U)4P :Rzm8,K$-Pހ"A/oE3HWrS9[ܼҀm?naQ<՗be$G0eGC$ߧ{`zI5rzki"_4U nL zCn^Tq^S q?40[ ~CÒIB~ϩ~뼎9aS]y 0ٵ EʵqϨNHB댸KK*~9`(; +ٺXzod'gO"R:W`Jk uVXH ?z'w1/~aU 9a"y禸a$eA~[я05  Bm#$w4g·U]$5L7"[SmU{((&ƾ<Phu=7w ?#x9oz?,s\5c֢qIKrdu,9=UVB9]#a04@~n z/cWIwIq;>Wo$^Ms!ZAo=5V&ҽ=N@#f=[ Ě_-3}JzCI,w?7^*B~%s;yݶSt1Ff}_:?*Y+ZHd:?p#f:ץs%N.)W~2=~xvI-5{Hy5/hu \kB9h˟A뿯󓵞ORP{HG#i{?7}nusT@+喱 ?4QƘo/\퇌N?V#oS6O̙ur+nˑoo:"D'~~2#B7:x:i{gkJ9/!_S@S3IE"N"O}9H#UE`Gyt}ɯ(#@յBj*i,U^b)'\88r2rK>"]{605j:pbO=Ŋ9j(d̾`^MN:_i%RȲr.VO@;Ɖ[?FSJoIe+ IsnY_xH`3X>U2caB9d '%vvH]Ȯtm)H"Ӌ#JQԇк|&xVa"0FZr{ޙ,?тׅe:"y^Is˿ۧȵ[#jJɓ tp":Ԏ4׆[iHY/bKwAQb~tcȌ8pl^_Sc5zkX٬5GY{yYl\+{Jcܾ;\@ᛷbKܐH\Z;at٥}ק`4b #;|~~ ֩j^=LEϽ&#m]^dX#Р(6hk)&uioE򑽍^SQpS묥(tӕ91?[Dq譙8MӃy<}Ɂo..$gF.uGբ탦oNHY&qi_2=o}1_}΀ZH3[7^@c횟z@%C{cS Mz슬g̤`D %>(nuJg}u[3Gf $+FUHp2(Aadms4[F?{ZF)9HՒP!Cku\j8F[_-|?b'G[ 7J!O&fJ IL O;0t]a4' " wR7|ɍ|si\|VÄ*硂!}ńa&&N_]J!Ppɟ}D)yb1/U,F&%W^C+jsюۍPrݕwCߨgS OC[ ][puId ՛̑Cʿokj^Qy.CƲ%_dUDh F:/dUε!ߋC{ycp) "Ƭ?Ée?>C7 \0b/fB7Ux$Ҧ:Ӯ!xiN7+!Suc~RbTNJeO 2BH{;{Y }Җ}z4<{'oŶprE;}WEJn.hJg_;<:l m#W[e7rHC*5}$6ߋ&%$w~ Լ1=`iwՙs|E:jB)Mtzra_eV‰eEzM/('xB{_ U/T@%' XwqYayAVCᚡbZHW潹YH5X}y)F/#o>oBv%'+aV^^D>M^_?HJ k3baT̂$/L3yA]Ph*&#K{܍k`7=0X8 vù'E '+P== Dm2 2&(yHX Eu*#u)3>xFXlPXCi"/O><Ħ9~긭o4Q$ZnJ{^"&6aׅ˶*D@ho8L(iL\c; &6H!˜tSa^ SCiu=`ުv<<`ҬUO1Ƀt n0ߨ&rQC~l]ZviڻV1>1~5Ȉݶ- fΙ y̚s"cvb0&m8BK@ZԉdGjFlGVN{CRs``zkȷnQ$oo #=!P%&,LuRʕ~yM?и`/wy!RwPF/7z@/#kts'e.Rm{+fnLyMVo? sOsA]qFLуlN- iɼW=A.xwzLenK'o|lnӇV=鿣-."OyxRI3h>l&y-:~2ҘDE߫Yn~ńQCDyp Q;{E)0)Am*/r#y]Z}Onퟧ`}sjp@|q_ ӹ#v+V.969՘Sq>$ތq5߅;>~uN|BJ(!:,3lC3D݀l"?&V-Ǘ>#x>[.͢0/cMep ?&c7҄J=+C'qmN6PQe*8pl d;tl5c_K&I:S湍(sĻ,`ke#43w0 |i>nNwҮjMK4(hR؜(卍/>p%[092ݦ3n"DkpxD=nw8qArns"*)4KiLd \d9D]yxG^v&\zZ!@zrZ C$ͧFT?IwΦkOTꕉRW9Q0>d5Gc=uU}i((Rk' ~WbpV=Ev#ڷt]() % o{8od\E/ܐ`>)e'Pc7w?pi/w ) ԽR~kcѵqyؼ>$hn]0ik.ڟzR2+ ܢ9Pp( _c: Q:%H ASؖt[(B{Z%:ŋV* Y㳈<";n%/ p'ArzHm9?G,V: }|zUJYؚ1[RufIk$2&?[;&E`l=0vN 0N9ɟ{nCqiC(gݖȬXdz?WCu̞!̞'eyHJ>$ jʐB+zeJ3}Y$uA*?x,p՗U~)d,%NY+s`ªZYu5#+呔 EILϭkPP}5(<c t[bj#PmԬsCHCwIS>c˗E.-W.&e/GJ}%uW9TN,UP%3J q=⦎ɓ>(< ʼqG/ ^o4iqq>Kr.ZiL-E[$m;WFQ!nqI.q< Y]v*ZퟃǾKS$F'|RW_Q" $ YZ;-vG7oi &{R"`<$U_҂G#B}aΛG߇cInGuD*6KhؼVU)t\Uk O."^zߊl~]b`H>EvO j5%j}txn]?}fbV7شyD 0.ge#SIKbnsHvU\\~o+@ȏK E]CLBĆJD5/I)(,th$f.)\ɚ HU={I+ Cj :(.u&R{7݋t.;q+$StHoEA%ZDxl0GQ{ˊzdgm?}.z 2 zg yh^8N=''%h~R| & l?~N]?k3~AƘD.~ō \@߆$V_*sVBKۿN#C歚p2^* G:fyWkyC_ڹsJPAsI\U7^Q%Hδd],d)eea"4~qwX++@̋0& v7a)xhHկ,~W(y|OJ&n>ΞcqjoGi]~isd^(@gǃ(e%HfM'8ei8X/2 U*JqSl"UF2 p+u(snۜrMAȇ#$}?&nspQsd&Ҿ][<ۯ ̃N0}fJ n甍d.gM}=o0DuHyq"myw3!_fXGҙcdŐ؎95VE|VCo;[Ր?˧ 3+\A~/”pr7"ݔ<'AXzro 2(ߠ\%ng!쪃wG?as˵=}^.[$EIs%8߄0EY J= BTyj "Mx$9HcwVt/xÀi,Ld?sۧ-#ڙkstBuEm i"B!+m} t5bKP#ƣ0![dU-Zq&Oل|##V ]Nf)p[`'5(0,f H/?fCJ+30ٸ11wf1f/2G/%l{8͋e"ػ,Цo.HyU4?'a.ރP?, QP.0w.)?ߥ$ [#Vb%dV,F[6Q|C[n#V@u֗d$Y(ŧY^2~5dKNE-$gke:{A{*9n}}iŷxqon0(r{$2┑U&i8~k # ~5F韭ndC^J?iιӮ_̉篳3Я'+zFdtÛLޖO{%rD=;y%v;CrR6 ]dޖ:G'ݛ7" a>N%Me,~}PkjVd}̓q)[zç aRK?Wj@җesT:On0esYiRD.U(1gN2W ţVwak ezZ(,0TnȟLkh]xvdKޜ#{=T}-&PuG3ȕa̡:NSR[mAcc JeꝫNу(x(Hфٰs߻52r51>T| ~הoE-H٬T曆B+ܾ@!a32uK' 孑0o>r%-U)Wc+!Lۧ5+sU L&@}YDa5SZH2iJ0oғ׮skЗ;e~䄯C_WgRdǬ[B7ܖ0aIyB3Pd<SX =Evs0KyD#9Bѣ|oPUkbb=;Ӥ)6~;*dj~**Ю5>){ nkjcJi#xcGo!% Cg%~~{iH8= c {u R'v@E#7#!X 7C^fYsAjjLK{XаsD"s_°0j+Ư-*-MG sMHVS`)Ϯmb0}2ML33pCz|Nћv܆Or/_0s 3^e_n{1"sgY)ѿFҙilh[i.01*x;"S'3"dם"Sǐrc`ϑ"h+8q)r>HMDnٌ|:}~GrzWRy~7/ B0ayytS5! Ck: 6sJMV^vG8-YԪ>f83/5= D3Xu%/Sg9xÔ@+K%!3yfx\ jhA^=WB_Bθ3+s+L?SGwvuo0r STt&q35c߼/L i1ゼ󕾿mFgm[3sR#u8ldύ}(7f1ڕH9,űw=NgwI!QG\- =”50VGǰ> \Qz`Ҁ5:* FKt9q]^kZ!Wn/%{UøOFH]?Sw%]_? kđ ~5Sk/:,״"If^I*9Hبro3Rj nR'N.uTda~}/wݸp{)z-{.J.=NCRHëE 0Vz q/Z)ngl݅:unד9"2X",Xe',LςHr)'ٴ{ ?} }0txc~onU#MGPITŔЏ+ Ж iP03ېSw\iQ7h:DiǺࢧ<]#.}^'<_pz- XH-~F=埁H_}+;CME,;%386]oPUzJݦ9ӐL9PZZlʖYVI؆F vOh55gϽ{׳mH0?/*FV|tg^Gs[;~cG2keVq>5˽wJ@VNR DⷢHi= ]f[{AemM0yk, :o=JN}:?n+Sﴼφؑ'@ oLa76l#C iCC͝*[4"yeC_# 0(顡%RV Z_i A|eEiao0xf%%}1>@Vo1gڰbpo`7E]%S=Ҭz[ÈUWǦ;8: ɟ7|Snj-жsPS{Y^mbgu6~2p u'[f`To7_vaͪ͆&]Zo}bDo0<.o}<W'MKRoG_,B_c+_a}ZxLc6uI\Ug`Я݈t<.iĮM )}DĻK:(P#wq՗ǓUƙ"_`٢2Iԍ }*XSݟKH]H_N TmRIV/{V)ynC`ſV.*=rMB/]*cz[Rur8T/jhC] rYn7M&sD8*&"fOq/ACfH:6Y>'V>MUK#tBs;]"r%aJ[' tHxKzbyZΣ!;`Ɣb?,F&%Q>&2}KHQ +DdR)s9rd%u "7X\t ?|qؤfy{ z'g oә!{̑/7/fA q}/~EjN+r|('/4fn2Ӵq_~M5G~mH*__M0}A$ 49<< =dn46y iFrOwC}땛Q2|6v LvoΰU/|Ln3VlF "nD"EDzS/nx8n4fMbm_%,mkMXҜ<7i):< Ή}A3=e@;5 +:F\M! NpWIwg42oLN4H["YsVe9qFIט_3~/4+nm_i;vplNdw8,R> EQL4jt"17ǁ_ 2V0wV{w8zDr=,gyd:H+:=/vw>GƊ%/pGm;S4R͆te:0+z4` sΫVϐ7z{1ch&y[:U~<uG-}$/NyqT| zfO`mИR|+*,8%sTJ)g_ZFj .~oKğ&s?v 0qWI~0$Muki{ vu-&x]NƎB|r+|wPʮ8>`9=oHݨ8o: .T"4LBν'a?_"yQ(Y}Y:;fqAJ<N-L| Cyaq(M|}oh>HARwQJo80lݷn=T mNO:WH}cHy6B"#.F=j}sほ7 Ə=d&Ʌ 5D!-> ^ѷB;cf[}[]wn{9 ˝o?ff];v[xjx\ҤGWN݃=+~64>+K$ƅOyp 1 (\6xip{Mk#w\Y:X"%`T峈Ʋago-G˘'NafLVXdއ$ 7z_K{ CaZ3H]NT,Y ]2?~>|/@ʛ b*'7#SaOwq#E5lLaovמD:ۗ5/!gWǻԋb-z# _>Zi0"{y$qOq^HX2%0rsv tr\OˎJPs6}wr:ԅ*XCOVjvڜ}gwyو Iy++oi3o~-\}0EIL2JfGp\ z"/`N@ả_ʊڷ'Ǯl\w6#Sf╿J>tx~frⵈ{<90U#$;-w<]a0QbȞЧTf_NoL)?ԲTȫ;Ύ %C%>H>\rVO>f#7| ~YI'%?k.f SǢY=p^ɐOu HkC.Qt5RH VʱwhRbG7=n@G| sqޛ:"7T`}}E+Զ)G/?FA=d ##oph-N7n^_HTUӆѤהb-־O {O+EybC{IP3Bq0(b$Lo-`S^I E4榚W~|Ru?18"%"0mPڔ)~j\(iQ'ŵC'A0BI>u[tu֪@?$ІTK)ogg<"YZ.: 6߱%enAS-sar/ր kEp>DZ1T!; 5iS9腂:Di?q9Y/:ڂ|'-:az L$x}N$jOVYY^*ݖ )j%WI _@ZE֧ٹ CT վ!ٕ0qu~tl 5 L wgD@P/:P^/[??vPo'B[*aup7a.n"|00v席e3.w;N 0hUo% Lf9~/=E@A(H[./2Ԫ-C~yG!_ ^~&Hi!-fnl?2v჏; '}iVto4Bs_cTϴW?=?G)-Db$haE1&"KFoHY5 {ƞYr]Uw{C a|]{) i3g@ªf¾ĐȢ?cc)t ed=١=Km W't}fLJ^ Ix"ȗIVgf!-H_AȈ;짔JCaHrQS`\YIPZamȳjV贠wiH0[=( (n? ?X|K./;, ~%Z_6 Ӯ>?[}}m"_k&Y]_RmlÏ-.W#c_x.țY 6h+LeץՄj0^[Mna' =jxverӣ Ñ (<B0>ޑ=:0L6~l|6^ҔLjV/~t1/ ,>kE!d9UUGMIeUGdU͋_#XrG6>f'&\y5ן(|qKwӡSQ3BenWC.׋U}!7 3/° Uⶮ^|?7;׉n+"un.R^x+\U޳I> |R0#wUt駄qA9Փsb2+3mV DatxRG`aȩ ML$;弖 FZ!`?ώ!=LDџȿL'c 9>u-c.0gQ ]SP}wzD ws쾍b׵kUp]Kiu%CR-Z¸vԲ$+f Crtxniyx\Ԭ-ϓP_ɄSiaݫV.K'h)ٷEۅ. ~2$9 k~w&'E]2BXEĹO2#d/SA!K%cɛҗz!EP_=nEi(ضa1=ghVCi.{mJ s?`fE]¹QP[-CƒWҲւ[}zVuCF⑵3ЪasQC5$/6lBU~a5~ '7 Փa0SB c<~RdQ4o|Sǿ6 D+y|v)ƒViQŕnH/4zv^\ҲźO[\c[+(h~Q _ @sscGOjɈ#Shϼȿ`jyk7e}XC9xǟdcZR^;YV$xM{YGճpo"Sp"f1$+ [$qP,(ʚ{3a߲5+ "nK"I qa&Tĉ;$.9BÓ/*7 T#vqȵנ0Q^:b炤0a]%h\raU 2>ڇ %`Bi#$4']CjZD640K#'u`Ok{?x22He2t>vA'ΜVN<3O b_utg +CC؃0kXm.ttN8դD]t_W0>aN% _hEn.;Juj*mkmGO_= o+PHt#x3 _yҹz+3׵f];]f2yN.~i:R+~C:垳sWa-oA+׃7x u/q/\ 2ʒg3Nz!5N0xqxuHUg O)ODy`y!s˵t]XjeɳrF)bU;W,Z€ #2+LEdL<,]E69 0 (\ˋ*:^{SaaAՒyHO'5ހ~܇ z9a^4T 6L 9(c>RU E:hil:d4w[N@e^𹯋̠TO,v)eo4]Arb>ntRw2nNCJ_`(2(k–Js9[[ *Lv9f% / > ϝ ߞ6EĒ W+f D^LзtߣH-:W/O}0ei[qB>Hdɧ?wx,܁d_Ctzȼ,7̷4;l7ok[//Ɇi2K%R}2ikxNAK_(W?]sߦYQbh辤~۾z~K=YFچiUW[88ݡ'>2"xg5~r.2V?*x ĕϼVrpc@`ϯ{Tkb#6EV^0eU(GV~u 3߽&&N!%rp-(~6*DR.ib.{HR\NMdx#0#s۳ j*7,'5j5$}Z9\ 3u*C!-lg%w< mYtp'N$ W|cȳInݕ9+ FT=vjic.Gњ`iܴ*')ұJ>n W"_ARC{?LQcyosd=LΤ'Pá+Џf/`ʣ/j&|v ۯKI3Λ_;a@QX9ߜscqS/\fNa8<⧊Aq"=6J)zv{aC-y3ҞR]Bϼ҃x:U\5J RޮI?/*\WF s d t=L,r]6!)ӹ"B'ߠG9Rq+r$եH։ =_F7 "WiY=en,"p5'YٲVb_L,fJͶ?Uq ɪ:A0U^Nm./ C!L/[hUId.4Fֲ]kw& g9ߟK)`e1TN| } FK:̉&CJ`hO0c(ȶ#xO}j@+Ӵ`j `oHER f{|''&e,y2ͪ4Rv 'R>AM6dwN2r DCʙܟ#+K^f<~4Zxۜ3yHA;wZu:\5xeEmJ+u-_*%xSߧ6U=߅~6Q"V褛Aڀㆦhf؉VSK n9rKM,N XPZз+>{y'RQcM;#c#KO\]xz S*$Hxk;=ˮ eB?x3/Ԇ %&Z]?<{ 6%#DF0 ꯦM}; Bfv>I}(-R48ӆe5, )e$eSk1k#t|xs+{ذGj&7;cKSeh.|\%-Y,fpr ҲgJT=u=v ;rt ld ,ۏc;eAQb~|uțXv%ܕ0HT;yy*Β䮏BFP,&$jG98e;8oBe"h^`]/boKCP|QK6T Cߐi/]S|{OXѐ>U?3&syK}EH&\% 2S!(߶?Kߎ7&6wvyv;"e)i۱J.-laXUR,s&o$EuԔwC˥_־о-,  5z(Go1l}$X|t>` F΋xx:7vYuoYiE&=J³}0Ar/֓|zF#4n[i'>򓜙WԆk\7!od[}{\]R$ .OO˰0'y\(GF~_tILuF.Cj ` nw!E@'s?n =.XбV8rtJ 5xYuѼj;*D9VRoKJ0Ao.?.N,5&2!Tƕf|s30Sz#dy(=wO?aN!Ő'u4ϭ'xEH<{<єb:4;Cr`l3Q_yHVZeYAoGkϑɲחBsLĦg\W̉skˬ#(X=9[,a#rSm 3vd#Cb) ~ Jv*~ "kT~QH}+,iȴdkW | 4jJ^!Qg9Eu!ќ{F{ -ݼwl!A)_ 6l:PJgwuiq}Vvo7_oH^Gyv,߉Hzc1M Vp4@=;[-545:aJڝE9?Eз{+atNR -RB>Z\#k"InkyK̙YNk+yw芌?4kO=oAQh6 ߽DkF;Va'TVʵk)εFg *6B9AsmST/5BCv0iz+c cBu?\TLGx~h%QGKx% 3;s5H YI/HeW74ٻ={>[TJ`زxw>C0Ywj\̼}~O V'} "ރϡ~f8'LЃ;g$2{\6IC%cAI@Kj^ŝeEP\A} T&gXԿU`L?MҦH^Vg!sIU.~'AƆ*,!:>~SYw\$P8r8_6\Ӌewf9#}-`aScslQa}"$/Ry}CV?Wo=a{d9#yס/ r?uC]n$$-\ֺě4) +a8X!VdȮ!| y0j'Q8/ b ({^Q7V"]й#-c !W$$,<Wy0]^\t3Hϔ3}cE&6lvt쿇FٹP:rq|".zx2x>Ůoߞ44[gtMTrGlҽu C'SPNV'Iqaд8x`5M!0U0&r5 Zx=_d~& z[Y/>#1.)vIV`))^'WbI?{Vcԥ #iPsk%ǟ%*Z ?7ttYiQp8zsIӑL+WLI&Qww[VcZfxnDxwDwr.vɖ'W;rqN#KcwA}*8pv#ݜ~Qo2=$#rIs;N 3ꌡ?2VkvC¥;5`EsY~GaꏇEL= [4¨-}t`dm+VYc˾'#\]᱿kJ9y&oj8RBhG^P9,cT_JC6݇vQv{q?'|Gj5Glȵ/dy iTkBE?Wo4)[ >!Exg>ؿ ^m0bWԵ~hi{7nKf] χKۗuV޻0Zxk-+U7m y'z cKԇޙ#VV$m{^"ba͛p8Ù>ԳӖ"Nsԇ[M.#!{jrwלZ?LC"އv/ huan0ڊ@Έ>h:<d`tMO؍Vwk_QFY)F--HN|H O{3bcqLڔl| "qX $>Af= 8o(*Smչm(haFG}5j\rQh% mG憍Ϩ sņ _>kyU;'.E`]+_~///:})޿I%oYT<_$2I,@ֹ쏝E6.JЗy ;6H3Eަ6 4+x4U٪6#/?.Dc(XX~r6dvy&{`߷8~KF)&y^|mǍE .U!e`t_دD(3z#rU{!SUgC# NTg>H 8U߃#IP5ӡ zgc-gMkFAuE8~AN2M3.jXC}]%[8_sb"1Oi}0,yǁ+޺]tC.ݛ6!!dz=R]N -IOd ~Lw!Ì=n6K r:G A1t+2NVNY(7 >2@UC-<~,>Ly^7#. 5wGָg\~-!׋UE㺁r/ano4܆7z\yF ~,$l%B"Iސq|)~[cXpv?u%_hN0PJ1E;LadpkyTQF.[^w&:Y*t3RݘIGzk{"TȒv"S/Fz{gڻEMr/bȍm9{+kkR2赶˚!Ӑτ hEi$3mbW^*$* ig?#{/}3ܺK0C)$c`D0`jT5`iR H]yU.ItB}8uGCOwaf˻KaPUlb ~KE aaGΘzqyN^3 LՕ!^O#𕊚91J:|6&'̐JU^q0paKV=]Ls-3/^H 1 7Anؒ-m0?sBzK!}3!7U6Bӄrbj$!fRu|Nt! 9\?``"֧]'O|B1ݡG#'s]K =uraB"b~W7^[A{zj|WNtrWK!%88k=0{rhFnvF&/Zųu+6wB{ѻHgwwg-5屠ےlSF<9XTv)+;}n/}Qncod"K`~HNdq4S~ϼuaԡ<==!j 1bShBq7qAіU= 6!9좖 7 AFꓰ>"#x'YK8^ `z? }:d<;p b^C \ToԯLm'qui8JkO{sH@'!wt/;o pZIӶV. 'oT #1^q,*VkRqG>B޾>Mw蒩-<(>$5vMQOY "/N,"M:sm $~bsI[ +1G\F98MI0y/e/"AڬJ+W+@+{9,)>n*NW Do.&;_I"Yݫ|CW]㟭H}*~ VX$0U353JO <%ӛ (ݍ<;:8Yuȝ$"Tɚm0Ӄ'&irHqj] }wNf{Kwg(0qێĜL؝mٚAV 3[ 6{⫑2f&PۊfaR/Tn\EgZ^ riΝ~Y$+NJ0Y8`=K8'ڋ,K.!0ڹ`rpI;\nERG)ڞ>_6~0Y,tm?YqN#3_m~bkÌ$42KǑ,(jxƲ>1ow6GhjthC<'q'zo90VҦ:n~w|rL'sx䳛߳{c+L^\m] n8 -ET<"G~r[q OFԗvSi̇uKt^ L\w4`4X@SGm0^`Ȓ\p >x.É{/<E V#R8;߿U$Jȅr9xҽ0M3$flxe_=(<5"usǼ0.L 4xUErO&0cCBUӗcH)3\bց8wP$ݵKs&4=Oxb(?~5R.^P1s$w1F8z0ߧ^HEx7p]8 ֮o֫$;WN\6o"{73uTe2ŪU~N$ _ho{ G_)(ҏF(ɫ3qHDچLn|Nf150Wܼ=0Ϥ] iֵ 3B9{:42QM0rX4;dZЏoWsÚr0"ͷ}˼YX1N^pCb&ڝtvߞL yHݒ!͐ܠs lm 1hۤ?x.}~כFFF~N\ ubӢ\Whc~<[BKI cqmYt*?} Qϗ,NCȧy y&Z~rqk_I;#wQh"wy{8e?nw^4j=FR[쏌[KtAjNƘo(0X.<fAFص1* ~#OңҖ_U?A;s6B301ʌ b?:D蘒a|Xk F)#.1]G0}WL)4wЧ<"K.ݥg}d+NӦFadn~@cE Ou{~w#I1 F"~' Fg%9)%9`mwq^r%D\ :[uگ##w_|Yy_? Ff_;c`-x®-W!I&䩏#łhs;5 aSKD"]=ۭ=U}@dP245\މ< s!oB>+e´@P!x1QC`/a?b}B/WȣR=k{vWc +lax.ļ"f dg ί(UJQ[+z߂誹 p6?$=tڢyF.L1N|>LD8kW.IڸZhj&DK.zI2| k,k;P 2`d(ع9ϟqY"&Er}*9w,ԿLZZAMߚ-|f;ܔP-\#@'#o$ޕ]hnijі &/iB_x*e$b9pt]Ś;^Y㼤c 3sfF=hi32OL* wK{~zC u\oȏ//NB։n?GdťGaxAC%HQ2eX87yoYnMvϰw~Ú#DP(hC(HۊΕXTit߾0t:n_5i$LI N vmZI}&:^g(*yuM7S9 ڹ;ߧC۶H=5=3'M7CnD{j0䆺+HlGw$oc{,~4D_äGWmn_>Z_I~S,/`gXߎu qnibȰx>GG~1ewZK g]t]IQMk{`PR+O`:kzDNAU)Zͫ(> -< QI}H9|zGoxzղе$ܤ,/X?fs"9AB sMCŠI`4T5(@e_vo>O;gfA*6 Ua/+#׉6[G|ש-lӄ\ٛSנl݃HO\#-ى|ȕfI0YZپ9רKE"ݰkio(K: +]](6}]s{%$lv;+t=J+& s{b"٭Gv][;+Ț["5]XnCa~(x䉛_8*>EI2zlwGb'"rzz_)i^.IYno4 ݰ1KQ^?SiPηZV9 1:fy\hBrbǮ_tPg7BFwuEhܢ-GK{kR)] Gs^-Dڸm;SsjwJRU .eJ6#XpI=tD.;?%vI@替7l9^QV;|YxFCBl~liukQDܶr=)L\z x7du4ɷAg/˒FN̆ݺ?VD!]>c7r=}c{>ē[pMhdNŅK9Q/D~F;'#xd񹓛q]EFnk}0#3.'pH>2}BI΋a'}{$er/O^d-ugVL~Η_g*XmJnd-B9{sxabjm÷0g<ZWwJDu>ox83*ѱ"ӑ>#rΈY|1]*wTr3 g.]d6e ]8Kl0!(O-L\$_844 Oxa@f d[Ԅ*0!yEqzQtWRD/CV5m=apKybΑ?a0ePWԴl<>r CǦ:k7kQՂ+Q*Թ_kxOKuG^I4mYk(5"q):gz%ű.|r\=_5 dfoƮC(5t~X3?uϮ댴-CzTzodLMh"CAw{zsvو!2?8T, A{xw$#Y٘KPP{#O22sx6HvuI΀; #3u\F^6/ıKfh߼_^)ƫad u:Av_8`_zi (v1K۠Еh8o~ ~HBFƑ.\5E΃/-ߐ"ikmݿ^p F8ʳ]W_"җ8WԱ ck<)G~!H0sc07]GMg8"_Q!ܴFUF1q]so40lMh5h2 lPA̽lҢύ4g'N;ٯ1ߠNF)6s {{Λ% w0kI_O]'_>HzUޒ@ӻ0UHY%7^Y{^i5nDIbAʝF#CZ~\VtWS/˰&L^ ǽGiOLI,c/,~}H\% nkPIEgd/MB{((,Myo Y^YL LT12HF>e\~ᒤI}9hc$Y[HHaN=$E!_gn0PtV꼼 )b{ H K"D<P<.$2"{rpګϛOpObF nMyf/~ox] 59ngtu$;IrtC.^?{p^gߵ EAeW!bQ}˜>8i[鞇녚mx9Q_0Z߷Ő{%öt WTsPωD˳ʶ? vӼe-HuH@L] PuoIEFI0bmnz~gւb[gːe?)>#J>il(p?Oڿ 낙wVK&QfK7CŸ3ܭQ w#}svoOPCBh<2m7"uIܹM{^c[-О8jn8 tF" "/"}܌xKz0rF/$iCow<|rהӃbejB-/6?xZ#5y+<U5{*;c,JKMV;ԑ+!)iC.#u ČcyH|08rFq1OaÏ(ʝj® %##: Yy9r<)j!õtWÕ}@F<^{>L<Htx/*D-!##AJ^ql` f9JB0 ]\l #1äg<[3'$5!;OOwFlxE~ [ֺ%_ _v^X0E8Xs|\yx>e CJ|G/qj6$f2(|K{9yX./fuYe1 tAg"Q먣 sŀآlt**v`X#W./SI9&=鶞٧4Z4?z,Χ79s9FW% ;޸ YkFUҬ YhEtVsCAoN?}>,;Roҧ2n_%H3Uj떄uQ%2eʸ_aℌ6ώY5Ebߓ`eM=ˉx_Fb0y㲃Ь$k$ jnۃT%o#K#OۿadyaBq t@ʗ-ZHRsq0*t1._u898/q{Ƞ$+jucx⡢o >8y3a U#7T|WCH65=Hй)?뜓}b*ǭ67X,uF׺G:Ogaɳ/'`2w=?(D#ix6Bϒۈ|E#IzB 17Ƨ 9Bk/׹ r*3Kx%"E2#hE"wh|rۭyb蟽--[ȧN2_f ]<>w@33dy(Gζ[o'3KXՊ 3*{`P9t -w[}~-ΗƮŻUJuTEhʸ\I[Prj1oL)-: _,Dfb'ξ?pgJ/`$l]VOp AȖ} &]m.ͽ~]r;ĉ).͉oOVFͫ!5A1_C5H->J .$;*[A%sǖyGAf g&o@r`]f-v2I atۘ7faT N HI"D0)bw"0`in n5\V)+dr)EMF.:DŬD:i>.H1y{aAl`(:#F%u-<7v0q?3X*4iL{9b9v ȵ7R޵_ϟ7gMSa›NψԤ- Aok͠\4]Ӵp•$D y<_s\,-Y\K|apI[P_wpl4N]?gE"Q4$ER9=IvҐJ$JHR$!$d=^Oy]qϺC oᯫDg-ذn\i/ a݄ZiwzJ2EMe/q^d-D1F&p/ʛnH3QۈL e6ޚ]^wo~^kmyaҞa ۡ0?b}ޏ%GN(o唔x.vn3 GN{Uy fϋБu=헙G#SH!6|;JV=źDxE пj++%ϋkwYO~R&bC͒4d?X\T4 ݛ]&#{kV8zd =)Ŏ؀]ojIυ8g!h2s[͵)w~q=O[-w@ -ж>>/KUZ]}:j0&*HBug^/nGלMjg5-;aDQT[1O^WB!fct4D7 w$)/< F &/?kzQ7v;g|^]K`"k+RZ*6nп9uJ==`ʈo^ZS ~sSs$>If!ig!RIܿHZ2IPp9z;-L-ͫC^NtBL(3g"`^:tOiwnvI ۇf`u`!"_# y_T m} f`Rc+bޏ^S˟͟džaj.;o'Ouyg'#a],W_;"Efe?F;&ׯ~׮X5ʫq~z#$+S˚~6Hξjr&l06\eEZibé*nH5]G諱ѻ4g$(+G _ԫo y2{eEw: utK[~ Ak;ρ^z^{h{4 _4Qc+#QM"FQ=_~>=:\ ~0DꂂGcv0G1'IU ۫afvѿo 8fe\aH+~ 27V=cFAk;|6zjyɩsz)GAV}Mq}d~$nrwдz5s(a.+FCK*$U^׿IKԆiOH ۰c&GC­{]OWRtzquٳs~X>16R0~W%# n=2 ={_Hݣڹ"9Q $lM8:7u]ۭ#ͻFm//+ˈs{yOr{7 - ^FbgzLBFSpd0Vr).?.C蛗BYqJd_);2.pOp׊PɿK^ͼ F5=qNW[}xA|x &.=|]{o ̇ ;ߚ'54;3tO0TӁ\?'AY3{yw1S7 }Wl 7[snhi ކ!9!ߧ=`z޻yjP<+>0FRUHjqh)RI:Wȩ |;tsF7#GZwoO:H7|g^(YN0))G]bq,)UǿY\{zȧX>9՗G[y!0b\nMϹ=Е&ȉU]clC"[I?]j04}um'4CuV0=V& /F /=IeKd!X6Dٝ͜o;̗2Sao%R-!ŋ8#cֻ,֬_l=,ȳI=g.L *\dUraLOC=jR˂SOX' [ᐞ 4/|8|ж\Y5SsB #۪R+~m ūa?ߑs@?z (۟ iʾJW|`02,{#2&2 Jwx#^$aKU3fnR<{VenGp/$g,h”^W9hrƺ __1FKk6H#3J馅q(tNIG'\&;k `tzMRjI,8S|Y+ Qrhw*8U@ZwgН{0/@DecԽ%Orܶ~/D<یʌp$3֌*筳gd`]K_2xyY"GEo|mACֆeA2$;򼖘7նʾze::"-mM%굯*EAxCDn6fBH}L1{@O!Th=qP=w߬d<<^11>!]# uB_COH[{ iȞ H ڷi=>\0>UuBoЦtJ/CvONBwvPH D_Tjv?T`9e⫦+{i֥0i˧=CQRڑ6S=Br!QV\uNLy.Y'26LjSE[BTZG r9":/М3 .߻gΩ+Tc9Jo @'/钙KtvK^.kҪ+SPzZ3#ZoA-Ja tZ!]Uv!k23b{\{^FB;T!M\9Y5\\rAL+m%'6Aҷˑ?Rj^ 5M#3Q8B=SrtH̨Cren?vM#Sh>囙0Jm?츽gZ!Koƌy"dP ~\dSBܾ˃0af+2ߪ돎!9T^" BƌS]ab1$Ϲy,dRUK(]F`҉ jkuTrw@ׯՕ6ȨvYK{RC4L7}w/<r0R.D$nZ||jkhnXpr;ԬOHb+C_e,BncMZܛw@ƽe7yu/bT>7S adn|j#faR~:뗐mRG+Vog`pɘ6b\W:^Z\t*8ȏ{i 0N"C/D?ðeFNh֎."\γ -Ybt|lfdw8,)Q>c5/fȊAoy0u +F5|Tt"irC~&opB+6`w3)0Gׅ)"C/33EFxeuO?`БS\oI=N@һ~e/eht4RP? tGP=)|oL}9YgAN0tB˪)IЎ(pz=ok!3̽~d>ڰN$n!M(zr.}`#tQZbdcFtk2arR?V55O`@*CTy[EM8pca>=5)w+ءp# :zfFK\ dqY%4"m-Yȳd%30 yl}vɦg^/.#GwvBH95Y#+E`S2:ΒڳVAyYO2eMe#ImWKU]@ަ3OJw 8)^me!ЉdϳLjxmmx[cB4]HH摑.e#ue}|cܹ7ن,"c`hf~q81?J[#&>mY2C[,&N ~݇)kF"rbo:燯}HK]2ձFCկϖ`da#DynW&GP)/_ TTd_^RV)G_0`M&6''"iῗxc?#IvP0%5|p'΅sBu/-/ uI?>5P*V ~/GȼDGѫFƿ{,~m0P'ռ&J :OWD׽9HY]{ytz Qɯ%y>-0|koDS2b;WM,) .< <҃i Mȷiܗ0Nk E3ȚE~B6^(>`!g$=@^oZ(ZƍtE~@&NIH=|}ǖx#]쒜dII|xs;IՐsI:B7 5Bw~ۢ>ށ] ~1rnh%+`("/ȫ9&Yr(뷛'.聩3ѢW٠FաfBF4 Ng[i4ҫ[6 t~[ 6t,Da۟E"_!{bgk}dnV/ =dv龶h[$߈TX.ջӇweԅM:XK9<4;+Oa<.k? 8lswF.HK `zk_2{Q?wjp:H8[0yp}$LpQ:E,LېR4Z-Hhs iOcj̒ˮesZ{q- r?y^uCclN3t48_KV4ywn *. *f4:{d~ kPo{9oU~"`.~CM%ZGs_ݞw%z0| }i0wGa_ [m6L>Nĵ|%go`ծg|tZ#0ajm#zmQht`+WtZ`z95;Ӧqʣ`Lly"侀@ZmN4ŸMBJOuάxrV1f}>C$]Dz\Q1vuƯl^ \nxӪ_Cra אRc%$b҄?T\> Cb]ZZvϊHٺ_WpL;4;+WQ f?_W0n? Wxyz  X1Ytb]UFidHω"XA/^<޶K";N!)w +`nib _&dh92k5Zt't7 =D2uՆsg7;NWde J1Mы~QHk&qs"px볌Mob̃#hi=(08X,ge;w-?(.PhY;Dh.*Rt)ICFGU +r$ !E^KW+H: TK_-i(9܇Ad͗9εϦO4ݡ4ykk, ٜ/zJrNJjE"ág 9kzf`PGBϚ淆 zIY—ճƸ=3z :$rLJ/y޻o0wMZd}-ʼne+IjO'4g,s~oŪoԐx8Xm }>I V+)[v^QXɴ@at5|@nhY9A*+T-e[Ӹә}iM8+1EI<e#%eoBRGe酂0? l1^3? i"#R$7?wZ'g}0$x9$g'o c. RvqHf$k/x9 ]]a JaƝzy}K8Mଲ'W]U;ГF@-{Ei]X2KZ0poEkTV}6Nbfe`"C0])dR=ۤLE*bS&2Lb/.ȯ1xsg:@ @ćCs7 Njx kՓu⬋p NcMޘW'[LlN۽{_>4|谬xLEC֝#|O6Q׭nA3B#(~[oM /#&я]Ђ>֎+5v޵Ai_F,n{['H#%L/|苯{pGIon\*m_*TTazKίH:t2 E}Cu_~ۖUK掻g5ddu%Kusܘ~hi+K2:0]\LSroz>(u+Ʉe~#j_̀6v/wEW0Q33Utm5Lv3w X!P0ebNB߮վJ°̻ā&=y] FN*O8GvdqE55#Gw'S0ZSHQ݈$X82 ޞ&z#iw%N梹 ,hx) |qm͑@ੇ'Jq!0.4>2Lk] H;@R Nr孬Wk$ͽDz.Y2 ,!e\|պwH|lϨѣC7o6v!96+ⳑ$}zRbRҁcK4?"G棝I2O&xfiC'`?N&Ҏ?^TzжH>LN~t7{$P#"4|*BZI J9+;!ys8IaszvܱBhLxs+V#xƪܪD'Ek_|ͤg QSg77m}Fz1X:zKg'!tg0Ҡ^O*poL-9ɂ.#܏%a=pL|Zϋ;9U|>>_%[=< mz3} >XV#mDj5M0L8A;'aȕ؟5W{8BMW;盭Qwϭ 931AڮacdfahV}b& %"^Y'fO'x~ZzgOuBАQX:m);{;Auah1Rd?_T|ergmȤv"}[ʛ۠UZ7𫐷  aq/W&~z)CAK',xǂ"/uyDwVg?nY^ [!/'/μK~,=8 n1aG  +wWp_{'8oUו0Xg* *r^köy *+KD'3c+GWܾk8'R੩v+MG`MDL"W 'rC}ٿiO2% c[C>> p)CVz*:ז gCgCI3Ў2Pv/0+֨F݆hu+;_o{( !o=$t(s~ L#2mQ.}9ճZ&x]좧Л%_w2RسT- \fIPJ[u &wd|m#Av*906f؃iU#ׅgszB]$PD& ȸ6jMa*(wӣq}/-6qZ2bi'`*qkbnU>µ/ =ď^c%IuʖļAjcgv}b3Zߘ wVR1ϐй9(`0M%9ZHz92lJ3γͺM3gKQ]a{3EJ\.- C"~!x&OG+Lvgk` > -v tu?Ǭ[׈4Mza#Zo\m!HF#幷Lꥠ:X Eqb颗"[Y><:36z-O+ֲOE;w3`h9^d =%'WN ՓAiPe G_mц5hs\z*:UУU m<{s@!%,ݯ~ 9Kzzb?ARl uȷyTe5^xiro޹%Ō)`AE u ydۮzz+L&qs;J}O{P׿FsOPB6toO.YԳI.鯾&ϖ:GHhC $7j9};~1F ]{.>mF Onv io2.f'~6 ʵ4#>727ƬARsaT|dUFi'6%qSXҞ)7^vor3l늆Aj u't"F_$TBZ8Ys|`9e9.NU9%}@F* Ξᆪ >cݑJHSȅqa_7ufMz =jM /Gr$_߯KHlh$;mkL<*_w[?jQ" DUڐW> 0(:pVƤXw]}vj$;9ZkgڝT`ZkIrsjևɌx Y:43KOly cM>]OwAjOḦD cFMcя4`t_j60*ꐃ\RDĈx?Z=aX?XqN"ihȮ&|h~5׏xTfP&Ql?_84i"|kAg巬Re澳>C_08eٓ0*E@1?dx"wC}I:=9SUU0~ˏDЅW&k#Ϳ]zTNGV!Ogu.ѷ;5y>2T Ora,s,]a,I:rTf#N IWmi.Q@b5Ǫe<'鿒WG3&w$?NDJstWx .n'@Q|糤РIX.=ձu-w䘹YS;~8i>Ls.y|P$?^ld}+o3>Za@붮Z4gÙAaG/!\0`wj᛭H*{f4(&[:4x_Ww!ЙM%,1Dr>`rW{MPy[3?;W 8z?-❚sr)P JAys"kŠ|])Z 4Z^>7ήTv2Edw~gDeCҍsR!x@G{dCJdT>= F}z юF}HvV cIu 3om²rwZO^*w RJːGbuϜ{{"Нo׼ƫ'y#㡝㚩L2dASO.ZB;+& ԮU?%XYHmɎ'=[t:F~%ݶ(QO}tUcJȴH}@z+枣H+P!A^=cHSp-I|H 5s97Zk! ueylɿ+>|0Nr̰&Opʓ}k9HJ +ED1݊o9V~>z4| qni(N3Kk Ls3HV /Vvfh<DSߨk{Ȟ; `HT~\fvQrqEv`5I[^Smɭr/h|ipUlp#׏[_KۻMt֊Hm:A-);/H!SК_j =j#_6>-|+:GI7x: p:{foOgȗbmLL~5Aj̕iyO}wDŽ]xu1hϾVpy!g`([҉PS, J7֯>yQI-ek0T ud'BjNfgyh.Jri d|atWۆZ-N;cߠ>Xr70M 8WS_;?~)&_פ ܉Dvw8QY [,_C%Ҩ۵.y۶Ch0]E=.ĂYw}50ڶga 2cG<ڦ0b5zz8R ܝ#9Ç巭"Ax)%k$C=R~<47.Y=i U.vPt=OV:;abхe3ØU+4'\~w:4r@>K<%>f"}A>j"6Aom\2燷V\϶_(T 90Ta}^W7eB,e~%YqF>>C ׈= ߛDMt`ȱkq?HQj-~G]Wájmb.>w˽w8^NA^.{zB+dž߃ۼs/\"NzVib߄Tx[(7z .;V"~^%IYO͉zS# N MϻjQu dۉ4-;?0m*MF:y?CU"(<-xǙSD\V#IZ^P"5SO5%?^X_x O߀a>ziTY*=ۡX|v"?icόc_!}My<|;Rdf,@VfK"bݨVz0pt%3W lٸkFcyW80b_c8RDBCj5x$ȓ.Ӳq}_nE9&uDG05VfXEvqMcyY.&{?H}*T?Eڏ^CW*gHnV;;$@x^LZ9 %sa2kM0c&yH+VZ dE'_^!g#,jzcTmonܫ(0Oi|dR$}?=Xj7$Ֆu91.SkP|[_7EA3ՊqvrS}v0sRhP| z9M` & %Ryhiz{_:#m_O{ABwϖ+(k9 ȉʉsm`|X16_~#֊UO-J][l>h;8WcsGdHYtOv#]b){S ]OK1Dr..A᫁O@ȃeH;nI.ksb6$l!U},d-j? z^=$W{ ;'Fז_Q`qenRQ350 }f3d& զlC$-lFw#bO:\UCvF`,>1Ku.ʙEՄ; *mgu/h3aP O;+*y)tVB?)zRgOzs tH])H=o3hw&B@PlYDt S h&[*I|e!{dASu:M)A>+C91Nj'ʩoI&E>١s͐|K742{4F6@w0 AkqN[?!x[>7wQd}mN&-^7Sut!7#O)_;%doik.hqv|%B_j邔]v ~گ]6j}Ғ_zBO0F|Җ_c#6#9]q:pXW柋=ٳ4U欿YC ? 焙o0s1KZ&#TǯКߖKZvDjy!l>F96Ah2aM|葤jw,'XClݥ#83Vu%6NGh-%8i0sHQ=RVLq?ʓŲ0~B$|{K:6j *5OӲo+BVv?ôgx!L,]d8H11KaA-0Vay kTVW sBumV?Ko1V_wiMYhLet6wWnD~͝$oޛu'ʿTNcm~J(1h4ztA-JX$'Q* `<3~_&2Ϫ,j.] AۢwFjѸo-&D!ޣ&Y n7 ֭MfH)#l|K6${$݃W|ڮ1ٗ5*yw/clmd'>:KyFr_8ݕ25f~ j__s E<EhIR^["ÿ3`z|erYޑPStN!0Qj{hU;:/ky4a*'SZq''S;_uq|in<`v,Pq3?x'yJ 7`.#{Հ46L|}\( %ZynBj\:>7S?OފloL3\LZ=p ^vH]VG ?֎|_m1Clʴ F3?*o{~@zC5g!gLo\rd0>WaϾv5fD-OׇM0,޺YMr@"Q89;%1^@٣2A/.Y qw+oMjwe+wzmvRMҸۈT>WLWMa7崅HBn:ף-9ؒ7;gλI/$oI,价Wc;nW` s7m:FZ@` C a,H$?!;L˲m=B߻HzTn|Sq@#RΤR,"60K[>{h+2|t+ao}7R6I.Z3ubwC䪺U}SBRO6܁N$3sbow! a# \my/#~+\Q|Ŧa.7}$O~Z;L7[sh"92b6V y(뗽n!!98_(| Y9y `XϬTf#V+]wպ F N/%tK݌Fݟ :ঌ~?dR]8L5 eaty9穚+PHUu6O91^uDwg~u;Y ) NUs;7IE/L`""Yu(x#> i~Ə\a9/w䮤i6=Ȏ?bvVⓁΧKd! tVMrP #"z-ǡn <ԭ$ꆆ[l>o% ajRk598?NσG3>iceN<}~_24o۷wy GH y*) ofoYom V +dX3Dc׈zS:S% `ޠ_0e[䡌]ϓs%ayT.8G"O#E#)s{2 9uUOl{b:a<>z uW-XSQp# sM^[at;ß*Pc2^BDyk{ K=_]΅EsD'kxwf)w`$өӔ*\: )v|_[1( B£靛ŬFD%Z|j.Ᏻ=&`js3Xfq! 2n i[^wHd|mG~2,C@Iݺ%g@HO|#^@zrĜHQ )k&>X/7L`2W. Ⱦu=[ ,* vD~ 'PO L蚾?Ƣ32G(UO=v։R/Q17U='r!u<[P( $\J=-aFlg *N=ŋ+UVq%7 K{wԖt"?VXud E{V>)Nv1mz0u~1޴NGX^$ձf-HJ9+PRz^; y?"L[: EH_rY^F0Y-8 =5Vx9I/}(;m'RTi!yI0an3 Xa tw'I 'Zb0eyil}zv&Eɫ$_r,rto.58dGˑ޼Wz])&$[wzyh^T^  5:AXE%ȹɵ=`{]憎 Y9r%`vƨI uB9qHp}ry@ԥַ K,VϞY<7{áҏ'xjx;"ﻇ% [Rʳ{kFGeBWI-gȻy cE6^b0zQW toVu{H0W݃HG/@Ug@J2/'j'{r~>25Zl>d\R )> :^ D"Y69F\_3<wYon qQ5u9&l#;)5L*-9#%<]< yS\S[|eZ/m),ݕn0UvV/u_AϚۮsǯowEm{wdsOR,9a]t);בlZQ;YjT~;T@LZӁ^uiahEa9k-nƻe=/S>  :"[L.+0E!΋ zu5t@΢Su>oBq[v ыG`~Scm4F?hW_ી&ʍCžgd+^2 FTAJJsğHZ;:^[q! =R [sR~$ "gs?a=׎c4EqM8& a6-k 94OT.BF|?Rpe7fzagxΑyAKTNMuk#h/O4WDBQw3`;m_@ߣ{C~Ao\;0HX>qvP+_[0@۲K8,{,"WNĥ7u/L\{$dx3=Kx{<#qi{zq"B?]2>c S9FΦ oy F=iRMH.,ڴ3T>05оΠ9W9jciH;Z/u}5\* s>.!!G{PP鏋֛&zpSO6=b # %%o .r+UƗvFFe>{ID0;doʬi !<~ЦGzj V/~i}ήG+]4ӧCfxE4?Jqs]:oլfI'iڽO1 Fv~^wKz3fD % Is3#XأmOE1&냲[iÈdtه F~6;;Sz0-_&CmC6$;p˱M%5-82Y/>1@Ftq t4jwV-?GY=I:lX⃷W?k1Gj&~+O?ɳi7?5KFnfNpT#si0!E]* _}hX`*ShEk,Ik&a8+.[R|`SS{yI=OvJ?S 7G:̐"m|]ګ =4v=!&6 n7֖z==W-,| }gjߣL=#Ĵ1,p/+!?þm2~I<cLV%CDA5914_:1k]*f G7?r~bREx;-y<膟wA\lť,S.&(էff%FV5xеuݖP;+7<:IGcQ|w_8y$LlywZmi"oefz^w(u)2!9NrH=-&[M#=Vd'*1a^"wݽ?0@ 48䃩/O 7 jҳDPaBbF, +m7a֤: 93lBWtXңHֈ`C|io(cfm4Mၶ׫G52c:s͠G?7e} 5BUk1\Z0Kowݶ9KHD&oezK3kɆ5gMm|MsB_a{^]Fk(H]g%FY&1O. (}&T^L Qٱ|C:l۽AFZ [x>wө**.VJ*Xe_MFR6dAhAÉ.Ndvu׭A^͑}s)!1(YO)ҪK ô~(*> wDG#r1Mae{Z-0romK)x_Xl\Ó? 'vYnj}?}ϣDdN DMBe0x !O~p">c:e Ar-+^,ږau0~, ] }o%=inڒ[@&ȋ4C}*ˑ,8|M:;uION 'lǙg + |M 䨬BDOz{d^qd8![.q3]֡&Sz}v;H{mJ2!oiMo:bxb2^TYCZ Md>3gV*R5.[[39UQ2RsſA2oeI.η{CKBA?[l9xKGvm|]Jꯐp2IyLR14R7[M^4h,ڴc!NJ"kE(g}Cb\M{z,$a}8hݿ7̗4]yːxv ߮8HŢ2u)񕝹|nԱ\1Ww^hԷyqj o%g uE_UGJ< e7 ?u pauR1z|ͽ{#"[??5,$;?>ݤKMu- RA(vICctHtN)p0'0c| BAqyMnHnض~;f>Ԭ,7@r]nl8sI5*E42&ayVЯi,L ,x/ƿIӉM Nxcco8P.֕꿩i\ZɊ$8\r ,+_GMʷ!v[`qE0N8fRތ0X_"8ƅG 5E:L˺ f5# ,,j!.\ku37!-S׹^:o5Aŧnzj EcjHfXyH^VI̒Bb8,tyv_NSe݄=1/Lxzt'zې߼R9.7]^ S>!ζB'= Fuo>?Wjm3"i\#^c Li_'sUdf2v#l@[W+lѹ\*9Qx/ 9 MB3az^gs\9hVFil]z$-~0-7Bo6z*2~ ",6x-a Y p_)\gUWc׋E!Q1o'k.I }'uH q}\Jܿgx=vyO svo1bA1"fl hF?Йw}}?XAVy}$Ȼ~9VzH.,GoؔAa;2\lRCR_3h,h],>o`=xލKC.o~c :g#e-Aw@ۇ6Ksd(+$n ]ϼaTrzdOBڿ{W Kȑ{|0/Fw7f KcH :[k񼴴wOtGw ?{3Ui;2őMCn}x".$a@ϫ[u6_K}<%Y2o/#MlD\[r_ X4Ë=!-Lj}4?5R#-ᕫ{V|, fm* 0wr≇;R/7'){{@nx74yRdꅬORD_@23Au(?&[VTִ1'X~<,MopBFB09ګ- EOF3!G,ޞzy +ڕ~h0[[#$9wKYtr޽gp$)L\3 iap[?0M}*g~i#+>A:WG-r"01ܩf?: C}Vڛ.RHWYL6|eȫ!8 =v?{0WoUr:'2w%;b!WS ."#嬒/Y-|s#z&o6pER>&6`Ξſ,d^֌Tr;bwYב,(\jcVnG묵]Io v\^= l1P]=e[U##[hK02AugX0We[thT9߿ێ$QkM=0?XUGeZ#9C;z+<#g_*QgE1?EL~J mI&E6~6RV>ˋ':BY]6gs\BDRŧtS6Z?DP)T :tݏ0ݮx-9ȡgI7MmW$>h>E01ݗ0|њ#Huk2 ]\rGMƶqf3oܶn95qE>$h _pgd?oui|mJ5>6P:<۫,ASTb)Vý%͖, 7PSr] =uM,PA~ڑkrȹ4aԬw6ӧ/J#-YT_}@n Zq򿐵={ DcRk3tKsnM9 C滾Ê˵kG聣޵BwKpx@LFhMsYbPrqۇ>K =ie5`ϝp'Ak3\W?%FӬB_3Y$tm7Ӽ{\I?R3v (ǹzg̼aYc&+8;Z^`hſ[j4W9Yvq-0G^Loő=HAؒ@IQdd 7 isOMc`d_J{i|oFqpY5dmMsg߇mOZ}cfHO@S0 59H[QkZ?; |d;S ug@6(7BFZ\2_9e zoQzahNwWs#o}\}V0Vbus;xҷԼ:y)>YRB%4}!ރZ0NӢ_zGAw0uAT ?Uk.q|j*K.G,=(b=Cjͧ*7@J|T>џ&Ī+szwBt&~2y2Uyar kF$>sҬE](Gx~-Yf|N[=~LE7CFxPWrdqSGYލ)Pߩ}!)v 9=:1xEJlԜFǫWfM N8-@}0,p$*d*-_r& }.$"#nRr%bIw놜R}i-65l x"DW矬3W謓]1޵ IF LSᮘPF3}U}?F! OQoD:<8i7v?e k]qX\i1ҷd.VWuj0v.oMФ.Pd3y 1SQp7wbVEBӟ;zaTxIaQ/57Q /{RP O:-b)SW.nwrq(_;Isw&?e])"N!!𗃣ߧ*#%i[Cn9yt~Zkg_'nq*B!oӈ~3ґw4qq\%|604m }/DXϒ9 1c: Gٗ5R #vz905h*J$ҳar)Ћ&bh29W3Bt] H?Ε;8D偉A[uDX d-: ې>tKvU{X&<9?zw_#!UQ@6ArD/ٳ٫HY^cȼչI {qDfEvW|w} ˊdKx}o5Cٳk??g+4t1M׶T"p'cT`wNlllJ|Xp۸ȍd%whcwٜ̰SN"f51HԖ?k Fx< =k\AvVz+ 1WX##VRhi_OHɹ`]!d~ۘg5Hd';p $_ OªG#7s ˑo-:/:IE;}Vaě{q-= <#-G%9-& >0O' sJ[yȧF'7/tj\Z}o|ˡl~]Rc],#K EQ^ myq 疳Ç`8x҅^naZs$Q9>) ֦ig5 a¸/H-4l`|f=*ԣ{+5 x `n A|u3h>%:kKGVwHsK')8"i{0umeRI{y!=Ҝw',&yg zSA>Y Ae?6qypʧsQnHbX?Tgd,w]$y{ qiGi4 MxdÈ/VBeN >Il1<͛;Ld;h3E0bS#w2ahC{iyo +7LT/Q2c=Oֆ@\ qaƐ700pTkB}H1~}/V]-Kvd/_odJ_wrMufOP_m.:;\0g߷r^W-Nȶו0xgM&Lv#Fn˞z ^#uHHG;T乯BM}I4 =1-Tڅ=VY/nSV\G`⋋ mX?ol <ϭұ/`TA x9,q'..r"Hqg[S9)BH19j_o~3S?L`! 0mW Lو#/#߽[Bી^W/_q=RShM8\}$+OiyfX`w5O'=n3ԓ IE׽aL^aj^$ן2#~3Ie[=к^tRҲ>$'On3s'ح%~_߿8G>B*;H ,/_Ŵ&~Fם(H&R]&G"3--o=ҿ}v<Ŋv2N{(+鴧9hʲ)TzeqR ov#{c1ւK0kav1!wtT]@9f%+BƐd}{τ>m(kѿȨpqaw;Ыs=!k"%Y}ȹ؟}*;;w_?e߻ɪ1(}ͣ5侚>9s B~]^hZP/[)E$A~ݿS`$弿'R~\D io0i Ek2(atE ų>WA/r/>_Q6ͫe zUˬ]*r9Yײ3+@&}vw,^M3 ?awR:NpC\s'o/ 9*)O)I^ 46yw+./I[q|;r#EHIyƯDZךj=uE㤭56;=tɣYWncx]鋷W6|ݷH]t?odx˕B'3&]$ {oHhJOrɅ7zCmnJ?ŵF2RYgL<&*^-HMk}C(`ԗ{O*!}pнغv0ȵ2N'.+xf "3Jv~t.}{R]OC3Jkyg{fRJ&H..Ϙ _C{VC#ZPqq 8H"4`BO{x(x6cJ$IJ%i(6)J%QR!ْ)J "BBvlɾ:c?yi\׹{Rq^z> o܊S"Y*~F{ߘ{^bǽ0^/ }K۸hQU4H;ucK1%6i#Vfc'D2{j]dԞ.e'br@m҇nCA *7~Ʈ;&K<}h+xm X|kh.̣)L%- ܤ;bde3Y]nYPwdHB\̌vª ],} l|_w/y#\ZvaKar"nP=o)Ey#5TI^m6> b8 w̕guǨ H%O13X~ȶ&"}mCg`Ua߾8/9#bGI$fYDqIX6ir)dL)udE(me'Ψi:f7zМ ;ڝizC=LZ+ޗkqjQCi"4B>x4N7Z@ī_Xr"/i e_'Z%| xb]? 2A\?a䴂| !BE +S1enZ=+ ~^pNԪEc :pbW4BR˨+l1$pF#Ҫ'= 0e5qXs1WR^KÌ[ _:W/A$ӖÃq %qf44侇n-E4$U۠l#0U%S)&sQ '¥áb%c+;JSx6R}Er}>jc~J˾}4/_#,dNՃߔ`IO߼>u7E,j,;]ydЦA@L"@P>cDs!w,|X E#V߷%l:Zt?rh,MCg6$F+^X`u)g:x4-Uy|K_XZrG>'MI|g>N O)[+aׁY4= wO]`A8`*0Hjr2g‘?ؽ~L%Fa찗p9N9Qt9#Lj^| zb%%>D:":b4{"M-[_B}3ru z̲:.Ct@$hvmꃥ3k$:RKf䡿03/&9Eto GdX.sJߝ?^ӔȇR{ƝO_Ztc)F_Xv5e}' U|>Ĉ W(^m)y9y8. z-"yqCTdl ~*MF9Ifj`z9\To0r7jҪG^J?&XrǴ$mJAAsV#,tv}VDzd̹F\T)(MHWc)jLLN/%8"ڭ5<ik襫_UzqC kB#}a^)L26LK9 ~f5q?,QDam~NwW3Y|Hp'lgMͳ.*W_a2d[`KV*c5ncK m)#.]@<'`â`#KsBƯ.څpW5J!*̧ԃNWIYA_J!tX+(earb-gM*f)eyA_ %vl &?ȮpSivƮd~g0{k@{}EL(IKG)a)NEasѷraֵ*-iGbi@=grYچ7c]G?ȓl LuGeL >fo|*֯K]/S ;Ke +W ݏ=\O {ìJkM*L[m|f~Za$$xb[NLEP~W\xqtӁ[\Ǿ'<#U9 5F0'gςߺPhI:q!ҟbGR^`-ߕ"|c̃'uaH`wEQsm E?b2E `9ZNՈ}l= RXTV`p<,KwZAR?]ƍox]o_;f _UzbWg6;_YU/߈ܮڅFz$0~R]1"n `2qVo?0vn{ E@]]P7SO^ޘmm⚎P%Ҽb~<+R.B&.vW`c R͊ ånx+]gO#ҽ;.OK`9)$kz0gP#Ey2CcS7Dlvvz1ߣg+0ε\:,_YW?@sz< + |C :M "@`8/dJ) 6Y}uxC?q?"T>\B ugbZЊ?',Y &7e$=UWn}/(qyyo DzU1Ri+ۮ¸9<@[u Ky)E3]0Aװ!^7/y2.wOEݻ||TD=➯y&>Yn(@*O<w = ~nUC]޺sairܸ(hMNK(]'ZAOiW4>=I< ֗Lc rvcǡ0oG$H|n36v{u#,oxwx.Dp(p~\1>ihb/F/|Zq+ɭg6%Ѡ;"ou/BVs(CDґR@_N>,!b \QԐ5^=dmlOq%d7l{ rN"2KNNc=}r~q7 AgTd>Sk>z_l808w Bj5heEpW^ ]%~ue+6$>x 4ƈwq<蜮> R[d[ - A8ΈЮS)m nb.6ސMޗ BcaqR|x'R{^K( ʹ .)$!{:t$[u xh/lך[a)a%0<]tOsr\}Z\r uJ,f+J>"DN{m:}85Vra R;{yfywP2\K;n;X#b!n[0ePKcA7ۻNڥq3{\`˦5O͑Za< d'.zDis֬r9xضc؄H3^0uX(].}50'M +@uSZbϝ8[I;x'Wrz7%ch8a&#_ߕW}™~>bKlK=xf 2: dpz Ztd`٬nLj-@wË,:yI7A|!qnXҙ^!onDxY[^#rFq90s2Sl >Xs=2Mٸ g7+ox"t-< K?SauT̽V | 9>ktOw8 Ll'LSiտ}сrf5ZŘ1ĚĦ-ap2M,DnaܩJA m}ϼ$\ȃwqYkF6OKUJz/#|/ŀb_gb^|owjCذ~R1iF ,L_|q ^@+j/-W"]w%S\ېӥ^2jŨ*௣$ ok5a_9*MRtBRzG:VJ ^CyfGEں|@&PJS}QPG(hMP PR}5F Ҁn>J!cWj*a,9UFX#R=}#"'N9וJQD"bn'8o#nM{ʰ?ٿmpӳ(`D /"uQ,;JƐ ķOy5<ׇ8FdmqÞ][lG$٤x)✢)z>DH(Sg7Y+#v8r#xՄ?`)5wcNi~4獑BOBk?jŏ,],?{l1 g bFWV|ۓ$Q}&DhQJ{Y{J0Iuw5"O8)| [U}xɿW1Ѭ ۏ`澔Q1T)(*2 c/3/a E*rg gvgȚ#ܾD{N^>UR{ n maVsbߔpJ+±V+G]뉰:"T>z N_=[2K >Kհ=UXm=l29p;BK%^∷vp8"L6JC} ,q*KvkkN_)y$P֩PU t)e%Q8>mp(1Cl;p),w,<]seOÙQkOĉ/HpsqߊZaZ ˸\>^slskoګk0l+"|۟F>9ME3q-Wa 7lC?4ARlCXEW05Gw|fwl!)Vw`Kފ#Nj1܈&=.N+t#ѱ>0ŧcxrZGV.6 N2'A<=+żWnzEґ%2 "ϖ`$%DGog_∥u$#GZO6⑌II njs =1"OWi/beAyOo咮,)&_ sY7:"q|~B,"T&U_Nií@Yַ,0/NBxM5!~Û/ G}vKW%.1qA%L6ÀQ 2$~t}[뵡};{@M~(׿#![O6 Z+|(#IQC;OPh)03B:ƫ"Zݿ1=}ۿcasBS"t{s,9h`pPH}&W+~H6Wu<ϕU ae>DUT'ə.!5S3'SF.3߉s3dBVW"ϳGHS%X_rk79ވCKȠvq7IVK$":W!.CIqqjD6?8g (~BG78W 3UA,rg7.!['sddUHD_oGR?[fU`tPg<$?%sX#7gL-iE-B>C\[,˔7B~A< ^87?%ZLޝY] ,PJy!g!ӥMl|OfR U3CBiޱߞ㗾`熔oPX"imHs}vX/ȎLڰ3+/b0⼄!-1׮o@DIIp}`8z0=Y k/AS>p_X8q\MSGD|53{>~]pK}ē-|2HW98[_ ^)GQڬ_?|{| ޮEƘѯ?xmf{{½3}G"uS˝Z+`&^cO]YN9aW AaCv~ d⎷M3ŊYu ҩCǽY~$90q.<VrHgȫc."Ijc_U {q75Y9|Nt*Ft}j̈́i\i ϲ%a;?_Yd($5g!s5H?9e9:œ|4q%F>,-|-\+u 0.k/?U35f }~hAf>;I٣F6}!z7\]\G1zk嶟 c,cĦX FhdYoVgn?B V?ϖNkS}|!"r-=1 B;(0%L{Ö\`Ms Fq~XPzxqf+\1_"+5y 1 7>x!`O'nD߷0p92(Iqj#rhXs&E pyS8Qw$gavVYɕ@%*qnY DA7Í'r Lߘf{v'N$Ex%wkQ wz }s{ s(93 a"u7Eu\q%Gڿ+J'7*Ty+o' "\]3mw9'|G||/"|ކ}[h錸 *pg8jG_&L|ݴKL-POêY (g9eɾZQLRlXqE>5cXnqzppӖ{Jԩ4qKߍ*D|jX^F.q95$[`,ӆ0x:м CMK`=Iԁӿ@ҭ'Kn`k\>+jX EH?HꩣѩO7\Vz{^|` T}3v}` ywmOb#D]}F?Д:G0/~ _=~`bd`BN`dv;*m9ҧ݇\maH) :5Kn5;w z.~K}sx*}K 2Bx,%X*h][ʾ_:HכY7WâmsĝtM@ʎ~[koN f{Ag%d:L[{_`x G]uך20VE Nf31kA;ue"yؿCκOy!ґ};eT5[}GX|"o,>q>g#|`|q_߰N2\4ZxTB,c0QvgZΟ5 CǙ4OθS_[<'5?gMS XoI]WK jsU80ǡ/VqAU3GDS}ӞKnTZ|GqH87:Zu+C"TUw!( g (!bսQL5q/s[npFW[Y-ETm 8)2N0{[f/ڟcr.nOXURq"gز),֬r5uvL[ hݟ:aa/5?wi*",2NDVtƊ5a+z:ϒ$S9@q;|Ο8kov܁ZI kӊ}[j>}\ qJf"wOޱ념?u/y#ϭ]T][ 5;w~aV_uIs-;NlO"RI)\`CEd*Jx2g^ ~_mQD>t_2 Yo| 众CYg]ϚxÈ!+a{ZO|w=s\koΉ`W4w _; xyΣ=E{EwW3",8ogG#n[ l=ZxL׎$ҁHd$ פfarEo5qDE19_1{,aot*MSE<Ÿ'O-`FX/NԻemcH$)~xfq \sq"sͦcY◡vST[2\w WryY2%f+\["7I5Я$p/N[ ɞUHQy!9Yi!b憩ި~X]]^p~cz6P?uPq(^Kt;{'IÛ.7mGnf i KzG+cݗR΄hNd'wav %jqBGߴŃvVNUzMٛ艄U{]?WUe_95⠻C6GʮC:( awrd7H !b~#\ǬoE#}h coWЂֽ2)@;+0ט}獓[p,tB|Uq\݉G^[%f׫8/S'GFOM)Ww鱈6Kd8$͟چxLVċ5wgGv_b7<?v ?S"5CZ܀r9kumĹI*# EY8\$YP2HT=U <֗ӛ"C%+3^pϏJFјzDxg,'ɋ:ތpѨ0 'ڔ"Me'$9/.Tv*u~c'w ͭ; 9B~(b[| {v}Oin#1m8d˽0!z0bMwl)Ecl&Ўf]zf `Y7[gK1I(z{"{+Cvj^/Pyr賏Hͅ{"DEUmML{ms> C[i> &oy+aVk lc'/~KZ]mJiB8.Ĺb{\M$:jކ&j5{Қeg5#~7I&'O{W;;Bj"\f!]0I;aqGGa\<[ލ96Ɉ~o_N#%DDZD_A?KR7^ ֫;'>)DʭX"5QL\0TGv?a|Z[|4?a>?A7.j`7w@h:x",W~}9 b`*ϥ;FwnN gn;f*Ź?:HPލYr}#]:HiEZewbZρ髗"m?j>pнCbly漱U4ԿxI7)SB\t'f;D'Zz9)ko {^O'kn@L\Wc =<ڠi)ZY \kyҾ[&bkA),Tr=]# q8 tխӈh(8D8U#|V@_@T-:ɒz=/s+Xv# LEſ⬿hJ9s1{Gǃ?M~/p_@m!3"eo[te]C$?f "y16Ń8RaxϦ yP׿z{?PKa|}6пä{#s+U=YO| Ӛ]r=i"³GA־X20W~")@Q]ԣ3J5bR0o+]0-a9?MhiOG]4)Yał9"z6fymeCdN:`*E8_SwM H<̊ipE"o>"=օ",}~,-Xt1ѣ*0jIᝆ"/]l ?1Jx ="of`􉅊t(n(E//{?\5*|Czd([aY\ܱ$mkg##8X ^NGK'pbںp.0D| Zv˜cn,m\+!%8VGHھ\U]=̜[Qh5bL5*>' h=q@e6jjD& qP4BkR]>X\}p2ۙ1ŝv`..\ mk=$%l̽ QGwukgDn! ؾq 慶u/!u?Iչn̉7!2qq6kJ"{dr&n.dSr'OJqN?N*dr܄KE\]ʅKWųk@' Z-ugs:1 ? M[rIcg+]{8|~9 &s/yFf3\n7$Y6YDOdX-8KK%a0*P - #E9U<|ׅmOr`Ѿމ8ޞZ!9HVmcyy'00g7HGNYrUwb0FlR!E(~/9zÓ5^hR8H6.5dH "ds!NkGC[Ɏa0{P) o9DYGMȷ;w'NC_-u%ԙAgzUD|r,}-؈bz;|R!';0k.lm iX$pe (0tG`ʓՈC[I?wDon?{wp-K4?6L0̇T_}mĹa#?vVuMs "v<_z\B^ W{΋K9v~0Lٽfûthn@0 Cڎ4ny)R>, LCEوxP`#bUBYܺ4v[?8$)q1K{m\sxug/ SW+YNT'h9@-DWZ]iB9,'wA5vu =foD{/?]@\^cϝ [s#ul{Ns@vV;d%3xDTΗP *]E\C?Z?WœyW/66x["XXi+̑;?D~s oU) nSoa.1֩,/-<7f+.}l0g̎Wo}-}~c":i.-5הKE Jz פC[x|C.M?|1}PdmRcr̚lamoNkN W߄XP fvϚ+)D\sz¯q-8 :> ׆3!&0za5V 隁7dmw:lQvugnxxd1= 0}L0syG73bBI_6]תpImj؀UrU:,x%K-(#|DÔ!@)T5~|&W^Ktr4vZ?G\ܐڷxT]WpR2]3ut0QF$kzh=ӿ zU %87^ho]/N_96}3bU0%viS'x;X:2b= K7 d``g6,B{b"u_Z "VioT˃:0#ob{aٮs68l"DǍ^sYwtYC55'rwy}J7QjOٶq0& یOd#\8ÚUe+51[B9h!3q]Yy6$lu03tgE'^|LIG:,L[2Vm7'ˡ]rUIuR4[1"{CݨJYɳHd&t}d:ضbv;+0,*6,9E"ՎWaoXF';.lkq$I-۬uf얢ô8oڦx4 ?hr%n^S [nK?&?>F{f-%ڟ`9uX|b:%w˥@>-x#o8moMTY*2ĦJWA{Y.#ϡ K19n 5VbEA>Rd@tgF &vꢙm'0.V5"n+3ӿZ~睟SPxO8?񪾏Rp X^3`)LL<$%'2? ls}mAiZx|!Xu/fϫB#ζ>Ncs0ya22{p,ǧhC:Tqf\37/ҏqQXJ|;Y%a?~𿗒k7ntqDp3۬Lۿ2H0k$Wiuλ:@@T_nvmu=|!nMׁ7'yO.CܗF(;B=,`T-My\_@эV|tz8(eMWC%ۣ:UX3r{/h"qB^)ӮgC|FԏlR}g9,- bTBx+"; v [k`wQs0-Q;km㏨L]0qaS 3X =ֈh^HCx%D'AKK:&t,Y~n1AXxU=`4W(: گ9IH{uI.0=lͽ[@ٹ$J0.yD*J^ٵm EXԁdCP'3*%*0mc-Kf+<~O%l` Ku;;%`dF#;`~R6kRkaBנy[+*_[ƕS+Aϐ0|egBBX+?7nU?napmO$;&R x&hAj筡MпEZM1IP} /z Z7.N8P\UF_ۣ0wg8! (eۙWldӱΉ7b@KHKa@=yq%q>̂ѻ%.@9#7&GA{QR|4;bL&Q%X;rC/|]QN0 ]<2T3Z 0lq5+j$Lݭ]D*"{dXG4jäqgVlخ 3 U;R~"u#j.πzk'a@kRUL~dU; F]М%EǯFjrPj&ж&?<]ַkM==n0=3 0Y\Ԝ9/puW`~Α!O><8D2۹TV>cW.M#Տ9j« 0?֙'v _Z!O< U\wH^`yWHr0 /-<>dB |lapZH"V89} Oe+l7@_+ިANmtMgt`Jz}UܕZ5CU.%$򽀭g( 0Q'l `Ss9p}D-b30/O,ƃ] Lax[r쁮Lt穅y׸`FEV~x?oIy9ҹ;Z;,황Fjp"it/H']Fj3yg#0i' 9l-wBu ߼U5>Y:Ӿ!0sJ,C+N75B`'~ BJvX0Vk9)sqvm`n+Ͻ`6k=-]0.(|C_u#% f^n>Znl6(᯷2O!ܠUWlsXJ3\ܿJog"bڍ!j#S0F1Nzv] XuX%WDJsae\TNbKU2<| `4jv%_'_FkgB?W`밊+0(1X&av|K ˉ9q#ݑ'O'à]8 >j~ VLNov}e{eX|sdž2-p@[7!.ڞfO^Qp\`mCi@[2`}쏞 7$\,qOX[bY;5_ ֛.fWčN,<$݆-z6^"3Z7z2B;ZV 02Wu ; ָ ~c":<`Ňڇ`MA /CҁR;e/2@ ݚm?B[ʟI!ƖK3'h'?HsD7S/ 7!B: rR[>!7/VH@0NfPV/d&r+6cذqMMr$..xJ5? ng%,]tSp\(~lw I/];R`l5DK:J@UzIM0{Zf]R9#iʑJt.hHBM&F#Wݾ=^PqQ* fx2v#dX?=,]_.|rA'U^O 뼖-tO.gjMfNOa?;nt6>,^_n] 1KXkSTomF~ɟ+òwPqB̭PXDHYW s2,"e k`>Ib}D8so[(L2N"'wH@ottH^)HS?uUoQ[kBM0rҿl_V0:d6x>'GLC NFubYv"Z4 ?4f0YR'obQ94>29weVj0H6);:<6X0z* V'輯i[Y o͉̍Xpk.^CDk·Ζshnkdo i03ѦN To#ƹpMQ];0^вiqpqFΫea"igt m;R?,n\Z4P.~>'+nac[8m11fDXIM#,wڄ'U} lpxeXZc]%6+#è Bua4~l@}2kX#K7{/vzYꞰ;fy^J]5IgLj\5Je[=S=ɲ0? T[Q0?!#.&;͡=՝x!,~@g{6`4s!CF"%Dv+\7Uz:U,7ep(qlnyUNac{qߛ,j NHXH(Η'kQDcL̥~t+U|D|搉zҚ%Yxqښ"m?SAG;oȦ!IDGp0zi5I6wX\"T቉CőZk=F׉ArbYxMSw[@%%x֗!{~$%ZR$%af>3+SD-~A:U:ʽ(5+y=jfωyE%{.Ons,G\WYߞS\;a"=ذk`RGk73G~aٓRhPGi;Kq0!23UuL`B`(|,}<@Kmz:R)ϔ$L`%.Wl~_a]u&b.aALt8ض9\6:4^qCHn_cצ)8,JR|UuRv|YR PyQ͇ӼlvdKPw/NޓZ@0U#/Gz\WgΔ3QX+OuldbE=9&6|+HyP])P¦sc^l_B?p_&WDE?Ksb"||?"k*?_̃|0gO! 1nʰZ\o?I!,^N7Wξ﷧Qx $!m}5wĆݾFBq-hzy Bw9`j;2Ne5C3lji!yu͖C~bq`F(Zaj|Vc =6JC]ѢhG  g(ﰆII0TW,P ^g,۞ 0̺x]D~}],+i-aдM(:tyGY - 01<].̗Py z 藌De65VBer@Hqu32 F0Hإ,Kwh`CJ p'=_2(`vYG>,Xmizh"/2H4U-o0}TL} }7w,A@)N l{>h HT~" {lg5*;KCJO٭IogxW [Et7B tץo{wn|"LoڢBOw B`\&=eٗ{g`W^&XnުE)Y4Xz;Hh:| 0ZD`jۼ#sjF'suO2M9eYp:x 8`ƋśEX?e%ԫ}}}*gV*\cĥݞ%o)#Z5L_4pЃ [׽ ~igtc^$Y\!gz&c+88 ϩ#iIW%unB:-}o>Ll<4fN޶ aۯ,p9k U9wd`߷*Au (,'nkTW#\FT(˂iVu2M7xsEf~j)Ѱ(qg+U,z6Z`}.ުa8e K!zGԺv˗WwJ~ME)nyF#]%es0m=/l'n{wWZ `ͥ[rHY ,vc*K>,,x&p)~GΞ+cXWE GDadP6Y~ wA&rDnE`lׯY@9Y{s8Չi[Qk.Ѐf&(Y+SECa8`"?S,اxD+  ·l]: ez&sZ+ W {5&ݹ'+Gp yNx萨xVHrz0gP-g(gV,>:uk %ỡGF_{/$a]w"]a0Xה}u6(" y{K$i`ܷ T~ZQу85w7 xÐ20}$;ߪ۾:q;ԅy„ԩGwC_ c[,1k3ANfi0Cm/eI]:Eq駱_7$qaD0,Zp\MWH)YcsmY(Zybyn:ȻzlpMA8`01@Ӷ9V3Vbkr/ ]3xbfc)X/ۂ6ћjCpXm4vs hl)؋i30`nszuX8ٲ* Tp7`x$xLYǠBT&>{ 7rBd5X_3fW`AejK@ݾEA=4Ȉ?lN 6 a>$m NJkӬcai#@1ZjߜxqgG`*$ì s26T,,̅Q `4`ʲ.,On4t1#3]4`6c z3G:a XӐ9p׉3{3y׸;mi%]7Q?<)7{ Z>q3[Rw=}ؔ2\jыFدO&1r+ =%cSn NK~Iًԑ//,fjF@KְUEDb\yn yc1Tso$6,)]ar*,\149`-qJV>n9z]D$ b婿͠8`r"_<*5=5^o ]Ԋ$(-1Q 7W`ϒEaiY߆U`Qc e3m\[.uG2`j>1+G%/"0 ?idFqf{?Ge`[3Gw+15n L/ Ԓ9*|0'sus3[==CnaU;' LNL 黾X04G ) źӅ0N{>,}jìuzDU0¶8|@9VUj!<y'!k>@\߷n$ ,Bl%%Xip̈́q[Ӷo`dP5˂^ӗ2|}bM;LCY'{ q_]ȍ[@O~16!i7&n>ƇmO!3?"Ь|J*PH‰W?U8&VՂ^} w"^M Gyp090|ep:O7&W {ɫ3+sTqū)fkB};Wc˰h8Mo/Dž8KEwpL}VjNZ-''v 0_t2Oc Ƹbئ E ߟb]C&,P.da|cxҏ4cӱыofɖ w(r˳&g_Sf{h(=W)9"!0 R=Ov\\JHʇy5+@_3 Ά3u0Х50$:1:t|67xsHJ61 /HU1q4[b:k?!X\Yң΋./cỖW&g-5yo-`&},gqQx4XtD6D]z[" H<?9[( c *KA^߮y[lyCz|>~Ds +&1FUYIԳ+HڛBf&,aA0}~i{V %Ym #qXh0Sk;a/sPdn^إ;/6]M+ Gܗ j`d0Sfqbww򽞂{)ZVn㕄HZ_˧S7Ak ኘ]&0[~~a=FRK汇:_)ycmL o(Ȟ+_-K yP`+ IDgugcg޶Tv|*٫{z.: 20 4Jlh˟\s}gӗY@ǩXz ,ԔbQ튃IևiYnCۯ0hl?ta5B@Oih# c.g (7D(ȿaT%@ULߗaeF JXyGVY:ovLQԣu5>ۢ`NesWn)BroQ~ɵ5[w;aik: u'wHC UxnL?Bz_6b*Kܣߩ&U(wb鑷a);Jt`L~'A%fjw?%}/ CoW9k3b$`PڶRI)"ǁw䣙:'VV/a#_Ot^ż# =6h^[(]0gLLMH!78jq/I"zua7&yVoz%>k>֔=O~G d#7Ns# Tn v2eoYܺ g\3KQ:F(:҆>+%=Id}8?ٌ:ӒuwXZl2tJ#I/o#D3n?3qF驈ܧ!Gbq!|DQJQg.}K>y[g`nkz+XMGۄ!q5,9^;W nrGxSױ*o&pkB Pl5ӡ;A_1 . %F0l= c.A:hȇ15Ф-n,<]}%)`ox[ߚ LW5Fv\"_Vga0aM8` ,gMErėG`Hgp|M,;ioW$Â,?a(޺qȵ<^k[ëv\v^,cjS yV9E'^PΫ`Cؘ:W|Tq ïh)&2U 7NwtL6|4G΃f55@,"kޙN}aIOB|  ){+ i4 }{kjB/) r4La<ݶWtg}Ê#]ϼj.^~Q*'fFr4Z< qy*b-UdwT 7!CX`zC]>嵼%17zM}a(勮JڪۦhC9!l\0!KUg \Ch0f:9hc ):۰jq1Y^ qq660{~$\ov;f\cqO4Mu޺1MD-`QMEۭOQ>aR@ySnh͖A\|^CN坃o]+>YO̧-w rH×˩оڷ6 b{z,a&_n,m_nUgZ `i#o/n!҃via+q lp#~Qdh?;y:1 d4 nڅ ]?+"(k s|Gޛ6UCuѪY0?}if~ʃ76+[ e]`q'v<|+<]k'{|XǷ0襤v>ks5 4_M3WBii(hJFlM|}Qy%j n- 5 +aZ`GP/D auk,N8B?P(noN`k8EwXoTpf1 2ڝ'@<#2s%.b3{NCDI7C>pcD}/r &xZm,xsR䡍Yp$LM6rb}FQov A[<0/hg [}K *7f̻eph4߷tULvy:aY|{>&0i8lM_Z/ j۳{ulN|ܼJi&~gP:# \Tފb>eχ?!3Y]r#VaV\QЊ9ܩQ,pռV`:f֝Roq7kJBڷÄc "76t=:H}Q`Iݷ`}*P/%\T CeEўCƞ0#j\߮uڴ(쁂 SiƟU#j#%`d 4' -}+^>9]MjȱֲPAܹm Ƴuxh۷[iS~֣}62(YmZ9VQ K<[CqZ {V,1S%T(6A$O7,j/ fڔrwQLO}SB*f/XQm]0!pp&wъxC`6^"Abo5;V]?Yk>k*~ }=XP,O`</@~:!di,hF(Xݕ vD*/{sΚVä0E?}뫑V!T,BhḛW(f`+ڼ" ?ǬE3,.%lUI ܪ̍j T<ևs@6R[ioJw՚D_'"L9[90SbSzD+؈q/bOr`fS™+PqhyY,uj oNecخӈ#4R "k#j%8Oe:7l,тC$DޓQx-Q8^<["LH_z,%"?Ӧ>cClIH ._5ڍSm90܋A>'iTU_ai3u֙KchO&7;O0i󆳁Jp]?,~d>߻~y}.$dC5{ `<^6?Nf7E{0h}m,PN 5Tsc%nD6{ں\M6p!-uO a.km#"ː҇#0USXR5yK['Ӭq}-'a6s?f׸2`P({.k\cPzjy#gP 4 P˄\T ZE`RT+n+A˦b'H%e?D&N$A]{Z]U8MT?t][_!QgFMz% V՟ģ7yjzV!Үve_ttD1RbKvҖʀCt:;F ~YiKs`dIbҔaF[;hc)L =@:/L CV=戠d#}[pRϯ,~*0E.HBETy&f߭Y# o`؍p,m]-׆8;WQﳎQe؄1w] t=~6=T%N;˯[@ezsx 0̟:&d.$e#\ݴÞ |5+pz}k'İx ;&&?6a(Mg/"4=je+|`.ZO(g[VB_To qN0 L*ڽ}E Ki%JrXIu:`߼E9llO>|^soĥ#]!m ru0|)dg{ϯ͌yq1~`H sFOca^Ouw0i\=`i`ZP/oBg%'t/>U)An/RDsGxU$\KrD+;}0)4֕@?A[[̈QM@g?04#"aT( 4ڳ/ '2<"Ra$ұ^x>"?0)bz09 @zdkE*.bFoCq-<*y=W!Ds3zmj >sè! Ň?*!";3JJaz0G71xr+ vxX`S@hg}8!7 %AanH7^ǧeXo@P?g̓jG_܇'q76AD:f+X |9g,gkt;̽sJ8^B[Z̧7ް3Yݍ''U"!o\N5,@X8- ݿJp7#{q%qӆ@~y0|~),>}ajg{T`~zۙeZ> K}|~|=]DTOϰ) N>it"{VE>EA60nh ZKG).?</ Obl 땼 űRdyKD%CI㍯f "؝9DA!B^M\Rْ-}3~V B AнR!w֕].~֔2)L{ٿ҈¿F;9kD:U=2&G>=ЩF+X<z.GF둻E1b"b\%_md7hawWf= >|nƤ>ݚrZ>V5.ͦٿ~]3勹,qJP(coR?L|-ָOto~WfP~89v;,asu0ܛ]q{М|b]9Z<Ο6=oiU<$dˏ(L>"K1F39X%zM=w@e`-Ls#Oe=2*cz@SNς住47`14:l*Ʋg̓,=ctVD"?Xb! .L-FzlisI-KHjcns҂J~fYtR3oUZw:לb ^"4w75[U//4e`LnTc+7ߙVL+ ^Cdɒpڶ+0@*"ُq݉q2P4<>Rdb.#"S F&p)盯 a%P ~ʏ8)k' y,nSc @j|q7|`'_=@ϰJ ]_4GasZ_`!"4$0zAQ(X{pt9X1$>@wƵ67HUdtpo{A_mw<k¨bdž{HF&n߾'wDcJ} x"G9oi,*:0w"p"9|kUuI8#jqKW-EX?d7UO;85&:j*V—0uƵƲ\+ 6[0HgX:g #tCk0|>KJ_J0+^04 0^s!cY6 \ܛbƉ3fa0JΕpdnH+qt12fc ʈM.. 'ttϧکo8O{*(<`s,e0{(}X`z gKdPp [l$+}.S7/e!Ƽ+f30wsyD6ܣn+Po\}qfSH{᮵W";E"=Z'} `:7h9S#+aRd'bQyS23 6~xazR v\2OTUXfas.V,SN<ׁgÚ fݭm(0>-V H- ɥHa\; T׼d:xmåZTq8 $Lu:^|S[b@::cys;6s5@oc X9il Lc B􋵟ZROp#K,}M(. ƋczD\j f*0)UԶ]#sfڡŒ:ufF3kq`LG f{Z] ڕ`Dtʱ j٥cO= #\E1gXLqt^ 3A{y_>n v f" c ë"?>C=~C{ JWBP$|p ,) Z)'Rl:0ӋL>@{FMV^$yz/Sb{a7)&<v%7rpG86rNVK' FzleƙX[$v߂BMA.݀\p (fE使^8xB?(]Re '3fpI+)&cbKA(b;nV<*sx_*Z/SҾyW4PeRC Iã4-$½b$බ8+}c>widZ. ];s<2@W^-<-:7AĶբ/ѲOߏ{Zi7Jf2pͥPIXz/+6)q0tz>Xepz?O_~ ׈Q] AnOu7I֒UP) z{b.sG~ ,~CBl ʅuᆉo!܇@~բȨ_'WX~؆!!ehs0el٣C:ty=7&=RFv?9xKDd`z3m†elL- _tqijAKnQFt^tXGA8ڇs#0xAsS|?ޓg׫~LH I5,5`S'tQ%$[ܟXvO8;hP*Q *g?OZCxI;>,5vZ }Գٖ(Y%}ַ;Uxmpn5Dg2' /߅ŔF'0 /0$;ǤcXaKDddQ{9-}{A{k #{{ A>@23g}Mv|аUۿ2܍g[H}Uu(,/dX2qG"{=K_OIip*1PDBebuXb#V;i˜2 3[5^Fk~0<_FT*2?{ayӥ{dD@~M `.k3B>}j]B <ؗ$j soXFI6 a:&Н-Gmؠew$&^Mrc}&2={2~݇N 5aD7&_nvݼ"ِAY` giGxv_d'ؤ۳4sc8b,M`%8xQw'+ಊSq|P;d̛K!?yzU5lg Dܟ(/K%.T#weвs&uؖi+K,`3a|Iv L[;)AX`f&Sƪ+>P7z=w6+]t";Wp]rtsm{Zs' `=ӎt`պ̄dJ asG]ؔ+ 4p%ut9f,m F+U-Ջ`뵰`3Sɥ~.,^1:x ȳcR+an!#ЏPI[_Ě>i36B]kJ0N"fVa?ƀ,>,_#bL BUƩRAF|,&mryj`wU QY2ߌO5_wrh|I6$]sNC:q&G&[gגaQ%fbAȾ j LpD_hoޠ% T6[Br.Z@/S0xjn")7>#vFV&Xg?"6Ç*DD-OiD7tP#0K 9 ꥠ?K.wy1yqӤӷ*nsux86r'LaXsK&}g¾&:JR-6X:Ƨ~|5"Ad"#GxwCݍ>`R@ ?t)YKsCxg2z5 uW컟*k!>X1rXX5 yWasv0O]F9=-}K7lF3}+F݁-F0ϴ~1 i[l#Mk ŋq0#k|1 fL-]DLK o)q`xY#k? p] lWkq}];-:6  ~&Qt* KV?M?#5ɰ*A e $GCS'pʺb*'Y#C))&*2ìYM6ں#g":y" a-3i"b˂> BT|k1j?w-Et+> jz`guMhNYq:ʗEƯzBQL%{&Ԥc`i- `miSQEXz?"7Oyɳ_C`]]VѾDTKÿfN"a+и;񈎇bR{Z'@0vEDs(M]7st4bGDl_`g!褷cF> ѦF6i%9y(&<:V!?pM""8@mJy2bQ[㲧9aKM 15v7(}79Dmv^&vFO|@a@8zւ$9EhI?!;$҉m#A8]8"6wg2pCר˭a],6WF)ޠq{ghR `/9aED,r$!N 0ĺ3'{U]+esW)"bp𠺙uX}sހlQ8%34X{\cWC%zǟ`mɎ%`CGy`I&3_"-YZ7D׏Lg&U=9X5Rr "VsbɎMk0v ďgaieWS_:gFwAѢ+'aatRtݟ|#SmhmeJe"o6 7#r@=g?t!19FlDÊq)bItRh /$~ A'8UŐJc8 M/u zu,lzĥ8Coz(2NWzԩM%f2S Ye3e;)iŶ0jo&c2uaߛ/".]0 7Y=b+LiLւ@t!H%O.0?ߧ))W oфŝTOY•%1dAӻBlay,rc\ Kg]悙gKtȰ"'k ŒZ}:eU_Znw!/ߏ ?,1%t7R*p)B$qigwYdvA3aa.2kWZ/9Tu@ 1i)[ƣ5ehf8[i1_p&>րݶ&$ôXi1/F݅!$hQ)J-D,Mu1N ;Da3;Ο@OFh7+-Mr|`7c7s3!ޚ뒰|ս0s*V^bvHBK?}mN!6~ZIj1}A$4\.ktf'zatbԼ u1+╠頧#q~ Gi `s';fv@0'$\${]04 <kU(㩄\0ϻcQy<1b~SFG`Sep#/,,ѳ[9a+l*K2r.,?qٺ8Ew 8CrJzr21.4nV+w}XS䅭ca-ɚx>>|[O;o " -]a[`rS|*zj~]KɑI=@ffv[p Kk$sw:RN: 䧺İN]<Tqlcw~߼xu{ ޏ- Sh?A0Ү#ey]ɠazƪwrZCps[2*|[$ x NhpAL?l 7Zb+w|8`<5ˬ')lwv(> h㥲Pwg]Kw;Jo2Q\(,Sȇů݀Xͣ$H޵u(ǭjiAis޳fVק`Ŋ:5< ?t({W>LygEsX,eCRݕNCDTdXv8*sGo "z6 N_a)=!j1f, ]Mа|OKdpӀE:#/Ju`EՈJLZ !:3soKXo ; nW#|T7/4 w+ARy%J F~#_a=c)[DW 7bmcK70$tySbZ;{i>1X|4K2OM\+.iwx?b3-| 5gOo^C^-J_w9 d@qn G(bXQb+CNkyCf@9lil z22p ^fH$:嵇;Э/w;>LvV^D7)_IbP+( TS`ݜY\ٹ 0SfW@TTl~zZ J5kU}+3)'pO+ OG3!5^RLU~oYҮ+-wYWtGuޫk͈E(.CaCpuDp0,{0W?Gγ Bg19:LƄ<աTH)ϻ}'dm$BVN`/J}׺h2O^_͹]9_:{,K!HP@Ih w+*z(x[=S\٭:Tf(3= umm zrcΝ e9ṕKm9ݾ )X. vHlqa7k\߂b+Ij %王GwPo~gU0!XyQDL^zr.co#1h]q џȽ'(Ej1ە/O>{gdT@fGi`+"{#F_vרm? v{2ʋ0+Ό_?=_`im2Y[*"y 19 su͙eKG̱@Lgg5`ǀT:,Q)GF#o5t(1t<3 kAzClÍnDoIPRs0,E #f>nE}0<űϓzDž^{\eJnFl2xVu`B4b /{V_sB'E%=Ǚcq\,:EAفZK V9k֧Ί|<VAbZIXua3C@4q n _G ~ pb9^K '_X9JB׸o r>gq?X t8& CnyX;TXs] p(Gzq;nQYK BLH+71u_%!TTPwH'0$e!;׈8*39lZ^|-++{`Xt',X$'5Z)s;FDu:ɳcOSVL#,CD 4[|⇡9bN[]Oba+ "œJuȱJEyQi#̔]ѿۼM<ei?4aI`kLejg8|&wtl-<|&]sCuÌzZvl^YI7GRzli62  YZ^&&lpz%;bSG`q0+N &}\l='Y55Ᵽ~/²t~|/ۋ> Gߧz/&a&`}G># '2 a]wKO$\>Maȩ)MeXRvs(xkx'=#}xtgkߦsw@c%M7gL}8B*1nSS-O!c؂#͘_Ai;/('=gIO0=aV} PS0lk;H]띾(">%V"ywB-`j 5'J!A0;n K-c0%66b ;r![5R(7.ݐXMC SL*n0ctpiXra9 T;1ze:*'-J G.wCvO9[5FmasQxy?^q/ߜa9I/X.Rjn\xxY~2d_3"BNu̽O ] aYb8s :PqMibfq28J8A 7 L>\`cR='.9+Э||c>YZ %GDWn?Zӝq)E0_5Ά'@v@]x6ouWJJ bZx^i-< ЁE6A[0ܓgkE'`|hxVoׯ2)A-/?7)IںO Ylja5v&N{t>*Ӣ{sea~hu'CثpN+ tn2fw>&9lߑuJ@Dz@O~cZK]J8`GC*$jY\_\p ,bа7g}OWaa~8~:ֈ 1봧JTH*oyx>MZw~ cjF8gx: 9uim.F SjU5|i;,>s{1SvB~XX<a = vGP_qqEwT%ʎ3x&Qr.Nȋ7g(B1} N]A/ߒ>@;t<01؞1 ~"vxc·6%ւDNÂHF2:WVI |7?RR½i:rW8"g.JZbr!ߝhX?>'Cw= -P?k9DS z1ߎ=R5} fU XffʙL.6RDW˸rcL^쯨B XR?jg=ozFEo\XoY;3$K")DE/(#$.Ղpu!v9C' zx\}N/G;fnѬnYVC:vƘNsY$`2S!:aw/A_!,:t+TN'͸/$ɪ0Iww'ՌaW0tz)Sr[÷8w^+̊-Jr1 3JW:Y瑶2j0@۝_gh7E ß+$Va4˴"<1tS&԰|Px:d0 %`-}!XY9XQVtdd\=6։¿Rc`Z[0y9q/~LڲwlavWŸSøN97h/a [a^Z<,0Cݔ2~9k2]._x$r[(=qѶ?2 *]pE<XҌ{Qܣy%%[H^44t`o?ǫXaЭZ3Wfo,-l^q#uf)&W~d݆gd[]t8mL- ]`3gMD/\*՟e yb.x!k@M"XH}{ N'<*7~Yh\I*o*<"@˻'zE{_mK!x]}!2mm!’Ii(]r xVCU @ڊIWKbuuX/L+LGㅒuqXE)2-A]vӛ [»J3KC@JES`;+8PɟpKq:aQDvORJL{fLZVWojc0غl3GO xձ5N7r5>lp?8OC.Km@St1 V^D0_x5&aAb84WEN}I0hKB ^jh;l-s !NE[@ÿv)Tۏ &Y ߆+>6`)ug y!}j, ;:_σk~]b+2+@_̀ l8 fLrT/--7R 3grfUQ4C׷P*8,뮨7ՄՃڻrUaZInؐ=E0gwY _aܭ'O!͙a۔Qjnt=quT : x+}"×Q;Kc{>YnD4ۥX٤2h_&9w89R0Ā})! Uo}ͳu@g8鹙g|~0V1fO˰ ,+)@Ayvq9q*~[xbZ>}ȁI_ 6Ta+şeJ!{87<#u$a܄_:ݼ9KtѢ2Lu3 :%sUf阋u°ϣ}f/l՝ݪ8pg 7Y  :M  8=!2 Y4pu!c(Mc<eMCaРN{.CN1CߎU0W(uHr(tG\)>RhsEVoΧ?[xS`%p{,ު fN]90"L?/q\ evSuw3=I%>>o+4wm& Xæty wÂRpxP #? 4SYgDW%IeŸK׷+ >KR0.ϔߗ#o1@bF#p؃0ml<13~#xyf9FBCogPmkh,:tpŞ0o4p;j\"dS@N~vwX[ s a9ґsx4_{70[e{wo:]KLF ne; ggu *kixb\ ؚV@a]B;G3Xk{;$^_ /$\_V=*ay*$EE R)o~콽hZ(3s&_È0Xek\Nm 7Ìo6b)+zkbq=*ޢ:zlS_Gjq,+)8 (< {;J%0OR R< crwcqZDXȷ]!_p0ĕD?]S&ݑY_CԼ'wXVeegRg?`eb/Њ[ ~3kut8 DJ3=)P+> sRAN6tؠbv,[y2{ Vm5ɰyw_*92M(>hCYW< l7G.=]mdT_lځ<2| 0U,' !G\= O~|-+7 }:ZK6п.xtLNAW\w5?" JL_@iŞ^ɑ%Fc"-B篯UwA/T Y5 )>bo@dk4`)Bo4b{[a/}ۈ`HUH')8G_;~S*?^xb .i93<*.odC0|LˇѶ?4L`,eB T=+֓2rxwoBa^vr(s_ևcE"oxK Hql2"86IgKO}WԁΞ枭H(3k3G;, yes`Ĥ#C>h]پS'63Y])Fwm8/BA }:Tܿ)΢5}$X(پWt eoBӱ7dY;ٵ))lVŶz"`Rܓ*C Lx.M8G>/]k{#iǙqFxaxe.OAOa:M㤓 8LidgU~}xwC-0KXq+]JnvޙYkX0qBwf$<wTcͩHc]--tatƃ\6p`Xit Ќ^>XL\ƕ E5aF5D^x͎=g~=MR!tE;^~n-}tg,󎏟SWj茦ˈN!}z{ 2اڦÿh Y  ˼ E/I-sXX׽ln=p9yG{/`,,@y>tH􈶿=z ,ԏuC/H.EC).._CĞ]2) f MJ0.8]/ K%*k0[-1(_sN7h

LAChRSGYrxb _jGJkwy[/P)ؔcb*SV}(zMK1/b<ܗz VS,0W"NcjNO p 4 /eWBN8'>N}L/QW:B W^#ao\`|ǧoxahmBߨa`)PřUC8x%kـ Do}b2ᄀPpaPQdGj+ZBV az*/}^ב_H|}ٙ C7tҨ i\P:۔gNqgup)?՗x7X n>ggOEv8DhzM||jb'X81T-Vjxx\`wOKx\p@7N'BKˉv0m-'-F_tjNLS_u3 s' nָp[HTbj0m?p;D׾ BVMOCh}u={M^@H3U]cȆǃrpϫ;ad[r>yo)'/},wld.d K?4L:!x\ֳrF/,6 DLەAD*/׃U떗VӒ V~:~?S){ YZV{`"j9Bߓma/ 'h8aF+-nQH_$g"a6wGh[5鈠p,!X }߁ E[SO#"3pY_vo5l0~F^pH<jIgáG7X^rET~3927ǥ 1θwM踯OR;E.AsĭvU4EIg'Xɸ\|*k 1: VDo+e ]zgE6; bM˳tc҂D>?+vÈa٥, F:0;˵K^  6һ%as3߰.9| &Fu}MJQb}j,P 7vюD~"bpd#bg 66G#&Q/%u ;ן+FLe9s%g",@t݊YO\`܄3 r%,7=rW8nܪ' a1i'M r0[љ6K]i$7Qy8^sBy/?l'"u`nϙJ@]<. BRC=aC"-G;l)":s-l% |G TA[V]8*Z?B\@ÙED\%uEIP ~_G/s?^W'O64{Ʉ\U_܆ YI^ ~fsH`A#ñ~';SSE녎 B=b:ԥX?j[o &#OD{7ȅ \4,l/ɯsU/GKX.52Յ ߿][eD_ZjӭӁjZٓ5P`qf{*o|x4>OqAiVuq(i<3y^ ۩^%\g])e7#ofF췤#F]K̥rWE-bgޒ@UYᝊ>I{`~Onh{}{`O4])XL\9 sw&"b7O9` l0$"q 0K6}Ba1jr`{k)Xwx/ k_!]-Wg:oo}Y~ԼxtJY33 ?ث۰7nDϨ,fl\9_ :Vj0Ei8/{snͶ14C~:V>Hn2мArO"B0d@Fb:W~D-B0kN/6MBL]m;a.w.3`VO]~3Bx2볩鰴䈻$VnX̟ sJ- k_"* #dIlG`#ܥמ ,sjnO9tչ%`׆WY +MOFƓL`-/tġG}D2RSߖ0@o8}E9~}F0AǮ+)1k- dž4A$e{f $6.Շ{n~wL`JaQ%P3qд>I*^َyHZhikz6[!yBm}U` ;Hn"tB?[=랻$:^M\u<ך8QϤ!+7Mo(*]C'27Xs}u*b*.56,oȆh ߕ5M(sC֙-`!i}XF`:롊>쾦%Fa{ɄGAjW.f?<:æn@Z<dm ջ9Yp`K/ʦ8RdA"_R>،ծhƒݤѸPG #pkakݧ`<"PױHx Yf7 NVY*m~K0e߁ ;?Dy'lXUy}U<{j&m.^إJG 5`PA9?F*Ib-]D2Lnsӌ\ch8#FhAB`o}$E”6&c ~ztϕiv՝w4a"2<Ԉ{|DEƫ! ,-zΏN`m2P<^/U-;SCRU4ccXyu415W s.w*g!#﬊Zi|M0#޹دdOL>?%lU@ oY#<40?zȱZ #0h2ARm]>4ݳMJ0Oė~uW:QO֘8nx804',=Qk+Jkeо+UܶE'y ׵А(Zښ\_zV=(H<\vqJ &rF+̬yw !zMvu? OkD?x4kQ"B~~6T鈇W: )LM.+j &Үf0ixM%ܧTk.CyK"o?2C^bKu LR5&16H\1 Ei2<0G;G*jYK辒)y^ z 4_||]vд6y -m:xhޖeI$]([8VQBL8 Go=|a9JMd̴߽ "?R\m14==?Ugv=Ƌdga1#Q]8aF\ƿ՜T +uh: SysD)2{k,r6Z.B AVU!(XsQ)А;,x3I;C`jc$!Ӽm?.h2nKn%d S0Ґ忋K'mҡ{(t0 {5]/p|3|{mD̾Ձ^P쎹D?_oBo_]S,ap/{h6>V?oR ϭFˁSyaM>8\*X SZvUN6',”lX}Dh|ȵ=;mmh/&&LUwi_ҁك7q5/3HeˆNaZY*nVoN!l 34?{'UĶ b/Ǐ9Xa )jS{^ f< Zـэ^?d@e*O=Ys 8:6\CD2;aCpl.~Wk~­L.΄BO뗧=z[5_fx6G_߼&49ag0":qw 1ӽUIm>H݂9夂0޼]W5^k!3 2kh_ZNXqB"*oFˎ5џmkg5zuhMgLaAi8p$X1S:kVxr}k˯x]j'QߊEƘbH$[kAvv2ͯ>m""dÈ-+ Ap[)e<48pG@K[9p]фeC%`0}%˗6a)S֮$5-QtTo? IH%RiM*eu;{9ql~/]5w+$\8>NobOX@h sN?MaK0=ATytC>KL'P/ iW14CulZ]0ul*u3''w21={*9Y=^'Uq0dSQ$I QsKrҾ 5YdV?Fņ5@+Wc=pnq|stvRDkO6ť Ukbb1 Sur/~%7va+?̌<~&j62`{M#)X,zYe xxE80٠T[hB-e We}Q6;y܆n4x{Bš =*P7#м%%.;嘎H܆hc yyb`#[)YO cm® v%N6Oջia`5ǡ lK|Uҕ6}{oR=,(MV e{kU+;e"iK+F3kxRv?q(BKpM=tuݱ,^ߝJж64 ՟1@)!/J><^&DdƂJK%-`J$9ג>1?qm%35T:{ 1;w;\Ps}ډt> ?iKr3C7c2!!bG06k-ÒOZ,>;Í˖OR:E \WG9__2cQ焞=eiXr0.?w&3V[%=A~R4sanG+0;iH\h^I}@:Gg`)Wjm%Sʄm6~0dHN<+P|=Ы`)Yu<{W vQ9VOȬ; zx A Mo,1T?~OzCވᕥcD~5ib:[p334#GFѽׯ鼁NQcvګus*h,6P*_tӷC&ecayM l}JG󯟣&&]W)ȣqFl B)H_؊+|yvo:+)瓲. sc/&7f(>W^J,Gbz.>0n H\Ձ@LX2.[X>ѾYv[ YTdF9fPec@xx|.♖[c0_3+gگ ICʓ3-sPB %hh/Pҧ }BV}h_k c@tZ8g/cUm,F}H],uP9݂AhE5HDB/˦ҩ먩IMVD5a(׏`A|d9 fT@@)}~vt}~ s_˃Q.u^=F;Ay 20UYh5HtC5\#y;*Q#s ߔ“LnV cNj!5< pUI$=W &M5ẖVs2cL^xCY6waE:"{d AUA<Tqـ' s=qxsAj:L:ѠW " (< JVaFkpgXJ.wPr<+ '@i7IXVsv‵+4Ұ޹{v'0!wIcV= H\٦M#:(t#֊rܥ^?Lyw bКW*BS0{/'AƧʞèQ,4x;Mt#q$1Zs;{MCo9Lj SI5D&ϫ4Qo._NG=fA-b5'k4GڱH8%ļZZ2s8ـM⼦~-0?,`;i,+u'̩0qylR=AwZc@ģ?F[M6F~[a&o._ 9v?"zyy0$,,~_08GF]x43gpZH/r.' b{0S6йI܂r~vf(pk'a]7@~Fv'6OSyjavZIJ,F Oe#0 &M3 ?"hD]Ģ%4.{ +]%||@q7 ᅰ<]+hp/ °R %ʌQ-^D&ʢ\l)}y)\ ]YV~:2JG@zPapoJF1/Cv` Qär]"&-Ds0hg H^×a_jfh0`FC>m acPw a@uվM^B)yGqIҳg4cL&:$t)X7quZ|>8#l>ҟtLz?ҡYU;vVW?lRVdV2wF'g`N}gzfFⶲE^.eϝbh}-I cֿkGĤHg|5:EGZw)>þz)]; xǣ`|}-yaWdd %OYr^(>XyF adZ rM'g`:ۛʨې||G7Wvg2vˣV΢X͕=h m¾OOtI_S9{2o)pEhmw(f< {6&@$siI˙0\˨HG9 0\g*tAM1j a3v:CFg^0 s( vG>x@ WZC Vz,9a n7ctUCi3JKs^ ~+$Ìc[XVZu`R88x:$Or^=@;]l==-1~. y okXSĨpoZUA0OP 4P/'zpŠbΉcheO1W3[$ntZ#ì* }}:RI.RmyUUX .Kz_ғ;io`yt weG}qJbIE9ZsSȇgoU-+] v?,#f^VTWʰAg6ۣJ'ʜ9l0ckBs#aNc0[yd76{֕aa}w,ur!}zFu Iۡէ7բa_O'h[HMki/lw=F= h9ak&>4&) COLp9-kq*Eb 0ıjs&N?'1 ;Vpw~Ǿ/н+lYq?T3pQXyܪo5#J0Ú-|G]b~co2i5ރH41J|kbE~aeo%w5]Ż6R#epjԛaFK໇ nC)Oר?PV{^=݇|t3UG0ZCX[93}UTE(VͣC''0t{E6X3,Uz u&)qw$$,)Fܒ# 4t?-'+vi *-,m Co `Qs/6ϔV?|[x' _cM=z[| y2!0GD5ьQs46He\ci=uS?Ѱ [*z,~%[ Mi`j[4ι^5j"AkNWNpX]oݿd>-JD-]*E}=0PޯDSD/HĖR$Zo(jP9mN]̃[)>?; %\qs*NLN,r\'l~H_Bĕ&@z|>n.216X^څRwE|>7(u{`usoo켸 ȷKb"|rٞ޺+ԣ ou vB+5cS>\E֋'iMpt0\͉oפal1rl(Neόa?A Da:\a@z8KV*~E5 q(K;؝[D%k?;ǡⳆ/h"h;.h5 5/ڹrxctV}~OdAOP ݷM14X ytof$CBsՂ^+QU '爭3b M2g+:P+Q7u?`$vBRuj})g_c|{@{GtEwVKHu#O߲g^1ֿ}Ѯ{?xXU3)Jy{HY j d¶ᰒMSR-'VQ1h| (&u!+ascf3c,ֳm;3f#w؎a?&6)gy8ˡr"J{دsP ^ mhLA6:q b zȢ-_qmA/Qy 'XyG -x1; $^j  o% )s#/T3>!dOejuHqfӊrJraFnDb/6C0$ RiW͏D=g/G:"E,aҝZe+qg3a務_WaGf;a4LtyTaG1>vֺs h~g`4:-d(4 {EbU0oP@+lg/3˫ ѰP/Dn}Y{=9ѶZ6~t è#ed`^MN`1]&گa$^F ԏ5<KE"){=X zcmwQ{QÀZX[Uڳ:TFu2;X۵vw>'> ׯArD#G^MQib)ȗNKMᏖw$2Co*q4FP3r9^0R`GR,9u>igY)- ) <ٔ+fI\:+ -B&R0'~p_wWP6N5]!U@ѿha!Y ; XZU, 䬰]B64E8ÉZnr_ uLҡ7sit4CE5/<U髮vhhr:mbztϭF2=}Z#=0e6). Ǧ\]<I_9a NJŬ/&od'w-oN,x AVqiad6Cw3< }?3(=Eh Vr|?aT.4/&KiT$;}ݩjnZi_0vR.# H*g ;)m@O.,m-s#{$.0~qiaC+͘g%}I7!0kKAs߫ -P͝;j:P7̘Q,NOPw_F38nf0+NULO- G0tJ ޕu#]jO"ö>][NKwgwQ bi+h˾ . ,҇ !Rq*5~cOɷ@Ө- lihhn0[\SK[b -Χj20٩ Q6vg45a0C:;vYE[k,gu-rBc}"G RWR[ %kØ\ {Bzzu zSWqъPEwpxS+M}#&lx_qv'66L{N0bhx w?Z&SwGS38_.Vj?5l^,z=x`֜@S/BZ1F2s+[\OossGT[(1,̱G\0m\:1 ~a JߍV 0'"zb_Y[?ȯy JkhCKKwƵI41J}>~|•DظGo_&3g<+@+԰ !ҋg`0 NժЩ4Dm8+ O gEo7U0:- xs˺\'9{X?⭿>><ݑ9+oGwxd}S1=:ʯ)4aK WnΠHN+y+y9>Īze@T~Lk,;vfE)=i%-JougSӄ: ]_aTW2W@ ]ڀW?МƏp  [50~vi;QO`I7&v DIhT"x ?ˌ"#8g {?GĶk!/g`Pf8l" 40Y޿å0eS*4[|tGK%{^'Z")cxjA09S 6@뭃W_Ӧ%^1jXMBB^WZH1D F'LLBؓUn܊ FbUS W=}4AD$֣v`[ܫv2Oعlڛf,;ˋ s_%~ Qj }O]Wڋ1)latɁ6Pƨ/͘g08P4W_ 5&֟ u 4WaP)c4g*f:*6D dZ[0XAgCw،ZWbF W̹aINꠘQ/t~?y zӱ }" MST~-/Fx8Q_+4#lPka~RS!G}>GU`yZm Ck9[NM~VOm|dM,?nv˖2T/І ~ kZj:;Pˬ\3}us%riuE!"ªrHGSzd %vlZLcC,xu^O!X>1FǺ` #!0 }Ũ'+Y0o_ IBPuϓyHAv/bW Ѝ_ݾdIc `AtZb ݀Z,|HJs)t*ٱum-Nd湮g71rWvم6>\+ r[6قec lß9̱@#S}{Q Gc/m%l=9u_ a4nGMa+hػYfsh,/]+;g=MS7lv cJj Fm*t6a0> L0jO `;)F62p@XRUkvI s[@Wdq] zhBwЈxpb6.!RaVJ#vY+dq9teciʹY1;Soh<}=A10ƴ_=z)1=jgէr@w*9850)%0h\/ l%2F= ];cAhJOiI z}u/Ža3 <}%z:t0 /;F8*wBJikX.QhsP8/3Lهu=^0+…93Ũb\k9d%/LjE,Lş=c=#y3]d -sOKHvC^mk*MHo®׍Q`*bQ|0 :xe\k`+j4M5~r+:"taeGu$voq:MYP9d,ʌOE 1T0ǕM}@sk\|DkO -"gQo?}* =+)}>Ȱ 3ƌf`7 Tȟ܄OKpooTeǚ&f>*4l>C55w5C6EWVOO[}w?¼W$&/2%]t?y;~1c=VrUN<Ƙj56 "ڱ%U[u4z0iǜ3ݯ\i0uF\>“Y2}=4$K>)|&+ 8WnpT?!D6WIxɔZ^O/&X0vը ;Fp(P Sq@-g"[T) z ; ~9͢ZD׏.-!al0g8]GAbV3J(,0ݎru}?aϴ¨b06S!8Y)ů"s%h>-ldYc שfC`L:j3v0,.džьMk ǻЙى;{<_ +>& Uҁ9Kgwj!jOcq~nb+:0*Kai"k13C4F/90ZxxZ!Ɂ*Gi.,)~\A1D!31d [zH p~ʺNCOQ= +xjzc4/0[Bw'FzZBC؂ Tlp_doǚƨi[(R/v uh>̺N7a R6 Y72jV3=c'ap>+q/BuZ({ˣ`1IȃZUZ[\y;1\ǷA) M6w /(;Rɼ%2λ,CvS"1RkX8-sQGF{x(ot/UZmw(K f< v3U *oV G&{'Gh9בOP$ws \)3ctP 顧dhTNs""63ICdž-0،2KR oLH']WCHyЄ~Dܢ*1QOmeTHc?y]O 6=5Xf ?<3qivhl}]XsR,fw#TQMS,"H7?aӅ⻰UY}ˣٮ30&/%HN(ϝaVsk?SU.VWVi!ŧFKG̸D4+>cN@>!l` Sa\S2a|J84Mv>368rISL6ϫw=L4-r -,B2.?W=ҔT؛Md9 )<.[e+WBUu]0P;ez0CB)<oꇇF]EI}ҙPbc#9/]GZ*a؄qo%ZNR= ]ıS@v}-䕖 QU9c=zrBvô֋αЧ}Q1Tnp{~v *JJ&:fOu0z܄Z/1 / *v6!؈l|jhjUG  5w FC3t-:Db|R3H&'F"mb hLf~„|;ްch:Tx6߰ȈQuqVG2cGa6]+? aZgZCh<-˄t@)㸦3UfOAu}SC'ohs1TJ hA'ݚA?ʯWqQ8'8gh'b# #3uBƨ+&C_zs`gh,юi,LVEϝo}Y 9|a'"fZDDϡmzS sVڒLDyT"9bsyޡ!4|)S J,42Oɛ+Ùвv7:lEfx-v'*"d9sg!?+O(pl6S"{r6q?{uh;ELQnJB;)߅ܱ3'o:xB fR:VBAڣ/j DOG~} X0L= PPbAs$0KzF}I )Yկ!v4GX8l zp| A[b_)ےFI;t,fF=xLa8O^L[iKU@NZw-}-(BP0"]oZ JI'Yi=3tWBO_0^J蜂a[|XX>X:5ès $[Fl.clBڕ0cGsk2y*ZayA##vl]p ~/:SS UCZskK7TZx2q];+ w<> ;cJoq ; <0{4 oP@"ȝTK5 wkS|bc__͋D- xJEn0Cn{_+aTZEɀ.FPxQSqN!:Z}iIj /4?Q1:2Q}AXfѐQx©h 5{k cGGwV4 > ;bJf6Q Z_¶E-4*x/RwK`/_)tVkH0o:M2/ !ga +Q$ A1tj ;=5MF0',籩K2~ cʵ"õi@2j% c6aTǣGJ#p0**mXIw!(F5n/C%& Le?ų{'s|Ri={rY:Re3qh7Z4 +1[xw =_p&|_sׅ6wG01=_>m^*d&$\ȻAr 'aއekQS49|h`[EM4"v'@'n>(۫0*mKw2)#0H3!lqt1. +:,@$#'7Bw𹰮BQHb>#)8h5bcj; РOƹ(™A3/_ 6wf[R-~S@ vfŔCX_.0M"~8e؈L:pc,=_{KJ.5 Kl1r⏣5vhN|/E۵mtaHwآsR+@z(;΍Yt` |8}%QpØn:ax{ZfofJfØ4lw;uL0DI>ȠѿTZ0* iQKG_.;0cNz MW/'K;0SYmy ѦY1 ɜ(bVEuL>qB[QYH-Lxt;ۆAKɚ0 WHM Nx٤* 0C V ݕBϣR jHwZ))I{G/q6 fV5_a3Tx<@ +vsa} غm+y53nt*o->ds]a BfcG;u7[ѯXm۲1x9SQ{o 1ctt RC ˗.rp.) ZgswpX&@^:dIN;hCͶWZRѮ.6cQo+]QZMڻ6(C[Z; ġwaLл0}k/wwxd~i)~=VX`:4)FE i-0]؈*] 1'X1*Zy` tZQ؎| lMx\S53ٞRx'0Tp r(+a}`;zLaHjw]Ka0?`*Wفse'&pTfMdUjF}vLR-o&:]f+lRuϖە@9*?J/씜hX}R^~־%T*R$o!:FN6`60\j2:N#[n[G0KէLlPۮf' WueქaVcm SuF `0Qus|iW=ֻ\Khfɑ&90ee)p+ͧ=`MK K$Kxuq|g<131 8)eN)T>ei hr!Hkz6n&Y}/o|žm)g"9V!a4WzĨ^/uuϟo kd;طtQgHe[G:;$oFm\Ou5v`tQ^Oatt>/jaLU'ڳ=%zk}0"WH@ ,71zbI_K[C`d5l6Pq[hdAQ0K~%l^8r.LdIpjV'F9͂uF2Ӂ*m0Ş5c+WQأR8ڳ}r.g 0"z&a(5!Lm~SqυS{F M{rER:il3̉jPi2q-W1oF: Ô3s?1ي%=#e̞z#$^qw?9K|p J?]<٧cYzNңi;oQ1΁B]ӽLE3 *D{E9_ \ӥ\E kEn1`iCJ94,IX.Ìvjh{P%ZBR%X}^ l,6̑cx>ImS ݊Ι@tdS>S!@=u자(!.æ2:]ԾءQt2j"<˥T"‘iac Pl~[ `]"V*DUr}v'x@ )_B@S}@tcɴ;}{gмeX"lǾ C/!Tt]Cuΰ'fTmK 3lFe+OtCYAhI UOp?~r̶'aԿ۰R/H#fV^B {I jX:Gu3"::3P*rVwzOxEsaG㰕\ d:N~6$ce4`2أ;6 Oe9>fsA3ef1J)k7P]&%WoW+31|l 5>w%uLˣW/6a*v_-%aY`tT|V:b_` _ЬMK $}"T1_6*B1l'LP%Fzri-Ç0Xxdʥ0;n&Wc\=(s=lت!9e8F7>؅Q<.H/ǘּ3̷e4ZkhnkfWY@CASkNuwUվKO02̭L>ȳf4OP◌"zn3TҰp9v+6 1@ϞߟMZe+7%~HB }MVYL [K;zkK*|-UKݦW!x9ê> Fq~/92(kTYd:`wtzZp , (+;w];-^Md oFkYk)Pgb5낉T?`t%ԙYRC7( oc=IT0ysN- t}tȿJparϴuKg."jo%g=Jƨ5Ka96dRn^4 ,ea(IxRV)TDŽ KnN hwҀ PCvLLF-mY1G=Mu671f>X~rNFUv:o[R< ;a4ryy ŀ%F.vynf9%۶[M];7QoW=dHÕ4o;`8=5Vt03ٷ`ԯ0sS>(n% U,5GE_32gWمQ FLnIX}%u!y%:ƚfi.sOU#^ ,['ʖ))%0|+k F<9_ڛy0p~s]c莤T:Z . XKc\[m>.L%1;~&x?J/zS|9el+""QI~l1[(;16#2R-PhQT~䤉:j$}=:_VCw_(R] F77.ĔѠDV]׻`YGuhѼe$3Lf.Y/`,4AIF "~O 7,ҍ1ٌe5޷ժoPz\I 68[x+ FdP 3G'$a.Fuy\ۇ-CB:!ҥkف]\x ČD˄DF kYfn|MM{mU ffj_Rhh jL3]#!0nr|.MbLlί*in z؅3<-n >~5٦- R3c9䥮c4ƒ(v(^( + [~@MXfm&mr!-.Lq t +$0a\o۔*ʱ^qj4%{1o=7 jɁMQ)UG YvR.vlF;_[oW)Æ6;-zJ]J>ȋv,U>.N (nqq?n fo`̧ƒwq;;M4v=T*N5Bd @֧6 D91F+hھv>K^tU [+^Ո^ò^BYDF@D}U* 6o ͞Wko*.MQzHABS0-dk9oQr@]*3~Zz[e(+ɀə|ƨ?ɱr@+W|~9j1 [g*lfgUz(0=U 4:-sdIٮK/o 'xeiaɵWXϲݜNuԷZd( ܜSMn][~(ܷWuq=.P5{5Ha0D bLs:vG"`5@T9^ z. ʕr^Fqa=@VD+5mZ9x bg}Du_*6ZЛ8 - aٕO`̔/Dh\p+ՈmsT;]c,6Y-26a9p0BaSeNx3@,&JFṵ%4k`ъe;b{ y(WѪ9m!$,>}_ mˢn oc0{QB洰^D`k.W ׊b1F{ P8k˟`oN9w#b xwo1HWNRzߣ3k-5)~?# 3nƷ]X6F꣆-Ȟ{a5*?gmԪM9Q+Yg1J!-7{ ÙJ\}o]S\~<, |&|^ ͈⡆;^@\S awK!HvqAȷWG1MálRls"V GDid e h#mCx7mYh(J4T*Qɰ򳂫 [aҦi ~Iq6FK1Gcϸegg{vb:,-kBˋ`ώD2;r:03tJ7)=nQj/Pg*kK]g>M^2Z6)eˏ|yr-{z8dˇ^gI3XB ¨ ӫA=5V@h)% z'Vnm#Q>>j kzʤ軬;hX!F dg^`'Zh,i7W?RaODa,U\aѽG%0X3|u -Z(=-%o>B(ImaRk;ܟ+مMܨ.<,sA[1AՍ`RT<, VVQt[0ɾ&ce:GPz7 bpwMa>4#,+ŋ1+l'Jlj&8F/y. F^ûb,57`C\;[B_[{hkPokkVLlI0Q1c( #m${ԶtXmW4XyCRaPo'3S5,TsFz|,mu.[ثy}8 dd^wS Sabfox-`v Nx/:ݹИm:>sKw0ڭ{}`oCfg枡҇`y R$+b|a+KkYЭ4C-ɰlu'>t~QUzjQm@2s[d'9ӳUςW 'R@}5~w7ZE4lmZϯ p(,v-5rؒo|x v~p`,/Lܥ&h|<37F+H8L>d< bZlSaۡOPݔJO}@Zz.h?U,[vc=A*S鏿1ӗOARĺ nc;l> ು6uB`!wT~֦1t8j.7:CBf#keftH>1|Q0Q2֧q 6=?z ;/4g%EIaX=Y:?wz[ޝY[ @ΏK!~W7}ۿ9R n8X Jb'0zuJ7>tlXQ[y5 Lն!׳`ψ| hp *N[ov͇'.ya~^%g_}mr EvKBp4E.6VKwVp̦G8!{MIW=`Au9q0"V4{v«8ġEJ˲+jOr#bߟZ☯5<۹ɏVd3Uŝ+Bu! (yFnNҍAvCwaW)Y1\#؉L@N|o ]/V.0rn ݻZ${8bq> h :P+Zu*W$ f' kDW9Q {epR~0a.stF6? F ??F-A^MbFr5iJvigyHc,~ |@~CJ Ŀnpydd|.[5- M6'3v˷7€ mM`O9v<ێM6@~~uba·Ny=@+R)UK.;9PM [}} zF+fԇYY8@ w|}d",wFʵ 1 ?_^iR_گ ă5ضjFsA^)3 XoxXFM811h&*Rغ~?خbnG^svL/oE$] >:‰Q3gĨӕ" @dO.Lk$mQ&LO7! V /Q8U h^qq_Y@}:ʣ?m0yVz YVp#k~q^9_Umg%>1CbcPvti,/ʘaIDe>\=\+@!>vƋXn9R|-Q-xjoɓ0RƓHy݁D րZ)VԬw e|u~"{}C܅a[d X5H=^ aOPWQț)``v 3aLe. VEBw"z{ŋO`L>.wz0K6`Z Řg?9 +A~0:Xk^L .'݃ -8gP&uALPLd}|"`@)lH9?VYE0幔 Ka,gGlp eEjaCff5ڌŽn,0C:"X\Հt|rJϷqdiެPYsuR|q:PxvRGs\8M^hV^(jAA~z'ka>TXnHJo5z}#h4`N63^Q^ OiJy,u Naf_ + 9QL$ȷ[sP {G>1an8l䮪,-&mz::wf:Nm%՗0Y2<;W)?*JjAUɢxY/ɝ7$ßoxj(qҔ&O $R @YfKo2`oҟ+6_@WǾt1/PX`7o0f/w7≠Sy?U`]z/E;G^TrУasd;t SY#POo0̰^_ qwT5d1[ [ -ץkQ]KӁ+Kf20fUnH/K߰y_/([{hA{c*ƲZWy'~MyfŮF> Ϟ;Pz+4ݾ 3>;O=?9K]4}JiXUXs=0]X:mBUcS1Y9s ^gF"݊pʺ~XcSҒڻz.S7yw RI K0~9MlcQ3K.h1yzD0bA=H]<#L*~2>tZV}~'e'Yh w uq_X),hwSQr Ղʷ3]&-NxeA3z_%^km\Rxv-w :Oʾ\ /.K 50"KLǝM7?T. `g,}S醑3w­15GwqJR>!Ooeq%ߓ.de&KFx @66h6oBmZYV[@&mמWG^0gßxp9y>J54;z,=&UT+)O N(AWsJ`M_6#^4-$7wEZv۱]rڂNP,9lEzO6xTJqs{jZ)gԅr: cǭA`N Hۿ]3bȃd{&\մ8fmEV(ԣK@_G8啃ML"a*^.6|. !rL-+㾧r17v`n*H@u6JƩAM1s?s F)EyTuG=x. %޾(?8 5ZLNrٿau5Z[5c *qI6VlYp7?k_߹A}h:윿0+}@4@ՂoHCU+&隅p*XyUg-rϖ⩽0f݊DT\ց‡P)&E16Z<*td{E}"Vpzf.jJ_@88?T 3EyA$'H#uQf*y Fke( W~= Y ]=oe2jQ[ʨl4 ` ?C F1Zq}_aSSMwccn rT*gaKFRsF531@3~^rYsh?_Vh,R\N>ƥy6sB˄1e}@|Onz'ScblWskQvEr{Ŗ nUui%3/{n3uwC6eݙ[̗s@n~(.![G. Fc,V;ES |iu^M^ȁ#a}vG? 0:cga-)W1^ti7~1aͤK$ޜm!$G~j&['㩲xlߣLOpCN{+&qhCH.;Ͷ\˼CQcfQ{#A:w0fl TZֻ@Ϸw֡u-% : Jazdi c#, ?[__^Mj߭}twqY`)H=ZPhø_;*qVu]G7fdev iV8n[_Y(†TaGZ]1NwMPk}-I+cKU# 1v~6 NčDz0]Fa~DO59Lh;(isIa1kif#%`#.Ũo^0/e[7vq0vu]3@:?>=N~;DCkbha%IW'ТR&br[`?`#XPkV'Di D/Y>ёsUv&"olV{A(6B-*>( r]b8xRߖi)<+3ɶ?ߤ%,} OqE> 95P !_e3`ub֛}Pp&/x}Ł%AVa_o-M4 4cp{zZs RpW_τl);deeQ pJpTx0wl0eaq0*?W} M}vX#>t "OY*/|e`P\nV)lGܨ8{ `R+2i(k㽗" 붕6ϭs+f}W^\;~KI`u ve熥ԉqؽF8,;,f8;2u~f!IO]?lOPzokz$p X_^=K%`oGÆũ[V@T ]4L](e9ڧF^t`)>C] ĉ#h"w|~d\A.r ׉XU}KW"l@*he08s]Ook?3Hv@dGb&ha+N\@诼$ Փ[? @]A76[z{JNO۔ˈ"o?tN/ ß/BOҊ)\J^ ZY|6W8Qjxou3wla.L3F5y{,3m}$B!TO=%I$Q EBd'<>a yy{_̙;w-:<-^7 &AC?Výl} ٳ^.8i1L "\u/9M;R}RuAaV!Ɛ ƪ1s}HQ &nO bbZ U;#%I(T:=Qu av[M{'<ZO /$-`Z'8" V8TVnkruQwF11u1|ըz<߿HL@N`{4 ##*k*A 6}.S `dk~..2B&~?"p`̣VoⲆRTHKI[,hY(Oh2`]M'&C,~KқYbhnSR KV>}Kު1cO.#U C?tJ`*dXrBݗ?? N~i G|'J6#ީ >. ra<t҂$X{o GEF0aT+5L;T6}pE׌Q 9#?PuC1Fg{%:'h!C)Ct/3XЦ3gG|R:Lj0̆WeԉB5tv}"WT*`B-_mqh{=0)(9)xb첞Cqmآ?$|X (aFG>a&#~:Odž>SacK L(V^=9uJχ_ `B3߫/<Ơ }6Ɖ UIёh,wU {}lTh ^JBA& t9T8}JvO9Zq}~ھeΙr@qwE 頞VD MpO?#v08ġl&|C0k:QV#7hEgK nyeif;ch܆:LBΡU- o~ѽėK@CUI:kWCo Tʨ~zteѬB.5x7ou eTk@&% _vL\Z(o1d4%x"40K+D]rA66K53~6}#vЀ!$.ٛ?,R)r^i(@| z)Qw!3̅y蛉"x`}B uop?xt?^hd@/ eʳAduB tfq.Jt^`M˛̋]ڰ",r$Pw}6c{VVy%e0)-qg,+m_aɂC_iWPƉ42\mU%i`UsxX/`~jpL7tCo& ?3}.8_}QZr -Tk\8 }3/Qw5{ZR #+.\Ƙ`c}-ZQ?Oڟj`{cȉWJF Vtl7cwPu,*= άA[ЌEcko #27`q =g YjzQ. ?ŰМjҳe7Uտ@l=<.q &6jԣʾmn|a@d3k2c{)+w)ϑZƔ`CeOL a-g~з[3@{{Z3q#fi"NX:Ge![IG h/}]|s@!T7$Ef^#񷊧afE޴@+Ww x! laCk$_{T+@cU3[SP`w2gPRt̹AA0I\:GBI~5aj݇8oa8hqExXA%~}W ,]&kZD%q=U xsxɿ"\3u|S+F)mJ-ݩe]"h1olE!g7A/h[1#@3msv&* =R.ZzkA5W4YSWVSkFc-.N #Lz\@2=kڄxao`G9j6 ucq1z [L.@7 @OoKlE.ؾߞ6Ѫz.T?z ; w GAD Ulu-V#RqOA L׽{\no(Bo4@N}z䬽7AE++?TN^֟"^) ~uZǎ}OXb\=)1LtVSC8 "^卲9?*y's}12e"\so9.5$v oTi4tYKd"~M_dxdu=4o)8uOtcшPw35Ur@Y",VGmv25VM K ㈿><6 ϛ֙0{!PVHB<aEآ^zODuMu ,e0$Kuŵ ~eyWÍ-[9aB9"k T@i^]$Q}Yp_K/P*|UƢMP!Z<9om=>˳aO0JB.3kEciz;1f{P~>.@xr{VT!KS0a 9>zǘut'~ԫf ܁V:3iO y~0DsyJU\( [Ʋ b٫0[;R|ȀQb蹫U5%"4aE0wG_iؖ{kuv%C;m4!P9 ~OUۆ&9"!U, U7WbEG"Â?(ymhPVE'ziOh#@5-t/zo(,).q $*(?UQYj/ n]z]|-H̓Qc#Q4t>-H/8 & NCHa-jTHP)Jl .7 ~A-bia1??j3(kΫ^\%[Gp_(W)zhXLd:̿kH|SK ̡2,àb>u4}<V>zԊfzG& ]h$f/ݞ, 4{[,3D6;\ ̰- +N sZ̢ܽre1!@?f3{.v0_;o* u72]C ͇THJVHj y4ya~T1A n.g\Ca#mwPʾxwEWn#_-骋ݡ0WM(w-@߁F0ǤE)ɶd]ji]`K;,!4vhY4;~K^ \LA:%G qSmnNkfL ,{hEGh{UX6+cBw!^@01l1ioipƦ=IfжPƩ sO\Ja.NY'E4@n ,[mͺyw *X aoAnќ{^0\.Y-`%m/&6UIw=0$}4y8uSxO:F១u݀Q7xZOrZX?쥻 Y1Xȫ}2,$2 Fes{wK:߾A&.5gPuMyA,]77޵n( LPK.;,HiWd6{lšU\Nk`lP5=C(ƇoTch6S, ݓH\0 &=k  w>D/7-mrđꌋhVs-ѸźéFD|ZOr a ,g'a S>8:'`(=LUp\?(fdwL"jqӰʢYcW1Z)β)R4JѡePuϼ5>M^M *ך %f2w%{rF9Ul'p{1PmpCyZ@2T)vձ{g?C :aJs['dɽqg) =\֞5I~S ^h8s<[J,4?2BI1qUTBxWD:yѨ=QCiw4ֵB!v v9v^T 3_]% hr9^;,jXoOj]q:9&|I6]6vX2yzV/}nmU4bj6@\#b;bUV|~ʶ`@*ƕ}jW?G"'ehdP\FLU@i\|В&]{Fd2psThSVDA@ݽB%Р.աzo# 7~_FeoN4K_{gV>(B=:>T}0r}yÉ[yÆgnD3ۨI9~P_X?g Z \8xD^l`Wm)8[".&?2BϾ7H|q1;|;\ƠMrcXcg)$ZNCW 25<#h 47GOEw@rIи+A5"yc$;{8 2hBBE3aB%޳Wjl?I2KE72+Vaxuk+ (jMa4/r`Ty -nHk礧a 7CPpfS |vЎotSz/ ' IXfǘNg'(/]-,Ћw o:uΣnT,>W 9DtT*g1ջe $zG)gy Z~YM]15;UNG>{g(|ՀXakJʣK%%hD_,.*jSVh: n笝<-TVLlvHc 4_fU1Tk|'ӁPy+14*nf#霙"98~1 frU۾Ԃ7HЂ:e; 7UyònM@ٴπԌ?s+.C3ɇ#0O>MB`ke s~ /YG]BBrQ/_Ԩw#jݮM7Pםo6J1Z,=y;%*V~uB5;"7T&<ϒE5 u')jfp~ k.P1UC` x ƞ\Bг IK󟰤70&#,FO8\gJ"`IEVÔpk+Xq1yvM`mS{yk(V-wk5`R^1 /k7Řt~ό@RҺo1́ש7>*`E{wV/Tԃ*0[ > jfNy\N.,hH5yz.U}$kӰ #YeT9ĉ<20֌sš@!?[0L"޻aќ7E_jgxJS0 :90B*A#)l j?3+ P܃lX; ^7*0]9s*(T .al}o1Qbv:G7KØ bɰ<٢'H:ia_sK\2/^8JA`{>}U`Q `Cb>J_E-nqG?̴s UcLkn3Q~X0j?8acXHT743\@|~':k<+ r͵)A4 +} I<,gH%9~KATr''t=sxP>Dk jG4Ocz ;.]_-K) g7a'Jt>m}~Cׯ.dŬߞh}F"`*!T~x|p=D0kNAP3G0\B s^;' [BoI Gn+yX@h6h R7s^C~*|9ڤj}:Cu|ĊR;1|cnj<'k}q_f9\dz,Y,TV[2&] |XiH,^W:-rNB`3050!cz~n~Z%2WF 0_4' c<|PmԃjE/ijKB3@;es=07%wK)'|vC1 ׽-maЧv0W l:C$BBkyuĺ_H\!,0w1⡗1,|5Ude5Y[@=Zzv;҃H~h-,r{Cٞ<`H?.U$'wz1`c)gֽyskKߞPw-[Y;S4}~sG1~ޕdQ {&}^f! 0!?gN ä?"~~l܍^J.׿fdw{@6ɗT9 Q~Jߧ;xM5XiMF#;Ҩi-O&oyH>w|тa!eJ8y5V e3EA$*l'|2)[t?Rs4E@%]C@a0<Ӧ͉#п޶8ʼ+&R2a".dʅ /B0j5މ_ 4:@K^rieL@jێGNM%F2dHw(œ:y]UX f0_GE:Po6вLLh#EY㽛bh56Jpe{m`%L=V{S껒A;P1>]{֜m=1{[ݲHCv*3pX]jVu jNH`ڍa@]ѻ&a IKF~`ÍfcTS1p ;mO/ÒսV@QJyڽJbhfk*\@=w|`iI?& J4C!i!0š#muX1>й!jG I1hpZM#3ʽ@K),*~m WbYaeOT:4y{aRS닻hwH4בy}(;1\dPƅAc[ ^T C:Da&r/ +!ݱ*oTn񈙅 ״n-ªzC">lߘRnU\;IAm|s)77󆩆-s~c1M9 ]@ x)HüA"RhoH+@wbt_Ν(þճV7fzcL6yLj0vK4cH3bzv?>wݚF!4fB6ŘټaC*YK0t0 Enq By\Oʛ5/ &E3PdɅh&W7P[ܠKF?xrͶ;0 KyE`ihfw΍"1SF#&@_3 hԋ` Ԋd 4}Vgsu0])^v'M/A1Cohًych{&`,:5Fѯ<BUl%lc5o“qtc8c g(@׻Y΁|/^fJey (C׬ PL$__USJ 0 .Spx"3.QC)js` ?jIc%x3SGar!~'>y3i6EeJnl0qrU5Ɛs |9:]\r), 6smV"Xţиc΋B_Ǟtt ^J8 GzR`97E|=/x o#> 2O:,H>ơ^c5}'T-oCZW9P=#1ށkq'ˇPs{y& ,e,oRݾ~0Zf{*rz-*wfm>rD g"qc fHDzꑃX^/r#srF0GyHz-PoM.2w쯨0JaA5LY| C|V1)HcL/z t}~#&E1y'#U0~ ,qeq.ɃFi͕w/5Z0 h6W03驊?^amqZͮ'nǥ]_0==A-:Hw3WYDad 8MZbLQ򏧇< ;E!3!hO LĘFv9a0sÚDPqXu{鹽@:RlH:zַN܄abbglsUN:|cUtPѱz͡gi4U aO^G0;k 伍-o7¾͝>&?kᎺ?5r":(d9P[ 4׬)s.kր+{s0J8BHlRf;ްA8 w}݂E.S@_p]*$o*+ŧĈ POZ !}H6XQi Í2b hq}?᰼œ1{E4,P7PnE_w eAň9)GV\Mׁ.`fmU.V1eGSx`=پMlM+Keޟ00Б4KXY-n *9Rd+z(T6iM V# n=\joɂaYܴ $Sxpq(3 Lc+F}?f@)V7#ժ`W Jܶ]%1u~26ߌ16ê@ۿ2V%.7i _hab0LG\z ~Dﰅn[`)1<b]0S4X.ňsh9V4g}ѹG\j/Zv1@X{f1i+3w|4ZnXy[(nj邭,X5eDܨUB58c $j'ЊW'ar0+Eq߽~9Cz"bn9qo "6yl~ZÏMNKf|nLhh{Dm1o6Fd\$b j;[s>#2:-j–3AKfΑdn'P.x ѧkRmo 4" Z jL{ďyJ,M%a-CL_@SZ8 eD`H뗱0_κex m fƠwuϧA[[\U: <~wa.H =n@GO~k=z%U%![ja:t{BQ||H5 bnǂT2!T);Ĕ bŘWuyǴ0v˽\0iDK4C3h+ԁ/Eܦ` ]l8FJ蟟}EDl) =:ګc qGٹ W /;5fъA5T(e"OCO;ϵk@>?k4F-݇%?#/a9:63|6-~Vm9R=/{Je]ɰDP{ᠪWx[/ QJ_OAZf9/+Fw}ɍAe 4=={],켿'l1x1)Ez? ">^\+Z:ƛMOy>+_8BEroym  \Yf\4̱]?_fԠsA,#)[ oUa^oÒWPs>-̥5m+l)|%,wr,UNG]{Fv~ pREm9@7 mZLկ1',`ӥ+eL2cfUtI×4%dB /^9{ &4Dȣ ݈ !}>p OCm*2\]l1}T/ksWf"P^諥=;7k_n=}PoŽ77:jv1/4U9Qs@c2_`_4rΫgTwR ٣`,Bێi'LaFݷܷ30K7"}?}|;oeR=gq0a)ڷ,LNex?^Z^=SDA&k;6++/0)6Usry8cs7L8SOR:hа4?Yf5-(Aw3*GoF+U ʝl{QT$g K|UN (}>~&>Ca<IQ.@` ),iyh*,ťx\u8eΧs~.A"DPL j`[6,>i}Ma:l cػ/09R|VV T aݽLP(s=a?*ѣa 50<!(Jj@`36s~V<|ocYQײE9k'q<,v 'ZjeU1:+4>VέG7@uz3[{u'C8jqB# ںoK}3TxG*0eV6 h64sl` WBX|}/xCU H ⛧&@5J ,k aq\-x=R+#lph\$fZ-]"*N^(p/5 c'i]`K+<>:cٔ/NM-!L2+/hb<9\`NqX`lb !@n膱vԲ*YS̀_?SZ7֛{zfzDmV蓂saL-%pMfS_rD[X9,'KWXŊ\Kz- }I"< 0~vpXC* 0{_"_Y#c0!B^.+ma ]ՕgpVŒrXZW G<6h?Xq2eJy ͩ pwNب0 +ꙥy\O4cx14?Gێ|)* y;`eM&X_E{¡:yXdlKFh0$w4F4I$c|=Ԁ~w 4^K.OYF^&s 1:t >xn~ݝ1Z,77ǒCa]?3|'+*Cc跀d79NA1ψLujyE31KXguKwp+_h#0f6 wN]l`; ?WrZglojj)ӽ'N 8ڇ]f3l??/ /EcSzg9v;ʊM3@K =Nv|%p%9d\4sgo~a~HbPeIУϥ<}.@N+u{#hcMceM Dv/3)g%>&m'RYfiߚBސi1%}2Ȅ (}zY c0>(SN0ƖE>"QߐVw eaۘz]vS[6?l%9~{AU ˸,[S8"s6PG"T>0v ^ tٻUwgNӠ1ƧVŹ jK)^>5_l–IG( 1F)@>RRS-1?5\> F ŌݢOdhx#^ԁ-vw"6|`tKȓcCe$`+L̋'a ܔԎsGHN#Q:tuu14Zᔷ1\I;@=";_ -Nt]c53Yh=j譓@Jjt87;-to(ZY7t Oؔ1w߭7?y hmȁKlʼJCtG.) ȡx9Qs{!g ;-{:0qh+u=ca30$+c``cGwNT$qu'̼V cx?1 yLځ^y q`9G.=]dK*a|x= Oq0<LJ~<kec";/;h\hc0˫49a;g!q,eauTK>?_UJXa /iUcO?]D՚"ł;`&5ưI XcMɢiɼc=44ba ۣܲ2'ó0ë.gy+{?tЂUkj<c ɯ,q51.lH~zÄD`-Y{YNc]Epm1s*,yM}=kE< 7F`aELڝKmɔ]C~u M /2.{(]x?>^_zH%zz)&hQSE*auCQdx ~F񫜉`\6$1Ƥw?=׿rKG_%jz,KIL"%׀:Th+[//F704k3Uo>K {0!kŠfd]1榼N3h{S-K;Ơ[k˗K1:2#|<߾; _(]?#g}@UwyYڽ5$hZb`h7>=<#/`*)Ox &t_[Yj{ z_O%VچZ30^Y $KY0iT4URI:=̂Ko)?UٞmpGTU_@ @hE˒: 4l`GA̳d=a;C;Vy慳}uИܹ6ǸNAFΓWsH9.Kϡm `ʝOn?uFzn:f D;gKDyݾm6l֨K8-/rg ӿ5-i뷫4 i|45B8סv` R\~[kfaq>_S`}r&lSchFJ @i B撯0)cn"h_ʼ:,Ka,}Gn_V#tAXf3TH+֨e*נy;t }ݰFcAԻh=PfqLD3#҅Ctl|]CHiYЦ{z5'axF`i>YI;K@g gkcP GOO8&~ y1 SD[jIm| ]tb Wh)wX4%R`zjp +w$`'8$TˬC 0F,jEvy2)_ .t* `qw0FQ\[D&۫N@x\0L_Ktz+m +;bbl}^!/oO切qoN%=1=Er71<c`4h8CwpE1 N@|8 "XwÖ{۪@yzݽ0P>'y6c/,-5O7BGGEL6B&_HKQ/]nsyzh[ⰹ祶ZCP=bϙP! _ "ޝT!? L ) nG{Xpd)6-v{dMv9q2 8]2nan:AZT7o2xƤh;1A51Kkjwk4 {6/<F?O47/QOBEt$镟2݄5Yߍamk;k8NDEA+}\VtwQavgP$t^zycG2˸3abL8kti3)RlAYk,/<lL3D}V7Bjċ/za) ii]'HϽy>UXXsmafeF$.d j#›WjG֏2RUYfA =y B`~&'+OxyaHH.h~(u#/_ӽP[B{;yu0-6`|O1y k#14yAtcr !IDT}pp4DE_ԥm_k Fca1ke JϾ#v}qf:bwgvzD׼ߛloy;گ4$.*|A>%}aNWP>!4 -}Q@i*5,s_W>HR<P9r8S׹(=𴒡VXHwy(}7_O63D`&ճCGcG`ɩ;f[ t gic uw V5Q7&`7ay ӆs36hKwͻa!' =.j) ;J`V|7;.}{GQ/b(GZ,!0Y=GK Vhwfs+Z+%Zfe@Ժۨnil[9V4r.TcM3`;B [ugmp }?ubl;.G+g$0S,'5 af.viV6e+f"sS6`^/EOV߷\ C>`d3#/::tcXC/v]y/΋@J)UʶNX+;`m~[tK;1ƥ0c5N'L5['/。8c}@ ~_069ۇc8o9 )@1ʎa@*>cX|dzc-"># J0MWTzœ90fNdax6KkФr=cϋkDVD*:o7YQu;1G`TƜ/MӕkhN.L#Yqţ0 e<sbNh`elyֽ|UQJImHvE t}/N<u꾹` I\<C9[PY#b*ݟ2TRKtpF63$vEWQ@}g+9ƴSf lmtqHz^>Qc( |GSztidD3PhfV޺'#dlȸ,hfФ0헣퇡q0ή4. m`A]  z]tV(>1= 6cʨO0^,V4cZox=[OK;1ԝ0ʥ05c vܒok?a/g".@U{9u5֍mijf.v>ƐA~Q1 =|;gt13-:hqis"E vBAácT׿L܏ݎI:~-KN%8 F[/q-LRZҹ,HIc幷I?84Dh-gn CAEϯ.yS{ޒa79:>Rll[dkBc!syϽy֨cuu휛Ū6;J nߊ*`o 3}/B_PpGXن0MInXR~:&&Ziڨ?7aC7z;lL:28%vDU(W0"qO,,mƉ1~Ck?_C*lS*ƭaY-Stnb(n)[4C\D? 6%~kYi0߸ʽqxv%g2,`ODۜc0za^k|Y&?:'}i]?Ӷ/>b;/wo~460Ą3>qK! |cѐ{a=D*j/KjGyr]Kc\JʋW5L쀼کrX}q^lW8i?JF^A$c}n7@pzaĹTV8W6 o z"B4:*O] [R9 }b ǿ1aMM U錬) 7({-\4lK.U?.\oc˒y0_nR4r^'`*rEӀ!՝ ݧ3O6aTFlKø3ݓ7R0_T38CN(Aضu)efO;` vjo_ܣhcB=_M@N?skXzlt|E =qrԷa8x9P0\'~~іP{#Ij-!9BPp~ `*%3i9JnK;GVde+K声%hwCDLѺDLuQsLU+wXί=c ^TwPv p6{$ =Hjݰ8AYå\MM=͐14ȃkkneh8um^e!ciG(i.BYP]jnq|fZOOD ri>Wtԉ<% 껝r|)Wl]9I`[ ҷ`e&6rHݫ˜F v!s%Hs4eaGoXDk{箝@)p>.s)[FOq I-x]9hX1 e'AsH_p+k{spQ+@Jok-UUѐq:k Z3a .xYV텆@*w<Xo-@cs13_r@ Gaq)(=5s[~r: }Ro_~ cږ }Vy[ѡ˩$0%s`Gg.s3 Jk !s:.Kv@sx B@mSŸNy]c"/{vlYr ?7c\#[s@SIw7AC%aJ0V jF' Vr0g=53S#&}#k%FK56=T_ BCU0Xֶ! 'p$ l2X WG`'gr>CO33Pqp-}{OS_4#Jn&! oXqQCٷ%O}aM%mVEpW5~ i.@sY}<5D?gW)[a w6z sע0]3ngS֑k.vǟ?DlGtN@n~SW?}τk<@/xV s㢓1dX~0rl|)N/ܻ!zB5x UA?aH#3v08 +&{x@5/ZM͙07M+{?OB G =;JVZk~sK1oFBhf^:QlX(B !oAΩwE?&  O1uJ*B ZѴB09\]Jo0ȵei!yߛ#1oD4MGhCΈqƻ=^hjO%'@sf7IȌLϩ ;"}a+ϧ0vCK+?\՞0f#Jlqdd@),ڎjFh0Fu;A>?1~%ӭײ)ho%Oʕ6bsgC9RI3l3"Ks9.:ܟ&OBL6 JBHAPUjl-ڙt%uYQ49QD0ܽsԏݙFÀžүB[^! tÆݎhA;+c*ݣeDG[AT*/EAmL+`WrQ>lg=<-WDZ5#(Gs,V\OhyU6_ՆO]'5<-k#4<sOaiDce4~س+eTGF)9$Ɩc')*_L4}z܋]@Q!DܶUXys. >ԧZ@E ylnV6c_ JX l6de$YCݐd}& 58S^DƱNZ@2L?/XVk13j"aW|"j s:jnӳ 5f\DnC tq`J&0̶u3ȼn0A0TFE:ña1_+6ld!e>XoH;w?Mₕ abxRA-|x XؽQÏ MUEeaWah7t5샥Kd1_@~aѣM珸^c-(O0Nk0ҽ{kd \5ֻT[ %՚Ud4ÆD L$9CV_+E)j+Հ ==QT#'D(B:ZtwUH WW0[PRM,3Wd`%mhG0?P(bǰ>(08qfy?~~JЪ<0sO r&aюp@q<]=w f8ŕaM̧SM3yk_"o9LjAg/D]X[pNjp0rk2񮻣tKs{o{8>R#]NS&Nu< ^S=XE~9ڏ+E-_[\]K| ²0rf. 筠S۳ ]0ByW {8+wC0u;dpcU\6/V mc\$`| FI,T8REG_·@ul(6\za|1eGZ~BND5rӧy4W\wwSL Ù8kwd@2Uă:y)dTS {b1!1`R֋JTs!;ƻo1{xs{@W(Sx^+G{Be*BO@`x88F5+[ )첚`cd%dnZϒlA?}2IΟ"5r6šץba$c5?h$-({q;W%p};TCLGѡ>h\b? ks0aPS2JH8(OǿH C1pФ15~ޡ1 OVy`F|R!YbW $#4x8ɵ5 z`\4ʸjԔi EO5sk%Md45ДH$M.ܐ,H @fJß` Nn~M#?ٌтM?cfl(׿G1Fwa=T.E-~ X8`}?rz SeG}kO)Zz9FtA4~}FMw1%iU%Xz!Ťfz #3{Q '~l,Z CƢ%2]V0M}_SIhS/l-y|Y;}_|09)8wJB=Ӧs1ϕM8DkT#UEvT$޻PB|`Y/[dt!һ6i|á<na0'އrsg (ܕ;X"Ww|'T0=X)hVl l:!gr@F\^|KtǺ)40-C}?{[ IK0Y# ʩr3:joii}oV #5x%1fKԈtfζvH4нaAPW7q<cQǏ]AX}^6RTukyK0U c~6 .^ q#rd@6dž(n Pgy[k畷k͑9] .[TvwGU@)]LVV>sA_4_`z)L`粗.c\.}1Ň0(FMc<=$KGmh:r ѽ>mO 6D3d6p2xE[:ⳉX]X(BmD ˆeNkO`o15P88])t[ۜb@ޚ9,0=J8ؔ>W}^XNXx_^mTa1Eq8, 3 c*mbPiJڠXƩ-sɇLO2|"_;\(7 [뭥\Ӧ <¶c2b7/jaI |NrX#=C皗`›vG ).ohJ-(vçGVݧ=rYbL-c/W`_:<l|)_ q0fǯ/1փ[Jakp!w+`L]NĸTڎ= c,A@Yl2}s⠒B#U#GQ,69y#iΟ_kӽ}TR>j{R ??yn^cIѳ,1 ]wpgx鰨sol_ǡ#Q(dZ {{c$ a~E/ŠؗkUs[@b>U6ְKbKc2˾vh:a[r!|,-Xrb\o~bl7a! F*Xݨ #jX s+? <7)Dض6ǮѯzGl|>bOZal\u`Z{g"4zTTH!'ww=`E=1) &WLֹ r{ #cr`[_ ݯ$7ߓ`MӯTƴRn_>ҀwzXϋrpcc&M?0毵_1?:{|{pRrctO,/GJ`F3a\?1lr|Ϋ/&r0iiMno -L>EEzbxv -`l?j;9wX'ĉ>`bKqF+"wY4N`xbQ_XZ 3_]3B4N3rlNʩ@M ^~}{qwe@oUn@=r 1N/h4A {P@~8q\qf~)S:U&14FN^9(ց©avG`JֳhU.2~q2xk*E\g1Pk#^r`[m\X{Ik`=Wrą ēuDm)> Qh"EP+|6b0s<' iM_<1G70Xr|" O&/͟c;V٘Ra^W6Ÿa95SHZ3_g8}b&'wO}U >ix8z}M{tի;Ny =? (dl7Ժ:z )j5OMQhCU=ǮUBW]z>|g1+k tXf7f'@Du>-- LXP۳Eftrf|&Լbe1=t^2;KF#@# H.J,@a& %IsQ3=Ə'Fr1XV^ [Ru0mM9E{aӍG Uz7Ë߿$ /&:ڕy/>vF" a.BnJְ^4[I#0~ [hW qXC۽ȐWP9_-,S}{Mv߂^BWM~S~DžI\(+׵׀O]f X} 0H'3T/Æ$oիn T1ziY hZ ~0pϯ8}^`P"C< @&׵_' cߖ%Oǫ'6ͅӱ C1vO+a\sl,~6.(5j1Aٓ0U'T=nxn"S9. (>k^rpᆱwxCh/t 4ac5ME/ Q +I%0[.s<0\LC7 x/qya_U#<j% noN$Q7Hð}̑65T&뷩Qk\Vv[Ggᙱ-$I%$<'QBB%$JR$$$I%[%ٲʾd}_fck3yY:JO8ؙoT<>QDla2 [~vvFm/ YPxiþ$Lr3wυ53T"bk'E @j7`zi\/alto\}uXވ#6icb0^* 1*3jGNJ@0Z0PQ<|F#[lQۍ`[ˋ&XF]9+Y-B+ԕۿE7caPaE<Ϳ.JZgk ^@TcL9d/zH،~jC6y:L=B)X:FWTڛye\ K-&0%~1?6aGJ+N$7V j9t~*t߇Qu\^" t?dgew?ۥ }k|U`ݾяsPd{Gh( u!{gv흀4 O>0)߇/G]ɕn2꾸n7!\[]3XcS, {JA^w/%1Bdp8zW?/<-ٌwn&e }שl݅OR5NTZult+ƀ,b\L]e;n߳ E䨀efcHUGsam0bX)׊}:uT`qy=4e`lm 0|{4z~{\h b79; &2>mj!8ԛy3:9dlη{rik&Xٸt-\5xڕ]Sy#.\A8<{T8"W`D\KQR䴸)[/w$4Gk3d/ڬ%9, at_\yӿv$M:־:uajeeHNzy{ˊe uܤe :.ۚC@oK|йjח,l{漳}| Be/ caHajv &8/,DmaYe܅|m7p42Sw03ƒOIt%-Y`|9<*],96O(iZ4u WQ޵f'j>c#-{R? _q@ /G9^:! =;( ׷Fgh3oSV oetsIQ(V#,?2>bz+ ԝ3JKC@Sx ݼU3u1ɶC FVGʂѐO$=/''CSQA$ WS, OdCP\& nBqk+j:x F9`Y_׽_>}JBKհ9v*|k/7wWP˿P|Ѻ_>~ َtLtEa#yy>sġ&[G E4g9|RC0L_ܔ Aq@MAn{DxD_Tj͔&aKfT$^lMNT@0ґ^O3cG-+F' {PY|>V -Gc/Ϫa[ 'd[rq/H_R_771Q2씒 YY|A?6ݰ@*y 'B>Nq0wSiLv~)13âS@0֖8LNb0\P>t,"zN^In?q).XQp|SMHj)Oa+NIKVP&o:ttB[꿮9ի*-lPD&7Ϣ^QfF/MsF`YO0,[j(p-s}˖+hܯ6fg&*+b8S Pz1N_`vI!L)D܀́`2l+(.DН{kiZdۃ 1|5{JQ U/67N/Le(C3sSXi::5yj>U>c TVLzAZA~N3"̿pnaaؾ+8 ,~dh#?ߓAOB3_;=gHu,% q`ӻb?7aZ_}*85d)ʱ0b<.q+4\]"6=u3g)Z..{=7̅pV9p(x ;Vi[uaGÄӏ,<-QwzM~}")O3kWlsZP K\;ަV0zÒܔG Gr8dywOa ?}&w桡o`%܀=9[BI2M1p]w(i:˾k@7凭m=*,6'XPA3lx䡊(5 y%jo{1.xE}rM aI}Ɇ>Jqy7yЌtq{1W w+K(>Z Xak:d{;f #3³ G}0yt= ٭m@cuP=!K@}gsbUaz^n2l$D3gnƗVR0R~4=-W뼓i a135"g< °s zAͣ8}Q9Z!sE*S#f>k<=KT]b6:%Pg=S; S\9gJ@ rp0%_G]PqZ$h8\ulcL: WMb2 ʸ\.,ԗW4^_3@gPg=6u~(ٖ׀>E5 .,m5ʆ*l* `u݄H+H%SNE/9 kLBv]Hۅۏ1Zma77ń.:`tz{z{i~h{ʭv`_gr Vѯ~R;oPUݔ$zD b\l PE}]LgR-Ŷ a@jP ZEuܾ841MumXN_f^JK@* Zrzʷ Vsd,qRl2H*+2`^/Aљ?T|lF;˄J< 8k X8yg UɵӯxI@/>ֆVjn6bD}ʩ $BfAN0Yz#˾U؆~.Faq|2 5>Iʭ6VB~?4⑄R`kXM`jǗ4&߶|#χؖwǤƠ&CZʗ.ɫpEӽ(LW QTNAMԢ U9Hz;dR<pʓ`L\!.0s_߼+L::~-yEVP9džRRTf2&Y۩ Ъ(c{v<_Oe/* mvwbRjd /oekTO9ӝ}i'MVH_]߽Y/@:;JGaEv(d r~/P& WJw3[@:lXםw]c@̚N{g du&@uq}_('2)˯w1<,ZULx<#f >pxnPcq^Ӈi$G _ v7>5 JѴy(;XM(]9ĭ'tFFۇ8k^CsЋJCyp-l> ۣ=a1&gWdcԖz`pB/^`#= *q]yQYz),s*@= Rtl% %V~@DW.1SXd0Sw}YfTzٞ%VK]Yl=j c,gƕ0!Mð9ΝHˑfa)1!4}u|N)6Gb\TQо5/ٳJ LNUB2l/>i5C@_iO6! Ag1f/~g@Uyc ν -i"$YYd0dۛR l9 ui0j(*=.?'YGo0Gc̓bCYn: -`x]0y]6w|nTX4CX[wi\APlqћ˷v n;1 1>$En+LW#>#h#6}uڪ{^j袨,*0z]0 ͺ,C?F101#XP6DW +A?0y@ FTc*n*}\ 1w)cLQtCQ^4ߟ|P ظ09p03W=0ֹx+nV~f?C,є_eR_&0|Ev6٘&}_9tzbR@>w!wigʢ19?SaCP{!yv3yMӻ`uF6ɰ:eoq:~j>2iQamMt-X9S}=|XWbLx\2 w8q /M oM]/:9W}aG9 CK[qoFLlr/MAuƢ"!nґt=u-~(fYcUرȱgH2agI{u`IIUEˉb@nkXS/E;ׄ?L u F :ƼB./+9̯E)H|:e as;; lDrlMa8cB O|Ù0-*Mmс$X6 8Ǖ`C5)֞9V5JAZ8;ԅ}Aǖr.1'av}ӰŚe-Cn 60R==PU%цᒽo yɦܱg`7zPoTQ;3kNnXؼO-} k|c *Vy8팁էNqKۺ3RzҰj Ԣ>Ϡ;NzUx>MT!Q0f^<"K0\n}n߾+eaF'yC/噋I@J%Pհzl^fe6%<>fQZ=b0c;oE͚ I34qro9 ~Ot[!/}C?\hɻ @i:!ģ޲CL>L.p165%(}̊c ӥ{Uj-yoE7 *GXo:% ~w}.>i9j6}48l'cI:XF) 4 5;Niy`x>{)I 6m&[=Fm%+ +&@I L5[-) w;(Hدju4TLe<ޝ=mD]J0:vach5H:ßVd`J%m&؈ܧp,~])d$HXZѲZ>xR.Bml]{<'V5Ė%пcHs1Tq)5:?j,+1TkfU?+8/2t(zn.{k/(@%OcOIxr\UrV L<+KX'-{.Ix;J`<}?X=iݞsK|dޕ|Y&2қ X 9hՁĄ~6^#ݘ1_h2<*ҶX1l]ֹ-7+ (F vf8] *8hV_ >9a;y6ʹpCFQ;_2)*59. } ?D;= XhX[ Iqk8M]ٚN%%mK`ݹ upFHT)cjqs՟KH(hh.ޑ?y #,r_n"G7ʘ^GǖcC7'بyMS0JG5B1My[{fu HJBD,#3tպ؆?CoQ=OU2$ q59eF5V 7ZnÒzHwbR)5O-k۬|BGkd/|vOZ/3 wxata/O&t )P9Ш2V.BM{5r1,k>ߵ^PZća|+ FYz0 o>D lUĨX陔J 76tKR)Kah~>;X͂Ph9uv\:%1ڃP$6tMַ[8poJUl12SX'8e*69&d,p` o6 \fv8۰tL깉05Aڕ 3tn9^P ͏/0/f؋0b Ϗn0ȧ1pK>m~Werp<ɉ־rڼxǍ,T8\8~ UU{A06~dT U m$d^|a…;{Vⶑ2 %]Vi[ O+i(`VyJF.A󛓌gX+KZ:4nXV&myWk-tBj- <ɰ!Ify%^l; g SR0d+7O~"A KIe2Ea-VⳊ08A󨚈rvj?F`]~/Eg6w|Fa,EEHG B}<09Ƨx/MvO=L׋͎VLQߎ5f ?LIM^^䮷|cN=ә9tO*ȥIMiu~ ^R 6OX(Gd*≯ĸ~۵aCBF([̲}'8XNk@ڱ^buכIW,,FT{ej6ȫ:̡JeUFs%q306eY9B硰c1~:_aU6aJk)(ܳn#Xao$p ؓ0\KJ,JyG8˷ALV/ƨwJ_OoOYurF;SD% $L.ʏ!ұ /=SqâKuOY) ,['yM}Y)8zE]  ,1Ǟ[dRf-Wnsth׺ARo'Z@pr =*? O0@p~#K?{ 2,H==1(T%c]a`i&4{1 56GX*{L93|5bP9y8h-^@+Bb\a0- |eh~&\ɟmRR@.7Ѹh˫Z!xO<*[:2#0C˯}J/` k, =~ãrOhP_iUPZjkvk XQk|fD:+aJ9%K1FˍP)ePau !_~YV~a\4?tjI/gv  Usr4M.HA\)Y| O/²ZSя,屚윾7?/ YgaP+e4A{EҖRC{W.󮠇u\~dXu}2,U|6_TX1{XޏB.MNfơgo3K0DT/aŸqu,Z 7mݖAc\I_8-vL<ޔƞpr}F0QIq贅{~h1lDLi9{u]%st]&D+J0z] P~)4}2m~tn13" םYhl9lz0HCVWA>Nu3˶B-VDm&>)-;r3*MBÄ0Qֵ}V0,Y GCHY_1)hc-Zph5Yg)U}&Wm0!b 4:>=Faphah*k\Y6~ݨ]El }' v Ȇ3^be_سG@ͯ#7~-ïaA|ظ(nG c.,^Z& ;km@{j o^z,~}V/|yH?x<^ Kp hϴSFhm?yoW `f65܏b07?

dN&|E`}J!H-AhuWqSSPm>Y^|08@f /zXNum (JHÂ(YPu w.77xzMXl0B Ni ߝ[0w? ,8Fc soN۽0 2}ȕ65s'#aE}tK6#z̏`ߖvc:?Y(J)~0t0zf KzzF@Ϛ}⋏px2=IցٕV?1¿WS`ϕI#EcTN>B _ꩱb2RQ?ն$>u4/c\xJ ʕp8:˭ا cs+noN`iR4[0<άeQ^o|ZrB.|6q‰_*6xY`ܢ+ifs̳ gaQbڑKY]p lWNCX Y9HN胏.Q.ҿAi]Ϙ+ x@Ire)SiuT[Ի*DM|Nn#,m9wj.D:E0SvWCP*ƪaB4#hji1BbM oalRb_%ԏQކֻ` 5"< C=H@(l9ҍ/QyշZliiE9`tarZb|1Ɲ+M>M׏l`9l [̏ª9}=,Ο>wpmC AѠuvucH &fz ԇul*L'WE,{?1? c+a0y_a]7= }941i#$zW@ؕ._-X=9tWk7Vvצ0VSoM^.-tX-pK( KdeYO3 fE`؃~-"4/x> >.M# tB?5!' 3}`V,5d  55QwhD>mѼQ@];1|}l E?cR )EQƌaʕY5K[ ub٢ d~gѲNrs0ȴr\ P]e1؄6M[SoM&j]YmЁ1;mv¸m̺g :^ܫ*/_vlM#t7+[ da׿Kh3Qu9gg}@Um#P]aeoK5.6X7\KI 砿.bqc@ >u. _YDu,UlM}wP2SDX`,)/[O؝ `#. 0E>e [ca!Gue7Y Y V$#jVKx UDzvatj׊0&&ᱺKA_%KpQaDFaW?4. wu%f~,'@%HI604`<)osm@Q*c`Vm氇c?̊) ~~u>lT b0&QשFk 5DΏ4 `~g9J Kw{ rp+JM1ҔxW4UҥG޽& Wrxۻj,_kEaR1\eJYaFOmAXȿ | 0Ltd h[ ݟ.YF mj9.jat*G4f$pAZ`epMmm78n^΋Ęj?Jpx"}'h0:Bmt*?`ѭy!Xpۃ9c ohZ̿ʇ 0pɆl]g\ySf5fDʤWf4aP> +aV! \0vqca.4KAes.2ɩϲi(B<(ƍc|gyKac+:3)F$LKjͲyae!X\Z"y!cX["a l Vs&du.h]qVdΰи49XKeTOirDC[ OS 0yXl%Qzĉ[0Vapu|`#}_%kwN!,}sfkK)>c 2(`a%l{y5a#jQ`co`V6 ŸyBpl'4 ᶦv0_׿Ȉ}JP65v̢/rN mOYWW݋Dعwe)j."#.]6W ֮i1du,yo+sn9r0"7p큌nX #R9Xão\fj,7l<ўN-$P9ּj,8*Zض1UO1鋡I[0AQ,5dCMa.¨Ǟ3CЙYذ ~_H܆ƊQnǵ&_iz/_8 Z fɨy%N1GOCg |5 v轼=SNr}#KZXMƒƏcKT:zOWú&qu<gUfv\]uI#=-o@=#,n;9 =oo Bz"WpPs9_%{WQKnI_Ttr&'0o: 2 /or qd RwF[AާBam(Ψ/Y &oK}A@hjѝ>u:sJuR#qK1e95,`{S0{T>Գy9cX-`C54?W{ Zۻ{˲kT åhG{=LLWIvAS%&bL%-Jo)aF #UO4̾U(uHB'L.˜AG5-Ȳ>.WaG%C͜ԴY/h1tr.71E> [6P@( R`fwt c|=LYllb]hF#[KW @*gQ ofc$Gݵ*;~WXT{ @#Wl_pCDm_dF"4~{hA3񠏕F e`%`d?tS7 -B? x a]tз< ; ͥE(ge`\8 ze>X6Lqgnf,)+0Wr4A/KSᥞ҃$ޫ*GA7,:MWvR^ͬe( ){'DL !q]y-Z(L(?L+*ylgbN܂ I f:~@c7tm$p>1p˧zݖY_1nԸLO!F`pǾzh{u-oD|džko:-2 RE40*h(r}bu+ԑx3qGF-`)w2m1py(7 rhvϝ;9i01;L|#D^HeafG4SJkIdՋ2z`_AJ:I1Jf4eA2m0=/9.˓ڈB}P9ϴHkN!/`<5\ƦdXfřVA-~C}-HAjQY9J׃bܒ@9=+\OBSu!90WfF1J~>A_FX77DnT1ݬ0p-N%ap8b;vOM*DSV`Ix;H*ȡ&K4рWK`9(ԅ9V96} (ƠB yIq3mzZO uSsshϫCf`/ ۯn6:@`gGoVM+G_Et>IwLS%W֏A%1=YC9h>2xM so.$c)e',~rIM6ɣ4֯&j}9B1PO6Ms `*#W-b|#dQXגܐd-z;eF]ʷg@28uEF`tF<#mгoH?hosG@)GP)ǃ`C]g1,r$ ߬0-(}V>|,m.~+,QAvs FϭA^3d A1Hs5Q|2⼖ m5cжlPlAK~ChP{ṳ0X;K6̹'`{F}%l9%M;Sx=tCcA?;Wz `m׶\Fl~ 27LM1́6|>tn[|kicPOF%7Ha@޷0<`Sr@ʿ Ѹd gt;M9N_c䔃>wW,aCk{_!FظAÊ>r!u)hC ZĢAhq,=2ԆQ9~wPԒs/_ʰvȱaY*K`j'Jtnp0UQ-R/Mƙ9V y 4*Yi /q @o4bT1 CvFb~q͟@>)յ 8ڜCsV#`5NyZ  ё*;^@q eZnNb -kU0a!>n{+~uDazyX۾^/gC/zN69U_%l hkYǙ 1ֆعXykO'_5z޳`88`WPϵƻaEꞀڟK3a'^"@^4b> _)lwV0H,(PUAP'CDO9ݐ\oI¦1­5}3H;"KubF1@c|(|6G Q|=L?p"Ft&6E i*?[aJ+7B\ s {PurY5]w uQPqE߷(~ǘ{}=!]6a.=c^м!Dὖ  ~ufEb 3 l?<a:K}-?3=j΄Q=>{qҪx|?\Z޽ 3grgP{[1R xo#Hn/@:-##JAKl&o@iQZ٫"nEOc8%Fh"MH6+Oަ}{1wB܁ u|3-%U$. Ia.hk_4z;c3]myna=Ytؠ\վZvNz8FmWdq^dg<ΪŘeޑ7qRaVCe+xdfr3A]|^Θ.'.677b <4(rvxr?+{h׳hB e>7(k;@:ud 4Ɣaᚢ?owxߖJiC _<";Vb0 <@-Za|E}2f!D=;|z`kqLHMf3@.Mh(]؎֕`xK@>rI@sAWh0+uU[@#s2|b0}1G2%V:.CŎD `jz6IY#M᧭3_0ʩ`?k>uOx_^a$/uI#w'`Kx$=:5F>se8:_:^.lT|v#*|Nffb#a|K#Cv}xGdͨm+0-`sPh,/b,VcڹļQa[}9i׮Q0{o'_eB/Za8O:@`_7ɚDߜRlEhgUu?*+KĹ[m (:.(ss{ H0Ѓsk!5.:C,;K! Ƶ4^:tD,dy}1VLW׌P;8c݁(f >ĮLA}9+XNb<ek+)Gb}q o;K vD`8~/o*1O82pQ[,Q-ȑ3Bh`TsX1>1/y;?ӫi~LhMYYZϘ%qrQ2<>X ]8,hM=:S c7^5c/,ohzxY q%hTiH2;g뒀_ >5o`ys@  utQEL=uAVO۲ sW]}.xVeUߐ/oB{BTwF2>U @8;p@ %JC&]Uv! FWͰM4~FRN ~u+:`!Z2 MXsW Ӟω=gPo{ T>,U4{~k&|i6^Q=,iw͙r9=Iq;7g'a 1Ѹ6^Ŵ,)e9ʈUk nM3AAoEhƫZ0qS|]ְH*m3ЬIS@I3,\9W^}iz6 RP'iؙ`uvQzNe[qPwŬ7.z]7>C 6ש[ӌN\YaWz1 s T)W"6kT;2ڌwo],Q?X> VV6շ!;ZZQE>P#Ob*VDa:!c@Y0|K ¦1AtD4²~ Vyl[aǬj*Óg#a!W]M5 vbaV*I{JDm`*&~R(*E sRPu)s؜̲] UL1eQ1T~#_}Jn܍Ksz@ b0]0)Y*L@_I=oQ-,>˸3(㑕m+a-Mip<&fY%TA&s[I0_!:+T/=ӷ1{|7:ӡ:Hjbe H_? Mu$\uqB#rN VF^3Ґf7:3c`ۙ`x: `'99W 3A/=фVG@:%'`td.-UHWB:PWŎ=jߞd"?'2PFឨzK _HƮBf S*糒 ӎ7Z o.`G41fKWJ OT(ðbmGt~z~\h_߂¯r<ƨQd c(3W?72yE>xPa;.E>,A֙'0Va(OٰBYy-^{ j PޡnlZF%~skfH>!C2#j`*y,JQ`7jQ;Xع XI=6.z44D+*p|}G_lNf% .Vlhl;㣣0= )?P? wt|˭1Br͟XzK,*?zZnj<֔"pc̥c?+Ql{,~'ÚZ}ߩr:12ThTS Yj3P.CxVEi0h![A_[o+1:UQd^fg\BjwUm2èܥQQ<+#@OoA SHsb_f7r-3,`"D3rfÝ/kRaS72^r'E$hޡtppIJc*7k[#Y-"{, 肝{oVǞj>_%oI\_kb򧳥F_8oÆT?grZg֢*F9{$4(Ȑ* L*C^>0^"azUWW %=:eY=k*l6mYbAW, =_X}wK*Q'{E0#հs]0 w$AMdXMg:wq }ѲɄ>{k/tÒad? W<o]@^dEmZ( d7`IO \s ?|S@a fҼ'af=_}U=56X$DZ'_I8}IZ/nP2;*rBߏ\V4=gP $888BM;=!zl˜O~%ȫ&SaMD@ ?1ed1V3 /^w,F3j;g*=b|f?;2$4b/Da&=fwMٍE ADe0p)\Z'i(P`{r{+ZȬ@z>'D\?2)QvoQ_!Xs]Ø+\šoѼW ӺGk}Xthuq_`S4SX?Y-psч(ҩoM'y96 ;G&F7}+<7٢s)% dp7G=`yWK|:I)"|f# "U`ۨ.6=f-"1\#&5/< <̰չE_z"B=Up?k) @|yPiQ\_pCAqB`jSt6$ݶb>aΑ9X[ K$jł0Xlw # ; cJ/}R&`ʟ{lƓ"gnal0bk-SX >B%AkyY:Fn׽]^1jX} +y&q,$+_ۭq7*T I qjڟm"X~MYz;6Ĭ 30VDXI܍;(`vZ磑rqu lov(>6S axh)FW|gwѭzPV(sÛ~,_#ʰ)߱cqƒ*0[^8oP%[`R ^H\&:rħN!]LctKFkX/L6j,Dᡅg!P'pV0V8a~ ? WzcO(8~ND%#An>)?7!WCjux}' 9Rغ.7, FrM{Bo!ؤgf@& @m9ZTcSYkgIJ$HyQ~lXޒdZ S;]ڱc: rUM><4D>h2! # 1NMDkbAŽѝFؖ`Tg2ҹI=)QI%ڧ)WH.iۍ|?XO[>ja?b`h!~;,s!1U+<1~6NjR uUar;{t{ sgR`rbJm7p⇧UdfWKli(ALAקPE_w7mR`e» ft]A?#|k՛,՟Qρ~ /Pz}z@5"]_ _)%d}0oQ>zZHX~MgԽF|6j>cK1Wy~T$"M}-EjnIzD78z. j 3 l㠶G!/(CE0F8uAmsTdW&=_>(RtR FFj]1oniqkunn"{q|f8LTN[Ǩp'oFu}ѰnE â# m$ai.p=|˗cb`.\zpb #a J3/~wF.5i5ςH{co,bR|/)H1 fLњXV$ߕKxS2%:?8' 3g入Y?fq/xT}fqz8 ~N}f\ ˇx]90YU|L"ֲA^0zPgƚv{٣f-@'"̩zLO5lK!?RlF37OY~?{\= /tQ XRۃ]>@ \{5LXdfy [027ۓB{O4sԲh &*"OQ[sGUXba> ^ZB,?jלJ 1qAM-+MAM:Y!bTs&$V;'9~t)yt'`d䤾 h|hğ\ /r@2=`n;D*Ua4 $a&gAtfWX83a G;l`P֯s&P؊WCs^'\aJvN+XX#GOٝ%t*2a;XOzkF _2U"ۺ#=X'? nO]LJrqE ه&NRGF^dpK~C";H+%h@4atd^? U- &YX:%$2[Eiya\gЬr32g~DWZ UR\[$PzoVCAx s)ݓ“oqz&m䫡AV"TZkPU׀zt7T)O~_JC#B⽚D {ۈ uY2aY2x42 y,qFٷU*xܢѢ5F0I@k&0ħphx8mJx)lVįImE0_}}$^~h Ȟ>uـx.nBُNhu.3؈[K?htkEp6b/w7ԧ XnEUb]wP_? ~)3 W aHSw>iMQOn?˄Zzߖ| xR5a@:#6ϝysULJ@fRfkzo8b\>Aﭸf}ͪ dPjp#!lƀM=Ԍbݷwпo̩=;A6\[3:c#͏Q{pf(B _:5abuc\1͗G}a'&}].cLQ|)z֪5^:Xߗ} _`p ~qߵ eX`u?:V\@^o0A}R:KÊB%v=l.4-2Wec8%cWinS x]!?!,]f M#7aDZ8\37UEic YOb Aw-2 bBH/9WJfn)3Xy _oJP~XQ 9\̫[@>'6/n[i=+eG|J蹜gVY4?2;ܨAyL,^Np1zQ; (!3 leA#lWswe)/a<~6sbW^{{&);q-˕?zF>v=atQib88AM4~-birbWZ};%LrF51윕Pt{a#0 ˂ 'O`L4\eaL:0 Ѽ]1׈BY!S<Ϗ0G& 'Xq7|rг}lw%UZDn<v ee\jp?םT1\d8.6h>yCC3{`M췅b|{R !nIܢ7/wyXFcJ.>^W6-0]fp%A˺fq- <S;vRh#M _//A<:/> Q(u7k/ˆR?xQnXyC63~ أKs +ؼyt(x1[J"Hm&^Cţ#63[<p@n#uMXty=PSc8aBMs>N:z  a(7+{F]ͧB4ZƳB70-!H5U\;Je&z>G6pscpKT1.Nd)aҟj:^;ǾZF}oē EipnU[4ζ(]î_hĪQ$1sM<|}ϿizQ)IJY66x)}/h [2z[m`eM0 #]SQ$Gf[9uknaj02yE @{#Rm;*F~5` /j|o-d/V)׍U43KȢg WEs`%VhQT^/Fwyv  Fu}n˨ÎƷ'`BӖg '>M Dީx׌rxKw }44_/ %pvߌ4op5*`V* 1Y@,gC;+8 0=/dx (,1 1J@N]z‹[;Òk7D2\31><6yka]0=ؖ8~bbj6 qakw W)lC9/03xx|m")ΏV4n8cPxyu1DzeF~e@1c,:n폣)qK0m1y^XYyuV#}DF3KP&hsKl rFq I vi@(wL7atw #0Ft)$%gaR$%b7*V?Ja"!KFR9;aMM _=1a2KԌV=nR=/IAX;r3ƬHN,l^W݋FEҕ `Q |m\T_py u[׆#YJQ%ùqa~7VUW MPc7)dW%7N8a~\3ضQIN}Eïǖ ? b7'ڑgaK@).`yǍ`Mί_P{DUM 6=)U$od/L͹Ǥ'$,ӷ,e?Lho. .~"W$p#>9_M]}$;jB~aHa} X=G=mb$lZmQT]-fb#"n!] p"{G<`tW>m<vN8NJNhyHP朼7xބg/0zwvaBm? !aWe>)׎ ks7%;"dŰBl F(Joa-%}Ϻ_LL̗ل_\ya!Ea c|TuOjd`yR^X-` H=Uu6KNin#/>t)=T]m"#MțF@>jӄ@И&2ne^06[-agm~kAy=>Ltf~b P> SЈHX-t+L Է3z>Ur(XC/}/gb nޓ=%1{j`|fx'v.~ ot[_SaIa4_Tl ZwCa\s,)F?Q*#1ykԧ͓D)\F#[֍fߍug`a\y%lSsF)NU[镶\ v0g4vx #\_T&.D;3ؖU[#+lY9-ΐ˥vO"(6RvP~Iֽv06BOvGOÆm;*N8Jӏxeb> X8rH D\f3VUMŌct6p ڴrc̈0;)ry' Ypj4RM24"IA]bn ȱϢ~,JL85NK5Wgv^+ĉj-pol0}] Pw<!J$ٕE $(%d%Dd䖽{9u;ߟu_z>s\ZQ͡ 9TM!e[ `6n #t$V~c쀜lf޿8W T4R:I jX-,ź?YFYR < Sz8 ~=,e^8YÚ9,N+LpvᅾUZE@6,W 3>ŒyWMCc jgkު׻alCeo|; EϤӓaou60ջv/S?5ۭ$%7DsQd]v?²عn_j qu$p;cv͙pO[X 1{-c Auv#ܢOb{z ċp9X,GlחX$t2Hg+/t\PV[nP~hV˯ۨ2J>'bߟ <wۡ@l ;>d\Rhe D{_Csiٻĝ?u('cU0ݲhk,F֗ꊟ 0Ư0t ?Ӝ74aef3b{ Bg3l=~Իªb@cLlvGNZDoĜ84c 7w澱E4?%1Al0aU&=~z$g}`텵g+ \ՙ8Ò9-=lPU/Mc4qqnfq9>ZwGf>,̄{|+2lLPk%k}rj-`#6xm,X|os1PNAOͥXFĨX~z* M~Ztvk~^7@VcoOc_>bNYDX:}.:dd%G%/8qcO::_Mk5~Cעr|4o~06$I<[GҨws?;}8V= BT]/ K^ؠê5Ϸa|Lx]Eb:>=֋O=R^x~^_~4e7G/C)Ks`(6 ⭹Ïu%uÊnyQ8f2E6Gh֒wȵ7۪*f+q,0YHÆ V8wk?#.oi="E 9/pErq++:^)\=qluM* j)Wie49< mj==_ZޓrٙӈfM n_FUZ1X^9sL:hFD#ȅL0i_U1bt@*`#aY̥X2vj^UOՒpڰ{|;C)?1z0{/F_[ցص=@A[;ևF_AJFo05 7} "3asi 3=o#d2t4UHfS0O-\a)g/X{W1(.#LY1Kw_ѽYWGiDEMnxvp,'^QGtGQ s#9P1XQX4 F?DZb fA;~".Ɖlõ*ZRB AՠcorОXb?bk"BQL9̹hL>A/g 5CځcvW{47AKjIH+ɿJLLutzx+S9L}&+ԋS"< 0T,3`)ڝ/X!?}a}'st!/aa\(L喙 D Lᣠ@ɏj4O]Vֲtg4:z$7Az9[0q蚫=)L%G&,XGt)Mj>V6gd?&bG]X3 6͸ig%0ι&Xy4yz|ƛ.k Fr~M! T:vbm^ \N!)7x~Ӭ+O"%57cVO ÙU3KOhXzZW?h%=kcɢȬ::??1o֚@N_AXA[IH[P тcrJs ݞiu}m5unϰ!5z!˽@zW>vm &1g8^lTB>"T w8 }b=">J_0“K|>4EOaWYUVoi}pJܦo"m9 FΉv>ocQDk!_Cda ړ04&υ_o2 s5A )uIz0w7u,fKξdAx+ras22z$S Fm`+u+Php_Cnv~ WG ;ϛB/>G4G`ME1_Ct: |7Y6q0Un#ohpw}a;#{==a~bgU2=\6-ذ nmź@a $ bb #.1>|hg-ʍݡc֭ռa]o:9 2i #H, ^^aD95݇$iSʵt v2=&J`UܥOךs*r8 T}}}z%]3W,8pRſj`:>HO{/yG"Lx6u/ F6\܃4M0[c]W}aE}l4H|[G;ėnVgn0f#k zĜv|/p/ [lƪmpC7KeP,h S|D~% L+-IނЙ"L4 :~V|5@ͣNfY{jn2̒8X\]HvýPl[z+B݌ ;k{jhY%TӌSrPR7-dªK=+^[½d/ 60q"zowXk;h)"IKvZMb]ܢJ`e%Ϭ:H:R_lgX‚ֶ^,Sԛbm5irV+ -" vGx]#w_=@r."q 7GdħMN7ΖTo}bs!7b~ut6C6`, L,̅0fmJՋn]>&TJ6!T I7RXOLh8 dDȽ1 wFIa˒xU6$kRǀ\҆K FUu2\$#T-c_|"6D*ގM aRH wLvs˙ۼLD8HSxu[*c 5ϰ}c=ASJɁ&8iX G;@Wgf3Exa+Вqr,YZEaP"cXU9)sQ&K<@*)'$[oL9 !^}1]hD֕rˬГ/lPkXw{-܇al*<.KBN}Du-`Y9+VS2Nf!oa›0;(ګyLfaag,ֻY.:X4b2=5 9C$XyU @4ayp)Vbmx cm*6v];Wf7NQXJĩ>Gw>ʉe@ =q~US>N:4.1uǹ>u`\4,EB¶pZZwtWW龎bߛ=^f('=5G^ ާض=٩}aFB&l>A/=G>/?K]KO(o^ŶTiKtu!Xi7bq|uKGt7tBt澆5ϧ6"JlYtǕ9ہXHj}ѐ&`y|w~oq!u6OKrYJleB8/FϿZî*& &' &Z PKNlp].#!LÉkuXCTmskeRi͝RXu{3;PN(-I9^KD<9جLzbac{4VAP1lFVM~ř"Y}݃(| &\[c{T1? 7EWjiE5D>UGRB#mI|x uGhjRؑU^ܯ5AUޮO/Xt.4bKsT-FgzNM.L;Uӕ-X"~ xLkb1jўKGX=;E;,4];rz9?LM;ߊIi0;,H<׼0sk] -YӚ"?|/pogonqs[XuyU4~VaxoSL✂` Ѷ&z'ӧ6Gr+|H;$-i_=5%ae>;0޹֛ V+OA%%?ّK "|ճC8X*(2bFx75JƈR-1_A( %5ǧXI&Q 2̷vRl;xTz%~l C"0Eܰ{C|Il_Rj3B_OeC!l[w !Չ-Â#r&~D#VcR| I~ѠffO) YL 'P&=GN}'>p(;.2R(}q=}) ;m;ar.-z6J4 4.)tf ώ_Co562G٠WyAf"l+]@yo_⹦ LNZ-@u=g7EY鍼g L]~|sI`֗]kp_ka*[ƴSЀpï615|kJ )5Jm # Ng[![ɓ69e!iu핀*VA ڪSEL=S*-8נz5D:: &+kh$ lS}Bu=)b-g⮹݋Yht+^X'wX O#nOa8|c%FGRUa:@\\ to+bҺ#/qTɓ^4¼>srsJI!n0Oxd5w .*"wf.qe˓m;'vzo.׆l3uGxa >C@ue> w/ю,m}l,;5t|:~{sfXAzy'ko oU܊cD} λ-_A I8FTp>bS5V7%-kM|·\2XYfMǰV+ɛ0ڿtmXV1ȁ53CO43l~CS|e*gxdxDe1=y0N2‚)|@ni + Oa'p+p{:(gsXGM0 sA{շ?"J|WRVsr!ҽKÈMgfX/7 CQ)t/Ԝ$fj^/\Vr["7|&?(3Bs_N'tXwl, ^vR~6JyRwb^XS2/G+B^r0{jA-=1qIZ Êƽ}il;h5KuAn5fW-6^aY|oHf#gw>6hf-=zͶ1SW4/Z8a +a`ߛ9 6?_1_Y׮i9X( ;'nh-FmRG)MI0t5]V>5gg ͗mJvԛf{6*1H#BÏ@ 12z_@n{Aulbb5߬i˯ˎ0~@!19߃? H4j46ˋװQt`h66ܔ_Be7-o3-V`$jO+N'a/?s[+rNHc[IS%&02Mаt0cʦQYd,C\aKY,,dg`c}cZG-KZq,Ytd?m!/TvD`dX "gx||ي4lhKW=tz&HA'`J7~=zԊrj耘dX -P6=sO0sQL93Ab|:X++*v>}Ld_orO?a#핉2L)d fkͱᰌE:+y.̤7aeTC@oOwbH-x=Ε;B{B[cpМϑEl^ZP[?X8p+Nbp[y☏"Vy/YvQkFp,zR au=띺n F|0 ^²+5`­݇ |f=S0r0e' zLsSSHc֥a8M }5lkMyU `'VFh龆 N;w UTec+H/?qx'Q=FﳰȄnUM]8ʏVXI=S, -0cgtKM^_G~bV#/xO:Mk*rU#`~DT kC1֡wleB4ɭ;\u]6R) XwdSIuz E!xQ/evD*Y`|☽69 vjnl4/oC桫?k(ћzݞoai+wX6a)kUيeNXUL/ϓm/oªjˊRXqa w6 ƍi(\Jðfv\-LOa%O|rAEy8ּ^l]C7u杅6KDs /]R67p&a?Lo鏯K [30N۴[!VQܶvs'|eTH{ieICa#ú{k'W0=Oȡz$G%~3e=nCVOa}nك`42vߝ]޿- kׇD07/Nֱ蚫#lm _U؄Dݛ0^2\Ჷ \`HF b&bkԁU6J=SL5aKc'8c7 WS[=c' #~_WVŧ[^TSO%v :1wDL+ r=txu , {jg0mEY4=RTd1)ݕ~X'.k@@:eذoF="tݲ bP0;|o-jV\akT&S1/CVajuPO:::f6r">yL-LEޛI mb<hVd#0s&= '["܇L*:սu<nm5S_S`,ɠ 6̴  Cɩ6<ǩ\ˁSrnv!u@ډS0ں?bSD 7'Oq]2 < ׆@9 ;> RdP ±,& ?꛿e=fĠ/Ιj0~ڧ@XJZmDJ1b(ё 7 º„{%KY#8zL[5D| oy9~)#,9cJBGh]"k }o /aS_߉H,Q׍ʓnŽaoĒ=6}%J:r`Fv(#ЯΩ eG*˵;99kmysl`7& }E C4gzomA֠ao+r%=,/(B_TNl>R ;`}>VQd]?l=vѯm³j$j.L!nBX.[1?bt6]ǣgȨDu#d}}, !!vl=Qvv;5}V||n9'>}&3>?P%u; V,~e~R-ؔq-IX ʦ ;&Va5LQ-ѸȈ.U*M!8wO|jWBg<>Ps@&G [/9#$5"+;|@@T a.K.ٷ!O_"ų܈)&AC,b,=,uNˆw2,Mk|õF!0b 1 }#up?By+/+DV>zjBM2tW dA5M7$`E|!X0x^4vVVY]­;_–pK;8 H׍hR}|J/60S2`Z r?/ۄf 9Z0lߍ %.p F[;>mvZOٰYhm:>sz3eL6ѭ'u%ʇg7dn)@>ymD#p!Z(P\|&QDg|@#,?z{N^WݐH/oCGO!.1 Kbl]9; sw8·$cyRut-ZrIN&9˻V3y&?'_%*;or4 )d7' IMkC>vf엘[[Q -h鉅cLjK]1V@.uGfŽJ` ~<[k #TG}@ll {)WuLA%|L@SCpx)bX WR)܂eKiC2X;Xj9.#h9 _W(w9j`˱e;}A " `M pYXu%F:, a8 Xjf{r7߫/٦= #iJOM0w7l "ڀ?9챍F-sίϏ68 6`Q01Y]?ֆB-OCٻ/dum}% zio;-ľ$s@S8,W?hצ4 y/|p Ltz j\r9,}@aIn_5rUE`f\N9wxMmNNvYFfr`6smq !-;OMSt].,bp3@x#c 5_2{nyIλZhd`آSt`:SPZ]^~ںk3=נ :1H{q_t`4c:NZQWd 6Jv(htU"ôRoA[nB L:3/pf2ů}hRld C `,տYY{:v$2 S2xNlIܷz \tAloG,E1([bӯ-s)%VΚ];7[~I/cO(6V|F8mVc(4/1ťqk6 G:mlIǞCƱW (WCtvmi_cZb+/Ik\MlL4#ydwpX9r|>}}I7FKPt9ѷߣ~ \OæǫT~ܪv=*,؊_@ͪPr ,$ g@__Wl}Q|XyR8k%SlelgZv9LqwQ AYP U6ـ)!=ðs;tqd)I`X Q QCnb^.f cFtaNiȝr'V{ʡa)vE)6;8}VF]u.f[vX|caV0[ˇ>u4$f˚IaM9](9< P&_>iOJSI&ˑKbE=<`}Z^)IҚN,EyhJC+0i>?s+# gvOºW?1dm F)E[7V4L |YhZ"|U,PQ { 6զy7>PSjgXަ}O+hH/e-*T.}#Zֺ^< SsE?l T0} ]2TAz1b>EQl2{9'1ʂiz>^=y~E]ҁs@ >xҰ7F1{^<>pOS̓zz4,񣁥WRX8K,Fк!iHuO#6,E3 $.nHfxpI-f9YOC"cn,c+MMRSJi߯[,/RZ? ig'"%jc?yT}?*Kaa)'V TwC{О_|0V9{ G#b}J-!=E'zҩU0N}!V^xP6 sĿGNNUcmD;+a~ktL@+Ga*PyCϽS=yЌUmٚ'"?J2T^m~PhL_D9}jbWG4$\9_jsMr0w9 ʉ}]W驕.I =yݿ-Fņ7,[@[˯Ȓar~!-qoiAx¦A2{lS&x ;؇Ӓ}Z]c8~Ye:9Fhaǩd) .rk+%y3X+.Ǟ]DkszV.lrC=-I5.oeϲ_BW: HjXs<.Aav. ف 6xS&1ú.ÿt;&0c;hmmSS*m> zj3o3>oW ~!Xvz`Hj?tyEIX\zK1ڄDf˒"?aScOpezh|smzj;y&G!S0<#&|3֎/Ѥz̮RaĬu=¤€h߭v 1wۺ8sˠ=P;8!3#V Nȇ%"| DSZr=%jiRE@H8nfdM^saJGLܥV~xbtpR1^Vyah|e2pW9 sդ\`ٟߧ-+#W*ˆaʹکra̰#E*WSg,m}#}9wɞ +ykwr|Q^u*_}]>t5϶s}LJpnOjpeUtr;Lb`ᰅզn\'h|6ݘ*$O,X-b ğx\ղx3N :LJ)T 3EC Jma\j nQaźJ^IKw#A3bs=6ʝ}˞ڧ]fz0?uˈ?ύcVX`dGm,y4^σ>pa>qv!ƿ[7J+*L]Ƚz*0/#ꅅaJ;Ғ%.SדpiЙ|53 1(E, [F Rƅ0ny?l )RB`⸅F-LWZΆ/و/7?fm-i7Z [MEب ьO&oV@y-00>TVNw`~ɻ㭰#IQ2hR6S)\@y"+?< > t25 u@)3rY_$o!l]+~#Rk~(V aD*+7H+eg-TNhzLa^JV':E \r\~1ay!W)+yԤ->Y5ܽZ)Ս i k%bB*M0#O !XGoab,NW@< dl{,E8 -ea㬕GIlPJ51sߏn(c,|I튥+ cb0/+M*WWcz\JهsvߒC !Dw9qXY{y!`1y"/!1<>IXOΡ#!&x@1h¯3W1ɠV >0a ?.JÎص5y0_` }S[h?ƃ^2g(6hXR.C,]4A1]MX!/ڞtP3LL0򼁱/% D`4)G vX _S5p8gM5K^Q#qZ??ua)iUISK6_5HOX-&X SIsc>R%aEIYڽ`+ᴔ=pkj۫v{WB1 !CfaWv.s v^dRF} S$냷`&7g{& b:B"z^1腎&f-*;ɇycq/Hklxబ]9 3}ꥋsp~DžFfVg$ަ~mw\BevvU7< E{b۱, /陨} Nna9cK9ka6 +9n =koIbMT."T2 IV;7E Җw ),3gatV}FTKB(??P4ZUͮIt?L<- ݀aZyi°aS%lym*E3ܱ!PMədxɢp9_9\!OLr89$dBp6n*Qy_, nꇡQ0FHNe5b(\Эx~ÖLG07w&qSbO3;'c6|5#yrx}kk6̡72p!$6O. JOf/+9n/Qw"4Fhqpr+ j9D$¸]{d2AA JtjMSޜ}KlWÖN-?EaaHn=`5%0Rwy n+4S?x pv)vF]kClš08vJ)b)0},%ފ yܮ|>-f;J:X>Ua@VD}D lJ`gÎ'P UQT˸&&OaUjMT/l.~f$|GK`ix{E>tk]M݄u=7g;ew;,ʍI#j%C4|u`ddA*qk(npSnoi:u9?":܃_0w7%!0uw3),gaX -lׅ7u>Й}*S3DD0C c6P.ޡmU~_o+OkBS\^ԏÎeM,/bX?}}*0129ˏc)':rpaQ%?Jp&SRŗ2B.Jymw҈Yo{$G5[U*k2~sD6v5YX#@P! }չ;њ& ;+* SRq<[^~炝GgTaUm.mDa X٫͢L^ *9GO2"4 rŭ@>Ljr`mk]'XHĎfD8uvV~o,4;6|["`٥^h#>>甄8Uw? ʥJK@u,vsKff?俚>ɈSX $LZ+xbb_Z>bxN+1 {7_Y+YƦLʯ BreÎ쇳޷M?a_@0P: Db#^ס/8̣,o&g=.m5O F7Mdc;2MAbAՁSbq?ҟ zyV!-Bc3F £T54*9KshSߌ 瓈O`[{FOlzxX)];x0"xC/ =b%#?mwALlV"r'DC+oXDѬL!'3UaA 'fFzUY ''wBb9 6$x{gɰuwƘoiµo ZWo8xtA2ͳ"k׼RmM&7IJo'\gpuq!.v2ݾ5h1QC+Ra}ƥ]g厄`{ŐNGye7`XM{vźejSVCs un9)u ?`M@^(t@8!l'aدBr:q{ KĨpr%ԨPFw ^|]x (-WK;Sw>촪 J߇ݑI7o:6yw~aLJp^(꺎d!Z^3B@ jW3B}N֯Zў_b$52qoBd#yp86h.GX \acm{٨NO̡7DE"\"YGVmOe`SBɰ2_G3;aDp6[ 5X16Ta5y|4Lg780GŅ@ln7Fxy`fY7ltpa#N4N_&CJi@n6,='zXjL&·3(tDݶ LQ}]111g%=8_VdAɛL*g #zY9I0PbFd 3`x^~ZarfApʛ |xg⿅"FmXaccGI jykE hQ(L5?e/*_&vpPv(妁$*n:ƿVc%'+ w2-Q$9_;ˀ{—{_P-‡-$qސ7:\/vh#wn2<?lk#iv!ndØ ؍|QHv7&S0nw Y /VLͫNFN'r2{&U%PWUp5 ~I1繝MX=QK? _eyoVCLwյԠ~(\khI{'Q1ʡ)<[4s:^|o[!$.XNp$&BIq}u+ &6|quʨ{ywF h )[M+C?1R9 f Nݺ Gqb\: ty)?bA 4CMsV.Q0Մ+1r r aXf#'L`d?N%}l*Cx {Lpaw·8 DۣIa /ėbukDaPbMh˖72 "+?s&k1'`Wk99!\PvFK^5xE:^O5L9dQG9w q5g#]9?lT4 hxZ/H\ D9Qt'ow-g#b≰~J1O uOn V`dE%]k*K^.']O56U$G1\:onͶtǎ#Ֆ߃oƳ<iqMϞ밎־aƬw7:'?zFqGjFH7ׇo;|`-oIrM7%%B6/`CXflb[iprkq0X>, t=n ^N!<.}:o2#|ÍsN,u#j 7w$$@۾-o0­eN }fUDc# lW2lz DNŸϠæa{ޗ[XJ(Lwo_qZjD_ep`d"S|;V\d2ڞs *~*E%̲ݩ gh|9+F?={"~1Kr;c.3lD| @z/~@84 sqHU@875,O` svo zCȌ׭`,pG HSO3GlȰ3P-_}Htك^,_*֦%뱽"梙tԶZ}u[l$|LfUD)CF*:K&u_k6Q{/@8_)&s `nmuN]~Tjv q]"c-%d40c5Z~7T+,:kzfi :wW)("}Ί.zuH9<=qH+Ofe^iTʧroBX}1K<tgS{7P,#m,'.Zqo_j\WlKj/>+}/_ыhGNC`)Hg-M:^i XaتJ|O@GH%; 5nb|Gǭia]C\SXu߅ -×pn!0ƞDC9Wa|wcfhrq2(lұXy-,)F|@~9S>Dʋ?zK"tJ"QRjs]l cϭ">)kvy(C՗2s7%$*5hpf=4{N _8Db{MGT/R#2{HZ"ޘ[Y'9L0yr7L7;މ>l9Oqە:yl%qҖO)*@!_{l 9RzlHn̜gF+Kb-yra<Ɂ/SACOl96}AΤ1kɓ10rnk +KsR0::x|2~BG~bJϹ5 ;JKs^!v<>Vp%a|_# 5tF47Bo8`eV׺hCTDLmd s}&basL`QU e`ţSb x}} (J{h]aÞؗ vuCM>褬;%a~_ $G⇒`"_byyp`>ob 0A}Lw_'=ʰ:טw":kPȇlCliGaYM'VD!NDq"4:v :P=5ebu,lbur{^ ("4~ʓ*<ފ{uGTK+[̊9NCҵcT5;-fgZ1gx b)ͻGx^ w[֓1XV,z&c#~S!'a0*.3}Ȉxv2/ z~B$Ȉ]oXgp &Z HQP?WYbH ݰr8-k4?C&- 8c̯!<ܳ ] w2Ա7s%RRUq%O>-u6UƱ ZXOCQǝ͢mP?RŞSL5lg.XoV26:nz8Tk6u8q ;1:xx' VFل9hjGÍT. ܍dM߳@=&ƜP v& }oeg?dY.wye ǼaJ)7юrmsVSV1_(& CKm2-I ~tfPil&Mݦ?,K!:w^eZIaM#=3?#fG?vX3X {L 6/|HO ]5meXdws8fl~Zgr"4zY)ɶ;sHlG^]X6|<z/pbn6 A: ZxJgÈ:-g x· efub,(,Mx! 麷V߀<4ӅYqaQMꥍ=RN @hFtgldCSYܱDX=\o4ۗnU=b9,]ԜSʊW==ͱI6w}'}YΒ@ѧ C4F%V?/-?ֶ'ūʋo6Hu2B qf'f4nl0M~/ښڏ*.ARhg@󑨘ۦ1K@{YDWChf.LbW'6Z1QvX3 cc>\;c,4wR z&qAz!{8TvBhš\`4얛Rb -pWǎŽc9L|: ZACOߛ}F$+mOrayԷ;a]{<0,>@ [gi`d6VnU;+_NwDxvE3g0?lZ#06:-E_ FuUa;5=w{'`) ;5msIsdz0DkCzTu%ML:_~4L~;CK1&7Bv:]-k70͖!|h_ØdűP9oq}Ĺ' TmU#X偏z@ ?BT/R90e>ZwهSE8wAG**#QZa_o]]ÜŧPI/.eqC?QS V>C4KtdZO9 TZOp㩨Tfz =&CO%@ lG_1ҋcXS9 GtA؈٦nh^99#_&,H.͇ͩ}\пݩ[κ3/6R @9ya K0Hfa"VթxRm@dO'-!c/Dazx8+6Y?DA7ֽߵGAٰ/BK@dDI1?x[(}A1X9$F gݦز)imCDu׎vV թe ?_:9QQ>Mh9Czv$ [މ>9o~@rȈœ]EܳGV w%`s_Gwᓵ0x`q5zoq 㺏 =Gl#X>x ڮWrE`Wz!Vz%q ,[sB@QG)SDj~Ǿ̱Z(Y&b36mǙڗ@pu:dm?˺%' x{jXi/R+6&oR%{WQJ iDNM<8uTW:;¢`{gB+#btʉ~[NXb9˷rJ@t\A^\r ZFPy׿ĝ̩hg 5l.!} heU,d&5avX>woXO GdB۫@9j${9ㆈGOll]us7^kض&.7 &j''V!p-Yx,blI_r]&G8xaE;C/Ӥރx0* u %&`=ި0R2@1j ϙӅEgϢaBB,Ign QcGrb޲|@}wt`lG7_(sW _y6q}7L邯_9^⹋Tnrh$R/nQ׹#}Q{flFY)G>Ct!>/Ck0[!_lMYDNP | Ъ#DwGG4]6Q%182c? zVϪvqG6Pf:7^; 0QsIU5i] +Jѱ40bVȬOarc~wDOWLM)6*c薔FR\!))QjN1\a.9fG}`!]s)yPӴ(~~0S* fԠ2:mc+M,l:p^uE_0uZ3bV"P׏sFxnTN8Sr9ꚁ?i{&jdmBgw $r!oύ@>6GqT^Fg}u \g/;nb:b~r/G`WBl2,f">)ky9l~~'c=G8,bxZVr^yʿԫ^@;O^~/L?x g {(ڪa4 GⳫ~!&%EQ={UtMvFVM"Ro\5Gݣ0{ /LΓRXMx g-#zo&@KSӈ,XZ黦U7"}WK?m}#ړ{,m`ǃÏ8`nhH7*MʃFyZht„%bYT ӳF=퓼!Ϧa]|N!,;9詯BER/ҩ cN.,ˉfZD~K퇓m0-k=Y)+? lȴ0ޔu1?H J)КL|γ$ glܴ%a//ct~JhgyUM6^z -㊅6k4*W*-ؠքja;%6ekZ=9-ϵB_t˦2L2=ׇ G;^#50+'OLKhöD_E%a%Ss`ưq- 8uЮCnqD,Rqv!2(M HDǪ@JB]7R!vxfia뫀r+'xCִe+<ŶmSҕ-.^6{h_aS 0[U%GlY!z"QP0 KzqyA}L/ +e5Ff>K?'m.?æ:܆QI^4H2PB'{RHĈ/n֨S=T oJwJ[}d;(=q&H/]6{nmpvǡ0R;> ʡ]YON+ TBm u,IɦS\k7A/Uoo,2LXn}I͸yLGb^k (R0ٶ+"2%$ah)A~Xom–mԧGwA$1)=|7l7ݫ=g?v Ȍ ]*1,T;0q=y+)fs9:`nKB[aʨVbs8VDѯ[0&Pǖ 2Mk0tcP(jGn {Ol@2aē8p,Jb GTtX!l߭.1P .7{yFG6uuA-*m:u&S#zn}_zj{*ÀM r︊6Kju~\K qXCOb:tl1,`څ4V;'z< l25Hk.k>kp0}a#B,8S`gD)ޕ&=7Ӽ`-ݔS _bU( :.Z346e:*p˿fijt:1&yR`]ٺ/a߆ޒ;]|2>?57Ɓ!ߊLb46wn-w p*Q\4XK }9ܥS`d1[@Mt{Q$|6=nK/!uy,|3nYB}B8d4=4a?OՇLiѓ{f{ļ4}v'F0% lO7`ճ;yI;˩9@ +4g +ۅ|aha wrGl zYXOir"@!#݃a-$N]$5 aܹq&YX V1[y2C5Yg^Zo}/Ei:cͷw^[ڿ.Sx PrhzLlYlyF̄2`up< %8 eOO4tjl /^ߝT\Swث0v~a")ݮ-(mϣ5fa. ȃ߮}jQW*`MR Ly+?Ʉ7p:lf.G]?3a#U{G=VIӝp)h?ƞKfDղ6/E[f+ 1C[ Sx/;gvݲo@D?q q (m5t[0L||. K|4CoH_t_.G,zy?%ʁ\kw98O/3c&@3q[UסnJP,WXH;kKD󖟕4T֒yVYxLkY*?t')!_E. [uuљne4c > `Ɲ eFq}Y3M{!]0_ѺKNu0q9$#0N2mz$tJyQ >x`!_X*?5c5 Xmvc-msJKym"zGtPZ|`b=L6DqdH\[wQ<:*. 2 3TRLV63bmpo15]*RXߗT`o&@8 %Fc :|ur ^;a. ,#:`ǗA'CDzZʞqI>yNeIȫhG_v~rF4ϾjXQak.[=ư* ϾPa7m= 늁;uX\ VAѻ@;z,p:uy ޣ@g y~,W-paХZq;s,]̧C^(Oz[u x;0ǘsʟp Boе0XP(k ?o^#كn8WSg[ p,y7ij`8[h@^祎MCo-p#KŸPGӎ%3gF;sOxY&4xzڗ Uug? dpg!96(-@n~Oؠ)8njc~w?GU QU)'BcIyz)>ƚ0|*,~n0qNb;'yޓ[nfPP*۳L(㹓f32XaF%ӯ w;7brNWrdJ{7_XtdÅ5^b8|̎0N!.w0-|C5cxc60Ζ?L^Hw4[qN%N.hj^sMdH]o٥dKJ;gsgnF¿4X?^Ӈuyee9Ss^ ܿxXҕ܂H="miAq޺*=4/{8'eѽ$伪"LjrE^u@),[Cϧ1%IKk&4ۧbǏrEgqGm2IC(dVh*y*i{;+_aj4k٢*:~=96)'`5U?LF0jE#eZtB<  o;;-xs9Ct4 qIuN#w>ߢiu kBM|zc#,3j@z;xx] ϛo;̊),U&}MP 7ƚhL!7 Sߠ72L4h\u ٤~65@lUvX p/ SoR?9<*pSD9}8 Ҡ_pqo eD@ gOݠ쎃@b΋(<ĭׇ }%D! o`^v3e򷁻Hwވ˭灤4,=s X쮔cA91^bF$yAe5x7\= +67s.$J8m]Rٌ:ZM1e {B2Bi0XGIO"&o@{x7c=k,2-#B <-a?ttrh;-a:$U)L(̠!X~梬N\睮`w` {-D׳j+l/W^E3DZpac45ͦ<Ȱ1i3ò PյK1 #•6Y`ɌOX椉"Ȫ&^07k}O*l0w$»t~zr:R|~E6] iDQz1\}"y:{ҳ]PJGϹ'p D C /^ 2Q]1rK""fO1-*RMy\9EF,.5c0CV:$yFW\E1b;$cYz߭(el$!UgsQˆqn4Ç3ߋswAl͌jEOpVcJZ8 SH,wgv+Zy!oaQ62exD] ߟ6OƲ!b؎h# zs1_s;2`M4Dڦj7"g1>9ҹom9a)#9Y_UF qO}xY$hIyOE"b4/?}>Dqɞ0:&9L^/z`!Rzx9hЊ<,z\Ĝq6abۭS!SaDs PY]N !L61T䟆8:#Iie49~@ Ϗɮէ"u[ `Я|q520ONq)83{vvv/7C}_#G Pa'xŤp,~ οӔZ^$9]?H/?"X,+^.ߠLIv wc32aJb^ tNA,d *}~W5n8CR+\ zr3{M4ݰͪrd~)3@e~u +=tjh ք&I>!uP7t Aߥ3lx@2ZIb}XÌA>i7X<y߽ ];PR}E TI;s߬{_|r3:7o krp=b;cvG FHm/!Pʒ6e?/sٹrNI<#"8D:yY jo:\כߵEdAhq!OjLS>k CO +-X;h2/!fݳ#0hj C @['tpټ5\[s\!l,\2~,5_=qN+`hťLQcW%{@owmP+}}k &Ǹcwzܧ#d.<ڜ=o<^~"Ӗ2TwA/}g Vh3?s)ԣ՝g\~xU# ,ʕlYÃNsa./`Y.xqZ) ۮa>4ֱ7]uPWQpC|[늅ZӼ*X#k M!"_X|x*dLn9.,b@>D!5ѪUK:S,+ u4uQ Pdۗ-|6+h2S&Gb&Iڒ6}*u~a@~ W-ULfiy7긶=#:ON'mί ⟽-j'a Ii 7N9ʅ1,SqYT$~|CvDl&˽Ny%`:~SJQ]{΃ː6V;i*&=?ÊrqoH_\jL+(Dq.q&N#c.\% 1'Šk6O [H窶C=zR݉9c] wJzI\3@MSP/j`Um v-?pgvRlGNrfA|]铳b7xO>T?[bra=DHkX7=_X?fd`CӶ aL~Lj]zS0ׯX) nt.eg\t!qȿVhO:= (LyV֭4P?^r] f*9ƥ˫V=>JIooj;:3s rO-s=/RG 8#0 ECϷIaּ `{lt*lLbh…âȓ*K{ VǴ@~kj%&TU{ZR'g~O#2"[~\@9ȿF*[ߛvHf'0avtޏl2{Yi<2P ߸ h^K{Z`eR:TM:UU?n)ua"쑾ouo4Y#&& yimɈeۊdV?62HK ;?yfuD F^oͷӼ9<$VuGM;q:ch:l]srO:]'b˥18HJpFm8J8uF8|(+8Cj&~ʱٮ-ux2ZL-l\!7nk"ci  |$b{@ RL.S<䫔D0yV@ ^ġ]C"TXi6kFvfzkdRR" ֌M`F??t1I~<ſ;Ti*93nl;-+?>*sn#O&VwU{*LuRw*9O0&ĝ. 6fnW=Cc|}&)1+z1:+}cl$|Tj.⊕a)0Poj"m瑚cw2kez1riOu.k: /3T<%]_JA_ô)a:(_*H[ۣ& ^We:k"uTg:&,aӰ2L4 ~y9lрS5#~]R!b..f{m]eʧ| aAd',Z]#O#׫%`ZIuN 8Fm{X{*IGmpީfa6PVoyi!/,Z$b9v6m hf7 -0g| pJ?o~.GV`)R8`B:qOxp!Swp6Τ("Lrݱ SI_ EqZ`PbX9eL5xh[y_zbqPb=[9~& Bן <űhDkyfs,śy5pb"}tqU;ňi"#fxd+뵃sZb0,/fVo J CODk*9iuܪ\ܪ6g!!"@ u45R:́YA60wL/>'ʄܱ52LaV ?ܶf5Hj0lT((DžQN&@NmKr˔ f@EѕίݴSV;nfeJ׸4nә`#y}#ت_\Û0Ɉ}oył̳J[ X?ݕ[N}\0Tt^:U{?ɀ2Ap5KTgy,ax* 淏aDE6WaDnT,FD DӛɇF3ݧ`qeXVscVmXj|$ ڄ=akB~NC">~F Sg>C_c|7<4,A O}D;}_$Ko:iN.zQqZP\>]l0Lq1.#B}A|S GN/JH|EqnzŚ>4qi?UaԴI,&7"kQ<'>Yzȶ7\ۆa;I S6̕Zp"fݱ.XJ2+ d2?AOك$,S`G\KlH/`x6"O`u*D d`qw]MA}{X{m-w3]-aa9ax@,ؾYAPg5$;Ta 1_K kBKDY.s欣{M񩖈nMEP %4` ayߵӦ@9#ޅ27Sx!JP>L'7LE`l.zd3)KIJ8hG+z'{:"=Rt (#-91۸K-dEԶw};8`c*{$? ܅\.; %욏߷9z%pyѢSw5ٜpJ0G_9JS0}" ?H}euz $ x^6ߩ 0r;L`;̄6 ՞=PHyrH59)YbQY4UEP$ͳq!s隇ЖnMG^SZ\7(U:g鐛kWi$T"[[|4s#9Ex'\DF:fepq"cL71/\ylI-` qD#PO3ᰪh_$ ; H!›Lu:[y3dm.3ye5yO W! }:?&*{j$і8];{fyk?|MҿlZt EWüH֐v~;} .̔i+tۙٚ8K(qwmk@q\q9N%}pϱ_>U1YM]D yGG,,/nm11dD}9'J,q?sm :NNs\u82ۣo!e>#Ɔ jt}%[؟y4g|q} ^e2!biXtu~p;T2̦=QnU6ޱ }#B52"ozuqJ 5x{YX =yʙSNl F nilf ΰy4}~%TU, n{OS sR%Ԣax>קDZQ"'Ob9uU[;O!&ֿ(0p.XsMo8*E]\A!GL!Sa$ 5| T?0RL48?|"v[޳RhC(/[ѽx@5\D3G`#w3WU=9qolʬވ/]h.=) E#Y0c`Gtk0̧!F05sځ*,)|Ww@E=W lI0k Ib.j7_tNKu&x8 O{'XM3rR6bݘ^uKLX o{ k+t]pFe]8DJ{z"" w k:x/]'=U>_$V¢'sSf |=8扁/BXAWL)!I>q{hf(ꝃ>B6>go^asUåtIqʋRF\Ɩh췪w| f0RL)W]ONդ .Xr_2݇j{_d ZvgO3I3o⶧}"asj77/ܗT!CdX?\d׌yK+tԜ'G vBd&<)9M3CdaOX~)Ĵ+YRS?TƔW0.LY(c&Y^ؿG'CV\mU-.FAwNG,/rq&QuI]/-{#30?:4üHx'v\c?`ODG3j[M}v=YQ˰ܳDAaQV[$aꤗ@}{)"_$tVANN~02[]K(Ż9xmY&:gʆKP+;9X-qCۤn ##H(Yu9( Hq( Ht:a|ӎ\0OYf^o܅+=gt^t>L=#!bw+78٫#]Rq-]fY>ʳVn'f]l?,ec.ID2"k/Þ؞>=;¨罣3T,&U"cIҾ9<0>]9^|¶%Mg6 Qo [Hif8Rꋴ>]JUy+uV0tZ,F,s`QZQ+x 60`pP\*EgLv<#;nVev5{cԐt=9w>psb$ˆ՛[t. 7xxUN8@tu|Fo,΃s;jhy4c j3VĪTD TX)‚GJ7d`Yҁ/aPVf }/K,@o>YQ;[;NpU${<^ʸU+(y~{㿞 k0sTU>̽LI޿u<@2ߐiߓpp/TZ~@7[!'w][xJn%1bStGD'S0ϑnԼ_ݛCUgMƊ㉯dޓy=a.=jZ;ԷV:/%[#;CF`2᪘]ɰ3 O;T!`24q7*5.ŗY{"XC{XHHAbՂ.P+ #e%{ݺ\J%nE-еc* zlu Sb/&X){jqF U@ȼ =2p>b%oG,%٭g{P}(;8c`;ʖiJ([AD!eޞNfr&ݣPN<=w?zN~|!|nCka)Iee}`W< GQ7oy ~]J [N|g~ ~zxmĘz-隁гP? ._ݦR;Yо4s}0I1E=+{_Nn<[kt@ד+?#V +L>OxXQU&9_G; [*sN}8Oհ҃4xؤ8 3kJeqi@zKQ:m=J^/?# w*@D<# ,D= +j@Gqkc%l?0uNop%)˪3$|-PUb_Ea|Xj,4+zS ^porlɏIsAuw`c\`, @<@᱓y};v!7KalZHIOݧKqIp!V{- +Vv=e0ױa~Vswq~;G2k؝ﰢrFm8\F$i:0d^㷑'b])my%=CXѯ Mr:wn-Wk{=\X2PpS@)i.+d! Z\M@Avy:*qL!Za&-t2uVK^ [7=+/cJlKgORon` u z95чNM-d맶-@ie? ]N]r05#qK6 k?ɚip:LeZmsy.fMQ=H($ 었;L}6ð0mvo_hM`]1 {F^/۪p}uNaR ,`U2}o1Y <χM_`TLܮG[r`ݪ6|<,[I:gL9ᐞwVxc6hh~))QԲsfegμ^YRՈ]N1l } TǮAE|>Mp@حpOl튰x{&QlycRk|_fH_*LNݽ}wq9 \ox`ї<C=Rս_>:s*n94i= jZlzc P}*%:frw!“3BO^С«?,M/FXfŻPh|:EgxcL?X SVc8̂H穅װtڹ!_j&}+-Bo+p.KIoos-?n҅W{-$Yg0زahJ;h^n==b#A9x=]h2 G =uϴ`IvFXZK }HmofLYEW`xb<bLWfn)ˀv0^ޗK o8820g3I@jΙ@ &ޗ``EYDH]΢sAAyFRljz'p?Yۡ0uq";{!*s. $ENٸl z'+|`7@Ք|Nޖq1 hB~ҳ=_Q?pz|zIsM60NĘenհ: xM t\=6T U`ԭώG MǕHnb>77e'$>Bq+0gv񁭈ЩDN;^q ^S%n1͂ 9 0R}S['lR657MZ]`cL?+\/ DqWW}tS# W&WMs_̫70*q(;">!ܺ#J`{fLͽ}8b/ r _\fɰ}iH܂$u9!C8r|2nO: si~3.7sqy:b_sÇw[‰FܲMc%eTN܃k]\/X7kKj> qagkGX?UeOa$ߖaSu0tZ-_׃g44?uP{dQp&=_I^0\[k\ 3ҫzvo6Gu&$[#F?&9y>Q9PhQ l_gϏ1A/T sD/<ީ@k9ۅ0< #%Xƍwb 0~h'T]8R`"ޢ+0g#N(DWż-ۖ u[KA,|@ KKW$^\[tw3, $]{CVm| `M}%\WZ".. 8i  gbBcĬxP,8ӆg?VU!bA$>~ "n)'--yt=o (;e]lq/~Ĩ$ϙ־+'[( y%Ngv\`Z|W<'4xB_e{zI!s4b?bd.>s#2>dI2%y#t0jygNn-H;}bGgQ`w" ؐ6T!n ٕHU^]ϛ걲O6[IE %<Ϟ-.~e-{WNǍwc/:dTdDa3i/%I5˙A|P:z~vӣUҫaG_@]F?7&j 5/LB.KO0] 1YRH'"^2@,k7 [#.Wm>kxqdSqZ/L/z#RrX&o: a.*iD|j kW)!@e#_LS{6ہ|lqt7ܙH6 =_33F})]+O50g*ꆖ0E0XehTh껼<Mh5Q{C{gK(_Ηi~ߋ>=\ .]p^b{'R/Xh~50׺_$L]VJb#ta9 >bɴa@LRr7O-݈^A+}?aC#O"n`VP5fe2;}]k1H U!zF$jҕ)PwF 4ᕏ_S^;1 s?ϧ7n Er 00]_J8̪YqK + aQF2SYr~C;~G45:NyNHWvfަi p/ԞTmUEܳNbn x889ІHi&1^T5E mdD7S%XOlTuJ-rV&nkP&i 3an0|t ff979y2@5 ۣ̓y%΃.5CݺcU>Rսw6n~ݹkiϏ?O+0%!~:vɦHW3<|r}A r7Ff:'aAM&G43f ͚=K曣`SrK%B vsɂ>Xx'I-NWvͥ$kAGNp4mo(ܗ?C@ot5,`c9 i*&:sL+op,}uIXl~TR_zxcMgX qK@)[ROËd׾+yk_yO6bTh5^@0Pۢ-z1lԓ)|z^2\~qX=b` qLTfe ߗ,ٻ͖Qb8L+Ҳ z| |ku^={mw@g"I?=[6aC̐L&O!jM^-zi# Fu: =a٩^ȟNҸ4̉gbwAʇ=ѩWa2IHv{"?^F ]:DXfAS@s-,G !x!?=FA 3s7Mm46W]\<=xύkQL%eBqMI LҮ+9/¶q3_ gơ^j(}JV4 cI迳ߎ]/צ?T3&|γ9&=R0>+:(L!M=Ƕ<jSo?I֗wUO=zl F9w [[Kqedߛ i%~,h e=Rl^/էky%V{C-o)Cj&44PB}B|F:PEG A4M?D9\&O\Z%m5se~xͧ|X`=yg 6|xx/}2'p@pv' 8'(ujrQrDLaA;:Lex fOO+,Gz OsrDJfTe<F"㦇Cuu v4Wt"/ksO_=]|s@i_ᩀxuMڳ!0Bj(@[9m; a?Ke91{ |M264~rzDw{ j8Ø^r>XsZh(;-3\3A ho# Q'G5-% GmG}kwqRqn5]M:O׈(f7`VJv"Lsᵨ՛x sis?a-ekXS}uc m/T#vy'і$ oͺg^K̨E?S*m=ӗJ{+FPqG50)dr]>LavWW@6q̻6>L@; !- ^H~Da{ i53$Թu c2E\q?Aq )y!C 6ʅo#cq} C'T?8cM4(O>kLo{ӞMۛ`p^i-P\*"X:(nF݃{ti+}\-r[H}\߽k& g gCoGKq^}z+S%,lw!S]&1'aID88D xGkfJ$(Sp: \f'0C"+.q-· 9H Cf z>)OG_XBZ}%ЕQgoAȗ{`s'"hvjdӛe Zt {9tnzVfbňo.G"㾷[w\p*w_lWLbG[09ӽ]ƹ>il@A%HkM g 9- ]3uJ l :NBvy@Y99F1@"C 43HI j2%` /]Sya&{Xn+Y(-Y1ô豈aP2{W*V}A7׏)4sN 6JSaÞ bՕy81XXpg0nX٩TU=l&P8\<kuȝ`ƕig~#{R1%4w.,U]qNj4eY b3 Cmk0\,m_-1 T+8`;;(noj\#V n,,@)^= U=yY駍PnżzOfhwB b9Vτ+`jtNUCcTdR0eL⍸.ǨOzx>7 v9WrL=bčbC ȈYZeϙ!&ܶR.H*cz_~ᵇ[ioβ<]Zr1? b%kBvkpw.ZY9xQ'TnE^?_NX}翆uAq[:b(r'n!Y J+e8Yb))/'o -cח9븦Xzu h)sa<8ROr.m'K>!bc+(=C+-jūpxU9lw}k*B}dǫ!qľ5<6?)d8¿vnV.52kؚ %y Cvj>5 'p[G0 K^U6c //E/,Q 4z8nIy|y?k+UfnoA+Z^UZ;_a- k0,)~rxbP Eu;?;v~)+23|G!{4u`8~2 ."lrGbXJYYeh=OXr(\A|&xPxI(bJ:{4 'z\6\QR0E}, 1?|7,a-xɉ7,-[mGoesU# U{8vG21 KkG=9{eQ>Bl%ǗWگ{UPg% =~7d\ aZF<{yu*S>y`9FhΒ:G`9Q7yc4o$DTWؑdsM l>*;ZVs~~쨗Kz qi[&΢+x`m{ z_qKVT]x*!Ts{}?Ea;ó s;;ꕡt}߂S8ܸTӗ(1H cn>M-+ 1JJŰNKj\;c &0\oo港UV k30#o C]5ӖM}xB]qWv|tH: i7@ ۶_Qi=.{>*@k °(]μkMwY_M#?2? :0JF [~:D-FFV2_pߘIu-%t^RuU1FBb X7{7CƆ'7`51>R~RϦ$и]]_u (Ʌ.rfX8.~!nX4wj/>jl[]@ywX n2-Ld't P@5&6׮ &vBaenmF4'^ .{.4!C)NKmc5= :R D3}Mq&ТDü 2Ėpx"F_Z$Sg[<"6P˝Z"p35YLªSIWIS :Ǻ݇h4dK)f%.`CBv|g0 >=Ϲ`y nOX'-a1sɿĠ}@˺cW:t.HLoJRLE55A19/d[-_DN}uTTW*fG;:w_E$萒0d[aa)bo0FLp)"Hxқ4`x́sW`3Pqɒj%^~"(׺GlAwd?rMZSG@ {)}X/vY\FIgU67LhGsćX2 "NߑGEM}'O00abw16=  tw) _uRЖ'uCҳ{`߾xjJ\<<)Tۖ ڍ:rn2lw>XQAT)?C-VC% ;.pR 1U?͹/w@¡"v1!t!LZ]_sr|[ 5"aj_rVܴ @bDḶ] uRN.Xx} lc"FJ0,y)䅐W!U("4E1V0fםݞX,8l9ŽHax̹? ]lq_sP|lؚ2 b0ZU@Cq'nK#=`se]ƼFkk> C%vduZ]!n+AD}R܎6u-­/,~sP nX=<.Pk{\uXZ5BhͼGs۝\pԽ׿<iw'g6',|mi o[[#wdm'kC4<˾Tg߆Nw2 Ĵ˳zKV]= ~Q0l9& kmaUp mWG `a3dOz`Önf^^# }$o"Inj6-7>̶ 7Cչtn$V &Bsƙ7Z`Ij=b R&4cI`sv L~y_CW,4GF[!Rnk?G@_">C02ԺO=VDĿWĵn95ش  ]%[;f,jG!*r*b6hM8b4 >9W׀"atfG%e,Cq,'p)w6fs^![SqK9؁[.⁛ᡧ LN`bQR",}R[ #ۿl`.|ApErwC[ПR{S968=Puv}DϳSj~U 5NnF!/6jp:mi=ͱ++R"_#R#B#ѝb[h'OY~ yzBSrH^:b<Z&HN#5gFc )j5Ifnv9 NDMzasrkS~XS ~ VC۶"w߆Wy}E8↦bP53>}a qU*aԾjfFd'fnRI}S 4o.H0W^OyVw$cX%1*<< 7S8G6_zw[S!q7Њr#}sjFלm"W :=}]>WywL~717?{kaGs`T,\ڱB@ͭX_3ݽ+òVE٫>#F 'u049^femR=Ld ?9h<Т$yE#܀DDxk:}VI͐]\Ik8N ÜP.\ƃ'uyabp,9D;.}4AF7fKۗӲ E\u(+@\ow~Fnם`Nrbpeb`ti4 wG]}'4Bifui7,5 _ '?1T @ WF/RJ҅,U8ļ%AGcr_tr\z=? 6=8",i?`"a1\g|>D?CRuai._at'}'~1+y,s#*{ l۾|wDعIWMTs6}J_T1`k)BwxT.A %vf(Z14b.HBY? wzhsxcT/*WO;nt?)'ZJBr-a%;;$3j苅{c)iVO+\źP]1{2 _o L3`b'AT_KktS6%;/ڰz g bY6c&{ئ}Ű+tLdgH_/au?/Ҿk'BD8mG}٬dQݬ߄%ZBOnMhOr/Č<+? eyCڑ`5=#X/4_nO|[zp: Rul X?pb9$綵 y5ۚ>c6UfF,:4M~?羶%$TAݎaUQ1^X8y|n6&;n|ZF~ Ih0¤G@B3t 6uq mPl[F:sʍWrqQUe|D,yAzhS?t)tlvLL^y .4D<[ rI&+däM7h d Vd6q\/0W̝05e[ >mg}Ag 6g?7,d s }bEϬCn "xhCˑyw?O2 Bg~gwPr<7Ҕ'} ,(=o =LK(F]t\#VM۩0KΎW^ '}?S' 0-|]"b<-nOU7+MzT|%=ԘDevg5'| &v6*pVR+U3pKAbzT)ZvZ9 A>6 DI.'e?r`oj}U3# *.NXC|}6mqB`=>Hz|I+OL_׀a'x[@ۗ_35X |ʱy\mO/wSU Tl}yk9&z,Y9T߿^##cڶV'buP'HCrbě=0w1yoiQh*V9r7c6ֶhnn܃}TX ۟1K*B99Ɔ&0o9C~\~#җEDcqdd"R SVjs֍SgFI ]s٫604&C1 ȹ%[Ā")XU*47=}|x ˘Z)^Rŕ]k 9mwCbjkhw%% w Y_W8sWݚ r@-uϯ<4oXN+@ټa05Djɜ}%ʹR^#5z/_C'"81On* nL'ս,~QPj<^{@=!*iK)0ݠd Wnzow+.^r]xcG*;}+ӭq4I&_SPcKuw*H$ȼ1a?KϻCu,qMO?-.~'qMGp ~ttwcۜ`֚,6,㊬k[R/⛬2z/ *hn0K;.>D6 ]$^v̖6u 9n˄Cšo7DÜow]z*C c^h5<7'rTaNaVĔv g+"n'u@=}aS0(=y /r L(*|Dؒ'޸;HB A Ǡ|Hpu e,?!h|#jHmіhX?Tn=>J]\qz&EYl?5+>LLemxhk31ø5^xd@?0A Ato;YK7׆zrTy+٦0,|]cl {۹D,vH[uD̵U!lXW:ۓxMi4)60[e zaͷsq[P҅!߇o S7VtR:3ݐya4di\ ぃY'CvC_ XwXΚ``X~+҅vdgmfsGN_Gu &a2H8"5ǟM眙+U{UPfa`ыmUb̘| k!?y?] x3Η"uX4P¤Ɠsex \ ED:(O'̮RSmyp3:~b؆T#qQ0rSi(uS]_'P:Gy;*>_> *OQ!%,TY0/}ck)Jl-r6G2Dqǯ}[`-^e T&b؜va/n<=oX+Fm`۔Wh]a&mkPn\“w|h0_I7@r!K&P)A˶dG~QSKݐ 4t8`,{W5ς)B#!Nv_z<^;q+;,Yta#m~޿m(|8b WmNjy\A:ʼ'۹ (^=T[=ܳGuZ쿏0V]Mry3-`דA\6>,!zibsۅoV@N KV12@+Z`"94KQ {'BSBJw_ԛ 'Ծ =kffz T1ˇˆ4t6iT`vLeyyb11X~5y3k+S@v#Mf31yCSm0OFWULĩT{8( eoIWyƩaXqcoʮi'v]B0sF 1>ٳʩe/K>0J{}we~KzV?&L-y_-?^:_'&PF?s@$VƜe5eX?1ѡOB02T徍0,-::ohmA2u &S!ჰb-5&PN~h~/]|Awc@V} 3da " q\I8HTʡ\|k߶8F_;DCB8XXޯ/lPL8KqXt2; [B p/7bw\@O鋋0̋"8*-b KL M"Lܬ8E-.@kB`(AQj# 66(@Y.79z9*Z(R '/!vVv hdjCa5nay0|I&tk3OloaFrlOjj+>sJ  ?% s_mC GXWTiXKU`IcecDTkBlAO ~jC/)z H#GՎE夰\& o(f_@}FgZKՒJ lnW|[V\g ׸kAa*sXC }P w#ObHΓ]O]{ӪuE)-UD[}ׁ,6? 99\XX _-NpܻDAv|9b=ip<,{&_oa?ʽٻ){Lv=*u7=и*k+߷ >!4Y[bES\4N-u19-f*@Z c䣪5 fZD†J鏌a^+v~8wx-q 3e3')3 {eIRY % ܏5"[B$$)%ْP?{d˞c}ǔ1_y5Ιs{>Se+W\Wa9KoSI@ˠotpFZAn*'b4}l\̾8)y=KoyN{lO fۍ >EC9 V09n1ck9/:SYͯmg8:O2"ZO[pc|Fg~ `! l:8i"y02Ϥ7P/0oz4(K/h$6Uޣf"@y~7?./`0ԼjTG/? u' ̵[9e5/~NDtLcd=4xNIT7M<'⊪ث]QOڇhFX*HC}kI=^0]m4s礭,/v;׸J r)\w嬆Ҿۦ@ixKg*fn_Mkر{U#3m'2s]X-nȭ| 0]V* S moy0Lnָܺۚ٘Ŀ9Pk||o2 \s{5í?s=m7S>jLډyƝJ9s\Q/ۡ\hg^Ռhmu ?e[4F/gT&󬓀Q-F 0}?!^)@ c%?T D/o TH!rc,1fS|P]{,;ק.h'Vf۠) $ptE cnLJQ.YHO|MoFT@{_@yT26% N"6Cn#=2gv4U]!5i擈ZzFA;0qѱPv T X .NZYۗc;tX: &"豥h}wg ܀~}nX̑GN.ky4P%Rr llfc.A-:ˑ#Ϧ23I?PW_901ؐEk2a^AѲ EF=̳BlEwZPw1)"~7\iCw_agH1j>k^ dV`8f^ Xpwv;]rv5NG˗Tx)=JQ4*w0$ vqB^Pp4n=hԑD?e[)"aƅ8Ep#o x:*.6¾j Ŕ{I`wٴ}@߲w[rJN( *8 v.k8"4a',P7t`AHcOB}W>fȡF|TN2`q)bu,M( 8]\0ݟNC3 -q{Lcmn^ZhFX@laEMXL ͖>' I}oSw[z0o:G`szC JuFVNkt?AvL0Kc; 솉^” ]+B, Q꡸M=~[#)F^&e'Æ_cJ?$ћPםT+4_䇙0@Mw0_VbW=uJV|%`8~~QK )fDS,1Z̢=6Nizbkߌp7 b 7w[׺e6U4 @jb|7aD=>_>myi:>'`#Ehg㝙WoF'30zuCQcjw: 53 'UܩM.T4o4`y@jnQ$vf &~`}mZ`S0+ ɕ=?c>/ Ű1 _jB=ŗm KO9n2_,33CeyY1WU4!>vJ5H*c㓥0S`󿳏k]`$s0U{V` F{V?Uds_-yo>k#pUQ ljo--0߆ѯNK> <W6յCޙ_Nǫ#Z020>}tmfWHo>o Agf1mcXȡ-~6IN5A TF}QG ˻t9US1=K]u1M 5`gL+ppfv,0ڳ)5j[0zڂS|\Xq.Wpװf 6lDY<_SݥM8~^R}o.6AXWjgmJTk L@0 1z2ÀXq0LY"R`tm}o0W&&v9Te?p%zƋ MpjL}8MD`2uhnJڄdwb>s,A]Mr=Ɛk+EyFK-, FV+נ?G+ϥ2P]0Fku>\?+xЄޟsFP1#Ë,?dIR FA&!؟l8!V%60ET˄jFOI0Ԋvhp\q(yݷ@=X1vCGŜ}qbŬ 7Dk:_x αwąC[l"L!FnBVɘعZ1S M =b9v$l)w9/\v0{z C7eO~\|Znb[My.>j~C/lWWSPjۇ}u"~CYJ:K"0s`\F#~ѝ/ڋZ^}/~fMsI"@dI5ZP گ21rސ.}$3|@Fc:z.Y("F{GY}$#!֔6c{pt,Хpu~gUlQK!0cx0˺' _6LD-gfaM4]ƪvl=BYD$4~(- cS+}:x˛'#atC{?MN#VM3Ȳ B69`2_H"K85pw嬃=" G5IM:3(9uh[K`wr`k*,q}8D/)\&׋N8R%U:8)48x[cu\!&0Wشl>BGzL܅1Ng0hhwK,,k`-MhZ߾/fS0b*rj(;WJGL;U1߉~`o`c>2o< !V.Ž9G~Iz2d[&n50k+^~KBRykYVAK D a:~3{ he@c/ZLYiUG\nQrڷ_>ФpBڢz(HjaHfs1J;N?T<3OK9>lrY":bl )bìJO| A,iaFj}?vnyc/(ɪ>}i7j8Mqu1:b2vnXwɄ$EKkHxà/5`DW~Ox Ls7k`l{B (M櫪_Y9M\&g~L3G[Zb|0•4jN?+"#J牰 ֹ{Xgowmvԣ=6/Ha {^yvLqSs'x0$xV_s/?!xu E2šk Nކ]7z2~BJ5ʕK0-x2f5!^F VoPz,,dHB}swG`Viq6vo/i+\VMV(kԏ qXZ2v ƮEGɞĩ'\'_Cjk r>Buߑ\jmSlgG<‡ rtw-hݻq E*Ua"K`ܕ)KevD$>VwRM,3/9P7 *KI򉕚P1cOc^0:b˷攡h,%lʝaK58U8EPoJgZis{^3b8ҽW.S%k:@HmX0&i:\Քbu.s:HGCo~)-G{ۀ`|q>]s, hSRV4@+i3aKqwмW_hrT{KY)+uN"~m"l h݇URpgq0lzqAx z~m%+,%>{yPj|P0Sj]6?F㚆$*?l:2 n+M# 0Jы U+\͸aؖ.Xn\rJޣxUY澆q_;tv&UX|pwh0&3|׀W2|y~;+ 1bU67\1g+*UꭀX[*$1_z?휻 0\` {ۖSTa7ِT\}O>հ6v%3[ACKI{~.\K}qx-X땓rL0k0]lq^(ގJpw3ayȗ^&wot` w ΜӠ_H1 fǽX<7ˌ?kGňF;[m=, gBKfaϐwyvҴ3>Q9W3f fZ{0be6C>Կ@F3zvP 1:I%/QPR":,hOˏ۞!trk0'͍Oտ/^ث8tthc t:n ջp&gLF%whM+SFmU**?? ضt E1,N19X-q^3 {Q.=ԍI?As 6=gno1l?zsQ=ٚv=Ƣ%,3%{Vkw8j 6MA: wBSc\R7ѸjSGz~{ۘ/#t:{gr5`3&+`urc8pH Pˮ/'>1M 1Vw^V BXkz'?4";6_̯0l!XUH8ɹ ŵNx':ٙ#r 2/x {@dU{cNH}e3?3=9: 6dKby40ΰO.VK0O^`{Y֏¶3|1ȶ.In~q] ٔh1Cʖ~^sZ/VYgA2?tSwj sNpҿ1jxV!1?)N%bHٱ ua!a;v6M*_ h>v8YT#w+1j nН'S_ B'Lǫ}*f-xDa lR?.+k1 vo/@+:#Ss~y1C^myyiã Sܣ"#;o؀uZ;lj9v\8.1\I5{,t?{[Z^>orc| ۫;Td,g[䵆Ŗ?G`O܏@]1B8Fàa]zp! tm$L{ejpb%=ng/`.WBՑD`Lk4FQ` !;[W~SC6ַ=db8Wkw2su fs[tNbb4`Wa؊:&{p'o#E`"}޿ H Rqdn N)XLxT 6zx >NX/SpƹB{uX^e!DF Wp%-e?{P㥠 x[M`tڛr-`iIm=VxUco:N!B=/-0r+:AǕ= 6Ys(!5<1#pdL/ rHSB0d=%{cvL )8,]pk1z1ZRئZgX`|푞^jOq0fgU1/?{PA?k+Y;gCG#:&@'z-u,9n##nkΘ:'5KK:mfߎH@sv_)[{'f`uiRtaɣՎ0tw#cUxtɗJ]g=牗s^AcG䖎kF! !(J_EMQX )"{b=|Uޓ<`}fX?%b6{F)P]E&xz"0^ a4!<`D“P:qkF hyzX#n1"e[+bj]6%gsY~[{|=`lFYJLz粊 InKn9wͷxX.{f,,XT/ZiS+8J"1n~g6bϏZ0_ooeIT[^v,F=*2~c>6Z0`]3~j<ħ{eM lcz=a919~bE˷V35١m`i;PLĎnrG8,l =L?Ӆ<8+a~H3#^hWE4_[9L^(ֆ1O[_Rq\0$8<8yԏ1Ҹ0Mʋ#vNҀexcuL:X  gF&dt|aNDZl>ҏc0Wkw =;a4'iL8t΍BLwFi+ k0#wǷCL/=`ǩFrя3 2|x;QN dIʃw"ic {V,슝Q+N$ zn!KK>w; t9/$tNhxx;ca8֖ $sfXiDq[m#u`)O LcNL"zh41ӎ4yP c,ϛa+O,?cи5l ZQ(Ϣ<U2hq׷ T<4Z'яx_fG?o4p? &!BLTX1PnOdII{HuFb'Gx Šڃ]U+x4$jA˹SKm1as =nGa`}M@Xd'HK٣a6˓wʸH Hj_>\eQ}B#0㖍l;L6\/y^ ,6RhnGKX=*7CCČni%>tI7L{41$͚Hhc 7=Vf%טdQw.\C '%oc*,//ϾVR3] X#Crf^|>dcrtN[]L5O*!㰻 <[(_ q| `+7XNs'`$`}ό.cěSPEẉqEp4aFZXX5%4gG&}heYHa^J$ %1@)ri"HoIL!+!/UR ϦeQivR}4QY&U8!/SS8XKopۣPN>*5, ~hᶆu~,sb^Mg{u{cнWNugk f>V}1Z Q3Nk%0E |ЮYkVs"h9vJW2rәpjٚ=[/F '8@0;Sł^\Q^A!,H[z>c/1, 90ҿsV<i0帙rC}dN~@6񙙥7 !6Bc4HZ<otVd*?*zH-²I{u9u4&/u䄃9EU{b'Qo*_[Qkw/Rljhr`Bj /2ơ?wogSy|)n\D1MΨ_чWmy-^]{I^]Fsm#!^j9>FKgf B#?db DK)~/U-O~\3oMJIkaqCJ$S֊on>=β(Ѿ6V*<_D5+<0rt%I=K(VkT~oSw;:|4=97pD?MK_&j7QOWR !t=s < OͅFk`p3rb.fVjmׯ]Gcq[qzhPe9>_ =tz84ћ}lXq҇ztk)$tJVr Czm;jnv˛Pb)OPnuý@rP#"g)nBk0z)V L%^'ǩ([mXr4zV}$Ʈ9b4eLj4S6W2yA.ghĺ' ʰ3Sr6-7&PRzWA+b9F`ĥnA?(!6ǷXa R_fg>Aۤ;%3_V%p 1EiXchI1?`y s; ؎clD01"<`t v/_ zTV/ӸnΗ.v@TS)zI{0l\j<ڧc`4d 7Є6VrGyq Er%`7&9? ]b1;H 5^㞂Aⶔ^/F&zcDRT{)ߌŽ^K=~ DK7]CxmE=Pja-1o15>n})1=iΩkDn7X\FsC.אque儁=,h=3ןyD_\s2hK|j,_^q8 s.M.>°k\,,b # L+fZa̧ ]̑s7 V1gg/ vӂ8 .~DA^IOv(چ9y({GYt5 vVvkRȳ#JKkS/*za Oam0^E!,L Gj./r%.j.ggp۶,XK2I 2Cn7z@JwAYaPr<<!.O1[``x1 8Ɔ:~Xw{* VG˜pk4Gu/ʯc8laA,ex +{b^ǫ`4C9S{P}v-> d/)C@xcr3KwxaXjA8=}N1ρtԿM0^L'\E۶T7n8!̅|W)K ShW8CNY(.`}֒<+u˗3>|* wtX88T6Hqatl x~]/!J 5J!$0 /-jnUbtς^KE^h/N`lC< 2)h+! ctw0W=[?{c^C/F)]ر@`늽D,7|RWCS};XbU8cpfoo]=AoN)HG%80#[ S(G!|XuvVcOw`R}XQ|:ه/pWx /xlF?"CCx߶6x‚kýiw kr,޽0[32oj &;R!y4l"XVn $CPMVh ,Y3nUjC1DKWKZR9G嚋`-dt "N uZ[EP||n\Sf[Ь)Z0FK Тo Fys]E=Fb;`㴘2I9: 'ͷPp;ӕ COneĿ5XG0j9N{CF-l7&PqϺJzEЖ%ͻ|RA*(%yG$ɏ+ȿCn6nOk^&7`ESvkj 6c ]z0~Js'{Lpf`BIlsV",>uH 6Ӕ{q% aL ⱽ(7+1V7^s_ Wc'^ YF]N>3Ī %}qs5U.f5Nuߩ7{Rh,ߴR❵iq.(G J*B˿ϿmϙG~k`ؠbw W;j'ѩ0l;_ wA_8|FKnpJ9x"LK0U¥ \ݬTb2WW]2 \V|=3/`| 4" gM>*CanFWէg"`fɂC'0I3~ Z"o<Х(N~̑@>-?Nrw>yч.awNJh64G:o=r8k# bz=n4uvzGi f/N IzJ%%8`jjps^v/K^+BywxQg'\`p_{rU`&#gV ߘρb6۳+L}&sZ\ne{ߥ71nj`%U+=US0L|NWWxc ,|DZߋV,}+tX1F#,o-׼ܿ7`ŏxx[X\vȬbOE5!IYͭvCv]ySU=}w~ FCXE.!5Evkkxny`?Ec`E{f4^5A߿&Z}[ nm o.$hHhi3gE g& '`O}|Xi$^YF7t"6^0.^+j_4}T;7xUSizqN|";6$^u0矻q}򑉜vNfs> (߮|J:{` -s=\Od&C0TLv m`}A;{ koĀlva݉Ȭmq Gx%1cm&c7x`%!h% VNk!p *a ? C|9 `sF@%̙ _JA%_9^k82/|T@J\:{?d*YQST.\ԻY^Gҝ~BkM쵲`b~s4U *|㡺!w w*1Ęw lIi~fK+ R'a`߈ў;+IoZ/¸|whLѤN O|nuy0%$DJ8ݏ,@]FjyF03ʀ5W^d`¸'(1\geVȟ9/ެ9IC{sJQWr(1^x9ZD$;CѥGܔe%J _A(4pfU,4~YrM'e:QŗЧNnm -`)K^w1,-h4$9ε L*-s8D2l8`9;/eB sFlKԫoS2BoM}Ya`X,i,rGDc-I?-"%})ʎ`j6ڗ<Ќ*fVwƁ'0*v+N/*G1&oro7oZ~ Nsޒ?o_ާG{`-]"/W|s ހ!oymؚk?i3h,4V-LJ<=:0+)v(#.zV~ShzAC'Q̟ΩK>6V%@6) ^KBs'0uce 8{93v4`cӪyILGBƱ Uj~Vb.hJ *(l^`p~}F)8 u>|jbRQt=F| ; faP6kwMї mi8ysIZX~ᲟC)U^oψ`FsZ`?|scΤ3wa(<)5-CÓ7Z`ח1 fX,Q=TA *cQp-= QXQ Vf.hfeUZðkJ AgaFۨfXy;ov+a6u7+`N)_)ib7a;qy0FiNQpXUyT>L󁵪: K ihs"ŒaV$XP::=F tMn nf\D v[Z5fU~VFm'ymaF6Ꞵ}@:ȏFOkяjMrn LUJ|h4L^7Kh{Ff`JFOtcL,Z{=Z۬d}վTXz`U8>V}7MHS@,¿M':Qcϸ0q_U & P᯼^@1E} 4G'w( ՕC`8sJ;8s R[X0LD:C5_r-)X^ :e*BFP$+ڍ(?PTݝ$Mؙk:?5@# 3ަ?6*ʫq^Vf4B$qhR>E=-e8Y;Z{ON v9YXֻ"|'@̼'cWd7wt4ڧ>:% kxnӗ/F\?Dh<О=( MC Y+G*ٝ`E,ʯ|06ÇRf w ,T@ӗ.id)B @RM3Wl'-# /k :Y=%1i*5qKJbG m/A~'_`x3ն\Nxcm0'!yV9,QUݳ42?w%G%z1U y7[!r7x}i޸+w"1K9%Y hPT-Bi.nPyܷܼwY y'a/'t_؉=vEMwWai]:Z]nMI9Rwa_jLt+>W7x:Q,OxNBâ6s[)lUIzdtZt:و|ڕ'aL?-_.I(\mH kz}rU4TYV4+:'TN LA[~&eâ `o`|-ؾSn׾9ƪ2A !f}MЯ\;Cn‡1'!0yΝ+W1D0N)E[-0E#rE9'mӆ)y3pNB0Ƣ +?oסw`G^:(lϛd6Ѱ/ѩl T_1#"ȖMܬYdxVMDpUfU lv7ҍMœR9I9#f[+qA盠7 03 oF @Wy=_Wi7DP@ŲP74\i42BC$Wֹc*zu y* 3T;>H>Ewǽ1=Ga w%7_`x8;ʁ+AXȞm>M %aT;(赭;b((,w Uëm.9Mi9wL&>=a:,9iaa'(0nk' y*^0+T[30A61/v>؂ ꗑԬ J`n=Ȗ\juaHJD)-.\̸<||6z _JHMǃڽ͖KB6Z.rJX1 oG^ЏRA(C{&VF[uzFŹnP+VەԢNZIwlCJk?Poc;p g'C}W+E2ъLjQ/! leEm]]8bah2SE-eqH2 &A R1xڊP%s Z8 }erlh 4. A wIe.oA9G;T]"Yug%qQ#ׂ֕Zj" =VLN!T, TIGBZ ƅAC=h.y> :816@[L.ԧR=:)Ш;\{&Gr1O 0vo#)BgE]k@2`SCiOo~@job8P]^[ V5i`¥O6#7*&y d3Шwӓ6P'z=-C;P0nکT#,w.VCٶ~?\= u׽џ+Wc,uf2W8G>46.s^8 z,e)9yS ͎.\P>AhI0tyՖBmu2g`A*Tach(KA2X۳w>^HbųqΤB cW!|ą)dMFE5X##zЕ2yKB޵Wa10FM7s6NFZH_,2-p/E 2V$Wb~z# j=_? ] zܭMĸlKXaIh" lT0Wu @=S*$)%a,*IfV\:Ī:? 螙V„.3hף o;_W:&O2ƛЍ҇Z*zq'Œ#,`cjsJF7/!EhG^V'b6wgaD 3cΤXO~ȯ_5j!8 +j+eB<[yrV @t?fSNl= $sa9(]\#"ڤ(Ta}߼u0GG ? -H %n0#R<@a'(iT;/9&٬P1Hҥ8|fL{Ɏ%?So$2F`9;h:tFP[v,ZOAi`RBo#0-]Xʥ hxS)('G5qVFfS9(MNuOCgRl_*U @:ss]6+3="OX94K K<0 fYWH-kP?~Z1jK ~8$cBǴkuOJ^T=P Iۉh覗aFhl\dݗyk.3'<50W^ ȶK N 2XsDY| O,5̅:q0&=JCi/ФFq1zD<_p,h(3~fDυ_g@xC=04jPڠS=]P&G& Ǐ 7aFFH4})L"*hcIX9cT:zӦ8ՍP޶CEqoB0o:u 7s|8TN4ÇRSPSzuIwmOe6۬TS7TD5 Ech>)>Pisau (^v4?E-erD\56jerT>?տߠ(l9zV׍[  w~)ѵ?|"*-yئwDfSVctɣ*%/)p|*.K[9`5=H5k@.|j'=w~RUF6nCݧT_Nw;|3a.xL%nk"d܎ц1rG`b=" ԫ[!B<]:HWCy0,~H3MchP#?+ ?c`z DxD ؖ(3.l/`t& x8GZ y8J %#@nwmn_fhx^0}Yyw F&ng{vMe5sxx~&&5>^A k ]v>Iĉ_)9W,^k # [B8|4*>j= !n+b2`/\Y5`aXgzW0M<Ai7yG>}^nC3}Rmaч7`c@ܨLwS}o]Yqh̞0B^_F1#XҴn}zxLzXc-xrVNG!Lƾ Y5k'|.LB@l(&R;-Mut񅊽0 F K6wFPaOVuZXdChIN6L~ogKqz0z_ i: _F1RAj/ wuO".0V]˳b1:51q4Ns[L[P{њq@r &#ĺu&0z&Kىx}TB=Ώ`OuleX-:""@՛ XD.|/B;h.'ha1i1z_[߈ .+W®v#O%(knڑ(Ӄ)Ť*) O yB/a$o^ 9Ҝb FGsò ћɀ7O?4vBPŤZd&懕Cq14=d= ƴȉ A?ƷOĥ)7-?[r 5̊X_ªm,T3ݓ\{Eq߽)\j*}Bp6NAW~ʃ5vjks|h1 h$(SvLS鷘^{t4k~u]xvM Ͱ Q=$ ѽ7c 7_F-TqN$[Zc}*@ˊVfzs(JC;R0qh?@UM>7_Hg`g0C'ynڴi[Fz俙Y,+rG` s |]6N;~\6Ȱȏ89n'@Ub^+46;atކk5 5X֘VZ]z={9j3Ts9P8S.26}股_V= 6߷&Y2yZghZ^.e[d ?70r~PPjsNyy },N]к]8C/erh1olXIStajț!Xl&T/V7MΓlh^kѰoG| IμyB ܇~Q0u'{[U@zbc4g m!{ E2U躊^wzܲt`2cl}]pO$|.af> rML0vKnɠ6z VOʍ-/eOI/)SWOo%@sf;:}sAQeG0$ki܄M׹B+f ]T'8Du R% Vt wcL?BOifИϰ GA-=ЮNfZ{Ʃ9Ʉ185&{2Va ?>TS;^;Bke֋01^.tҎґBíւwo$/R]0pXZJ6-u`?,lH66e_ԽFZ@؉(\Am>Z\. ?\0FyCU)f,:LOpoGoX<0;+΢P?itKE_BwQ_uA>.XPw<* ˌ/ZW̕F(#rߛQhI*Í}\; O址u9.uL,?'%][t#hDA\9{j_NJ8)Z)!@~'>(6b&Bdy @ r9 SY垀 3s3qzXi0˽}N[K0:BǗm}ޥ[H#)s`qٰ< "bhk:FVpgKF`@vZ.FVi7(-@/oKay'h"4{p{=`\]8o_Epʗ٠icR` ~z hJj큹 Jh~BuXJ+ jaO{^v#dac,F4{D?i=8ꪔ#xbSIt.0wG%O՝4IBݼ`vp] kz%c c3׌/~QC;sGϽU0& #|`fZ~`@mv8wW1ҷ ϩ~d}v=,4 9i;+ة2ጀ:kGaE޵U?C (}O{10'WJ0N ow1C Nb-c|ak F5ʎFg]~$@݊y'nd(WT,JױǧD#=v)ǝWQ@ G~!=qLJNL& o5ÀiM<TTDD whi >#}a@d((%V =~b(P5Gu tX@_jpLz"Czjco#4w=~zE lK&>f5˪kj{JـkL &~aï(ToH#Zn>YZToC[UUq%S@=0#VQ |̦oh}d]c>j-C5H20]SA$Z> ҙj$`scqy4a2ҕ}3IJf|Rqz՚whpn{؏bX6%7[|\a'wکREZ,hau.~^A?S㾒aw(iׄAl2@_ɱu3FCmݜ5ԴcZt516 iEG@ivhěz@'/ƥXM(=7 ˨!Lm:ϊB`T$F-;bpaJ%;n:Zҽ()~4"+k!^Cw F/_]Np&|) 0|nX #Ԗ}T,P* cu(PIJB#bZzIkeW-WBf j )L־\{Ϡ󮇁V/Qʇ?jl# ` ;C.g^s(7 onYA,Qo0X6MjӀO: z_( R0I~Z%QA(1F̵%7 ّk5@PrO첱~u0?8Hp/*5Kn^K`t`_?lmƏ4W;)>O~CF'#5=am}|cTF'M4kfc{?;MVi_:? I6rX`a8l" >QNT;X 0ߚPtweˆ~0i?pf m|HhݾwƮ Qi2a2S-^b x>L ܡ<̴f }4]`UnmS%e ^۹ Ƶ:D)Dhd,F%Dst_JWh7)xɯ350R aV*ne`4CrQXKB ,{,<7Qw7f>7 [u,?fJօIlj&~u*e@CB@nU%# LG~=1+@=v~@΢SC?pjAlf4,I=>2هaebG睿M1fIN;]_[8V0_7@o(s0}ok)?6e}MIJg]0渼^цlr󡖎W`Pyhjvt"aj@X;qcT=Zs]]?#L$\`MW/W"0|喛mU.l\J]<ڂ1I>YSz_}\rMDuzs}FLԿD{0Z1; l3LdQtPm ʖBɞ!$٢DP$?[T%($$$}}c2w{]S 9N6t`sI2MV;z@nc V N+3!*TB\"[?,a3V3yHM#Z)ޗjLDG'*|}cc)=]RG2v>ϕ_TM%w y2xҕ.bXwv0LE{r¢I?*>w9I/Q~Ar{p}X%>9k~.^5@, {jC_XD흂L3yc3j>4z}1^e]#Bs&/^jJQ艬]K /LyM[J/>vNmiiF11>D!>6CqiTeZ CG  oR#Í 6%B#v?&!8 7։Q/?݊2X `;D6&( P'EenkV MF֦P81SUG637 @*qhs"11qt툡*;Ej>] w_A o< %v>D"Tlxb^qܕ("f%{bm!e+flK[=Gg#p)iinHr+K"ūqxV Dfr  ¨Xã<ބuj8ڥ!A@17"tE ahbɕ݀o8D3kˆ1&,mET c~6T.; ӭCm\L $ȩp"ZC/$lYr;[ɧ yFf a.܌_{B f->q̬]-bo*܈) K&䵭`SO>hjہc~!Ұx>`:5'i\&]Ob }APϩ}e;ߗ/'1S?]AK_ڠ[[ySr P,lĨʉ`Ol̗/& eȄ-K-s6Fm2AzQ;Cdfdj*,?[T\@N*0ǐ):'p*ذs0iQ|R5üˇг0xvs.IXFO{x> ^;-`(rM lsC|X֞SXu$q?lޑ9U-Cebg* 0fȊM_}X:G+lUf>`HqN_cA<ŗ`kB?Kt] RaFXKsh}W0ٗJ{ʁ@Ob%6vzgN~ 4a^B<,%} {7 x@̦|'/X¼~@bzl FJ$h`xiK( :r3 MO7Ilnk,8)圫z]4v1qpYB w2\#mb{"nJ6[>(xfj'6R9h徹!/ f9fa˅rgÀ%NnN\=XIB0X'sk:uw,%}MXa\QDp׳wlNm'Sy|FLQ#⢅>X?Ny?&iz]Do',h_YqP QX`V~bPjοHw3.[W\6{0ݎ{05ËlxraE5HI=';h MB?,64fbٷa*aiS UF{N܎ONe:$XOJ^oB0kSIJ,麸?nkWm=i47 %}o - yS:-dR+bxk"j"s㫸P#Oށ?6(p"X fۦf;j;M|8 K}*:V ^[hlڃۃe;a͢=9|/粜3~HS260tt::Ғt`ǭaԓGZVn)0֏+TffzVOX!2{SgCqAaYk& Iz}Ͳ3BMs7ʤYa_Rk lDl|zgv<,u(w]Lad.nf2@O'#\@4(ψk|!PؒKyo+o†q0{+Wc< 㙯|Ρc9Lsòn/',/.SC^iu;໱D␉ 63hC:`#PcrV$6Zy"[~qVM6^D4?jN icCosz`\Pc[>1Y UX +`6;?hbVwX=o1݃ `XNBP0ѬOa]jWDS4+}*2H Ðc+G^;jp%Ft;` 6 Ows k <\ʼ Ыn$KbZAX21K9hiֻy%~:=w> %0n^Cm\CiX}W$oEqX~w蟎X{h,*#v%1>Z5̅iӂ$٢Pp z6;a&>ٷ3_9t6  $z0z s``q &HcgAlQEP;*W=m  R:#`+aWRxIsؖ|Ax1ZwA+>M&}yzR˯F~;ZX#eu'T־jh F7sAޅuk0T$Yqy]1S,ݞqFrJ:U7K¦݊R]ʫ~˱F[_``ŔucmioҼ*;kev 8qpgA-Qq9Pr[\CFhY&>ƫiR|˅?0ѯU}\.WYvAULlx"X] lQsk 6GzADM'HKYBY}M@RνVjݺB`wGDwlD.1n(7ü ϊJu1jɣȒ(k!l&wdAQ{k56!8? [[씪L#E$add/}”tZv^wzB fSX`碤 S/0e`KI5Yv-I14PdjގœXOT1h CpC]ߩgTum= ~RwtL' ^ZܷƅE핿Ƙsa A|X6 WsoGa͝h nxCw5<+U]x7-&'ɯ@v )>)53opS8 3E PuX5`==6KoyLID9 ,Ia<:a+x˃, 5,|(HEvl*KI3'['kۘx! ^!I4!- [ 㻰2)R<; dNKtx$;Q1K=H=9{Iz#2π=ĦHQVB +? #LcZ믠c/`> y=?=ys55B3(5Ѹ1oBy|EXY ,8:ums p1z'ā(mQ5b))`r'H m{KT}af)1woxl%VQ>XS_'~I6?ZTĠ|}h#ȖGn9iCwa L~FNy7@.vp5]܃^ˤi/_ gZQGMThoèX7oxGV\~2#=o:)KJ%OcPz oZ9f s=Eu5 OmB&)ZneH~ -&V@g'~Qуg!PGʄWU^0Y&݈嗷 VPS_IhN<̴}['/KtS(7]Gt_Bam -XTՎM߆tﹶMMlg7z sNMgf}4;p= fB"lcܰ6.TB HÆ (|:NliT"'hw #Wv%:D5](btE#&QiύfB_}&16 zhìAsQlG{P1y?Us߆BX}׉18Ygn@cJGy0{Id bfPb,/= ߵ%cKo`% v1F1#7mA 3Oc5 GѫQG4G\۞T8baPNI</\[QŜwi-xxqiI޸9i]g?EV?͇C//Q,yp+bx{XscjyiݱQF}-`j|g_ew_/r#_D7cXYXnM\JVO3RI^s/].+]Xլړذg1fS^9eh>:'}^mkgO7nV↞!Mu6vS]~c=`h"@Ђ'M0ǂOh/>Aއ` UtϞLkIA4EUBoĕ%9Hw%r= u_M5A#FKN$DaR _U%61nr$B^ZB\h-d)`,A xs;kDw dW`:X:߱2hvFŰ {g>ns^elpN'l۵xÆ=e\y+i@y@o?`)_X?|Xt^Y"ߑsgXm2F> yC7?.v m, Z;? Zˑ):"4 f0ה $Zzml[P|kX{3 B°8!*>bP8o9 %\{özv$;u4wEB#a[ ~ uXIts)@,=dz)˲90" L>*p4҅0/,{L)Fʓ-ӥG)ZuaFoQ8g}:7xn=LJa|QjXRyeDWPx{P:=#si:-~)_6;gMBcm]J鴳U=f5`_^nw@Io,0c;\]|JG./K L:0vI0Aa&:ۛ)0^8 ݁I/Xg'~F4d0 Kn`*DEY3jW^mߚ6a#$W$e" ON>%Մ:sIF/$ӏY.Dd/ P TʢBIZ A ?C*#Z/<7wGKjSo+|_5Uc?-ۘl",ǧU"{,oQ=w>v1gD-kY1g:Ly#6ou=D$tYV߭L[XH~B#f2B4.q.K伷v R@:/'.1ڟfpŜ50L]u5CW?KB{#x+ 8D;xEYY73sW'#IsCIujO\q _Jw8|";l[ݲD\*)hņOVqw q` z=ؤ,mTj2,qD~ _[;]`# JLĖnJ|pݙPcB,ϗb&Hf1kU{-{xRZڕz^z0qڳžcmDȓ` TeB7 wx!*Ê.aYc[Uܼ +Gs܀ҷsW;2$ foEC6ðy/_&֣-O C,ayI/6t| RQO{氭 I`]pFjP [ 6Wǎ"F)U#54N0#oX4BaT[ajۛdy M K:@zLU_ ۮ Wj Qw`KsM/ ux fdjj[;sʲ=2; ~LwH867i)yz:r|5 7J`;cD;z>'•Կ$ G 7z?dV̷"`*bb9tllwňT )h3 zq2|UXg穡b,n$=TVe[1/gYT^9uA[±PDkyM L quw6} u.7G oK;lNE[jD M"s@^$wf2> bſMCg܈iU8᥮)yߊsE {# ȣo.w`Q3lyu^YqWa@V ya\;S ; ܤ }X6sf X#߁@zc-+{O0|A3"m-ՇZ >/'7>tb@2x]-v>u7GmrÏ}w嗵L2[KCTO+N\|U5=$uf;?V`6 ,?{N/ce&֧Y g}aqXGWC TLNjU"r`ŸEēӦu~GDm@TP z#!ňMI4Läuqȴzl]`B23Yi@(Z'¦ˍ1idXu[v(r85cKZO9akM{z΁'Mm풿?adOQv bZ!dhr}Rh$ETYf=sHmqcX.ISE3ZW{|`9EV40b|(OvC ǯyiNDk곒>r+VdHigM"6}KfWWTVQk(}: ȪEBx ixydojtm`3xr sKV?pb :E}9yGDa 6& zJ#}y̙sj+a+|jɛ۱mLUb*,kbœ9sa㴿5 rY7yPn@hv +UE:RKY6;aq'F oeiXod% L3_59t0Xb܌(rtT >p \R/B#QAJc۩kPjfzx=C8^s jH=ځukYð#y\n>1D_: 9; -D X|`Q&{yCBw*?{3N4x ^:֭{4?t*=hWOJ5OĶ9C &)گ  ?\*λ;su^v*_0΃bW7a14LY\C4Y_I"vqofO(oE'O@~$xIo)9EDqmV:n`nߓcmn|:_U$'#TYoo <9[y2,FirMysޫ'qW D_D75?pbϔ=4.X 9w2T}d݂S~HAs֞*ݔ?{!c&DgK6V {瀥"aŽ@pV|k3ovշ)B䈦$k)~s,-fXaNF] d~֗ diz|ΰ\uɲDDg0x (J?ˆEa ͘@4nYߥ!v-P2nq67= 'PX}6 r?}X~; ~9BF9zdBk:ga@$-}.k$*U_oX/o`L||8l=g=Ct:ʧ{HK6+0:yN-i^@L|IPSggyA%6ʬv7MdȾ_0}gah3,]`L? U=#£rck=-er-3qt3wY?^*(”g@lz&cʮߎe!P&BOZ`T"\k㸟bס)$Uc 4,Y_3DYA/?!}o7͛?^& z \h;R^8hd6+C\㥼UXJvΎ=z:y@/-eU݄وvݡgBG6X7|wjn9t v ̟ǷU`G*ovYkϣC`0)'_Rs 5xvz Dmj#a>ZygmC +=1)%V@W \`h&/yakV\?~Ep1z^{X?)VSGӫU`jaˉ$: QB_K޹蛿a'm<;u.}ؿ-<ɂ eh]LByڣ< ދo [a[`[l^ǁil!%6954|2}lACI4,Ul  ZhalluIzeOv{Sd!ɕb w$g ^Gl\h$v^.saCWb.csHe5aӔ`犟քf~ ˹6杀/_8#جٞB BUSwXx9BfEFj0'quo^J #W}ʻj}l6}I֚}IGai*!jdG_†b"lXjW.5w7Cփ1'k*w %/qdjGdĬ:b05l9&wd1L\Q(ٮ_Czy[͗?k_>* kOψ@z'p7<#V@`; :{Ssοc dB"o.6k|> #,['ayJ l<;P̎( XЦ65 l:bA@E(Oyͻ:xlaf%=xa~k"Yb17s9Iv;Ӯ}ֶ`-H»b'J1›74ӱ,3a6v%ĉ)#i8Ȍusi`u5+csOYKKՍbX+jGӑ$X[LX7A/ma';4!w%W= VI3Qv 1B@g]T^f+ OԿ҈%J65LO'`)`>6XZF5t5W· \7Fɒr!]uԯbKVFIr&E@/e/Eb1qcN˳Ka}%OFBQe8@Ww]A4YlL4Y8brj/+ 2PҳKƄnOj6y~egR[]*6ӻV)̢? c#톈8%VPc+ ;ziIT[e{Xua=ߛ%ZBѓ"9K1I*u Gw?V#g\QrM,šoM/`!2i0zBYn,amWuV}QؘZgu 7U CaFAV0]㫆a}8XS`y꫇ 7AX.9Jer_nݠbgGaE[M؍bDG@4\z#v^ \-Tm3Γp<@OK +õ0pzo9T^;먓*P< 2G.%EFܧ?*z|-} wgCϠM#߫j '-=l3lm@:q{]d֞j> d<ؠ*wKdNӅ`R7Oloy ,zQk4z\?); 3R|ܶ3XuN|ihg\vunudZ@z\S}o4\ XJ}u ƈO&쇱-Xht[E ~w?6DncIqОmѩc~KZ1 [;槈u(5T>R˴Mlt]>4aE:Br.6:ykXLN J͜g"v2Vzu'?J7Fu(6UWy`l\u4^v382M0" ,^4; wCYL/6[A񂕚q /eNM0guR,j-e:vN}V$ps'Najp םL02Ljp"hV@պR͉s0Yz\3agɒ5%BZl |k\~>|n 5KA vӉ%r`-7G1`[ 7nel[Y=z_^ꟽgLJx= KdͦDR 57v.cY;!%*x|ޕCPYe7n*S ch_k`o77 ֒3H!Ju@(ye%va0}\2a6~QZ=^J8=;lh*ͅ]N{\rLO2ryw~S|(Ϣ`Z.qU+umSW@ xl|%X {X꭮Ys9bG`:[|@ >[9X'sfC7b`\φNs{9m%u״#ͤa[g J R-ƴ15<׀t2`(ݔ3GlĊai <77a0f0hp&H@#Qi6ijk>D:/SK<K_ENҊL罝G~Dnw%l _:L $OLN/@#XsN#7/RMq.t' B-}ybMLQ k-"ƺ}yKVq)ZWݝ<$OzEK}Vȧ[Vۖ봉a9[??3 /@R afHdvZ6̫" #s5=XYS}}|V\"#J~,KGz&`k+Jby)$~qnp}8{T C]:\/ \B KCL†Kת-љj%<_*] ޛ~z!ѥiu?' kRr` iX5~m8 m/E?'<þ9=фldhhhNFx_LN؊I0IZc޿19Q0r0u?o^aPwIuws1wl2K^wTu#&ժ_ruv(fo/r拄R(loRKS6n0tSV d"Έ^DcKaA1W?`H%h1Xzx xR|yDW?Fl웇%bN9! k*=L[:*뿨Pgb ;!nL0!=4.axMOpk[O:MzsG3l&1y"#LV}Dt_#!FVDC:- - z s#40ޅl|JYGSCl)hVD'o0)HfO8s~N)4P{C>ӫc+ dBP(U2> }hҟ{5t}h'E$J[&7.ɿ"ҧM-D7D~9G !WG8C!(7r.a0"`1.1opֲnPe7e9skY,a}:/"Ǡ]v'Әɫkj}Xc^ZmA 'F]FߕS:b 9UaX!&*PZ;xM{ݦ|8"_4 :2l m`ѲlDs _~~6vo뿓+JX[a}_2ٌDrṙ_Aѕ7h :- 1PWmMfO-A*%93w1V^laY3EA]3Pl_ Öﱝl`}aPls0 VXJG3"?{[Z]3+|+6>mV5E?!~;!dďn ʈ*FǵWrM+ ZЄAF8[D'-Vh/܁ st>:VZ~y NoI.N]X޹ߏ[R|cl$a'>4 Z4)aD?70t826Cr-ιR|±xHhzY^H>D3T*\`* 6/daO=.E[v/1/|j]փse6QyaUK:9! M%!*]fei1\޺%~;=n^ioWd0ړ̀o lC}t'FF }GlaBcP>[wW旄C1V]qX%LNtw Uez۳ J o/`` ^!j|<|I bQ1%c+w_jT4F V ; 6.Ě|lpA="n!/bvw|p<"D2ʍb-d)f+ݲC3%KWfPBH)ZAEf&oXd \@o:'AW w3nEq@gc#5 #ainhUF4JjoqH* #jP ӱ8ð%{ͣ0!_0럝Jw kÏDsD4I~|A{D6Z`J;XŒhUߙ븭Fƶ _?=ByL@4:031z2?d~z>N!'}sN#W5ZҾjVxۚ8gњ?mրRBUlu7 >{[ ۡ`$;M~<䥒$57x/1Gtsa;tfS`0{hC5?a-i!k&X9>OJ@taG+4K@hů#@ Eq- =2\j\+*Ϟt̆Ȕw)acK [r^ڞ[ú M1l*?o}zH$rú׬cBVW$kHà! \ty #NKn7e-7LKaWSC3¿YsGR$ml#ؓvkaDƼ.*>ld)gk/VBWN\r({i~l*8>D:Z|ݾ֫h OB3:;|KlJħ)]tfye6A09sM;G +jO(E{aQ.Z%P~~M)qɧ)Pbjk+:1c}@nF?B~O tǪa$^S)F%03j>qtm5 tBR*)@1a]jjJr]秀R70S^;PbN,f~|& ?aR9w'ޥE9PJ#O1j:o"͋ Ͻr8hCǩs-t`Z| W`փݐ_ Rd:2Vm՘,,  U;aZPbVGZJK_9QXz868)~;qx306{~B/bKbt0iFwW+ &n K-)))ert3gvMDtTEx^m4DtuP 6k^P}]-֒bI:l$+Z 1Qw}7ϺSאzMcTȜfz#1OQ{7X]} V↹` ź9XB૒DߞLӂufװ,St?-o}?eQK'̆}밲s{@0`&%8\xqPtៅ"]'nw~Xdql1 <Ȃhn(TfyXi͖q2[TVD? [UdAVQ>sf>ĥU&4$5?L-(4x II azDgTZc/?!wC5*^B 1SD>m~.uǍUy$ vА+zxBq){CSXyI!MY6&l#Ƭ|ʪX+6ULk3Po_w݃k]yKT~Mh}Y5skyX/>;l&2|/'>2aߵ'a]\;pS4# .awLłaX4~\w("Y"VG0:C֚6s`!dM #5g'W"Gץ0ߴzarA 5?#sRXby!C1S];zx5uy}_Xb-D19A\S`kyW`-T&M*}^ܦ e$QCLgCWE>Ĥub4ڣ#_ $z®+?z 2 }8pkNжc$ _d`1Am\9_<\{$Ax{~3`B(h̹ ; ` Jxٍ%V! .2,2 PfAaԦ0O({FVу>~鐣s#!@q4#2 suMPgs uidQm$O,$/DZɅrun@I{!80= -Ezhj(A̔V,tH9‘<~5;.bw  9.54c^Ԟ0XKy`14x?<$M!@,߉z?XL5=OVQ(҆&@Jy(.euRM|7EQ!7䴃B1b4)\< w 4]>(GWՎBϧgV@䏕lLYR$aAn NFfNοi2O-*piZCLwaQvrƟ.7d%}ap,$>®3  `NE4'jXwsHd`_tX{-õg;57:!Wz щT/1|fnKỊ1=@ljkq0`%7 !7ٜ"V dq0[_l% DI5~Xey6 YlrQ 1gA }0Z_BSyܛ(65*qrs |e#k0Vmд;c[*aE'~Rp^.`yP' FkW{#}|o/ |ҾW܂[/uC_XR [gM@ gkjl?76տZtq_Ż7Xh؟wT5vX8VC6GܤIwS{M{!/\!V桙n?`/*O*{ϹtZ@߬zHvMG{l-8 ._UóO/!:Sp'=~RqBz԰?T߲ ri pg^yjD{bq58]a2yYܙ>q>q5L&Ǎ_0SZ<ޏ9La tVtFtZ2n.jM58zdnlqɏ\0e.&'b?lSX6X>F."XO+-V%=UVf ^؄ϿR".G5{?)F=0fiS:3yao`c[6E>rG Fٮ|{ AbyV&1 ᮆQx S9Gaph# VEBx 1ܭvi)P֚ y?}K<C'a㥜9i+yH4M }Im6K#(JѢ-,ճwbR w=MɄUfE눶XQD%> g^mA.FAݨL*~",m\^1* 4w=H]WGaU#]⟐8-n???.w~.@a-o FF7AyW9xW Ĥ-~s{N>Ixx좵)"-ǏqKb1Sm#Qzb}kH(ьp㚉RzjLKA"F]Z ,Ɖ pJ-x1C AOgb5 ǧ5:Nӭ[~q/V·6g |S19Ѿ>R sm':aAÃFGIAA2Xm$HM( ?Zuc~Q;`4HY/HEo{.1Nӥ&nghb2ݕfׁٮS'yNT޺ `$͌hԤ5 Ya}FĈp vCs&n\p* f)v|́28>|(4ax#JݯŞFt1^؈(nq ϯ<7k`@&~?L®`/È}ѪhIF4oryiu'zT6 , fqsQDZL,$[UylMT=" }n炮Wp_+62o! _Go3êa,TѬhbڨ9XS}C ^VES]"`͕hY 7`$}GJ ϋBsH|4gvՁ "k .DdVM7-ʼnX԰氒5}4>HKv3l"&# !/xEb'v!`7>)}= #* Y٧4* q:`JnKnsܺ1׎MbfG9".Vz[ji;S9V.ؗ;On&fωJ45R΃^(NfMe e(60 H--F~eloNvÆ+CQ w'PR,kP̀,ҾOuN ?JR6b8WrfjxbѺraW0yh["Fq߷ 0'8VA͕'abcۓ+K$9aĤV̭Ck҂`JJ)= {iX7C-7/zӄ=E=s36Z/{,5ΏzVM0ZV{Fr9Ш( !p:QUD7n#0ܽ?{zg}uSJ}[kwHc9pTQ3񻴒֏'o8݇՘p<%1!5 Hf]&Cg we2-Uda~r:a;,K&~"ZV@T3n@g׮zBELwK!_6_u`l6Ή16*E4}–cgVg2~ŁG{ CQx7քϷ_|vaG.PlGijcBx<|Ѳ2{Ok"2/⳿Y !|V, @??' ka9؍R{)'sN*O.˧Ǘ|qm/Dޓ|F@\G|0ܣ!6 qp]g e1.Ͱw0^"T+R""W~lV%EfE3D`^fNC7a-A?2yP6= v{aG[}yc9h&wfjio` _/-) 1~~ (JϝMӑ31yly,? է2F5~Ac) ޻~ԐFL!sW)3CL:aul=/~qHO5!|V9\,Җc+&W#īuQ2K`u8#KOay49 W\-rXZi\PF.|Ȉm @\0.UYI;ҳ@"zu8R{IXX;a,z.+YINAD+E4"Q! ]M|.3#XJyuy@զ[zn~Q5RMh z#pr[_K3AXJE4?>G]ddI<,XMʱ!5[Yd] rS^]  [*BXoY+0>oQ2iB%#j1`_m5`JҗGYG6ٿS>EW籯dsöd=[-RQ"¯krⳕ?QM.Ĵ6V&ƴGRaYulKUmĂn Mz gye\JFeXwTYVd;(u_W u:hPPj\ㆰᢖmzD{sOت1P;`xkH$a7|S_]/+]]n6m$ucCѹ0%:2xA%N|c3,6K콏ԓ! yFt_Rj,~@Nq8x3Lea!y1Fn{Xsg=꾯uz;mGχ9|U ; f;4@شuWvy%/R9yV|(:%b JBt*ajp0jN.;1yF#|qWS2z.X"˜^Cy*^?70߯ w,]vRӝ|pr.(朐x:Էo}ӥX@ 7Tv~F-ak%VseYX={ 8㑹": jadאַ}E'~\1l^S,q'c +/@n@f>jS>S հf1p [#VtXVb@S`ts?w}V=q.k'Ja"cBAAw{&iA95\wyy`r,+d3n*FA7EXq&,\8& z;#8<}4+f2ToѻWa麟6k ^es$  6<=aPpeDwEﯰbccqLh -+$l6X'cS᠈AOb34I5C?jj7/ { ">TbLP,~h"'9 ڋ[x{H`8L}`M }v-'B:n<—{6$o{k~̀T?]&]ևMخA{yl~>6: I+[@a{_k~t.YL%l#R).XH¸i,y0} %š9~#QaDR4AUO791Ҵ2|e bL%"!Ga4z5y8gkdZ$YKy$I*I(ɾPDI/(I"dKrΌo5=9sg3٥ UmQ sny&4 VZWotQx$ VļڂFaz5>4̩;lVl.Ô_ Bb]w0|-aͦv{NgVA,D7rxy9Ƽѐׯ8%J(FBV{-WpٮmS߃5cQ_WVa[m#¹v&>*@SI[^Q5ژگ٣C j8svzx| 7tY^k4 o鄏υsy0__kJ`q|͒;腲ޠ6fG$PO>`-xq;vO;r^_)3p9?rL5>kU*uwUȨxB>htghH XL|M^`oa$~2X~{զR: Ӄ'Y0w>a" ZCWͥXɧJxxaJ6k60Ԫ5ḣ ћ0lfp+ T!r0qhp8&5XT*","LItd壖nd{ʃs:N? =ub/0\}L^5$502u`ŵT=V+0R0L$J ae)6xg^p? 4wZMrg.2, B!6rTdq= wX>`qvGM}p&6EIR84~Nt c[)лaӼX}W_G| _&41"KؙXo3߅T^Ij#t)15Z=ElҔc|łzXZ[f{\ba)Ld ۩%OQ3|^Qԡ6u+ hO'AsR4 H: Wt6-b*a^xrj9S[{lpB\ t+#|0v} ]Jr @%I@j+T3MG3עB)%rQVjt!"MǒT`{"4 6auuU7>dka{ENmCyut0<4]xqǟ4bZ5?FK!|~Yw N a.2+S@t7j{~FiQ7l3mOaZX5uuT=w +fQ 5awsaUVwH%'P|PftjQP%W7nRN C k=~rya4Laec05B-͟Q-7k^U ϼo/r-cbBZSny ȆLb39.q9l*>QdT³o`^OX]W_EObF7Ǯ0c=w3&=~j\b=Uz,'p5P[vUo[^ HMﯾnEqI D,1ޅÏg=}ї`ƯnV&J =_Q9MHb9jjֲkZga|m&t lg"FC)sԎ>e~lrQI=4\͠cpy/i, k.$Tu F7lYpj6'yC4x0ꪒ1j,!?7K9t<}0>NZpM2E 7 v Έ.s(at+ϵx`^󒕷&'5Z=]%PXəs7fڔ`JV>4{$m{/,8X<\Pgaajb14ǘsO֣IOLMk` g:^/k-i+~ ]` Å~O`exLn)}-voloӅqݰ۟I0ws@M%\5g+.bԴ Ъd|)2 |D.Rh_erN'@;teά(L.BcʁfQdKZ@?XdEaV6F'V|t `x` 9&S?eg~ǒ* &}b\0qOt5FpN+}~2b: &⬎}]6OUTj )ki\gͼUxn?XYT~86_o~ÿмO' cN/Bx|ѺϔCcQuO3X(AguV+_M~äA G-C,wЦ݇u*ak Z}h]65܎њz9}tH 4]_4 Mu$ 1;Xm==X= =1G~asGR_#Ȃ€,q%x}4,;1~AS%"46hʹ{|ۊ_nIO+6m{K0Xx۲\fJ/P:F/D:Ѿ.^^t[.27lӆ*OQ'^=UuNžB͊h*^˺g@/W~Z8ݯp0Eӓ;5?l)M&̹dS_ܘ`نbOPo)í$^^O^z Cm!<0pV9,Jž&|W_ L@7S:,|{ Z sç̯oS*/~˞DᇎEFr$èF'M.r:j4JOt"5CVǥۋ@L??r:莽䬰/בba%-6&Ud$׽`䡨_jk5]׍iXZ0N%1 sgaJV$"~~ħWFw9ʥ 9<0rxf"^MY2s2DhpA -Ä;޷ g&wt M(;)FR9u&| q@{A1⯥ã*{,5 5D_YVyGU{خٞԽ&X‰9om-k7i.ff.},Q!ZN_1{wq㝋1\??+jǹFw{#5@;!3 ,6-im'e>a .?B+^ŽT 2\_C/ ~>2m[ S܏I&0@CҌ 4{ lq+̾E͇0ˆ"?I115 ?`;&FwZ*6h|NWOލ X7C%uKݮhT:%\aig gqs",1^B~Q5d/X+ OTƨYDגhh%s,0nbuy 4WhXjlk>)&?z0Hζ( DmM :/jGA<2°rF_/ u?zEYv@NMh4zߓ0*=EVƺEPxT ,V],BS× a 6h kB7\1}cߧ[Šb]4ڟb0@Oa@pVȦ4jϩ-qc)n8W1zF,QY U0FvXK]Τt[aavxƳfGo鯣g°V!jlM6[ vj\J^{̝{.}I}^ :ox`QpԆ+Ƹzî< i({RC2.0,7bW-i4vBmMR@τu6G9*5,TQM^S%֡O[%JѲKک T]pM11/f1asPUDthyV `h)5-s*ܤÜtQ[}SH(dX/F$\5<`֭f8APrt ? d폇 URT-7w1LaYb*J>:W5V~jcG.KC-eͻvjxd!'Lt "goGՄ=>,Uh/ei֎Qġ-] d3ýT Ӆbd|jJJ>Ȃ\3$M/) Ԃ~D2`HTj;S/Sw0]\{($ pRKfNB/ާ\u7ULS`t7, gfÆǥjq3:}rبbx K|B/p)vգ?Qnθ`';z|T$J1nFA[V(;*}8km(?|{ ֋g?ÆIG4hy/q0&q{Ix~Xo t/Txe^C"n14cJlsf,gs4bӄ(F߸PO`7B8C(w8K1<]oވL?S’)IFPpR1 )ƒD4CvA^)h\Gaiy~4V n ) gUK@gW78(MǺGva|^h3 TesSS(UPsx{ jv_0 lӅ?!rEUعx[ U]\Rb"xwFɹs ?e=G,"^0ۗaX~^_XG9,_6Ndqaız(]ɧϵ7Zmz7-bӵF5$x=>4Y_U}R =i.A3MH vLy,kXw.h֠)@Sa5z#O1KvBC\amJV:#vaZ2pk%N82wi*-Z4ؔ5h= 4uGuN9&*hTy-c8$v-|<2}_ J`ڕ%|pTm&zE0kW{ЊC d &/٧Qxh}~e- -z f"!'4dPLiizܮ:qg  aM*?U_+_|{C@R9" A "HA`}ah81ڸ[}zkؽGUaO Zqe'\Q]2[Py j֨nvᰩR']yE"(3_aXrxOm m:rMy !%NKM 0:K=UPdFž? p K1zMa1Zy:`#cۄ2EwRj=`å;Γ?AX+KmA:2`0wV5o6a ݱFX dYLu[W:L1vбیQ1RB쟐PK @]=̌aT(5.Jz #V݇NYq:{iuZ8rat.{,_%Qz?zþ-5 8h nЎ¿#Ӄe7t),O2tc,圳qt0F9v<^twg8~u"nۄO,c6|^zVFuuO0bz@7 f(a)M}wa`M֝oPnv1뽕/C{Gm'h=n_=cp._/G"C؃t.EakɛE Fsz |S1޲sO0?== #/e#z;Q-ܷ ֜ cph$Q֤ve 1@ ǖeoZ 'D32-! %޽U^YU,)O0<+-܌Z^cBGju]W`oV+<A/ua}P6\tW$rU=qG0zhT8aۅQ?v0/ z%Ik}v,~*G0܉N2{ˤK{PYe Is #:ͮ~k~m{fQ,Eq+OshKNbew!-gqhܷ1j:HFcqf+9=kWeF>_i*Tw2zHa3`]A}c[pv4 T`ǝHE\57Iɍ CXP +:6p2K)tn$B/8v !Za3]딧l˹Ӓa{Z(>Z ;>il钰' LSvzbp>r=R7Yz3f?%~SgQs`wot=3!:f-a]2`MS y*d3m;v3dJëƎgۆr+fkjs;jBBa)n} ՖyS{Q ]~l-Z5 ^SQ2ß|/Lb/†[Ȱ ԫ3W3>1f~UR<=P Iu5wƃPq䃝R3Wzbe |%54E\ʝSbE+*TBM`H$ ax/t [Yji%))V}k-s,oa& tۧBa0iMT(w;e1* ԨE7JN'|M&8 eݔt.)d`gJ%aP圇Eu:N~ÿ~'/U|VkРH\sڝ+= &gOUAcqfcx:XDn]`hs`5I)2X!߷-aZL<] sAGp(@g;WtǺ'M)ZL[P J $]Gi|i9@$[ ~(`WZ$.=l] u{&|YߞPtL!-;Rʡ7FI>!QҔNCd`FV.|1I=(nvltTT!S/S+2@^Y%s?12c4IAou`mO/%mr:) ya\׸M`sזWtD1p$XWS<6-W~'aTw_ .c~&U4tʝ= QM⎯~o"6Ø꾎+ *DKc}ɜC3KSYP}t(} e@1TDDg-zL;eJ2 Z5#vJzKBw9 ]/qQ[ݿ _Z!^.N4SavkM4ݷi]Q%_piUYg@8nѕw;^ fLJr< 1WyٮxaVZ&1T4ݏ`z2zN'n Dl[h^FjנaԊxMhYi\.> D`мmwdmu%XG$ɻVПI3XN2$ҥH+ vcuZ7wn],riKF3øYoD׿}V YZ\B1QN5 <0#^Ձv h[OMK{U  2#E:陗O|Sr d]>XYMV_Ҁ("q[pr!*M4`X:WNg U3dS̭Ww;ҼO JػOUc9bfF^mYb;o֟dl_*Fŵp(K*ݣi0 &?Vb (S]_zaTT7R>~&r9_!آ1Ct+BɕF[rUidT7^;rjSw^/}Ge})2kO)y#+w 䣹Wxas ;c hu۱8E1֨?ǂOt^^_Ok.G#⾚0oVᚸ_aL\ֶP'{wŹ5΢_ !X;NB8yyWy?S 8- O\ ,Eq;ʢ VR"yX;P3~t@j@7Ll_ؓ2Z/\lY>ގ k|a}-)jxrR :Yoјi/j 7~>~!#s1*z:)Ej%\ X4yk@~ˠnǿ?7BN[È@;Taq϶491 ۦ'UXq[S!Sx;Gf_C}'ae-cA `aڦWRv?_, k| omYo|)qW.:'1IXR:q{‰!BBif 4'I`xA/(&f/j7Cw#}&JX:V2I3۩σj`ѓNe^ya,t)t܁Θa5]Fsza :׏&vK'",?3& h{ (bJ%\h`s3=)`JUKս ^XrϠq"K'+.xuv|v% ra]> ?x7^ , ZC}Fy"}nԭR-|!ǷzBߙ!f-慽"1O/ۭlQq ֟݃Na.6آRKF2⢢a*ZBcv?ڋ2P`Xads;ZH ԜA<SݞZb䷬5+M2Z:;TW1R'Ѱ)qh~zPVޭ7X<0i*XPy:}zt^Î {p5֒3d&yy HQc_s]B2[п^UVRT UzY=~< fXr:~[ -_f1.3c`ۄ7QW aÏøV,\ wh^ lѻ7^bNW)urʇD{Cᷰ".r!z$*uvUc!?gX`DO"OMJLxEJj@Y ^ΖbtZ}c6U#v0!OMJ|ޫ5:SG:t(>yV wG¹iF~Lgq`#S/^1y}3K*wlX}]zNG6GeaE")*ؘ9 s!0>sdvӖC.-lx~E.EtsE;Q%yaCӡ0DO  aohќK@ 9U=I7cKxX ;n! 6&'QW0r>f嚀kGe ' QVhW>zcѯ;?^Pdm8$k:bӉ2eD 141ht #2ґ`Xs_&xcTR&; 9vៈ̰=vݾؼa4x`gTD`r,L}8N oEy`ȡa?*WgTZ sWv:76?`ogt'*:ь6ԫ`k'#pMz8!2n QV#BZy 3qۂ'hsQ5;RgOSZE]rF˼ӫl:~yiDϼ!a4SkcYEq}ثuGP'waf3>7pzoxv[0ў݊G$qf [Xd %x.} ,1Uu?7=ucc;SDT@>֚*c3:WZ>wM,vkJt٧h'w1Ø`%'!ky?pRkc;81=ojziQGBƨ/W@\{t6Mc^w1Ro'ah>O@z4nNoA>WJ,l8+|(6B1btÔ~ф&`Q VInNph~CVQ<2sbga-kN'q4Bw׼ V2\)e&tM54؄6G:YX v`lD7Dn0j EK۰D5/"L` LXˋ "[uȷMzT / Rk ut 1*q{)Ǖu;WBC I~4,QDBO&Ӱ(-FNi 5C<e&PEa6 K׮îiP">|KLkd*졅m h IApSXO?5j|,\]=f̳u=o` 𪕟rބ+¤bc0q[ԝa/m/LhVrm^An]; q 2~6 ԕW"mB|NZK]d쒂r7⥼Z |5!̌__qY> Ζо hD.=T]2 {W :=,$>x>o<fb`{D2MQgYmX9x=Q10%0WvG9R>`2Uj3 _O"އ$`n?WD[_sʳ|VѪ0ܮB4<sΙ<&Oa>_=#fB8Q[1s"&m 9)0~CeW_av̹hNi1ƴ|Z乿źnղ>Hhώ15c(~وzzx^W Mp.Nj$+&sQ~wwXyK'5a궦BL,cNJP+VWjwEy1%41gi {r!~b~Yh6^Q;lX߲*UUja՗훿2L͔1+A!ޓPxV{/CԲoVd0]lLbГwyF)IT>z Sb$c,OyoQu4ynnx˫Rt<# [O?.=0h]d9p0IjʰcD {!^B^=IO*Kyb <=y23 H*^Ao8̫g(zupEcz_42\ =v8_ÇO9oYEY{?`hU]@#0 nVpҸ=ϓX`!YƱF9+9i kw~] [qLѫD |⮇W,0z$J9͓֬n~hBjz0婾a [t.;{o*f E/X`*Y8%ulb1;tE`݅6-Ⱦaw&wP3 φicPD4oq(BAFE8e]#r݆uW[WaKMRԲs6$n'Cv2̞ jpqgz17a!~[ez@ )ue!;KN4i 11X<[ 7YïLSQ='_r=Yͣx/U5%ǽRrVQAmB㧦g0aXJy*ba Kw(ܨ?Xk$_CU;Z }v;(-$goMC܁"WjGa %cY4N$AsEB ʛ1xf.+)i5W`jfs^Vctώ/ {^J IRNu u.X_J׹WY'Uի6˸)\aWGšMBqaT&b`9cFg[L?ո". +~5E\XR2i aFo ",&V5t`}T[2KA"S<}e72]•[hCmk`ک!$k3d`JyeA@HWX ~I|8K~.IfΫ2S?Q##? ý*ՎZ(Mo5% ;Lգ5@+NkZWohޝ>K} g%,:@zmI^<"~rvf_^t#_?] m%pK!sr"Lߍjx ~&M+y[ F +xdAHɚKVhaAdz/$l^/i]ɇ;!+e1AW]ItgIc`dv"׍澆Ҥ*NPƯbmkZlF0n%RZi@L~!CጳP@<8Z<)vC@ n4~uph)v5|H/+Xih1r<k~;~~ J5SM}4ī1fE[AlIq=ǨSI]p{-lQV^)̲^-(1ĕ"ẸC(읿̆whU)l o+EoP^ K)G ^ f3yHHYXƛ|vticz6o#'1-R^냑ϾfA0wwUg6|F3U'lǍ0[Y¼@FǽOǛ3}so Q[ck^X1j|rupl{@ّ }i+mUiN[$ATfE ,zSrr;rئֶc߃1vyt SӅQޙ,h ȽHAp|ipdrºl˥gUVY=3 3棆aeq"K>6JJc4rtꬼ_re a9fa;. ML0eArbtz赁8X;:HWmBcܕɰI(خw^~O/?+HB՝Ej]WKec LE9 +#$6yE0t{C@-t˰Ӫyz?̖}-A=7S8V|LFng¤̀8M2NZ$^}B*Ep܈—MBn {;V4D6Sz-3b xY& ~Q\`=m*Pe.)6ʡs`;<3[4=:3O[mS"7R&Tvo KzahYgJ@ώ@EX2yߗ/9nUJ3F;N?܌|qlY'ZyX9:2ɐMC 4Pkk_kb_U`祎[vsjѽ 6'ىâ]Ϧ0[}Y [<{w;>C?+ۧ^2V1ߑ[ccWy s.nԘO~E:M5z~Ժۢa)+{w9 |[Oankk_gY2l));_ ;s90}7c>E܄͛?`#8fY ֦$MƳc?TQQM6DYik9d ԁc^3F;0,O`f2v3( IX 8kXDSJ'O:2oϘBlp <$eS`r- <d7gh*FV+;>QBTG\oHqkG;k@= e.QBakX; 6rRU˿X1;~HT` WYRd[@!p^[Qo=G( U0G#]dXVmI.%|B7omL4 4rg W}FSw[e~㵣CF+}],m v1(OIv DM( v*vO~$4Ĵ `rpx)o~F͆#m붖vDj(2D!=7RX~tƃoƸNf]b~&f+ 4{QsD| XK*t#,QN~uGLv<~<+5nٷ3vBXNWl 9s$%'L\sbR9̉r< ďKwbNغugϯZ~ѫd;sr I/J_Lx< ;ΙmOy'QeVcG8#])?R8lzOzUlyG{08o8@! W-'ȂJ@ѫ"K޺eǤG^MZ):)?QCs(};ڗmWÀHe e\OhՍ h9[5]U躋2P 4pAV8gxx;]8! [<Cd'׏y+(}!MK8bϜ\c{Yŗ`7}Xv꫸U& ի6/FaFvl+)9Y4L }4l wTbak/ scO? YXv+87 ScTHi4Z"ǭeGC(ycIP,,}$Abt05V:OּZB0oD&U ƹ6;!lT,,LDB`[q0l[8/'i1<#x&Gzwt6F#Psۊ NYga-W#tcZE}|M3ȟk-v 5)hhLC[; ̧aݘeͽG0ICڰ9G @m7Ew2\WuUDItk+z'`L끵+_ηctIJ8&EWaTD_0I ie|a>`#ma#vGa›p-s˟ʛoǣ0! aїaJԣ)0|t,]]H}[7rJ;lꕰPkhGZU 1ڹt=XX])t 963pȼ{_YH0:!*CJ,"a͊ ۍXe3pgH3FO0 wU cJXq#-0.lE `e O(ؓa㻹0O: mꁄkuKJ*bȭLy|hR%zqe'V$ީɻ`I5+Axl/0A /}a])ƩkZb*J^O b1Znn5s;zD# e F[i(ˉI7ϿsyLeVPkI^02ww /tY-%ϚêGhdU52CfZhF+5l#oh|*5V g`[B)o`aG]rL"@^d145G}Nz,h˹gf]L4){{]1~r>/1#,;O|T@ l vCa2$TT/.F 1t*wnucY2p02|Feb4bxO=/-ؾHF=~0'~{Fk*QHNՈ1vɮBho] RtfG\/f/~C諏чlْxAT^* ӆWq@LW-QڶQd7a򍬰 FW'>4GRi72|6PAD;\;[oLU0 ++uw1}TGZ|[U]X1 ~n:+;XiF%Ͽ~1넿5\CF"(},p 31 {/^/=9`ouX[Qk+ i0cu,O! D}j Pՙ,vC7R`zCmhXW:hu9/J2¯̍WĄհ ~2p zNG1<ߝ‰,(Os'.f C*a hV,VAE_`zISF+i£ڧ\9w3+4)}HoFJ)Ma7~+Oϴ@~Od`qu:m;v~v86% e]/unsy =JO$u6[btٚWXhʻ{뢴xf7y1\.01Bc嵍RI f^Jc7FrMyK 33ʰ&EtZV|mW fW2;ipJO=̰ 쐄gx.IR5֣[^CPd?u=?}ūW0A*\(JHѨoR hZꮂUj8mX0:ZDoc'}ako٠;:_V< YX?2%si*CX,]*.ߜ}}N&З:0} M.m%TLXK?.H-lQ߸{,s1rJ F nUHq,832c>aj\fckuCW鎭b|ewa.(F4\0G4 l}RV]e-tA_K4{A3I2L.zJ)M{^*c#W͊zX1݁QAGn0վMÓ|;at@|#i{v R c)uP @fg{ ,2Y̛3uaA(6kRG\8 >f7-? 0H"K! .ip]'1J Ua7MZ6Sfy/syQ^ :hcc);=`"*HJA߂S=4vn ht}fTηBv*fX~"?PɈh8,t; ͫ'zueGuePi}Qh!l 7ž{69od S=pÓY~K-N+!;~јƽB\aJ^%{p鈤 jm# _wdeS5hpL +}';jH5qZ:NJ]$4Ɣ;=ho?? _u C/@^V?9~oQںxQ%A@4q:pFm0؄O2A^ۿ9^ }Q8kqwNm0ס؊kC[;nԭygSXG?k,ht;fU7 `lI ''8@O\aL +MᄄKN .Xd`&:QZ @{>_XvkEpm7(MPo`p'ˆeQ p_T-ImKp 0*X3QK WPGQ8X{Knh=6ga}0jiF}nmϹ`=E:{M+P2,3(߬~Վf3/99gzajFƵ?)̤`j>j}~g+פnŜN&j0i.~lD-`-}m2//لE[]-`s=NT?MޮT_1Fw)ykF%-<6[{O~VV~"K?`Mu=]Q=Jfu2]#arEN| Z¤m2 zǔ^|S9c?~ ?J]"Pt^tA/؞2*%ۃߊ#؝hY.}-wٮ>]{+0:uXJCJ+ݐsĘ~{]S4*1躏6wD+4:%c`G[,y5kzw*TE#H2D ֙q7;=~XPJQ)g.8>5w˓0r/U?qc8wtPyz8l1=dm;Bp˷j\PB'TVa*.KM%y*զ$<霭b#'UݰKЂeףl0uraXz= -ܱI #&xb\ȏOhd4Y?V ?Txx).,}a=AVN= eoN!;4>IվY"1̫ ǰn>{CuJR[w) 8 ycwG"cTNyB3^ t_wlY<,f .:ܵq@(EIUPW-gj7+5v9X62H[ PUg?60v, 9y0z0|QJXWӮSП"uTsj VWVOb@a8$ hm722auψ;Pa;FT.9lL{w`/?Nnxnʜ1]y.#ʰ o^h2<]oI/ ܫsHt%gcP k*lˉ*6L^pd8ltGn999xJ$t+\;ͭw[`}ʪ.I\~yu${]a aGN8)%QxiebaaD;|SNANh /d+K%atL])@.+fkN^JH~'sKhoQt"ϻةR z]Ѱ@;Ύݰ>w4F#߶'s&b䈲r ̓XF䁽#vΨ\3m~kHt?z +d D G+<3<Ԃaη$6pa)P<}~Ay\U콝P Uߵoc4ԳŠJV뚬.&'XeSfuh{WfI6ld }Fv>k:T&,r 2]jB͐3n' ƥ?]SIA3hN})p1rt C~*tkg} /`dymC SiF7tǹ Mv6w{p ogRc~ܢlS'j)ȅ՚ FMG&V=9yG7a7a9q=nGeyZIjW1r\X{=E%D1W:T0:X[ӯq.wm_2F}OG(5F} l3nV7(]>ox5ݚFw&bn4tzss6ׯ5Q OHX-"(:BûᲰ-U=l?|^tP)*&A!@Xp FE}+u菊^uhL?߅-) ,S\땢FHeeZ nKa:MUՃlkcRU5,' ehZV <0IC v,YdheC{dU!:l I)¸*ט_x;v+KԣuNb-4鱽Ʋ~嘆%/NbaGҰC+9l})yI|%ԏ`1_-?V-| sO Bs$ge8J8#0}+ǀ(Qt0m#INWUwE=TJzq]v h+݄FJ͢׽|<%yi)9DZ\ ?mhХoV.˜_fR^QvLrMOZKe[bvvZ+E|a*kraRule1&cro{aOOd^:Nr|7w΢R nZ+1Q4 BhD+{ *#kE悼iF˝ryUeV -?agj:mfiM=%7W|!}.F5n$W8:%rg/GjsR0-9=5CwWA\.)+ .OJȰvyj] ;%x6G?cJ`?4 Kf;J0pˆ9ݹ 'gxa{b# )~ =?0 CO) ?\M kFecðqgԅ&OUX7RsD7h")u85m{R Y"14:\7``"a>4Zs.y~eݺI/}xg ɛ)w]a>gqJ1H rYp'7-?z.JǪ>cJ~uXfa:01AiBca/~I~/9?aZ*c L<~o>]V%|z]oT!7}KÏ`h.q!-qWE.F}]x@Srp[]ě<71`GjgAX5u]^m.nfGX|-iޛh[h)܅ c](y ۓ=ֆ>r`GLؤ!]|\} VlfTaTZ? 4L.AJNd!l$^<&$r0^/w &(Qk 07dat:\0Ň֞?0##J0Bs95(-A]42 D-\O0snqV[]A}ynj,{{1FwEWӝqaA^W`E3Uag3 û_l;bGW)d9C X1睿sM(7H%X9uB ,Ǹ-;Bٳ'm6sDe`ϯӶ:RĺW??n*`ƗheM|`ryZF-g&4<0<lبfѐii˞bt<^bT!\ ahzh+]Ƣ)V6|?(Ƙ~0]~kϟpg+aeTi ;F/H>}JwOz`R^ U3kcG}AAgBLSq+5>1S"H9ՔD}/%z; kFG`W:T|a٧Tp‹_P{nѯPHlq66qaX_+WwT>c'j1ud7#5nKrG5.iHDQ=¼F|| V:Ɣsq ۱ObV5Wv8EnLg'߰X0`ǐxwx*!ĥ=pzE4b=M-kV8ed#XN։B/.]Χ{OF){4Ю2Ѯ.̄oM= Fڪ5+A_7(TS*Lvd,ݏTf~… EXQH(}S,׀n~0[{Mql'JV^(S\YyLOg@ #8 Ą/bLOZ`&߳4Ld0è~^mO9G`ZlphKT._; myn l01Ve]?Yo]V~0y m*v̘2 gz4aQr3p*7=e[|=]ۦ{녱|rvZZٮT_ &KPʞJ]FMGXV\GW{ Fy܊pI_31.oG#`س/n=Y>_߷F;:}swsɻx`mpùh؜6%5a|ߖUX1mHk1}l&3v&^1)iP+:pyՀS+ғVE\>ud ?F _;Q*y}ҋ +,7QiCsԟȼGݴ`E꧕ ݻwբqG#>`8iÂShg_V.z5]茬Ω*UL`]Ct y{=!dq׽)2ϖcm}X1Ƙv :_:NI{)¢0>F5kd^`3OZ\avQ>UڻŰah8o_Ÿ mBc>t>Bu>|_`5θG<,i<ߏ`ض&F[,=iDrظykaY U=+j9~F_ԯCdX[N{ Izn\dXUGINzlF'L_Q.`CLP݊t@qAK_<H~ϗQăo1q@rfHthGnٺD@4ڷs/VN瀤eY'E&a;`p!xOmw&s$8qtT?$I*HdeEEe%"IHB}m8qp;u]|}nu/=30xB fs*m9= FL>7fr}'zA 5}+2'܂$b*+q8y WXN8I!_LVa!c@LIh)߄ 2W¨Tl"bҩuլ~Y\F,r,VN0 DS~p,xS!4a0Q,4*gq@Qءc1eD8N͊8Qg0]Q9WC޿<vtD;O1 W#z曌Jo%( 3ڝ0{&hm.aL)4(.]:w;w`Z&U}.TjPw1GGC>*@hd]VlK*<>; C}]9;MCNKƶB97| a*ؗq~J)KM~0uȒ˄9xVOL'81e.aXQ+cdvE@<ߩs OO.0ؖ?tG Eq&^lzVllb}a iبxKXf̓Wc;qp ?0;q)϶m`7##[d;OW0J,Rؤ_l[za@t4JDi\eJ9n|-=Sn炁"qʓ)}7ݒƓQ0K*!DwСs:|&5>Q*59Z.XsBQgoS\*wv̀ZǺ13&=_GtN :l0_+,Spa'L_$R"p1ۻ]ɩu8D*k*pL OVL @.$Xa{ \-wfXٴ WUӾ]kyWz+d1@$=7tvEgLĈmt'DXo\(Y^Ք[lh-%Pƣ2"ĨUO/?8eE4Fk )XkpbL5E%!1QG `s?6GGNAQbvK'( }v_Mo~POEX{ie V`kN+O?ˠ|uE{!3EhLFF4L\l#i#fajhIDQC73^.[],'W k))07M3#ToW vk+9̟ ݱ`E,%SNpNѢ]5o>+ {aC9C`w1椊صͱ.#]΋V O>{gi$PHWky=뾗Uas֫oRгɟʳ ݞW#δ_IXEMlSrT[>Xd~6aOEqs:.US#+lơ/O~7YؘdlKi߷g'4Ɯư^N?.g}:{`AvqjtVsPGt M!L@MG~a%q@Jz>Bns5ú(%sA7~xڪߓ| )}}FX" 晍¦َ-%zֺ \Lqbg Tga[(:9ғ>l]y:_'Hcϕrv⪫[u;3c9'ouyئ ah?ҼIՋ6 X1>+{r\G 0p UOjQ[<_Ԉ}ww ypytbki6zui֯ۙj5xԢñ 3պ0Ə_Ȋq V$?hv 1nj$(`-BDgvm愭~pº&W=X ZiOt`aQdWv4l]:raU+:Q!: _&wP$QrNr.^1 33b FPGaGrġsAsMVmy_B,*R}~ ,v֢-òe+4ﲋxl`AH_*~MNlSaNC{`gU6`l*xGu;0vbb[~Jl.i| zD×{|c{di"Ĥ5y`I eˌR01zF$|M]!/:l/C 5xx|蟩ôM㰝"0DwtH#ϵ5 bRR0cc?.s<2 {F7ve(y47'I=Dw!B0z-ačuh:1M|gD6<^."cݕj<ؾTX!5 kI+~U)+aſU0qkhތhY&}u LV@MXwu&_M5Zz34*ʿRp;YC Βs@beHq(0%쌉JRxL}<|%5*wa73˼g+akM-B QY`X3/_sA/ h<,ڟ tl@UOPy& }!T8aGG <+%Y@{CNc#z˴%"O[oI?>\pW~ 8IP.JVZ3=7h^ʛ4SXIM0tȾ9p..=wX50Kb~eelpa3v^- ZD00̝(q|AOR@{S"9'¬8m^Vna*GaIb5\lE6C] wK]-UWqyZ0 v7;YI@:sdҘa_t{41$IhGա}E~(+ҏFaiBYt@j\(ͥN[ $v&&_0biz*]mU;]ķTQiOtUp!۰؎r?}KލjJOkm'6vgC+sP+4;ְ+:/YR .\v8r!0O9Xܟo`zJrgӰ>}eyQ|&`[0")6wE<:bևLqvi(t1'GZodjCuZ9B+Rh/kد]AAb'z9+ݯ>p&d@im` [,&xi?Ɗ?uSaYz!6<]/ ' j_Mo͚ F5D[,I oȳ 4E:MG!fVQ~Y6~'G>lqj}A v!nYAH@X\i?CGdG˳o`ֽfװ7bQnWo]lAGؑay>1 r _{Nj;o»P<&_w-jM6I ->]oϏo2ZgS/L61lJ,X$n,; [f;N_=c*nыЖbMϜz^?7> K `Ωzdo#w+OcI :V#*_qrEC3:o=7&`R*Gaue0߿|=./6lA#0{WRlYX#NSԌU0W`X7%e_ rfA'쯗rvZ8zGfXr \b:x๖1Ϳ#9hyl-<  $[=$,ltٳu @j{D뚪@}Pv}'_ÈYbb0Js{coٴ$Gܿ/''auNn-[1n<_T] Y.+ĚiR b-,jz؊%' 14R@iWC n_ˢ/Zgx 9bM{ 1JE8aMȥT]{UOuJ S3sis(hJBx܉ZݥfhQJ/fBp1+DV&.;Nҫ{[CX㺅8;U`+X]xa{nT.[bܐ-R*MlbX aBfLeƖ,P4`gvWb;6Y"ᒻ+[2,)J0sl<'^"$C+! f󮽚t>^kb9xH*y F6SXFt|0 K۰ϯY1fYVrPlt:`u)QX:ͧr1vmjD~N`lT^{@uY(ܪ"*eN6u ^f!F/YDWt 8^u ֖@ENCqLzV> gf aq&a x79̞E8M?ݗ 7r1bMxe2IeG]þ给[zp$YKӽ 5㖇?JrW)NX;7-E }p>3CJf"]W0gce"lвAҎ=>8?O-fXS 6( pvN]ȩ/}I1-X:ےd u97 Ti1o .j<0Q5qڮX; W  gS'!sLYmE[(1"t1U@$,9F>fae[ؑ!^ Syo:ܭ 5koe;ΎYo&1*| |όW @Bfkta:HlyOf^_QؕMM L鴜}($X V\Ѵs=T7_̜Um{1`1~ 6jwzKBwQ?Hb z:S0T*˫$XwX`tq6592&(#%#oK)6G\f3љ @ mԩA ly4ڍ',eqݍ 1ޠ%qV#fv \D\өak7,ب}*kJ$/[Ї޾o N?rGҼ1B({`߱#'!TgsZaE/UwWjw NgHJ4)UO`Ut3n-V}-b#{o2Gac$ig3̲*`D̞ F^/i"b wQB MlM0YwPbeC㕿ijK.ь1X+GtMl!9OK! _Ea j0>`,Vl-g]E|j ٳl¼6޴cڶNWq9*Hغ15TOIA +??˄Ǧfv+Ix:1+313ⷡ@W]^R+=n^Kt:i[}9ز苇)Uy]>^TE7F|Y"T0h*k5##)M0zm?2ϛ!j\aĭKJzLP_ ]QXyw-'xa2ĸ{OK)·^qX?H4~?0rpJaOKD"Nx'Cш)s< <60FEC ϋ`-/rx#'"CSaõHzvNކdac@XSގ}Vn {UyF}glJE~dE|y0L;l歈8bJ^y`?.]RrT'hy>cbqtVWL|.MSa՛}#+Sym+B֒9XM:^}0["x SQzY޾3l<=I+3rζ11 aA; [b@k~gZ^"PDzn vΪi*#M'`y+鹽lRLlHQ/ 2s8ԨT 6 amF؋/1Ud5okwv~5h7K˯kd,/,y7p1̢mM*֕ikuB4OArK  %8=8Gx"}1A숵I^zExRX[77{Wð.~7' _%Kr?J~me^Xlύnfq5I/@-Bxc2N~8Qۈa^*k#d7@7> g7`[.G̀x L}-J>q _}1ե3)wOmXSt6HFCSG?neԐ/6ZS >Y,6]ˢCgqoM *$<BŠ?`(i'씾 :J91R?j#%wx`ݦ̌ [z\3*s]ޝ20r+YsVs>jg&#db8x. $5I",+޿?&][dԽO}n$.ĠM08KO,cg/#)XO`面_zN@_6Rw KeG ]n=:8짇`CKAI]5m&X˿_#sGuűn.c#X]r=0%>P#q_q*_$ Feޥ@׆0̋U 1۽'/u$A9F*@vI:;?mBϚ%Gx :2p'H&ˇsa㍗W!NCJ0̈^;}kqZxWWg>̓XKpa|TQ&Y߅C`lҢ[>F, teTNxgle_mֲ%K/ s{Y0,|~] H<Ī^u<[NQrߑ- XV s6gm W)b`I#-$U-Ȝ=SK(Qyc3&5!.{I= !rtlM5X:աo 8Jbɂ SfadМA}Wgfy>h!<,Z-C,P¾>PK(.ebp5V5 ?h5]JpĪRX,?ar| K[q?`ظ.kk+4ήXn`|ɬKh{{p bJwŨ~Wۑ6t40SH<4`37&C Ec@ 6ǔ`3.cqCtic3ZoZ77C-Q"XZ61s^Xa=!ɇuFd0^r~ //kҋJ1fY[XB`N~ysg @,x|=}euvյ@j.OuLYvFg&D_*|u,=TqE*:)؀ae>(&d؂5}io GcG1-n ,QG7v )N1lТLtjygI*CH(֢x귣< Uqbek4%IiQ?|)CLLGk߯WF?NF?53B⢗mԀxUhv=W [Ǿz: *Xi-3XO<:/7TF]Yﰖ OؘoiLZ"l!x%yО/VZU3GBWYl`yOc2+OBvϤa*JDv =}zk0I s=6]W?$*`]N`~|q8& =2^ Brq0/} ^f;gE]`c_#J̠ôzE`n3@ҒN\gMbol$ 04ѬWm/$t[pC@8,rhʕ>a ?,/e%sՎRS\Mӯɷ2`yq=CMMضS؎ 6op|D3윖ׄ竗h9Y(;~j NX؃wɈj!W?ǝ9zy({h8Hb | l?{[ E0tys@f9LrilPfTSXQɁlE'1 u*òzEn,,uϹ-!B2ۏWډe/}ɰGתo!Gw5-s!BEHA7,.v\@8ð!Q`I˵M#^f*5.;}V P7(tCS~EcP'7a2vQCL-Osu )H XmgncuNZ+D [Tn3,q)u)_i6.a!,P`YS~N@0H7Q N^fw?W܆G~[4NԀC0@ ~6*u1|3 +O}+8>p?5L9m_Vς͕sJv@,%fw ;Im; Ni3Oi^xfGWޟXicXmzGm]gEo,WLË"6{GLa{uoηO^0+gVw/l]F4M"܁\/Q)f SMna}us5KP|Ed\0_2ʃ 7]}G2EUOڃeŕ8O#-c=l+ 26aVNJ9*–QϹMŤn|tF LX3D8їt`B4U;5FU0W΅IܔE o L ꙧL%ANi@-[=cC\TX͐=$kN#?O81-{j"WL5r34`k-pA3Tu>L3=3=otd < Ѹ^V}+ꍘ& "9Ս;+0ZQ@#7*찇C<8}Uu!r{V }/Ԗh:ڋ& ]ًa=M6<ҫ| n,:PnvBG`!X,l¢kab. =뽔7tƄ灹Gh\B\!,44Dɠ[2P81('f`D,w1|$cWQz#k@oĶwTÖrް@=!.7ؼ4tY,Xn*"{6PZ[O()Vhu _2r :cKPY L/`;Wy6A.th3(Ö9mk.(N6rN6Ƭ>q f53Dzl)byJ{o7ܠhXˀmc )atAdּN=lNe&;FiCA[j୽ 1LLZM'#m2,)r*Aݍ:>2ZvacA/ʫ.vEX` ZfR@}=ٲ۬K}캣m &\kvѼ6 ZyQW4ه?CUe;M"~</{*xBTCPh _7P"lyAŞ0~g59!]Vop}w!t 5^Y;7+a! ϋl0rO*[-^0ŔY2֠pjK:/9p~7aߍt lݖg.`cD/"~BW(#2~@np>%|Pp]g]dj&OR6UKqS5Ey2*3WC!2!ih 981]?aG]')KFa?{'z`9#ؐ[= ۍ*lcc;~+Q؟?ϢV;=NXhzPS .ђM;BSFrF&?`aW/(?=z{X1:$A_tNֱ#\1 elDZgÌL%~`+{^`@5v y  !Ϛ8HJ.ɯ=Mab~5 ww)˪w޺#NWވIn{ؾ?zgw"ԤLHnYtf le47 U <|1_Fw/Js}bc8ߍ+nO&c;ft, OUG| ,<#>mcdDgUscWlDJ8_HՎ׆5F`ۥq%ū6ǝf#>LL(\p><]A2rg/yf߰ p_?¶O쥯&@!rbKip\OL' 0.&"*F.dB:=b;3˧J˴6 ,,1:;!Bi H p MN.p"1V@{fdVnm5oZ`+G@qA߳@;<9VƇdXҡDH; *j ı'@T4p_.ݸ*kBOz7YsR" q%! @++#O(0C.DG='>ן1?QC,?-*n} EǬ{ hP_2-xԻ*VR4ŕ ʿ[ Bi+GV;EJyvn9rB."NqaM}2yN!b4J\)֌BL8od'^b*'3MFn@HX%xۺ4X-`H<HCaXx!*ɾݷXh&tZk5efOѿ?`uHk^ ֬ה@.& M)6LrY7%ϠͧO?gk,p0w6i1zECo`$Jgh0 bU|xX;Y'F`Y=k@!!= dxJٰG :S"p1'ީx|5ҵ`sU^ ?j%?HHz԰sFOaABbcq+sZcMвb= }4%ږH ̖T0l>lEނ ^-~ۻ~^za ] K.#:C݄~O\?P} _-ʽHX5JsexBt\$`U`4;R; WzO"^5eZuqǍPp$ ̼3r\a2pSP x qN6ԝ6[#<`wiY 33`"F6u!H&mQ1ٰ<- j hsgF8> Rb0ljߖ획*y(4gơGJ0v9#`&bnpXZ܃n@HR;Ƹ(be_y\,?(]{t xɶ/cu~!zSM}^EL_3Úࡢ ?h3Y:{ -x15̬q'TwXp%I[nf .IZy^ *s;4pZV=t8nm hXEK%7yK0apeV93t/o;}wWUwAsuol0): lY _R=++z YrίP)ydxnwƢ^\̓W j@eQb=/'`ɮ3m[ 6W F?{vL;B`Vxt8=Tj(L?MFo4iZ.hXWB[@dlk'ᄁ4Ž_oź9JKh΃.yA蕙|)԰dZ#; =L=GA Gc@8% ۊS}UV_rԏ;֚˜3@%@jr1WK'>v"'_5%B]#q0*"Uq5+poc;s!VXpkVʼSpp?Wx#wI XVןAGJ;:s~*GNEDaߥO09\ɌhԦ{SE,/뼪 l{I9XO9 YM=u"MvO0!²*mEjÌ_ʈK$N ln 6\r`؄՗SW&*C>GD7rm^̰X5O%!\#.j˴uF$f~JoYE|On$k/yΈ Fa]]n5וp&|}_ {2::@W01ݾcރukvXPOcXDozF%G1U;q+#1Swn@ țTy%|AqENuf,w<9}n3)>rL7-?^+]OeUsOHVU|BQGLr/!l6^Ӵ2㋺Y_`:O6& ^VO"mؼ׹%a;+5*&l#=zX_Loh ;`NbXW?![1R@8(5)4?}ugaɐi% Қ_S=֯9w&0V"s{_>,êP6ږ`y _L 8D @.lDI@7NaiT֞:RӇ$7{uX0={b[%oJ${΄VuL˥:cl^ַȼ NW@u=fen8VJ]MR o,F\]4Oѿ:(θ}4Sb(:Gx}sF@Ee٢#[L X-[t#ߴ?340m#J'-#"'$}kg$kiEp"ŽSt6]w݃:)@s8b n@ri~]FvwaEץZ?luin:]4T'-g%YìW"V_6^F<;~SZm#L s$jKeA[zڕߘ'"UyGaک7bY@>{{TmX nX5?3(f75t_ĢuNrROuEIiE&a~ aS3=aNs"l-MO+]~%QR}{=*E~zD/?GA];|ڸI1{޻\}∣U]@vpXx;X|;;u+ƽ7y8#WA h-mFjs4U Qb}% Oyr'1Mc:Y!C?<`6 ֙rZwSeaB|,q,:h~2 2Lҋ `n2fnkX"gTC8tia@*|y7cYOḅ+H{}7z]u!MDif_x"Z>w~},U1 5\M5܂.;zDŽbLcT8XWс̈S"LdC`Uw)^t~& بduV֔|5 s j}Oz8b<8h.nt-GǛmA^5Pq3%sFn^D̚Xp)6oNj|΁{Ͽթ0b*149mEwm$bU>b6]>,~暣{bb- KO6,w!uViXSsd]՜P1<0;RS#-Wv6!^5n<zhy3|Tڅ? kEM~zPFmV anMG^/ui6µH=Eng%DJad>S$j54LJċ#88)Gǽ"(Q mC)0,}w6&aFDtv.+>/#P>{yuŞCl^j~7$LtacheypZ1lo3u_ع3'}` $QW"tA52<(+tq]r2:ls;g kg>J՛Y|jF˟b7\b8Tˑ%Ӛ-!)wFLbECݭ-7e{q ?s(B{3E TJŗĿ\p `?LI*/~(%u$׆?罺|VyB]ۍ!0>Eȩ܉6c@;b3dbkɩrjWa+(m:4g"iu0@}yxA_ +Bva /I:@fy1#\`z 1ͦ?ʫ9uAwYzψc֙z{{)=.q 8ef ް ~^:4|3Oƹ)GZ0LP*o=,˗z׏^JqYVD?'ey,Ճ6&vr שr9U ?\SIѼTuFQ~2|8:,ͤCTf,vL>x`qn5"}fnP_wDB-”ff;> 6O _9l`"qǀ6pQ驺l$y+ ɺw ,P,$bCnI Kвo~ym]?C^ev%^ 쀵 zi:WvybfFyLJϡұfRh|- '?p(,frX_{>+(wf] F$ D;<ٯ} enD =QlUV:p@NCbܟmYt>ϱ7<@9 E^6mp7cux<(?:#uT,͏$[fbg@{y2(\1) rzdlŪ^G-oElbY2MHwj!<0⭛?-~H0'C X{WtyvVF G˝<ՠؿE?h\'V uB ؒl5,lzӺ !ax!C6*K/tx轋lo AWÁh#J*Z 8({# +6Ί2kKfV7`QL$Hz/ <8XJ̩Q[IF||?UpxyBvҲY jρ()XD枓}JJGIN-d:6N#5lY c ]  t,+BGYaCf!l&=p.z3nl~=8,f]Y (BdO>,3 d<ɠɤ[0W8]߃<,x2S +b{i@P*^Pj~oϔ %y0X83q\zD1J/O&CܕU{o&s2XKćWnl䁷4݊نy@v[g K,-_kR9^?$/1X<< ;\? [I}-H<߼ljiR#6fZaE,cѣ0o1w6Y17,FtɈӿea:Glޕ,f9w =Ra^w;m$~L¶Ha.θMJvfωWjIU4Yd)ͅ=RX|#D) _b`v}G]gUX =P ҳ<~F6s9_yV;;{j K1`SufQl{RV)LyQ}MJ)ςʬI w[DFS%~̈5˂-&!]ҕ%0`pY+HW cyr=^Yȼ>(#9ߘa,Ē)B?z&$-Lº 0z_~aZQebhz@1d#;G>~⫽.pP+I%np?zyI7Ã8{myihWP;xjXxwUfWwm̐jnwzCKZ]vς}wBDM3 +-ߗ E é2cG=Oy/?"WW Xː2G47)kW [=vLmu#ܻ¢ dXޭ+0w cSD&1*"`]E3P/i]SO\ Y8DYC8Jv[yb<k{O{NgP'3lQ, ĈImsn9RSFY QL Vt{:ʟY9iT 0b)՞a^AsɃ%\U> sp=x6fd} ޳o3B8Q4816@[;P$"R,ItȕCgHM?wY]/mKLJLY{|gδQ!w3g #D_V[* i\Ҫ/̥M8fy/^NC|S4)3h͈0['M1F 8RaC 'r,%w),œ_ҞMpD@{:V?}bSvkUfX"Yo( kW#|ƢG[`.;{1ɜ` [8.LBzSj7DZ,]goV璿Qrb1Z<"|Mع1.@8Gl9>O<)gA_n'?`%9x F{Jʤi +'ʓ0=8ZU#zvT%>,@܏X*oġs\Qۍ]ELڞ' 7lGX*Y„+4·hɲbO-ǖlEYzDB NlaA#x6f=zJ11|rAZ:PHɫ3πHMfKc>C!u9+yBWy*i^װ먳v6Y$TXE[^20fW CtEh__ΈNN򞃮0Miz@۵نyrb ɬ\Q;;ؼ]s`30`ѾbO:h?A5b7lqx=lxgnIG#,O=}rZXk[FQl+xl6>uxw3PU0=vgH0 .PO/~)2x:4| m!ƍŐ,qVب]"&,;uy CJ=a.W@ FEe/ZP.!c+31[c;-eS;+kQC<7)̎, +FYgykrWarT (6xS :ҽӳmĺN?Bе`8feF3Li=9s0r0XfT !!$BCr2f3b}޷ΰA?8ܠCb#Ԝ`<mw>flڤi>;|Pi+@sLTl>-ſXqNX PQENڎ5dU!ύ24z|^Bh͏w3gLk;06²$& fc%{T&a]^? Y|r؋!UiC,_Ga[QBZ.,OO^LX7tr֣4$x ]rUN@- EaZl+]ӣ {w*ֿB )hK pɲ9ֻǾ 4rkzBKSױVM$V^$j 6^#sX^$vz%> (:=&07Z.v\R0YRwh|U6,Nn6UDAef)0;mW-ϔ*DZ"ٳ #7K#H7b_ƫu F06V !rfHetRhF2wk9-+X:x0[cG9#3/c3*#ɋ{s:Ol0#V 㺁|36aE0vy_,L.)<%=0Wwʒ–l\cνI9XAc3؃6z״z[P z.{%x,{ޓ@O}2<;;G P9"(Y2W33 UM~rͽ?)2酲?ѣe%j Fs7?m 7jeKCsY*l\^F/'H{ n6OQf=Ҙ>Je s j:0Y~O;8`ߢS:;Rb7M|oj㣀 ғi<Oð*gp6JѻDLIO_9 `Y־x!ݐO)GM`fqB\%g`o(WbVFaa+UA˅uěvmB + sg?kcymXIeE[\ Ft,3iZCœ+b7Aýɰ]71qʿpo?:m̎--):8A .:]{}RoaާYS"3PDJoeKql\)tM[lʾ;2{pNiWżn |6* INBb3q Gt&֕W,vț* *Ea}&L|7l3j"92W'L^ϒ/' LPNH?&Xu4kgQ XR*cOO zr|0^yљr-W,.]>h狈#Mp)%?WWF{]2M+wE[1\~D]߭33@TyW[ 1--hӀBjf>?[%nIG@dtM! g>=YĈWwRPJNkN_cuJo6l3ΰ|d`7)e#: >Gԓ|)3߯ȂĒt>4^ <'2 Ɔ,a{9p@wAipas"6(dZK> >F)Klp#e< b)w$NQ~ R 4lA: 8 )%J$\o-Pŷ$RsYnsX9 Mž2bѻZޑOC]lwBEvg& 7l, zc[Ip0(sG6 [2j̆9XvɟgUdk0tSJї bIbB }|=_ (|_r*)J_aPֻ>jIQJ1*Ͼ nr}{M3}=rM9 3@~Zt!<a)ܡOaS޺b ^?"2L` ӽs4n' I۠ ?hyE"bHqʘFr {p9t{`$D+xV1uX6tL-Ղ>I zc2.wzRno)s#F?^yI= ۳sxb?_gn;'`=Vz,0wgUI<|,q+a3ޕn#u,XsXU Dѻj_ a{)n^a0*"nyC[O*3+R<)L+MC/_/RjXԌ~Lj<@xwtpu~[/ (pRΆK LOm?%2O9*e: NEAM37m@I2(juVŌ;=Nmi{̶#ydDg@:_CX~cu# TNfَKЭxF8'ObX3@q 8aв]](z3&dKhsA7d+aESn<. \Q Vl䷘`6 dC ZZÀj+v3P.UJm- 0g!@d9ߑat'MmFU*Y6,{0oΧ-ǹ4_92k ĽBY 1([85dv&BA5CVOh]r tÚlߨlQ&aV(e)|lAlL>Y_A0/0nn@g@GWq\T  P^) |Z:D>%w%5:jġ6y@JF?^}/6,1= H=i=yf%6gqǘ!:GzX5cR./NX1cuLn%NL'P~,\퀬Z-xXɟ/:ܓ{MG|E)?;g!%V.*+-$TBDBB*Y){o868u}uy7:.l¸E/"V'bq0,40"xGb9 %$DX2ς 0K0U4嫪FS#ǢZ8`Uϣ5N>(g{hZn@KF>hwh'P,n# XzMb"aX%NEy0{/B65FssƘT7>߇bS 򧹞p}γb#Yd%a$Ow')^DwXΝ)kqX&z)u:- Ve^F'+߬ '$꧜D8C j{aS/pDbj WK {|HpM#Ibav ڬ:umP_^eVgKJ*G5쒶LIJ|M-D0Qsz"6A 6B>s, {YtPazg|ѻf`yDe |asoUi e(k5_Z#+M^iiRwȰ"v]+ =wq?Q1*NXS̫Oa;Mw6F?҆Ő--0}AO(a=+44@{nA_zM'&eo 9s}{x47*EIj] b2π*-"gC%boyaw=TUR ;v:bQJ߹݌$6 rǡʥE(Rpou1b?1]E<-a{!qI*D\ ۺy`T1$1]]h1r};das=;0zܜv?,0^9Z:f _ ,،Eena/^:6¤j $}V6CQbɋ\]M`n|tHKiIOZ9$`oJX;TggBXbI/1l\Qp6 8ir1=p>qB='8rTYkZ$ah<|Yuߒ 6 ϡ̀~ 7/6vbWVkxC|dH7u O`c^Y~C=b,kT<" }sҙXw9cMug 5BfX̸k>6uطl+>`(9P_'q+zks& -z=z؎Vs/GٖҰZuS+a7S{eq;8w~6' /-BC,%=5 *(r]ƹVZe`R=6 ݭաe"xHᴚ,"v-Ġ(!o:wm0ͥ$^ WY.rœ(WG!cHԷ?mS J2=ad}c4=9.ZbULA@n ,ߴKZ'C- 4zeVLcswm V:xUL2лuHGscDi^qQW9Xqs*z~ K9.Nկx0R-QXWJ bx {<]UFh5UEH< k. B9۔sN( bq=#A$4p׶ ذql l gh1ä5s,iv霍]gLC& XX޳z`qSv藉*7=vR u{}Y%ީJК"ӊݯ^:5}ȝ1fܰgږruLКS]Iltv_7,2)>W5q#_Hwoچ Nq0UGIu)#7Y F ^ņ=* גBE V&d0Fl"L,WP&v\s_Ua)Cs|Tru{ ~?,@9*;&YOg/"F(|Vc*D7'] _m–WM~ۉ%=z diM!Np֩~RyjăW-|m3z>x._i!|کXm22/υ"fᜯcab[7þ},Z#Y@JQ ccGlu;GibNtTeX?マ/ӳ2&Fsv.@t~`,y4j2X#r߅#PlulϩQq-wV5?? fllv.7 v?fp04tuS:EzXRF;LL:=e4Jy=_lK?w|,"vSx(}[RfB90too"zy:BvLG&Rzbck] ?}\ ,Dƶw[ "!Ygb, u>Z@f.~ M>xm>^1132V@j>tZ6ԒꬢaK?N]{ jsb|܌`Qx#h* of0ΉW 6wal50Xq /&a9O`ɋAL;- mx m:v ΊN1qӟՁRF+g,=ahyKr'걎CwyB7-oY~V[6`n@No'b oC=q:^sÒ9 n BוDZDq$)'TlH(WED"Sە#ǬbFO䲺ܥ)0%!HHBaZ?BľX[e;X:aDkL" Q8џ}b́SYx~ {4̹?BﱒmhŘk~P; ODf;a#䟸U7yXHq?O%R`튘IX2*w6?:Yk: 7 oy}(679c[twʷv@}!XvdDе3t&Fʹ(XƟ@X[Kr0iT!&unly+n/laA}c0Y\hjhsg}$VS ˝ưFA$%ai6SF3La+?"mÊ`4t'f=?3Ks,휃݇5o\*ًYf{ [F>1W.k:CXDIR)۴ s 氉^&I (tιՈ(eaVv>k]} -#f+,\l{eii](~J1ZD_gTp%b& Xos6\xGX Q:ep/BPdUXn49 SaH3 zzIG#RVV`}꾄>s. ["^u k>//i"XB:O ^1 q۳nX!}L~UYB_ƍ)/Ϫݬ09fQ!dߵomB;Pm?0#0w.{畇;I?TOCcaNn{"pCt6Xz]l e5KE`~R369cQGD[?ú ]lgGaUss9 c G7`pg !͈Lai + I?0hС+T01ǐg3],A_iy/Y K+:{N_Z[ћ(qC:,y[aTXRUlZ*͊$01Ӝ*mn | ȩwvAÝWedJ/iYށj^Z&*Q^q6gUɃb/&.pFqZYejzEݲ_Т%{x~׆B֋ ;aHH+tW.-ʃ&Wuť*3tt! "3)F\S?41Y>ɦXȷD HE̲R0I[oրP4CIa֝ߣs藳 Q9<wS,!aJAʅ}O0h`o"b+kPIV$ l bj{5Ol8g{KIp: ;dP ~X{2w^Vw7, VM- x":[\lصg|$0" `j<2VM?Uk^RDku/`̎};tCC4f.= #. LC9-e\)f+,˹(`D;F12٪e+.`J >Fh GG0cV&?h cY6.nXз0=5=y@`p ؄Za]3S<,^~0⇍}!wg)ߩtT=6Ң4Ya)񛻯* va.(W'4:;dυz"4Rl*g(=v)=Qy{ ga_AΧ,0M(V䜺gP|[U+0|<*TE`x Su YJͷ՛O8x-EX`6l4#:6.5r| Ee`vgLs[ ,M1gnzѷpLӓF|a*K XqP<6r_ )D,֥wtmq}3/+l%Y?LP|;V~'_M箾U РKhx]*Խ|-}wf>|YB7^ kmW/BjzXlzL]2B5cկUWaMY hGf+O3D][βpI2;+P,⓵PbTv~#c,A=w`BB`1I=|ْq[0Z[A/N@L,dki5bdW|xELwH1 TĮ-C0nSO=obPO~0 5풰g tZ:oӭ""vCu CyL.2ԣ?Ŭ63ui]|x6|oDzj$eD]^Ѓdx~7$5tfl l. 6z̞C'{U:z״֠L7aTߍ0w`2"<-҈MG}Et 6(P`ŀpvyҩz5u bXv2H$cY zFfIZT |؁Eqy»91|yr(zrѷ`l ˨D/PN2`W'f]zjitEMlԴuaIL??h":&`eZ-J |)?>|͛Gʽn!:>]}\1p@8cA\o 2nT 3 wd3Km;WՂENnU5bѻ$c){^ȑtވi91 6ft zog^޿Xf]m*Յ} Q hw.LfwX,ǐ;=Vo1,0?S%ǒ-l)fdUyi SWv a ҄"Sޚ<0Τ9dvnw¨w` zdl#bWهlnX%{o{իJh'/x13W#al}#'5E` SVuO+*~*1@%6EIn7w}%X={[`nD6,1yK^B}z05]D#7S:2/U bfKlvLLojOF6G{*.kx}KwI*V7>g8P`ʥ8Xy/LΈ> KW,_#z9Ύz/ ~$GAtlABn؍cAtbbFn=i"؞b D6v > 5Xў*K%92ÒK7:'V%?ªzZOPޞ:}rVwIpe"z[o S8 lv- ÛmguEhݽ鿗mV'(@f.׾,Xa7_yYLG:T 5#c-6zG_%cJ}QX[MEQ,7,D^ / Cdڊa 4ryX>k7kpX3Ul~Z=x"WB4:T+δؙ/X`܃a4mxWt*u#ga,=T`4J5^(ݯ%r俐wco 6ֿE.GrniY1$1Hxf{K3[a#D ^-0\MBN7@:|9|O95q6L q.#c0ݪ6i~KRtlm8r#nIܥLuW;atwXW1uAUw0RuiMabLe T?H(&kiUٸ"~;a^@. ֳon1pI\IAP\UE ĕg5-|N; ULmAG Fڍ8#ľ Agx6yE)u e,p`cG7Ye# .oG d)$lʂQڦ\tеb ]zyGAiG`s9 μx>7^\f,'TIJ,SbXA4I K3ۖ \VG%"Jxjt%աO>.@V ydt}+:BsjaGcއwn0W%38xœݎPƶIF#NDnwgffT Xo 4Zvj:35t72t~a85vZNSXᅇYYW$w!BDNމ J'b+1W+'a::T96۷~֦nؐޥݠH b_V"dѳ80-w Vʯ}>D9Sn?v%~8<]Tl$C53eUVm}'`F0} LyRz vvJ!G bh*G}%|tEBh*h_J\jƥkil;f(KBJ9m0$/v+gmخoT RCҧ-tlm]Ij0@k#JaV3/Oyd"lOAīy)H9T+zy|L^OZ d$AwJoMrZVZBri>9C_XGb j%55a5Jz}$jH\^t!⧭0G*+ 'i*l1꪿6?h"-weށL}o ­M 7иv6t"_)M`6]P?V`nCc'?쫎 yBG|9lXQ%ڨ0F kGXT`[׵s\0vxǝ!,iH8G^Qsa\GH~*aAUoWMW3¢T]^Tb鰩ì{÷-V`sf?!,(^"\ty,"IX*BQdƒ@psJ-F0^w6GPߋ k*Br$(MΌ;Be"BχMYS/,WϛacE퀰Lq(>#݈.&r6.L\Fg2^(󂝅F7p*ߕ-lyD7VDˆۗѵ:086t)~Z_P.a"4¥3\ٝIST?s: 랑XNJ[qMI=oVqt|8xMmYu7cZ e&'ye`+riaMG^;S{Ouey,.бJI.NNg;b }-h!{Yv2lbDՠBS`Q;I# ϰHkr܇!#(+;wY`9Rkü>4Q R2)jtWŠY#QMo)Uowy$?tjִ̊wIn?M?b/pM[agv$`MFfx5 ƚe#㼃~ș۽㺰vfh劰0]U*\gzI +q\.bPy82Pi![y8JC*F:lq(q]{F'M Ā&l*F< .uH "уCķz?# R0,QV޷K?/T_< }+0t(n.~/I݀-!Nc[Oy|v¿~a.xl%_`r-S*$mN,a<)%_(STn^}VB (mORjcqV~DTW2d}bp>6.lr=KUah* :oJ^iƊYv#+Wsv s afcIآy5~۞a )tfU{y9+xbWuZtP5Pwb+¿@;`2׷ٹ Ï, "\t(5\5 x>z5kvD$̅k/ѻ9ayjR);:F֞d<>O[Os;  f :Da f {ѥ3Ĺ1J*VqWaTijSM{oK|tۋ5$ԉU\`<^K5v%V|/1 1«(B[33p {W󄪦׈ng?Vç:vH'JXOͰc^l:U&,@lo ~#_xm޾S V(̞]Ћ)[WWt0JZuvv;k뫎#0H6gQY E'ZXm -?GZ+"DtHWYSĔn:,QdQh>4HHV P! ݼw?4{LZD0F)t^o7F`QM#CmD '[> iV:Ygm`R Tv+AIh^ \ ?d3`M.3,3s"+9Z"E'uE3k`3 7֢ㄌg^A o 1ŽPױa cPfp$Q,7_ީ b7xY5"B|۾ܽiXw1<:uGu\ӽ a?-:뗡ib'fXڳ!yN0fzS mhr!{Qy R{)#yh_pқt4{?*v&L#KUm."q=Q=xpT6 'aRfKZl %,xf87': %`cKc=P~igü44D!`QUG{bX7=aqְV0L!-xBN-%u K1ͅoLE0%1Vb 'ľvcwX7 35.ݗч&LcG 9KGgr-u vMuK2cT0i>;+7^ŴZQvǟa= iىFld;†Q݃..VMŲ7LMatjjj|VT7㡂eBF4zBM-3*aƜ-T?xMT$TvJJf>^e r7vZ|W[hs֛;-1!IE^/{6lP%td$)c+4Cҭo": 1X1.yjü0vko7h %k"m!L=RtOCa; ,A8:{>夥~<Ąp?,p9 O]HiIłP{z[ h[I\է`g8$k1egq{Qh#"+FLDs!X~y+P/drri'tX? kORU!Q5HJ Rx _=Ɓ5܉*E#QaG@OdُBv\+J~[)jrSj0ΡQ$f˵l̟8.\.33#:3!s5X鋿;BOSFNK q_Xׄe1Jm P[|S_LAsr7DYcw(ȇ.`$:a!vE;Ij]ox&X8吅afnacLzOD{p?h5*ȓ<ad0~,]eI6lZ yBg+}!Psv~⁴|&6-+!zc[-K3;pV,..I|pƏ8cu†M;ǍMoaa;}?t4|Dik›Kb;*ŀRH͂=L 0ß:f5bAIǯ0]vR/D9' ۄTQ>]2bklg Ddcd`Ka׍t;KJ8 |id5|e|Cs*}b}rpO6Ӆ`H$a9[1M^K[e eFAWkea÷]z;RaF 9õeCd>$.[ >Xb; [La"y=XҰt7CSR!^(]WXCUyB:&"8HꞚڰwcː{UW#-hvTs0H-нꞞE9F +}Wkgbtz9S/qt7Y&xtgûO!zGd C*aϋ :? /ϧߥwթoøg<" EWXJ`x拉 VJ,k*٭3[(H{)鏍Jf+Al"̩wǟ򴶜FiEBP_}B4/N8>wY/ &cĶ a}4Ԫ::lwF.SШY/XV2_=|6Km53f`!c9V:ӚUѥ墅 w`udBBVV;\ K"{!l?sHDp}+:ϢpQ&v\ O(@s:_EӇcKaN@LAXр;;l!'8c6KsP4PռaX0vh`N<~ؤ3`oR%? ܽy}ac5].7{:KΤ uxOv p} 3zB4 / SWz|qXWc|DHvWFoؕHR@D]tWXg?yɴ,"&HTRlp ?6*gV^W $a&DgTă}XUxHr!`sAXU2ΓmutV< 6y9Ӓkf*VtaowHcJ6Dk@d;La맵3XywEiVS V}x~b yrޒ)aN-la0|(F-d*y/n_2+ ?Ԥ}9[[qnv+5 W4F&b"[=`C{%uJ7GcU,d0mK&ظ#z[-AjI0q:m5l~V]Cp}Id]7WV|b4hYbVs0q[aNS3Wy[BGΈlQ];EPqZG,|"wJa&ecb=yNLUua*Zd{MDs3ˬ w5.$"W)0#`Ҍxb;hu8URS&ÏImr^$';X"WGR+a۷=90W/lg;R 3>h"z8-hWg2`y^!Bkq(ibZRg]zuLK j*%Z+hNzżW@jaʉ="A3kz:;tKO5>U=Փʴnӈ6d.z+%E*L][e/-r96>)K/I4n8+&&R⸣`K_G嚓#Fb~]R[QkI 0Ɇȅ*$6ufa'$g{^Ü;Qjh(VHaQxG&a@6r'\{[0U hu*Ak XL~30lTaV c"I"ieK.ÂnbY6͘Q [)lS)3g:F\O?MaXٗRpQ+D Vz¼0sza=I.Ɛ< vߒX,rq 4 U:O 7S{V#7ӁD|Q:,jP}oO?l:QzaͧKJ?X"s7zaZĺ?VPp_rvNKF8|HNS 5_} Fkd_ŏ֖g:XLNgTmmɥb^zp$LM݇ɞ,ְ6z8 cUsxJF'l|F8.{{VW5U(@tr~\a0ww? [ϲW_CϏsy(W7gXݱpue]xU%e`lcd@),0h::mC`ݬms瓠LsQ9Zg}CD Z3Xo`#DXz HY`{lr /Na~O>C'`$`x9 n#BXD>b/\3{mDIW}|C\t2O?Yݝs ։Ұ΂v}zW13Ґѝp DMeGf`ݟ _J/++r=p:t;Ғ=[e::M ʼoE"{z^rtΒI0E41t|5^F,Os~jcX{[j K\n%fx0Mq7Xn4_0ܣ*@vwtמ:_1HEE{o$CjX/ԽØ=tN7AZ<4weyN4C/ڧ9`yݶG#W86}D ,06.t!FqcIYD:Ramx{aڴ֑9D!:(v )Reis|p[HOm 3;8[dĹu $>8ۙա@|oz7 z/5<`%3Xv{Rg`T]sU*z4ƶZ`KOE"epTÎ<:#7S0͏Zϔ ]2~ᚅt`[!ʌPat3Mdl|:9f/{8rY{=us1 $z?C׾ i8*,"W :_!]X-}@[U&^.e&Mtl/Kyt}:&+(s/r׉j6Z[J}>K>9ή_)}}D̚d#!}l <<Xj Z7_|IzpCu6.tV"&KHn?U uỰ1'-ԇK+.'0_jI,9sΟz$ Bg;$s) lbkok:y`EZY1~FqshЮG3l hoT6f<:nR`J*Xx\ FL D{M90pi~Z ,i9Hy G q*P;Iyy1 #Ja >.~ɬ6.uB)JD*4:|bJf22mRڈa=+~`K"]˭ 0Z-d8STg84L*vgaU}K@|s6vׯRx>x5D10c} LjTNzI*6Xo-r:YBZ'´h= q2ֺ #Uk@yQ*J{i0Vp𛇨V]ͱVr&Eرa蒓4_ܷk^Ο)CEv/Kẟa3_>wS'˽vqk!å/a1owj@ {}a (rWXM^Az>ITKE Z2CL4Xʳw{ q@VCy#bPw/r+o]JνȖڼ7~jvIr;=U < 3 dL9mwJZS͓KO2˵s!u1;ЋV?nHA{P;OV\x%7k3?}6һ]jb@S>.X.g[AfՅ9[-A?t. h-{Dz'G}!zfɈKM۷r bݳp?s|sg^aÒ@Bw@/5 6Nd;nV$ A\0ꢧr9جʡ׃@0,Dia{ws6{0/|JքL;R2/K~-͢?и0R8߻NYCUa ŗ/u?>E4ZKk0| io6bܴ_@Ig-pRml; 0$y;az>Rpk(vLIب"W Ei Q@&bSE[Ay^գ:+ ^auT @V! ́gi sЪ,MQ#?iE@'c)-Lㆭ`Q O/Br9l%l=\)IZ/b0GYr^\Qu`NG@![F̿if[yoݰ"VxF-½ ԍT k`@ܡkIh2#zBݟ7Xdq`!6DŽNV.yBB6rB^4^6v,Xr䬁 "4o+漎̖ߠ!%uI b|r.yrb&lXR0b]ջ2 -FClau A\ulh'&h fZӯjȡ >81(m1;4^;sWX>sn&~<`O _c?7-cL,rV,!O8?"䷙R#[_hNI>ln¨Ib!"*HliFLGNz "fޢifXdO;GQ&]/"֌#6gٸg.Pt#&$ʝ3V^L# ؖuk}G ݚc_V_Xus6'nii{Xu{w.kb^Cv^S S0s ?I`$e`Gk.s{xvm{!8*CR8y`I7LgL&w]Z,xl愿SqSy5^HBv 6l'3i(4 ?a#h蠟Ew^2Yq@bғӖz=C)t:$<^}\+5֛tk;;&Ԏ'HVk]`IWeVUmA؀;EX%Am1})VM(/&a l,]91*u _~sk5k_c(|WIQ3eV2%nfØJ .*}AX"Q/6.솥IW.E,@_W"n~BJի56xA{8zX`,]0L )]bx 9\rx0D.WJ,\,/#k3Uv|4iw?oB;h<\-z2+p[ÇO$FXV6;+w~ FR쌧͊@k/zܺ,|ewZ$ 蠥xБGl,b`0^=H6/Mvʇ󁛰Vܸg+ 1ϩ@Uӥ $+eSkV23 lޑ.V6kw"0$k#}Vβ\@J^s~֓t]/ל,,= ڇZV( їt`U{`?i_MT9Œ O{~ bCYXrWl,*"c]g`9Ͼ&~bDLgQt7sIi{5q;ԸxECaml.v>L02@vӫ?`Mdي.l;'OҧR{/ko*/8Mvba9WCP#\JiXDR~ҦE#{QD/GQYȨ@uL]|eL7 Ȟ! JUFhJhdYH[hkQD,k/ߡBr[:9\:ޅ^4,tVފoOp5={6+3X,R8r(U2S$qVUz#~rJVU۾LVYw,13y7,9xСF'r d`;pp3l7RZLeѫ ;:8=֡!/c)6;4dU* 2K`O9r8&n ךFa%EIv?~8%o y*əRѓ StĐPK6'M!bhogDyluYp݇UqP1 X{fdq 貚i^]ts7O _"W>"f8!.Yzx!jUZ}Qz [i+*Ve*+Zn~Fy =}3'v]ۏ%i^>&&T }5oa•DI w]:r "v?)X)3ὶ7#]F0K>M8(_^a6=TW=r?E|: ߌ1*~_ dqhB/ة( q~I=]Dk'kJc1 w/grcs.Z4K?2vW&җy`Ì᥮9j0%:j okJ/i 2\.$7>օ{b1~9Oa[U_^c{LDޛ(T+_lfn1*-xhaVj-RbXf>x=0̽io$BgcbЧ{V/;ƭ{iY=[XO6NXFFʖtA>lI}oZ;+sg* SX`\@u9Km*e0r<7̼mig~zz@Vl$\,tm{aKRIPu/9i(4)u#bW4'Jzj5?g9})+DW3/Ȳ-"|xQgH9LsD}/ /(f]F8%!ı K1KWK֌eSiR =kVݿ|r frVtV!w_ۛˮ݂ ƞ!3XarP|/ݍخlw>Z~1F!S; 6S|`mchgݰ8bKe՟w)ϩVzUUesAh9oc %NߎExq_$X=e$Bb`KO0|ܜƷ;G#i3ne $D>aT1U,⋪&+LaJ+( &; Nn{YYhz m=ŠcߓOeL/8Wg O` Pl '㠽B#.ח g5u37g:$.Zqf]>ŧC_C6{jPY F/k?Xv!돘e^u#µkK-PzrUI>eH=l^sb3g%`,6P" ;2Ffu* 6O`xkdb`lۖr .VY:\]HkaةSЄ COA?xvӟ ㎋ |MxwtA/<_nb1Pat /,zV+҇cyVsp*Ƚ#CtEg/]mK~㠣WY?]$b?Ś? ɶ}s^: |R-gwzf?/|x>ղ؅ZVKgxIJ-U S,8 ^ؾx{%]JÒSΰya̮d\:}OJ&3!ِ4VWCL--ƢVXJM>L w1 Nt y`^ȫIvUcYTG+5R갊VvѮjP?:pZf ַg/](?Z,n#riȝ7hDο5S`Wp(+53*Bl7Y`= n,Nb$> `i {arr4ls|mDX^5kD81my>6VPzaTsaH{⠢#l~,f֬-OCyzΖCm4к ˋLr/ڶ]jڥe84feM| 1l8xtȬ-'<>K"4af8,uvzƅp;zGa9p#ԅ)>< L1g|'t,;B3pL`3Nmay2xޟ5m>d#y֤?YVf}^w8T`~F(04}1-}5 !򈰤ľ'X"/0EɚEOl&X?` "Uݏeg\z:Xû`+4t,-vp@,߿wvKCLc/BW8٩@8"e2` 2;˄-=WU%A ȍ͇1#CγΈ_MŸ# OJ\4Z}K:I l}ɎDC.@捿XNQ;Aؼ/k<{XwcR g$*1 ҟGWUddQ6UK~6~/.ϯm<(MKr,&#j(o k{O.ĺknuІr[+4D8O7 M I<%ǭa%v[Tj؋{y0Α;44W#lA{/hsrÝ=R"n-aumjM!̹zLD]2N';NB~Jm-U+D6 9FrF&&6Nބem}o~Πz*&?@ ߈``a}XϜl%+/`c1,WY W9aU^s[KXp/&軹a0r(twK=[Vh%CscTaۥ?6Sڻ#@z]_X6+ Lqriy=Oh6Hv"YwO{Vba,!OF/_؀Y` (grU&aVH5hHxqhjF>>w@Y:h癗u8V% vGnN{jÅtB(,) ƪ Ǿa2Tew X?(;"Ϛ"a 7`qk]\ֈ W7mVO|O*W4j E `V!ʾ mo#XccU˂t:ؠŇv,0{b)#hc9sV'C:2)[. L_.v8%rMм~xF+;mPc6 U$`uL'l[_ y[wY@8B20K˛OwE?"aPuQl|F8o]'FRӃs/ѮWe18.jCSlڹ$D?j/wT9!&ĤG܈XUd[7sh"f{\4}=,f +#ϰє0sAJvc/ 3<|;2#^d"t7ipbfzXaL*,e="}TX̳|!@uVg[%ޘerkDoKaĠο'Wa3&\͋lsAo`$so ᶎuWqDd?!ltDxY/Vw/ m{Y͈A, Ք+I %J~.Gψ1=(6S#'aeHhʉlruJW湊:+w[1-Nbm1=^Ӽp%X.ޒ#t ~T~9'kEӸ^4P6ğ32[oՙYۮKue EcK& ('MS5oE"XK4O? ~LJ<vbPV9PЈ1?@sr͔QpR}A 4w[c6] &lv0ro/7h IN*^h9:ǕESt=J0՞l%Vܛ*rO^ HhjқTFQG?VJ02bǬ&z0ok\߾SՅ`<áJf}$>t9+ ŕK͕$z^y)~kdq}&mC!S{X!Y^>k?JL0b„`ֺ*QQL(&D b1 ""b -s23~v:_ֺk߾}9u}gnz[R-w[m6W:_饷{eИ}F}q*mޞV4/XRQ͎~OO~rסszߠ vq^U{>`oozeKԊ{#uuK*Qb@5@ܴ}ӣԺe Uj~E_kun2@\|l9ߧW]yEjc?ԭsUqCQ}=4|ZjOzm-F=SMG[h?Ww4OO}랼ICާ,{ H #kT+8wQ}G&Q뺜wSkͤՖ6޸_/69WRk?>s>Ps8TkF;Ju%N[g.M/\gU oo^;%.kwЕg\AޒZV]j|sj}/ToHժ m^zl5{Fw8a~[\yz^xZRM[cz7'^Ts/H\~x ׫vvq{{azܔ#cZ?8wVmѮGr^ R;.ˤ_s*zSNTsw|sI}tM“~AݣkIpr^Ӏ!i?q|۲/S&WC_v=u}Ԛ~nU w_^ۘ^Oo8=Ώg׼i7jpjۻvehQl,;vsۏ ZMP]ӏ T;V[۾fؚ)۩qT /m;vg՜{~jaU?Պ~_-<s[ mZ_)eϾ͎oPmx̓6LDVLW/۽Ú۝<^ػҀAjtw_۷Amt!|RhqK~M^؆j#x5z5}77=ƫU |jQn۟饝W7v~"-;iNmj{Q ꖛO/[3MhZ;ItVnRQcSUZ7Oӟ~ǩ-=3xezV0.Cg-ܴ(Ϩ̑mʬZ`A WN1낱3x`}u֝LsS5RscpoT%oR<]׵JUj.MOʾ]_>DMY[-{|lɎ3Pz~P L]Vן~Jmg'TqcĢK.-~*:}>/J\oz^bϥ^V|EStEGG^>Zɵ 춦jk}>NjngF {s?G;_=]Zm{&Ok?~>VwuٯڥVj,0=!g-L7,<37.w43ܞGjk<='@|8ې;U`k7׹9v>0(׺u=ڰfh>׷vSֽ;§VjdCmx^K>XoqÍ5*܋{5Z{^M]kOP^PG?l@kԦ[؞W[ԯ{nE&wT˿EUUr^XG.۷Ϫ ezSKGߪVMꏪuܻWmfo]~qE6:EMj|B5ǧm&r5j }Qr޻Co?~tVWFk_r/zCj5xկOםF]F1?oNծ~ZuSՖ=_UE{<6ujyj+>=JNcʪ̧^11NTբ7zJ`9Jx=negwy\co!cBA/]SoQFm_ָP|xaԩ նCO}GS[;T~.it߾wT^Ѭ3gQ>Qrͯ*gJcֿX}9Ίtț^T8=TO_tȀ_S[[ߕǨ*\߾Tѽ?5PUpPo[T]qϓT2Z[mR׽f̟}Լ^>SncO6}?TQ?U~=?2uU[WyNq•}Vy]<:U;)]^a}]۾2Ϫ׵|cTҖ?VܾtOMN~2𼳾;[2ԫ?i^p֥'~2p^j˰֟('b|8uY(vh=ϽJQ^r<([g5Wp\y[wmnCOTZ5N+ՆU^S4sՊʛ7u].sj3odp}ZmLv|}Sm{哣T#OM{:Glԯgw5Z/{u4_]|.tzĥyjS="J%أ/~݂Ԫ?26ZzyΝX_}ۙT^я}C9"o(4~*P=^IjS;ZyGRmltSJ UjY[VOq'oM_~nC7V <[0~{'T3,m뿹}WN|wNRYfj؇lzƽjJ\zUgə ^V3?MgDU|3CU_],Ju!~>P-y΋PߑuR7{GyM;اߛjCrfmꨕ'ʫUڵ>rpgե^{^Tn?ÊGl]n]^7Dej,:橝:բ;>%7_NU0`TjOn`Y_>H½OK}0ӷms{PԒ㏸/Q}\{^c~W =:Qj/{3Hmx<0(1on﫦GS;tTCݿjgVj:e{S͞y_udIjy?ܯWD[޺?J4;WFG>8/jQ~ouz7ݧ8 O(⫏V؂ߝ4gw6gu .qǛrW^S[}|j{O.oֳn~G׻ejqW9ICO8UE~Uܷ-DOlT&^%~z|n^5k֪-gƽ~qӯ4n[;Fyw:n^QlU^]ڝuTi¥Q[9._(XZ;N1kLzڭgSUMKk<%o zj뢩mj^Qmm|Cx*#i#ύvV_~Z)Ê K||cޯGMj?ԺytQQި/հĮ7̾-Jֱ㕇Vۖ[V;Ն7o}ljqzjŁNz|t=7Js_]Eρ}F-\va8V'nQ[CwUn7^~o%F|iV;?vZ=}g/D5}ZlYGy?usR^ھ???|xQ{qgG7\Khw>lri.jѫ?w|{\cK[3]mivD Sw;ok퇽>?o,xoC4SmO١/Xx/uEמWmȯ?W6Qsrk]ds±۾2읳/tR5}c^^ǥJ=>tѰ3u0WԼotQvzjo_IXx}xG/=۞0{>jIq;?}VP-oԧ^]Dly]Gql;RwkP8&yc^T˅rTU[?/=ـZS?;zGEy5ѭ+xaok6yw ߶LQfwwV]j]k_W[{pr.7 #'\FɗמU#^nլ~7yh{՜?;Gd޿j֟R辽զ zg2Mu9uLk_Ԡ*2c7vRuPߪu'vVhZe3/-Rk;}5/GɟkM}G5KH7;KFpʉ?e憐~/zv}zvGZ>k//MՎF<·ٷZyчʿBg{AM(Z›{^tyɤ;Fm:[7]Om)9Nn:˶jU|Gwe??}jofgjGŷ~H(qTr6=׸_< z߼xjlkVwŠ_^T kuť/6y UǦ^v_~'\~'TbNR=.^\t\53神j [ר~W:6jݐQn[I1o'DI3zqٽQjyW_?Wm|*%GH[9bĖwGy'M-T:ۭ_sZ{p s<|OUWQك ,K6۹w.P?kOgIj?3ɩjG^qhijӑ ^wԮj^W9(/1[Mqk~͐3\_q lvƇ-䵭=jA4L- (Bǩ9H/Uj|`6~q/ gL}rg'\GMlpɊG-N#+tSs'}R_e~B?_~w PˎU+_9jyoԹ3jTw^w(:E]^!1J~jλ_]u4PzyMP#Wu}}-jsU8aRx)$SQǏ-VᑑUӧTtRwu+w[:&;} y&쥊^}cӾcԖ6k5Jͽ+;ݭ~-Κ]ɞmU{ufwUz[{R[S9rj=ܰ}(yGc'<\m@T+E:??ԖOkM{eEyj˅>?~Q'n)X~֓[VW_ШߣpʳO;rqQ!t~OrBধm]-9>(ѶvACoPWm٫.TK-٦q#au-}E}^:ֽ&~vXz+mQZ7Vg(Yg}P"JGT;,>%;I?>ęy[wZ^Wk7?o6[oS[\w.lsˏEHQr:*Zpm|T {PLtۉtG'b~[S =gW+{ǜRzѵMwZwC~GZ(*?}LXs?bޱ1#*={ 8^mxY]jSj{Z~|iחﯛwnvWoW?~sgk8kW>Z%ߪ-ڰFAk~{1jM[eݨr(5}F^w<~rūcTnsy(go`=Zuxj%śQ WS[fVϬ5f߇6}Ժ &0djyˏߨf#3.?9=>Hݬ=l7Ϻ{mק[://K/sS_xYxW1ݛϨso]Qc][B5gWZ.{VzJs8UmZʀ˜ G-J󍗮YT߾sY;ޝ|WfWo8Oz?MjռzT9NNUjljC|ݷ|T[_{Jy,yl9?Km:*wKӺkDUmxNۯZ=+wT`%[mU_/m|nō mOZy;/z *fjOVgTx@yz`z8Ul-Xm:\V~XW+ 0cUU>9l;{Ym/9[!wN>ͽ3Htߝ[>cʕ8YmGRΙ.W#^?:7ܴtfm}|Ӫ{Q}C~yίGy 8g'W YZKL]]ѷS ;?? SzeR{'n\m.Y[ UI5Zn[׈gZӳ8g,;ժ>j[zyo[&J5ƛWoTmպuŁնGq^hYiXy5T[᥍.T_:gu}3NIϜUW|[ݱItKj횏8a*g}^WwMm: s׶HޫaǩMs~(T/L{re'Ujþ^; &uq5enHqtAGU}}6sg6pj6m^pE5UXv/oq3OڢF>}){w67yiz@tskTYm]P]MpA-'t^-j~yIE/Q-㭶>RܻgvLϹշwP}vmVp^þREu-zZ O{ҕcʬoK-ko6.T|\?Q꼻]z{ޫ][u\ç7^8}Ϻ`*J'Uf~}sV6˞^w绛-Ӟ&jɅVȑjNj?uWZZwԒ=5BUptAT*ZusGIzmfw7H+߲׈_o|Ix䚇Q;.KwK/Y늉 V}c5V:e>R{kԒ{O[x?[~({]>N״ifxa5ӳwFygZͧQ_bՋwYxH*ȟݟνn*wHEe6{΂#rymET\6Z:JlksGv{lz,sλ;s=#:V;F]Uj4'^9v@SFWu)c~}w^oڛF >[^jşK_R[ԒQ?OX@]]̙j}=>ڭOwLO{Ssd[ߓWB:ZE{^疨WxKud:W=w/?}sWǪ}fW?mwzsǞ<Ɲd?(UԱޯevW͵gSVU}Fe/jŎj.|m)[pQ~AWk.~n/˨5zoX͏N*GnXEɑ 7}SUp)#|yZ7+O_j%#N-?hW%6/8+dϚvYCN>oUӻM{pIy>j/t¶QbsvZw9?vZ~?\_y&'m~󋻾sszIo-jr63<֖/ ˼Ej[Tm(ׯemZP§nj%~Y*<~ר_VkjB4+\<~6׫nRCuxCK[P :Wv=ߚ|[~Tg yScwK&*Ӯ?Z]|Iϩvuoꮶ~5[fRkܥ?T<Շܦ~:ϞsSUg6V58oVyzkv^#wtMB|&uu޾Wx$uigi̸'79(JluM Q\pnxj՗Omcjrת ^aFe|oSf㋿ߞ=9젎^'Mj[}yTzŮ7һ>jz^4C}X,>wg4>jj-Yg}q} LٻQjC^ ZV~e]FVH Dq)=hXv۹85J};kSK-5_ְٗF6ߢ6t}H~¾KW|j]LJV/R w{Mm˒ѯT\ra/~Ԏ>?hZQm{y=*߳9f GMWAS1rAjgmԉCuZw9[휭'pzbO>^[޸ܽ%Y̼Q']坢nn+ܜǪpڸ3GezJgV-7| {6|ad(yxlZnQ-OT3MjjgVӳMDQ}0|u<=4̳Z7g=>jQހ&?/y5SzZ^};t(ѿþW~am΋?o}djfSwݧ*7/zZYSj+Tsz=o*X} ,R;G=ɑ`^^(О$q_k͸AmquW}>/]M[g]U9~ծ~>?8J]{sg~%?e^;{Kj8Z,QgM׾2VO8t*ӎۿ#j.mOjzƚPKKvM/sTa(~oxʏQVQ'Tmx`ʮEK*k^ۭ.ҫ 闚}?i41S㢽USY3hMԼrԺV>'G[4 5}v[f\9#ozӎ/|c5O[um1[v)sQem[nV+޷|A? W{sԆj(/P]Vѣ^m[Z2 Q/yGJ묯39J =պz|vԒ/a9׆ROT>r!OqZ{'k%p͑s9-MW? W.pejFɕU>}jظZ?xZuW'mOnY%kϊғ>lpJ7:g>U>QʎED/HTؗ^)~<~#osϪGFǬЂ;?U/?xPDkE .8캫g9s'ç'6=Q-hG}_}Y\A#Z[1%/:Z㋞q݊ji,W_m_KfN*kDŤky]>>뎍g}6oX׼Q/4{p5IUZ#FܡAT8|~|pw76|P0zYm&y9/̎('uOG5q½j{=wjƙ/5!nopJ!厬;9ʫ~VjvMW.Po. ~Şcpt5²)iTXKmWF_Y/ ;_>Ѐ_{N;jeC(ǷWN|Z3/iϳOvԻ UQkyӖMh ,:ui{Nmio~9Ev;첍^Vӻz'f M-/;2q?tQ ^~`Ւ+֗Μ㴋˯1~ EvosjL+ZU3qTl.W?tJ]֪Zt?ZKƧ׶u/ig9JQZ}_Qz VWq>(EM=ٛ|N ^4xº\[)jUƽYZx72=}-xqZzH֧/7[V-wݚCD]ڴYtUwqzK-h㞸BMƼ]׵U ~nV;~rVQ[՚jzu7qG;}Z4c{ݮV?].V ޯ߾ul;WL%ۦ/Fe.hOOp+}zɊϭVk~d }Ț9vg׸Cth"Hl%G 0`K/c?} 0`^5k9 0`nr)/0`bLOo0`,a f 0`K1ܐ|70`^Adz 0`UaW g bwټ<8` XzQ0n 0`ҋQ^oO0`,Xc>} 0`EUxewY 4_1QA cѦ?sȀ 0`&\߀ 0`E^26` Xq? ^ 0`(Yj^ 0`EU%z3 0`ҋQbt0`,~z{. 0`K1Esh0`,_ 0`ڲmE} 0` 0`Q` XrTwyݫ/_0`,͋0`^T;3py 0`ҋQ*aW 0`^T[G 0`REˏ5}T b:qk 0`^T/\u 0`~;m 0`/ 0`R.hWK cs y_ojD 0`,9F[N(` XzQmsĐ_0`,%á0`f\^e /0`^TENS  0`KQ^~аY m5 0`?0`1 0`R{̪_ ` XzQ/0`,=Q0`,Řxp 0`K/mS 0`>` XrTEy'u@G 0` 0`Q>fjǩ 0`K1vَ<` Xqvv 0`R[[xs 0`^^lhL c^-0`,=k0`,_r 0`*|~?` XZGZ1` Xz1J\r?` XzQm8F 0`K/FVTw 0`K1&_h޿0`,_ 0`cܲ~#` X1T; 0`);.8#` XL6ko}Ԁ 0`0`DM?^ =0` 0`,Wm]o:;` XqSK66` Xz1ʫya 0`^TV_ 0`K1n˫0`,XxO/0`,Ÿo} 3O 0`ҋQE߰O z՘mL eݼyB b8U[0`^T[N؛ 0`K/{0 0`-Z0`,_O 0`KQc׭ 0`ҋpnǀ 0`)-/s̀ 0`(ܫ 0`OU9: 0`ҋjV9Ȁ 0`0`9Q낀 0`{"` XrTEϧ 0`^ߟ 0`bL` X1)wk0`,wt6o0`bL{镚 0`˾_?0`,XC/X1/` X1) ^;ev c-0`,Xq S 0`K/7MW 0`K/F7Wf 0`ҋ^k vи#0`,  0`K1,k[ 0` 0`k1m 0` 0` 0` 0`j۠eo|un =0`,9FyU?[H 0`{"` XrTEw1ݠ 0`(+k!` XzQmУ 0`K/Fɦeupˀ 0`EUڿΎ 0`2'oBՋ 0`W'غv b gzЀ 0`0`v[~ 0`^T;N~[~% 0`ҋQ>8t@ 0`)>z. 0`K1&Gso+' 0`K/M~ 0`Oh 0`Ҍ{0`,_ 0`myw,0`,%>Zk 0`K3Ko0`,Ř-> ` XzQ"o 0`TV_0`^?0`,_r 0`cG=%` X1yܶ40`,5T 0`^ 0`Q|nkn 0`^' 0`%Ggf 0`(K.S'` XzQx,` XqǮO\6dπ 0`(y7` XzQ>ss 0` WT 0`ߗ 0`ήE[ 0`K1xf 0`^U 0`?` 0` X*<{ 0`K1蚋j 0`K1nɅ/0`,%\ڣ}u 0`S_ 0`U>Y ~}MW 0`K1Ms}F 0`K/{ %?mf 0`K/ kͦ€ 0`?0`TDbdÎ+υ7wYq9[g+[.?>8mHrq㪛-vJc[+!-էO|\J!Ѧ$|r6mv| ?N6>rWC|z _Y#7+lwDöw=JNozݖO;[K~\qg/>_>i3n-%]~\v_W_8sƑ]ubŘkm/G)R>nzuK>mfv>M-\%ΒU{_%s%n6?>۴z&ї-.WG2Sr$jG~}ҐKǹXqjh/ILy"}߽/nnD>-+[,sU+}6%ΥOz[+ؤyӕkrkӭ\(ї6q,э8@7Ҿc{/ɧ^}ylH\}|Jҳ/F/[q]W%UY_I?~p+Z[¡3 q,.:*ѥ#CI8ٔ Fҽ>WwIJzVR8sW2;]}sْ'8qK|9p⪛_\\Jmj3mble\fDZH%ǁDҙ,ʵ6y-]/ũԏNGM:pk/Iҵ%Y'o[J}怍yIs}1љ¦Q_Dw{\Yg9HlHowu]27]y.qr[I.?qtjQR8zqe$lڷU_Il>jW|r:gzD};Nq8͟8f+.}Klĩd^ffl撣$}{lbp+`MKuw_]Jr檉+8p\s̥;izնާSۺ8|z3:HT!I/ʉ+'ZWzto,J8Tʽ|ɓUwF]qO!{.VҞKq&Vm9IϤ$}eק6mI.[R{!Հ+\W‡/f\{%X\*MZSiJvi§mIf϶Fqt*㪯zhU _}]n$6$uiBʇ _z_˾/]q/6$mm͕?)|'չo_lqzG$ɬ*iKz9 NqsvW]qrk6+$tUö&C2\6vq/xĥem53;9⫃qӺqGqj誟7W/ǵ+ۧZ}'ww>۴w..K5Ҩ. zEIIx' vz҄wI%e$/͗KRmI4W\3+|>%3Ca\{%5+N?JKOz;q&]HR/lfQئy_>w.^oÕ8͕KIGW/_|Dr-}'NMq7n%ѺD׶gIb3|j'W7 >ё|暫|]7m_.>l1_$|ta\fͧDx>[Ix~\l}:_x،6>8roKg9G+}uw쫫ז_ljR\M$\:H}ȧ!%zuhZ+~ğc]||qɶG̰8z?>ZHS]Is~.̆83ǹ˧+O:p{|漋S[]\qb9; n=W>$W 8kl|ʡR_6{.;~h1=}<2J\g˸1I4'5%wH,|w]qsŞƱ-NFl{]%.A'q.qj%kH+|fmlIgsibh0luq҄T>%%F .ʣkDϾމwIӳ3}Kr˿7F%h%N^:\bt*g\84̵MO>}zNҟ6JjlVK׺sD2mJҟ䒋kDu8҇KiER .>$#wx\&WmGqAʭ;߳8:+ q! _?J˯)g\._=ę $ƭ˗yI5֗cx%Wo_ٸk˯+$siPR\yJi}ӓK_>PZ+ o>UWW]J¡/8:gh3ȫ6\|57-wW_I}u]V\>^m:)i $|pْjŋ//K/W9W4ؗ[MpӨ$|GGܸ}׿ ?'~iRt8=%m[k̒:s?|3)DoRl6$:b˳_M_)W_J~%:գ6\ [otɧo/p-A_}ݧAq4hWNKKKJʷޥh-]=Y#>^}<&%_߹ҦO>qkDI5׋'O?x$>/WG..l}ENqxsCiڸu嫿$fI.-Ӯ}l=ݥ?_IQ$9jɥC sV6<|sAһ<$)i]\p9]ȵ׶LZw IzSOwhɶ޶_G~pӏ?ǡKK>?zKljG^q.\Ij[מS 7:$vْ.fM!+zKz0n >ޤqf]>qٴs"agO]ykӸTX\uhƅO]5ΧŸ}-[W]\}| y'ը|ytX|֧1HIOI_tqm{e&IGqcڕri=ХV.?IBZFl\z!.>.%sK.]!o%eF8ƉlZh>nxǕg.+3Һ!㫏85)g^3)ᄒ3"o'}&P6\5luEgs՚.}3Qʥ䝏o㪧kD6N]>>m\OI/}羺H-ɵ]bҒTRMI)]4i\-Jk-VSWn%Ϥ}k?I4G>}~ǙauqY/iKkHK5#Oڗ4 _RKzƽV.ZsWƷW;8]}યwR%U3>I,.qb)фM%sLZ{])\ڴo9G\9|H1\57)6N$RR]5gWqzǧ.bυg_~>]zpp8=(Eϒzt$Ѯ#}Z]_I{[IIr'$qKmӽ.x+ٖ+\I5g8$:q'UrVG.l$}dzOömzri^ƒ|>.Z4ӯĶD>xvviCmDҫ.}=KǕ_.}ҳ.?kW/g="헸ry\얤%>hO{%sوR-D#cܾ ᶤy\>}Alvk/Vjwpӵǡ͗Ćv|;>.m} ik-_-\'ѷozItiإ!_-ďn>M͟Oq4.eO8qjI4fӂĮoHKZוśF|9Jku%Kq|1#.nm3Cңq'. Oi ]>m[&]!y`ӛR\k$&3_.mzƙ'3J1ۥmWt&Չ>6]|jmK6|ڐ%hRWZ_OWoI]%>]}7N}ʧgD>m\t攄W[=>nh,i.y$|HzU8K9&?a5<ؕ;^W_g^Wt#YoӼoj0[Io'V܉3\ϧ Wl[.R$'iOR˷W\{r9m7F.ErY_Rs7vN%cbsdotq\{]+6{n/ zZ_<=Һ8o{'s_.Kc$m(QieFo.IŞO7..Ǘ?}brԥ\KL6}KUCqCR -WNq'8urٖW|\z/NryI8II14૛+Ffp=&-I|jo+֤m\uSS)o%U.=A2WIgI յǥ( iOf$eә͏/8϶M?.-w'6[}Zu&KR_O~KcuiW]DZ]6$sOuRm1JOO>\Hd[/?Fjߥ}[\ruw|=ki_JRt-TR}HzG·|IbԮM掫N@R3|vURK,#W\qfϖT.-bφf諳ϟffmH4!ёTϾ!٧94ڥ1_\$ыķM>.On]<+}1mi .^ms§]_$\~rʥ?|v󿕣4.imr_Irk˵ǦI\+8<憤ƒ'G.%řt|t͹\;<@cf]ًÑFZHIf|\4j_m-{҄lҌ%qKgտޑr,f?]Ϲ|qٕJ>MJogK2}u]\z4+ >7Rڏ>{9k.ߺJr.շfU7!1|KfKljS?>.\81$ZhLһzv$NFl:}[.]H'W >-8jڷešMw>]mzIo\6$Krr8nMO8˥G=)-__H];cǗT'~ĦHʷͮzN:\%W<}k\iǫ/w\If/'|=8uIZcmIq%|?nl1J3$ ƉGmIHk]3ƭdfI!y.}qd# -mdO|}Z/O >_qjn#K:7\k\Z﫭Ku}qlӦO>%Y w祜/ѨCI=mOzљ-.]}ұ+/\۫ӬO8me.5ţGΗ+I/$Փ<|᫵.~$k$⻤zsQ_'qb[,ÕK3>\qҨ+fi}ҶN\4$sw>>~%c{3_uz'-qw誙Wܺl]%m%HM>9ǫm~I-}~%32N_HCʕ]|,զߒW|x;xső ʼnm]\JgD{ڸfwι|IzW?m^}# WN'i|Htr͍HԦ8B^һdžknJzѧ5ltqUn?~rl3NjOw=wCCޖ%ռ/>n|rp..w>%{}]5L~}Φg>Mhӛ48IK:NHG$@:>N^.bSZcvqIs+'W̮~˷ͦNq.Ilyl8]lq,W8y4/^Wc\V_W}\vm(/yZƒ..$|tӘO~Ҋk>-%:lJ͖f.Nl:snrw%+qhNҏz&MiӋ.ڸtqk᪡͎+N\.Kcrifåu=^&$&YҢ-f}W>%9n\Z&RN}%sȦsi7|}$gW|ӂ+|dՋz恄)HқٸT#W|1I8D[m94.7׾K5'\@ii}}\QkVvy.}~t |&mquT2$3ȕkG5_W^-n}}'>8pGqj#q>It;_j#.qgK;T >sِIim}vqjq"јG.Υ/άW.jѧ 8ѥ?i$9l/>weWmZGD'[~N»{;IT}yWڷ>͎tqǵ'6I뤜I4.Ѩ.qWR7 >z/ϟDǾKm4{IqҦt.)qb`>-5qm_l=Zߥ%','oW+ٶϦH5/A.̑=ӭMX%fdθӻO[xrivtBWj'wRm%HzƗR^TeIl9#mV3__H!=W.[J^$ѠOö~'.I4.q ׾l{]uvhF8<ͥ>]yHlf-v}uk\$^$v]ƳW\=]҇DC>Z~J\ǧ\4_f}ߨ/K.>\qR׸SYy른{iV3is}6]+i]KoܺrqW\{ܧoM_I͕/F_o#խO}= !\usǁ+G_}$hOzw$>OI }} e}㪥|-%=誅DG\Jt+Ո>]WKwM£k~WL<\<ǭu.}53id+Nn^i_$uñ8bǥAo.^\qt+.^|UGIIz}u\-rhJ?ZKa?mW#%IzƵU#m5R}]җM3>=H.W4$6}΅7ȵ.Y|ڋ7sln||3k~bu7{}ZO$>|~bW+uiO7ܥuiUc]3qns5K$iSԯ4v_.quiWg8lZt͗T6X}=g6/$s֋wiշ$g_o|}9l璷KO.?!hqzy4kӀ_%Q\ t_}$MJkKqrwswW^lۧ;g.> HsS<|\^q~,ёM.mHƓ{f|upiWi.ti6}KYI7&NI|z嫝m$g+׼mqǷDq{ N\Շ4ը4O$KwqҐ4?s"\r%7o|toHZs6߶m3U̗Sqg7$f+: ]H5ç8zů$7iHګ$H5( [\8}GKȗK>|(NbS`ޒ\m1J昭&.%y|4)7|O"USW>zBRK_u>t!K‹x|4O~\:i!NOJS]u|}jӶdĩ+-VWtׯqӒ+6]e\R#$=૥/\!ѶNǧ w 3 lho9ōO嫋rYŸ﹯~4ڷF/5qlKgT7sG¯dzƧ7_ξO~i[#Q;i,b-|TlKqk}Jg_2sM6=bӖǗ/\x!ӥj"8v6W_RItU5$lŖkl71pJ7%լ3>%|Cn yţĞ7Wnq1MI'j[R]8qJW\lڷ!ћҞsGzI|xq"_^'ё.-xt;|\gdž>KbT3%q?gnbtB_=ȧ}.тt~b{/LphҚĝqˎkKfo^/g X]3}ӌ/7}u3mN˟8Sɬk+K<Ͱ8p$!Wzt"i_toӏxlIuӌTӒΥ|j&7\m$zofHt )\ħE rpQ?]k}7k|+;f%}+{mfHT߾klw6_PtKM9r%GmfHI.BG.fO+ZrՋCmZq\:c\髧~\9HwW \HtN_zIfK+\9"OW:fK.Jjm5NIk(g>f\u=ſ䙫\(9.O[\}{&H|oW;I =K(չrWI{uՙ6}+V gOZڸҖ?W誫GWGW/S>qlH¥ اa~|v}usO>%5i6$r_HlJt'g-Օė+_oj$oI$\J9uЧ5aFtru𣏕?Wmmӈ%}z,~Ӗor̥%/霈ëdxř8#qruiԷVM?\ut](~_?r %ь$' pzҝ]1KpƩmfqi=^^mbq ҽjV.hF­/F8=`[#>8[AW.^8>ꪫ+F}}u\c}T+^b{š]=ǵ/%1V:Ә/|)+W'i~}_.tU~[=%brfVbpK߹Uv\qKk'oWGϵ$=EZ_\^\}WlşOs]*LjG >^poZ?q(I<x̀=ǗS$ѕ_.ljqݺq%_u'7I%\JyQWm%E}rµI6[6^=Һ9p g%Y>9~\ǧ9_z4W>?~^.utӔkָlK .$AoI{ԗq8򭏫W}q$Җ OR]V.>m}Oi]]=/ow0WKk(IMԶ4Wnqt'9 rܸ|+3>mK,!_m}c}\쪫-8q%=&}Z#W+%I+%gߜ=>Nqrݶ^Ko~[>q-IOD%ѕ3MIU8tqK&Ɍ*[w'%Nfx0̗զsIqt蝹>b+IqjkӠKl5ٶVN#ߧO\Id;bOI[='+'I\&/VI\~8||]qK${_qmxN̗^wՋǟG[~ZE8O>I]rGkTR8'_˷ק_ot'ţlzd>H5's-o]9цg ^eKCZS)F˦/>}8>ّKwX|•o.\⪋k_|ŖK>?hȥWIxۧsl#~$֛6;oi$=_o_?iѥeO>})q|-OWo4fWW{7>KkJ%-#IoJ`]}~%ILO<$+ircO>͹sOI]m\buӽ$n$&ճ/nmqUsm.\3!lõDs6lI%N}:.3y瑽}&T֚'EfqQ]-رm>\0')ĽC`d5N9 b_j{(uh;7䗂+3}v +k564fփ<4.i<N8 Έ n4E'!GA.k\36deփ_sIc u C.y{R; ֞懽yOi<`|5Ƣ}^+j?{1yl<&cݴ'r6>@NM59j;Wwyk11ﵸ~ ն-ڷx]b2ٕ#K{̏q@֡]m/]=c:@`b`_YF^I4vc^} .[^W<=/jX9-ΣMmVqf{1n+pˑ5g,X0fKyz8dbע_xZ^y ӟQ'5X49qj}-\^5$^[lIDrDaxzWufO/<7ĥMt Ɨ0?8K&nue7K91w7eƷ#m9gz̙fےWYgc#\<11q3U=>ƙ`=?or[IF/?O->[!xN9>,"~2){p ~g h3 %DrNxYK6&vILdBы.Ԡ6 2{?ߘw¬7`lrc~'333d=w&? N8-%ZZWʕ6K1/3vq]<2rBSʹg3rX %ȼOֱ͓+̢ꃞF`m//b'pL<țsfdz#zZ]indC.ƕ͑e.?͑Calq7Vkrq`}? g=~GAYg׻F;~&_#WE6ѴIQmRN ONhĦk6s-m/!OvO#vP_cG19G B*a,aq%:91K9Ii~zm;l21@ܸG;ɗ}YبɏӢ Z1w cyIe{3 G}yK`3A߶}4'ԗyOs@-h3|# k6s=0 };W]&..m1c`L\Z25C=4WÚo)ۻ<3\~CgD%&aq06s8оi0.E4̳=eMs == q_7\ 6?gF9`go &W7 ƭigO/3o6oΛdw,k/|<7S?L d/'WF乖7V[n7#F cwjY];'of 䪝3NboTͧ+6AIGnQϜ8³K \;w6oQ)Ayc?"/;3:HNm3QSu>س'r04?{7J&O8cbwC7L٧#Lcfk0{L| y ;vkroCzmM&&:KL ty'֑ Cckhӳ1,18={2ą4}3cmӲ?:hpsk&g-~vY8Rj#s36[lzƹL{|@ Znm&<́ l=g=c0L4V98s 5_$Osရ#\ XKFX%p l;Cш+a֑VO6g w{8=[SyٟcYOahMj1C>x5]}t6hث`YHF߁ S\sib9mC˖8=fr)vчm0x$5\{v9IvO7#ZOsH8[5̞!4ƧuDjg #ø1OM+ڇmؼ VG~s3Yxdb9wiBm^ĀSs~\|6]|Zx~'q#$< /WC{cƉs,} k b6cL93̵^ӫ+gXՈCQi f~P|`?W'Wns;ۼp$jgVK™u8~[[su=;80?O3kk[ s:s5^QmӹJ0>pý} |o+ԙk㷮J!{Y¼.q.9l bGh<ʬ#vyDlk0\qyfǷ}jyfeem5ք go{qʩcDX˝T8qO:l&mg7b&gi>8YM0p =qɝ[1\fį63!/B?4?K|6fI5l8cm=9Ix}51tBYk東k?ʃ[DžgrϙX^O5m.At\>k3Xه:}]3 s6rqmA5Ogc7g]6BXS̢}Bn~(f mÝK!䓂}wi9.-lbcs)/v81'c@I\ n1'1)_blQds&{3ٸ3tcZO gq2GN%6lcw`mh›q|fbA/<Yا:n&Pu:ނܹYlElN;? lZdbEv!oc0RN rjqdiYG۸m{$c]C9;x(݇P2@ukNvvvbؤ55A`SһyW'DzǨf`6˹Ԇ={Ѧiޓը}2#ܙ`ܹ]?\pf?f-{6;$uG~Q=zoNڜ˼c7fpA>3 7l{j˝S^$<09 UImth2aրˑ>bcb Ǭ}_Ɓ5x~~gֆn'y`j39\c/`?ZOԼaL|uwބ^SC[ tPbqO  /ԧ62S?e9rK2/W<[WԏV{-80;si )۷\`ll"7ɝQΏ 623H8 ^fs2V i 9N2Q7wDƂ\ig`梿sz}Ibciܷo;:[n'6K0ƴ66gbYm qFf%VxY(/dȬMu@n.h.4gܩ?16kQ8WsKb3z ;bO֢S>ŬSd|`{?k9<'a ~shzqVes=ްйqzYL{8;\o >4SB/C{>g !If ͙rihI3SJ9Ag1qvr:f7/;01[)`/g-_Zȃ2]"\4m3za=g־Emxpq39aF~m<ͥydgyGֈzOc"=`cbhи7Dn$ɻ$ѾG3 }r1.UM G YK%9=|rF`un{x`'9k k;mnf3p32a6_!w#/{AYu/ -!$ GG kw l^YYsg|Fo+Ζ[)kYS߬ξ$\$t  ^<'<=)|kF@I|a`_>37gC!{3G<J54OE3#a1_c&[8KQˉ٦{g;Wl g4f` q\}FK ͞JN72|fHNxy<~C7 }bxu]Of呵\6)7\m 8?Ff4ɑ m26!Ks{jA&g9{>קٿ 6{bufϙ\ޡ>{CGڑ։¿~|' ^?̝}ggX02j"'Z5:^7E`PXgNb4.s W2aƤMRLfgOn olf\qgzH1!ki\qZs'so4aW/#_GMW8(m>-?FoX@%1>qCio4&}g?X9[ |SP/bAY^7F; kA t?7C7b!hȿ5|_䝡 jء1ش=gCu Fpi?cgD6g)6S^b >nޥl n!j]Oj1q6714 \i} z~9qkgb&~g1\۴lA7 et¬4W"}NS۩q>Smj YCp.<٤ŀ<$&dC]h>I<\laە# 5Ә831%vm\3}O#>N|LR !ZL8Vzk\3{ݩ^rG{ڴE js$C}rf?+Je~洎JYYFrqh3mgq~3~Wa ź6hL SCTy΍{_lch\`S6rD9ʝ]=U S_}.QZ_gQ[aselh9i3켱;J->3‹kآkYh数xBmć9HqMbq} }oO04i|i1mv8f|09H9_mP?+kʬ!1G$1a9AmBYKAE>Xpľj=vH'aM#loLq%sfrE)\vΦ` ~SgixC`}!~:` 9Z3:K8]\7#y` n&'K&G$^$<{mŘE{q>'/ZslĈq7b"b͹J낳[+-VW^C[Krr4H5w^a |憡/Oߑp9w~jz!~pblo&x[Fef$w}q:hguAi<Z<1WvvF.#^l?Yr3j_nVqs5鄛w81Ils5ihcklо wΧ9G^1$ك4ΩmgCrc.]!e,7tF!9>4N2t0낚8{ӃXG<0bL9a]in\8 i89}rvm3kR 37[Oy͞$#Q[joGLc-X cKuC^9s bĺps;g8;}IjlR{ֈ$jyJlsb;sk(w<3p=<|| 5>KyJX4M3:BlT F^C%;[Ϣ'=8Y yIf y~ VĦ+sxCgEmk2k ',sK-sڛ7E\gm= ?hӰ#n ֳ2^A2k94y\l=#>ꋉ%4=owj3=}F0\s捭ȓv֓5p]&b{ϖ͖-~䄚8{X=g4&?Ey'{U:P3XfX&?+bʆ ؗZQ_G;:F]fyf[#z%\sqps!Ƃ&\Oyn}G j)y7 >Θ( rڡql{IN{`8GL>Q1Z79I',ɑ֜Ө;<bc~g=L '![mwIf-ǏpyN|`rTĉY;'iΌmn-#]Jk̝I.$' 9{8qgIraYg7H>anqW'V;m^r\dTߜVs^YJ1pGyAmѸg w3r54CLsyʟn8cr0v֐5ڹDqcqp`we~#77ZNG_-m3EB5䙦#K%ߴ}0>'1zb\qSys}N${8_Z^ MG 8GpΠ&lW Acul= n|e67Ӹ59Mr4Yhևg3,rPkl̬G\ٓ$ֱϹs OaOg-'[ƬF_ayA#`nfoa=0c~AFmup~厽M|q4j7sѸ!> 65澶;@>_FN/g|Q=.7䐛Eٓ5ڀ,ҳC?$"p1tv qhv 3`-Hp洀6l5EQ_Ih Z\kF}7bul6?#{}+ڢ|Fwdm.cZ_>꟝i>Q߶4N~sgֆkV !v{`qlp!O6g|iq 'j0f]fԷv> .mAߔ;W!߰|An٘7<~ s}6^(7Y5)wPPt9a= w$~(]c91G/Zd?cؐ ?j2f73k3 g&rqJ׳1_mv0l f3{ c;[3kWK!cFCn^എ6 ,< p6sCL8sctO9}ً=L?ׁ7g&ԝea?s3ȦIm-r䩽ĢՅYqy0K0 >xP=p.9 a 8 )7/yyX0w&F#[N?Ҧwo痋c G\oxa̜#s6yĆs)IsNX?gܼIYf- ٯd&/<z'1j-o+&_XS3[6duIbb0f5Tyx;g/#&˘8s.5״Ͻ1f-pns=e|Z0ŘA^:gďv|[ h8$ٛ?C[NraFȓczg ^4F&Lٞ!inwB6~a4iLل5=2ϸu`#ۃ{\,ygg`䐇vl_9p=Mj={fbG y^ߜ9G[4TLkfO|&ZOg }bԞGp^ }ҵص c'Ν\}pv9p!-MyqǵIܕJ>qp{0/?oj6tLr8ff p`ŸG.h|G܌9Crkx6 N؛YA0.>[q΀=ǺC#'zqg ֓̕D[k0r!kcx|<.ħpf#6Y[+BVwg+FNo7{ NlM3k~6X4v.Y$k9Ff 7?ؤz5F4?eCZ$.޲lg4kmikbIj7h:Km#7$dzPg?#׀K_؟\3bBF[FR[S{>|a}uyhqq}A< HT<䂶i6rB;k/9l<ȝD\kڳ<Ճx0}fE0vۨvW& R|z6#Έ&wFXP=Z=Fvo9x79Ծ2{|i@>ui%|=DbY~ G[p/`s:Ǚ{ C OKZ'u?wo_yƽcrb`flt-7o YVo-~,-yìGƜoƙ1kOn3iQ ڇycC6 7>y:ά <] G֘']c/~F%O?.vmQ;yYW GF{VLnYp947oL?gטolR1x kZ7Mĝk?}GcO7|%F]qgF0k3:s120gKA<ǩgd#բ%f<0ᬠO5&<_W&7}ר$η6_7nBåi +ĨͣYm@x` n[u }K"kypzfoۣ#>A8|}ڠ w4f<&qb21߄^N{ڙ,6mƋsZ[Ʒ11Fդ%?g`ؘ?Ǭ5fr.[b5)cҜ1o`/;]zmg-f=i~Zq{ۮȗz>g>rF2덺s/O>ٛ$c苹Ɓ~apm?獭5ǽ4f-!Ӏ?K}hr}#6oZn &Pԇ7v/Iy00kHcFN3~dƶ Z/vvA5`C!ƞ?YZ#? 9Tϴ>'=Np >ڴf^,CfJZ&7j9=gi53mF|;fu63^l" &p&"?8 sw4z²cΗ;&N˸gx1W\ab1۞q<`qپZ076Oznb>6)6׸Xm9qN:b鉭|= hNok`ءq$Ll}m;piSyrF0>nfxsm΢Mx狙zvq-8CbL왒ykZlc۾Qh|ٽLx~gGsbaM>ĸ8;$fcsE~}L>j8ځOv>mߋ4FFcB<>)h`K3lO5\:M&LN4_B0o=/+O&>7׫Illz 3 d8ùc1/ I8]1i 4 /Nl2˜ `%>l=[K4A,ܙe Xlz@[ڜ#Au6pn1'Í?ę$#ȅf/_^iuΠ]w6=, 9~V{Y Փ>1S߄CԛK7s=p. IkVr$pcͰ&Z]hn On;a׌C.bMÖL`4ll ~L؋uR@l!T߶dg$p<ϒdv/XO{C/[\ {F.sј~z]i_!jۖg¬ =X#sc}ڥ6]+I}r3vH|dc]? {)f7YĄ<_ܩm gu1gM"wfHYXAXlyh{ےYP4& c&7-?q>O W3l. {lqiHrK//]MI^m+ cLW|8WS;3~b#N2Xlk Ɠo%=o5qSI'^3Sl=g |ά׸}j*yǝ'ܽ6m1 9ƀZ7m/}nI&gČsZYiq= 4kl*'7mfeb {5^a/Tf<qJ$|C{Ʉ::癶&sybcuq:Yh؆6.c@d|b$Ӏُ<9I@9di|0f}'1dy8S.l[k6/g4) /BPhfㄫAv/g=` u66čHdg!34_#&sڳ;;wOPSءAy?ِ$iS?tcBW9Q,mvrJy ,WԶF;lYfg o& ]dCIWuxbܔs.?^ 9p|oxu8f rM۬s]QCLx!GYHέz+]C/;7hz>`̾Z[vgyCszzh/$P#M$:њR;x6$sW(/v@̮oGнL-uj@YK5(%W  :/)k|q%kIܒm~cPcI\Ccf|sukH0#B{Ig}q15~yGs{!^JN֝hhZ{g/:RyޢyS7.F2{6ms]|1ٸ Nk-[-?by83{#Sqd7l;k~n^ns3(E9`K;7mztdk1s0jGdbuΦ41 F\p=;yf勼K;C;=;,cgBœ\. qq5vXkaI>-7Xf=9>k'3(\=7?3{:o$1jhogAyds#9q19ZB~Xx kًg,լ+7IȍXz8mg!'/C??Z Clm\d'=؋\\@.^Fph;` mr7fE/z/Ib]&$6 |4SO ėM%$V>\>X,3Ah:J5Ƥ=}zoŝs8㙭 asplBb2 }Is'IhsK;9w>ا RYo͸@l1zgc{ɽ1!$O}-&77pقdzqk:v;Ism^mw!'O Y}1MLGAZ1 !$f?#Ć|i?bȑmTEn都2q$3㻂C9`ǽx+a\=cO cj Z ?v*al~2crjרۓyOMZN`V<'C. ~f> YFs'oί ˘ w\>>jھps !,O W4~6%ȏ5:#::s<3s}Q_#͙ā!ăyug3vn3qѷ1Cp}7<6@yOzydA~&/{ďErew&0_2~._,Lx,ϴ3f aocY_l>6g鷈m}s55ǑYf|A8[Mo}r |O{zes`N1W60]~zf oȍ{9`X8x&bmiZ_;O۟LgM RXk Gli1;/{5gydY$&{h~`8O\Z&RӟM#%{.^n3K˃þR${8a|N9([Bͦ1!y.ŝ%F͈?|عo\s <&~pqesh K&!X_;mNR_}[Gɻg8h=鄛x qy Q.Dmzݰ~6mqG|`M۴Ftw#͝o_f-jX{|e'FZ?$zuJ5pp-~%{Ԇ=7g| v>si1p=ihis ȳĒHⵝ߬ C7Pw ZZwٺ!? /Y -گZ]66V `aqngw&OoNi{!6ZK@pdi nng3AZgMs!GNrDrk@[|Ѹhlƅ%,/t-Ċlfqfv2lh~Wg/ryt^bm\Z]ypb6NWys;j'aO2sk6k%6Z1> Ɲbz5и4f3yp37֒rF$L~s|h1`T3ʥN-qfW]YgS1s E06~ 佋}ArGy!SڴیMg?-n?͍`?l@.8hUQ5sp.;[ٵMXZyi.յ {huA,!sXX;kV g}5Ɵcqս?ekم5Cin~wG^sƙkFg=C\?jeZg^q3`img4\lN矗7i{Wu߸sY͵ Sr:~zkT/YXҹq3.[rqx? ǶKmL~k?8bռ\笺u{W]uݪkJu۬lasgn:fVG6TzsimԣM]ޏ+7k\1c[qg|sz/_[>Tu6?Mֳճ`G1xSMƝ.-6[az-'kV-aW-0YnZ\/.cc԰ߤNg{i_~vKUnn3K\G;II>{v祱R\'1Zi~xw\rvrվ缇g3׹F5GU<0 Ӭ7Y;b-?6rz֡,TsM[|i>-Tw~5}s&,70]ڔ=R}]by-DoKy{crb{ eoU&ىJv);|-Ue#߇g:ޗ'_<\r?W̹ܗ,Ʊ?h7sd\~9cy9Uso;98O XW6ӹ9}֦dbyc.[]*>U~2̵7YDޣZ$KynR<^z.]9qƶ؆bvo*+kYc?cQlTkoc?FO0X/syZjګgQh?mR:F3?68-"fqM&օ:Q^X|c\jǥYט,yMrͬ9Y[ñlӵ,=V:OlC܋Of,zMᬺ4 sZ|R;y?CMI}c-{9s瑯Crݛ4q8xY]ٞ/0KN8ϥZ}E?yUY U-kU\K^ uzVys~'5'q.iNgJhϱrq#3BWˬΦsg,)Mxߥv.'Z~>1qgRLǺ!8M,ޛfarξpN^jU?gW>rn+kG}s7=5k kQcʹk]Wg溔8WU''"~Ɯϙ~1|/؅5VSRFž5/\ Z9[\Li^Yc&cIcOK:'1k+޷TuTU-^8_Gfyiy{1ͮC^'Y֩s?WYh+^Z=C||[\}ޏ&3i8v64,w^]Cj.}^_K]87Ǫ쏟'7G8>cᓽ4\.6:_*7cZ-]Y=2Wyi^gg}Ϫ{yCZ8o?rU?y|Y =7/ Ԍxn<ןrƿx_ cqg ]C3syy<&I^/3ײZRҞ+S;ϊc~sФoއ1˳k]-׆ɚZdl|//uwRqi_s%_jBK0b.k6[>tz_q8pzZkj\ڟ.a^]uN^Ffq4I-޿Wdjyd10ᘸyTUɵ)W^4{U',! kY[\wyr bܪw',09i03y?}1{ΫqK]x]e.f8;ؼW&3}%Uժ]wiϙ0x&C;yc'8{0><¹ ,?霼_gs)tm}ϖ׾j9ӽI.<|/=kYei{NnLq>bR]hk_0=17YY?|)60[K<84./0i,={L=Lg:溔S||>/?.?Sns6fJU/;_O>OF/ϻ{{gLz>UIm|O}b縮OfZn>i&5!7qU_OjZOgng=qObM&4'<ϸNLz3%gv_MsxV;r_ٺ' ~I};cuKz=+ ckYYH#j/11K|wo5}RYjrݩ4I鼪Y/wfmS ]_/I]؅5Ͽ\+y5f,k4UX'Q}Uk8yN&ȳ2Q߫ҾIgqLlZzMڙ]Y6u7frqLhgq籄q/i?sk>ӡ<γqy=fa֋m}rگۙwX^<}Zs[zy<|s~{3{+'8Kw>xC?#W/o>s^Etu.}n]o:o:}6l<\;ۺ+;m_ ?Ow y'y8ֿ7ۺۺۺۺۺ+;m_ wAVz[o:\im`};ஷ m<o:\m<}6l<og `u[`e 6 ۰͟)m]gm]g/@߆ۺ+p`]XװoNm ) 339No]Pk95ag `]]Pk woWz 6l~6 pA 6vS`pq[?O+;m_ wAV xjaZ\p-Fn:}6l<o^xgO{g˞^_U8ֿ7ws!pA[}Xu'yXuXu8 \ֿ7+]Xַuַuַm<o:om<oo:om<\ֿ7ۺۺۺX3333{?pq[?Om]gm]gm]gyXuX'm]g[X o |[}XuXuXu8ֿ7w o:oۺpoַuַu.nXuo`}[o `}[?Oۺ`}[|[X.nm]gm]gm]gyXu[=pq[?Oۺ'm]gm]gm]gmXַpq[?O3; <lm33; >o `}[`}[o `}[xeiY=^==ý+'8Kw>xC?#W/o>s^a`}[? Tti@tU*н{=ޫ{u{@^н@^{={t !н7@ޛ{3{ot-%н@{;{ot#нw@޻{7{{w{w1н{W]w {7@{{o{t}н@>{6н!@>އp{t#}н1@tc}н @>'d{tS}нO@>gl{t~{н{C@ts= t}>н/{/нB{{1нǀK}н/%@ޗr{_t+}нS{_ tk}-н@7&{ t[}+нo@w.{ t{}/н@~!{? tG(н@~O){? tg,н@~/%{ tW6{ޯ@~'н_n{t@~&н?tC@0н?t-{ 2{ޟi{=a=^==ýg_\ٿ8޿8ٿqmō]yx|u2:6>1988888888888888888888:quձcW>}\:quǵkc>}\6qmǵc>}\>q}c>n}1qcǍc7>n}9qsͱc7>n}9qsǭ[c>n}5qkǭ}v|CoLJގz;>v|ɡCo'Nz;9vrɡޮzz꡷ޮzz꡷ޮzvڡkޮzvڡkޮzvڡޮz~ޮz~ޮzqơnzqơnzqơnzy桷nzy桷nzu֡[nzu֡[nzuՒ'..c<^y09O|{>yUg>y_qkin^yoޠy捚7nޤy͚7oޢy歚nަy횷oޡy杚wnޥyݚwo\ijshn6m5h޳y潛i޷yh>7|ha͇7|dQG7^m>Ol>SOm>3l>s64klj|npy7_мyaH cK6_|q%͗6_|yW6_՜6_|M5_|C75|Kͷ5|Gw5|O5@5?H͏5?DO5?L5?B/5p+W '>7c8p~ߌoM~k8k|{m\盿/5+_mZכo5;m^5'?mYϛ_57Ϳm]?5/m[ߛ5?m r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.G˹˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r~4ȹ˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.G˹˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r~4ȹ˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.G˹˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r~4ȹ˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.G˹˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r~4ȹ˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.G˹˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r~4ȹ˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.G˹˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r~4ȹ˹˹˹˹˹˹˹˹˹˹˹˹˹˹ r.r.r.r.r.r.r.r.r.O"y~ 7p;x[u9禆u׹9g]}fw|'''Nzɹۗsɭ'w^ bS6wW+//j,a% +iXIJVҰ4a% +ixIK^𒆗4% /ixIK]I+it%ѕ4FWJ]I+i%ї4F_K}I/i%14PJCIcyvKy(Zgi/ޗ=; _=w~wɞ~󎓼nr7$>I2̼=I)L8I[Ns\͌tqE'uDu;0WJb&3c܆݆l bm7xhvSў?n6|6|67^cew-z?.O܆n'm'oçlßنO݆O[)/n>}>c6|6|6m{نmýmo^p ˵'>nv~='RgU6p^ /ކ? /ن69pN=]l6|^ ܆߆a6|6jކ/܆/چ/ކ/ن yt6|6|6|6mk?n_߆ s6m;wm 6|6mll#nëۆ݆ _ hmOn 6mx6|6|6|6|6m-m/چ ߾ ߱ 6|6v^ ߵ ߆>Y/ֲ^s^_Ʈ~sv<|-뵘ket|ZۓU79 %}u|k?=]ev͵n3OUܨ}7[,{'YX79վZONYF9y_[p])79?ܮsVtkܯ<[s:9^~7_v7SLs\Y3#gF<~fD*i %14ƒXKcIc,i%14ƒXҘJSIc*iL%14TҘJSIc.i%14\ҘKsIc.ȋ]wM|˗}/|m2M6&SdjLmm2MfejYfejYfejy晚gjy晚gjyej]ej]ej]ej]ej]gj}gj}gj}gj}gj}6djC6djC6djC6djC6djC6fjc6fjc6fjc6fjc6fjc6ejS6ejS6ejS6ejS6ejS6gjs6gjs6gjs6gjsEɕY%|vl_<եN7{doC/]K?]/>q\\ݻ>yw3_O=y0Wە|-ǿo[/|'ϏqǏ-/;O?w~觯^}'/7Or 9ɥ7O{mН/3r(_9Yo.K>./~ܕ|Ey/u>Q?o~9ץ||E;}霷SiGҮ.>K{ZirK},[>絜wiQ^OǬKqkORo=ߵK>ꏼWZœٻQ>}폿'J.8?f9D=E7ܕo}哺wx/i*7-ߨ>F~?V~5_{᭗?Y O)z)™('[\FޏvV9_c>Qץ{?yگ".W\ҎWw |58~9Nsߥ_ڷM?^ihi71DORnt+ς 2,R{_e\l?KyFp9σPǫo^vWoϥߔr^QR.U'+ >_3D>J)oD-U^F{Z_ur)܈|żd駥{2ω~Qc{^Op=:|*,YS M<7xG7.Ezoўt43'Q?t|s:.KGѯb^|o_Ơ/^n#?u7rQ~kg;r{<[늨(ץt=华Z~Ro弖)qH'_t]xP?O[e\dkt;?xUyNp;WKb[pF-Xb\ʷqD۽߫?rIyٗ)j0{(|0싕^_麻wO^eR=G_ڝhwz91|^z='RWSu~|W:]G ߪNc|R5u~ |d)/=ڋ^U<$5qH/˵DuNhQ~^yLkʟ~JQNڮ}8&D']W1ƅ K9fu1>Gr]xO?k5]F[R\+ĶU)8[Gh t7I}j]F}.]_MؚgvWcB˯x Q1j} iW|7/歺&o)P/GX|ogo|JKǭheNx^̓M?~6se+j!^/P5~E3Oezyp2F*yηyWo}T!-Z=1N=DJϳ̫bKkbH;UzJ_qq]fK;}ђ+,b>FeG5_88-ףt^R9߸>rq3ҋE0Cg1oλ[j>˺?<@#sop1帚^,v_cߪN5?qt#?\?G)//ljrvelbm2~~Dŏ>Utumwz2v!(wG[}|Iǭ/u_2ڷz;f)XgF\o.yӲTc})ڣ^o>K:ԓ^w*q>\џuCW7J߭2%S[]x'xO}K*8coi zz,,^b^_.;g NxGt=_q@a|.SƸ^ץӪhy?":]ݚ?ɾ^-8g# OJo.q(߈*Wצb\K.|ωq\sG FWQO1;:^gc=|) Wi/+ou%丅-#ڗiW˸ҸU~%(V?y\|9/^W|N7z>zݿ^X.־MϢ\p<}Az=FOU._|'e䣚DD9 2oXG:y]rݬ>W}?zQ1hu`)P^Ǽ0YUYGZ[ƳCTQx:1^D묑(xQ܉Y+q^t߬q5NUND>mOXG(ox\e=5x6~"׵KP|^Ƒj|_%fWzZ ?_W/)ҋ `bvUѲ(r_8~c$(lj~RN15v؍vL']%SPnǸl(M'_T܏ip.eho2cP8ڸ,Kccި/:D'~+gZ 1Oq]H#]oKuu}?ҏv#}4}^zgc\ҘG~y 磞bF'Ɲo"TQ%Ɉ}hGяxv]+Yb'#zaD~M>%߅k꣜ƺ|QKe.E8ד8W\k9Gn/{ϣ=shݖ+/Zw$YJ{筈'cu='SS}>GB8U>~B\orMz#+IS1Jy~jqY/D|(wdTd?xzXw׏t|R~/'-"]ΩYr~r9_sV1鼭q?q/vPIU %8n'^qO×Q;ոa2ymp#w}@pEƾMKʓ^OhΊ|u;}nM#JORo\D.}eFEzU{mxRu|QJ;^U?TPVuz@2|h_K;x M_+Qh_/;W۸Z?-~(1^+sp*)=Tn+Kz:ںy^ś/#OU ?'wT?Zp}Iux)ռuRp'9x׺>%#Sy[+<7Iks|yyg9Y/-!nxr?Pgw_#ȟσQ}s$.Ǒs(}1b~3yz2~zgklOU…Ϡϣz(e_~ <:(σj7~$%b#_<.]x-ϫGr?P~skt}♕%szqvۿ/}<.(ٟ?AtJ9ʽ4K?/}qh;+f9^cU.Q޿aw\wǟ~\GGysoaWiGKyܢFV/ޏv+,ϒo|{ ߚO\=]z_Q9)'mOK,_xq糴3_'I?ҟ "DG[Mi"ʵR>yEZx{}ON8³?-wyG9,x㪾]_q8K{-*U11?}G8??z%>z|\>[)hOR/% \< \+Ot\Ɵq_hq7e)ߏz E.-u)jz~RHO{(8DG;8>XK?-.ҋ83wp<{9nQ}t|)bhqQoK;|rK{*/\+tqۥyRp>_WR_,^ope9^5oF9J$_,(~\ nE;E㦎O:o+ߏv"RK{(󢈥J q~q(']D|\~ #~|t|FzK~DyG,,%Ap%'yyFa˖uas]_0Yq5CoOq$֟e/\+=s)7|z;hOQnཬ:9#̇.}w>"=*ߔ7ڟ.D=y?r1onS]E]>J~c;vReGuDxTޏuyR߿Jj~̳#N|.yOD;+[m_[+i?2j9q^b"R.1\ҩEi~Mgc9~:)XǗyO߫h32.,a__d_?b\|Gk31UOt|.鯺YKc}%qgbfk-OSԣwD9G+(_"[?zGGS7i1FyD{y+?ߣރo-j?4;W|_ z}?\~+QOb\}ȯWS9Od?ż% o/jޫGYkϪ}(h7ʯw:F?Y哟|w'V->uʯWY'"iwʁj>,;|d"]he_-hr<^)L֟e$ځ^k\)(hq>QGy䷵*3t=Tߏ\:r}3]'.~ioףPZ(_Pt}O_n:k#?!dd>B_i;;u/b< ף˾2/oc89%OׅGj"ST|vzz^vWz/<4b|/bվe3\e~+}֫UMz;.׹~=~9Ϙ輯̇_uuH{'w|D>q'7D~t")gG>c])>P?#u؟/&O+o*j#_O[ƫʹhSU:OqM͕~BǍyN)>lTbc:Cr^e^^׍dm+~b#r=<1o~Ǐָ.C_;~3~ykI5|Ÿ#R 7k}4֫z6DKžzaQEO歑x.{}We~׽J}Ѳ\嘴ڷr<.ۘGOS7ޚuB?hy/ NἮ㺧_tUGO0]W+<ŗ(fc^YڍNU~ŻzS஖{RڎKg٘ rNZK:D7~γŷўGc>4yO!<%ZT}?TzW(^M5n"m_E>{c}j/X?WޗLpC5վ^w}dE}zTN(WG~zxY>SuT" /Novq?DgW%Koy,e$ڣ .Y_QN1NrԳ2e:/)pX.5.Uv~I_ߕzVmWṙ4WY|'FLE\?)h1$+?c:NSKV8~i(, xmry]r ~^_E>_u"Mgr=AWmo?Ǽ.x~UtP՗|:}>XqVSƏj"_dXab<6_e=\7O\/ُ*K9NȾv@ӺN|Gu|6*o5ڳ 2yL_z?ݜy 2cwïPߺ|u^)e_[ZV܇Tn/~\9~xuX>7}NRek\]}|NGqk߷֝Un\KG-\>D~\wJ??:}ֺڇm<_<9toz@ӈ/^NVOc_^_U~<'uQ~PKrxC?/hosZV\} bGF\?汍x>S5۷^_>u?Q:s:G=CT#b=O>'rH'ʋONC}J?h>^/K; ^|X;Glj_J|2M~|R՚GVպ4/Wɸغ>hk?.u|辌84 ʼ>gEy uec[V>`nV<&}NA}lH_[W '3?+of9^.c>)m_'[S OոR[ո/JVB2~yc\ӡӖ>71ڏ>Q}k{ur1i=7O2|}ac?9<.l<7y>G=Ej,)Zڞu]Uݗ|Qo2WgNKqs m=|_ӲӚ8/~f)h?r=z^>!-tX-ڗ%v* >Qyz!Xs6z:5楍:K;v瘄OR[ :,| ~sqz<5oi9;zM3<8zΪQ/Nb6kyo;:bkw.U3sc1o >~E<~4ꩴstмZ ~|u^4c0_Jʯ\ GyXrzqx_q58Z:ufuA>_h{qq\w~#e~_U'=^m;<<Y=~Z.>|N~HD}s7urU/>rE}W}N^dk|8Wυ۸9~r o;q/Ϋ[~Yx^xy}重غ<7P8H?ugs\zǘȺϱq!8,zNQ@_xӣz5iѯ:Ue9z]>kIYIe=W=K?elg#tz;{(Uj=_ޯk< 5}j|9MzeIGGXڋquݢ4GuA_;99߷n׷o4~^/Jk_vM]¾oþj#/Ƕ}ߗƱuL{׎ZjմcmykǔՔٮϯa kXՆcưcwŮ|ޮ;1u[[W7zh][Mj_v;1롶~LCUP~/ͫ9Culߕ2Fo_+}j8_M9ąC9Tp`W::αi;c>︭v|l;Wp,gvܡ|P9&'گnp5cs>1?ƜCce3njo:V=Srվ1mjv}m~;;^C\9pz>]P{>Giqk)*c>*Cg a C>wLlseڮ;v^ w}~WgZyڴZr8fZÓ;s(K;_o7S8U}ꣻv(Υqudv׫itL~Czg[岋!Ws,κ 0]1}v鋭{ǔ1W֭|U&w(o7C8w}j_lcʿ/qP^1aqkܮ}z闻R ^۱P[}mUoϴ~ա|\M[m_}jJ?t.C+^+};ޱ{#yuνs=֓gm{󖗷䱏ݲw e<}ܼ zope5 g/ְ5\ᬹuk`{&} kXp}w kZگop~=5<5vnC8vs=n7^Y5pd 86 g=l־~Yκ/ +װ3u ^Ózιpmq g7~y.=ua Κ7xpݼ~+s{C({=w;߹_?'x__GWk|?5u导{xկ%=Gډ<7M| S\?~zݹkkG|>xo/}s>~ԟydx kG{xj2~>qƗ^˿9upw?kkپZ=yti/՝kŗ~o{>5~ xt)/oz}pŗ])5^c_ߜ\O!v k|ۏ޹k|/O. _xӷk|ǗW;ڏ_{_}tznq?߹}UOϸkg_xky/؋>5a o&ߺk|t?p#O$k|ŗ/֝k||k|5>_z|AwQ|k|׿پZ5uoMouo}=k|FgŹ5 p݄n+s8[ְ'nFYÓΚc+?װ5a kXCcְ5<ᬹ5Y5<5ְ5a Ydž.)z kݬlg}^kXpznWa kx:Zza];?uIk8pmp Gl_yMuνs=':_+/~/z,{}n_$t繓cZ]ݕ-]];楕]?8]upZya}z_H:}u~hN[ejKW]exmhYkv=/}P9㴾slYD?9]Ms_.ՙCI}>jOrv}y_m8f[]ebء?Ǟ!+ ^gkt}j/uLҶ:n}P+CmZfwh_/s^[v:^}+V?<&ni|5>i{;gϮ1T}h|[ZnW]j31};&}s:s;TP9c8:V>-co}gv}FZ`uLcWۮZ/׺>?~ʡ1>~|3?fv~uop_]kZVlZyi]s~g_?Ӷʷ>&jZbJvUw[m{'u>o;xL[ռx*s3ڕn\wͅͷKU·VU>[ca{,]Vjs

    滇E-ֹƏ;GZcܚ9ġ9o̮`_Zo/cHne,[c]?waW?wsuoՆ}X.jP]~W]nͯZy7gisGwLu~vϼ*C:4V68Ԯr-Cc:ny_|pͺnSž*}rVks[mw߱աqP{~[ll[ͮ[ls]wQJ|k\ՆZumnW7_ܕcsەVcǠcCjڮY=Ƕa+b1W7V;Ńc՚'~y;͓>~\My9s]:]tL_?&-ηƩV;)SCe븭|SN}W]?f>ԪVi?fpL56S^V{{6zo_:cۢuЪ]q=MWؗZs}eujG.߾9Z?k2nrkmkV1m}бw5n7_vV?۪V5jsm[}5XSF:1ib1,L_󳫏WZci*qvͯZϷ:eͮ쾶+o[y|iҏsx綗s}-#>н/z,{C/ Ͽ/[̗>}=}{잗>%g?t疣xm7yy=dY>@fMDQqNj.^bcż8ڔWV^yyՕW}y5Wcy5W% +iXIJVҰ4a% +iXIK^𒆗4% /ixIK^J]I+it%ѕ4FWJ]I/i%ї4F_K}I/i%14PJCIc(i %14ƒXKcIc,i%14ƒXҘJSIc*iL%14TҘJSIc.i%14\ҘKsIc.ȋ]wM|˗}/|m2M6&SdjLmm2MfejYfejYfejy晚gjy晚gjyej]ej]ej]ej]ej]gj}gj}gj}gj}gj}6djC6djC6djC6djC6djC6fjc6fjc6fjc6fjc6fjc6ejS6ejS6ejS6ejS6ejS6gjs6gjs6gjs6gjs6gjKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d%K,YbKXĒ%,d'KY'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ>Y'KdI,%}Oɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%CdH ɒ!Y2$Kdɐ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ1Y2&Kdɘ,%cdLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%SdJLɒ)Y2%Kdɔ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdNɒ9Y2'Kdɜ,%sdN̅%n*09}kk{z nnnnn!]Ct 5kHא!]Ct:uHב#]GtvHCnt;!vHC=nt{#HG=t; Hw@t;"HwD#tG;"NHwBҝt';! NHwB3ҝtg;#HwF36ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀWj^m x6ڀW+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+ 2+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r+r::::::::::::::::::::::::::::::::::::::::::::::::::zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFjFj&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&j&jfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjvn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7vn ~o7;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~ow;v~oww;~{ow;~{ow;~{ow;~{ow;~{ow;~{ow;~{ow;o?wnpϿe| {i˧?jomo/data/sldata.RData0000644000176200001440000000552114410253602014314 0ustar liggesusersZ PSW~HnPBU="U~! EA-uҪ T(cDD) $aG!{3 j3N=|;{qy40(JUutt?PzBC;JBi-Q| /;6X#Ao&o>l3ԣ"S &FXPt͉yBg$.}6c{ܨeOBl,O~?zlMgO$(?ꊝ_=Ejil޸ͦf04[ ki!)zK>4 9Vz(x%4+K=>\͕Fʰ)Zjf|j-+kJ:E@w39_ ݧw], +xk8e$C<<))ř/#=0R*OV Nưׄ76n}=Ǣ_Wzf}2lF,'(=qv9$9qTO;ʃUj/5c{KU޿!}RǺ?/ $Cݺ]Qt맨x:;0K ls|ѐ];[Bɞxݬ@%*P ~eoUYKY.p?Ugޝ>% obi>{q?9K_0}n5. fk M;sIR4jw,|[iEME/lPǏ)d05=u',\k''Qth,c(ny<9=11^8Yz'=#^),,oGӡjRTLDžB,* c ;2]߄‡WO|2ti%؄6=ߑ_l(q1] ^b^6OzNh-Tף!ďd//םx/?_P^H~ Fqލ%(?x|>ao}w[]}ϋ-=}nik߇~n\^jkuY==.?27zI}ğgqI?)S>$!Luר< y;.oHOڱՕ\3~&1㹑 {\ob[^硱!$Š׬`oK y^L$4z=ȓC<r2q1ka~sins,ur%="oo \_\OiƟ&W.uu+`݆s#TJ+!(04~M Ū҃&jomo/data/cldata.RData0000644000176200001440000002063314410253602014275 0ustar liggesusers= XMv+"IB24'ɐYC2Dᙊq.dJ*yФy=si߻ݔoݵk97r ab[5 Ǥ54!^بDPd4%-o0j8ffS Au~")hhU<.9`~e+- +e´4#A 5 ӵBAV*mXfc>6 "]),;TH>.#?W Mޕ_>|F/~=Tk34Lzj:'eG>βqe7.%[ApAs΁ҏ>)+hK,4@ @Ak}wcZMmwo EgT{8jnu1O+{a/}ƷȏNCAS8m}"kY|=ٯrX=Pm8dw5#*֝D$妍/eWj35l!k_j=vVZ1SHrZN#@,vubCxuIIֲ4'M>d:8XvHt Cgw}hv%H[('ƐujUfDP?o߷:qK @_B߁bOsw߳ߌmyU\,f:K.sOv(u,_X νf%8zԻ&ŪdWcf@vJt=|t5g0:4%v-^ ۸]zoQ^KfzOZ8L-9,#׃Rf-^ZL8OlxT`KR&2k/]Ȣ2|OxW썭*-w洡 gt<1ϖ,q>n>8gW="zl4ȋGNe_=(Ҟ4Jpo6R<~DMɠf]܎3)3@V?W˿>!~^-Iܸ~b^= ;Dj>n,c4hR˼8op K-c7%Ng#ǃ; ?@qvRKayYWcMЛy#*/Iȿ}Ny\ XlJ}DoR}AI{YGF?,axsyd|m_Z~ҭKcnWW N]Ă(XqM>:Dc[ ~? woOd6*^]ncV/[A˯W/ SZH6'Ru 0!~+YO+cڬAWDSY]Ph:(ynFx\Ry&5sxu xav 'Q_?='|W]w_]sog =QzA1|˕|/^!v.D޹X_X..v_*zwY9 vs8Id>4+k?yEPQ9+n6ű!>yK|8qz(y%pãcQ%竂GMfg/¢TɌlx"we-K_tFƫ=gVl緘ۣ{xLہ˟=k e?ku|j@umcϯ5/3*פnƥ^+3oDX`rJ޺څ*@Uc\L.ym _jwv{5&. |-}+;5u>Tԛu1  q.W[ UmpWsU\Kp9GAnŧRcq>sbSgMޫS w ^Ϟe޿hi#gl l['ĝl]ٲl|NuT'5HG"piWIRCa]$?KUUDjF^;޿%_>d +$eNtTK/8` F?\p'xfmT$dzV+ìdyqsf ?^.} ,}[X6R>nv o똙=;"t15]MNY-G\Z.xD͒{_M{}8?^aj/M|IW^V$1Oޥcx0K<{UUPٰs}_rz>w~{BKj*Ǒ_ūߣwmikk V= |muRͫGΨO%*IAmP6x 6=Nfw|NtW@T']V >nwP6w߿4x.?ׂV'=)ËW/C 爸 ɂ*8@U BhE4"㥷[8zlCaDV9AԔB]x,Q߮8vD"!!7Aȿ7ėZE7rys@>QRpW3ivI<r:{e_Fg&MDԱ'c]n"Bb>o\# Or<q |ڐ!6|_]*>kTb-׻?OQΰA؟y$=HYARZ`h8k]>5wAGC^m>ʼ@J¦=⩠P{3NS%! K4?ϰ>>γoV U4_~JA}P}h̑t=y'm *#w?Sy jL#π27 ˋ wƪ"vbv9xST\RݨW*rC[&4>cG.~1 {'z Ugu lW( O9s >Pso@~ViYsM,)YZͽK h.*=>~F}ۂD+gOq7Y*ͻnM5ݸ`>Jwόk]yWrw%zJ |xk"iJj3܈-N}cQ*}oƥޗp}8 s o?J{*Ϟ_CdA\bH"Sn]ax2@K9^Y,b C.t{r Ļʃ\3fFNpPw@ץ+<;rm*O=ͫ2H^[ƛ*cs]yUY% ki {ߝxy,S.( aշnY/Mp 0.|rn}A`S/OE >:hbP~7Ow(s4\\\Kv>i!ZtTW7'M{RɒCO"vÀ4>XWrZWe ʂ#4k3Il{q3^ wF݂VsLuA6>fí1bm|=Q 9C3ǾX|tkR0Pg÷n|clQ{;]w0'ʏXێʸy-{R̾fO>6gqxc+pLbSP%?b-<+-5ȿ9ohP\w,FZ"]t_Ej`CKquG$Joۊ;?r#ӽ{ x:@M,ޛ՘.S#>9-{zkW0E6DF|:{AG[ v:yA7a:k9+i̫Rx<Ԍ? w~D\޶b4_kxC9Qң9\w'Y"ڼLJG-\ vro}'ѣ% FݪǺ&3>{JYb Qm??7p)}&WhW^G%N}UX{6{b3m }!OrпcϪYҿ;<|w!E=0čM|X {pw7T"ڝ<ۯ~98{FR(y|Q]c=X"ót'P~Vmn81|0[gJUAɔ$sGûy2 v)j@S:ѠܫpޗrtVm RGssfXv^SBOK=>:^WW*$>:;pȕܲ[vgZގ/n@ەo?ddo|_.h,sa oX_EKN8ˌ4CJC>y{$;p>.[#W؟21=/n@/ғ&Ԉ, =^ܺHhc2'q1ZǨ7! )j<@@ZsI+/X5uStJ%\}StDU;`]Թ?O#MɥKJ?%>W>yRQ m/5Oʡs…~s8^<1~>P@85B˷ADž X/, VozH Xel?RgC(ϨCu 5ה<^ ):e?z־˴>H?^ U@tԾ`=0?G .H58l/__2*#zŅ8+G`>..W>y8/P~Qt@ziyWgAEyTD#A)lOjₒKɃ\A= UQQu%5`(~uoj#/>j?|z!Lܯ`q`>5yBrPW>C J/ϸñ֐ 3"ϵ(H%*z<Qr?>"p ^u(:/<3T\(985(guU9|k>'d]qH>m\)\OX?B{꽩! _XQz@ N.8~PJZx>x?+Gi= \`{s&dl7iM3PrTs!>8O巶ޯh}?^T co׿y7TIɇE {~ۃj=tazۺ_~C}†0y C&Q~UoG|_¶C 8~uWr~׺_Wa:mՋzk{𿊿UWַ湰[7_+.a5~կg[Su߶U]~UNGuy:5a:oo]&q lE}ysѺ,l0m*h=h?m=Ρ VI_[]vuWt4~5~~ut4mhG&ru(9gm _{jzm~n9_[%h~ܿcN85ǘg1>bwqƇ !6 ),Æ3 ^ ZK`cmc|oW{/\xp}!l9<grPg+&`x0΄g[}{ƹ: ͂4< ayŒ3f _<8(Q;%]p~0ĠuwZqv2~vra93n%SF"fB `]??x`fxv~B~+ȧu_PC!Ol`'΀,h e/s=Kӆ>8WZ_;3k5L>;_g$qHB?ϙ:h[싚cc-´3Lyp ^ؐ܂p2H'bZfIoUkI|utXA A4ܘ} IZĜWaca~`VT@#n.AY N¹Ȃ_pf5 /Aa#j s/Ck[ H>Ъ'1xaf|3`=/8NQBP癱 $>o8GZ9ڹ96AmehR_ 6VZJ+7u1?DC4D9:RE31ADBxAAAA$TAA$)"(HGEP" Cu89~ ~^%WI8I8$C±$GBMjp< ICB]p 'p 'P89-Ѐ H| O!$> IܐčH܈ ?H|O#qc7&$>g I3I|"q7!$>MIܔH '!5m$ݜts>!sH>%sI\nA-HI H<>#I|>' H/ $ݒ[tK.N  -P?(?8-P$@Q~@Q~EcEABn Ǐ!N  -P?(?8-P$@Q~@Q~EcEABn Ǐ!N  -PhNVk?_$';r]ΎDV_]6RlcoHb6nbu4(MrwMM=[MX?rXy G1Zkjomo/data/JSPmiss.RData0000644000176200001440000003237714410253602014405 0ustar liggesusers5Iu."X$۲1x5]];,,$E`/,$G9l99sN8gs'ܙY9tݾUU/=yё? ͑(n<msCO/ay8佟>_1 Y|ϹxyEkso8>M/Wo~W/o -oyV7_to Ʒxѳ3, =Eo 3wxɁ]./FYR|۸T,Ɨ;h>?Oݽ[e0K!I!KHJI/?MGi4Jy(Qj4jǣ44ЈC#84ЈC#841yhCc5ϣyS(}y:'O" ćA<(뺽C| W#???;aQ1q I)iY9y_E_%_:/Crį@JįBjįAZįCzo@FoBfoAVoCv@NBnA^C~@AB<È????ӈ??󈿀ˈ忎[;{G'gW7w$?!3 +!; '!"ѧp:ǁ p`80 p`rف0 p`80 p`w p`ø90 p`80 pǟ3vW۩j;Km'ܴ;w'w;ww;w};x}9w};xw};x};xw};xw~^w;w;w;w;w;w;w;w;w;w;w};xw};xw};xw};xw};xw;wZ^[={={={#<{={=}{xmڮk!{={={={={={={={={=}{x=}{x=}{x=}{x=}{x=}{x=}{x=}{x=}{x=}{x=}{x=}{x=}{x=}{x=}{x=}{x=?!~x?|x?>}|>}|0x?~x?~x?~x?~x?~x?~x?~x?l+???v???????ܿ0  `@0  `@0  ?|p @8p @8p @8p @8p @8m[0 l|jш`lcl 6` ؀0`}vo 70`l 6` ؀0`l 7o 7llo 7[{0`l 6` ؀0`l 6` ؀0`l 6` ؀0`l 6` ؀0`l 0`ewl|s|&vbdqf1Gc;Eyc'+E6řbfHE63g ϬaL³`%%%ͬ k(6V[YYee1f<Ycem`r%&Wbrbb1XX,6ƜL՘陘陘陘iZZZZ:1is21's21's2%1=31=Sbߘ)Q"Q"S"S"S"S"S"SHt@*fH4C͐hD3$! fHjETE-*ToQY/ݒLdZ$33:ObcL̤LYxy"k i3IITLTLTLTΉ1S333=333'sf aefIfdfIXVFf4x4LfN㙤̾L̔L̔˜3S.wUhza0 Յ9Y&7XYl,R9Y9Y%2. ӳpyPH¤-L¤-L,œ,k!^ Z¤-ƅ׸^B^+T9ԕC]9}ը␨ѩʉݕqUYTZ&Uyݕ|*^9TNA+]9t+-]i]y+qU歜$jg qkWF6.IˤeRy' 11Fw7ݍn\&5Yc518HHcj9LhLF7F#1KS15IИ%YH,i̒+ɇNw۝K%vgtNgt&Lgt&Lgt&Lg>t.0:ɨNFu2WD|':!֙\ <̳NusUg"v\=2&mjs1ݹZ\ w.;י ޙIۙIۙhΤLNum}df:i-OUyfyݶ\TrSeVTZQiEVTZQiE֬f5+Y;s:>jmY3v&ΤʪYfnVY]Vm(J(ݪtҭJ*ݪꩪii˪/]qԝTN*W'iNUrUeaJJWƤrcR1ܘTnL*7&ʍIƤrcR1ܘTnL*7&SVYiUʙcT{TL*g&3ʙT՞cʱIؤrlRy55TMT]U*''I3*'ɨr2'UΪ\TZqRLxomTQ6*F嗨<GETQ"*_D全9|YjjXTۊR^ QjT|*`[V4}SdNɨ0<*gYpVy8<>U.*f?|-gU.TWk{ؖUY>U~*?gruV:<ޯڠo+eY_Sl˪NY1vVUUڣ:+*g۳b|Vy>UsSVsSVʳYy6+f٬WUsUjܮjn*ϫ|jjjj~j~MU*Wժryjjjj*l*ʽrk*ʽcblSmMjST6MaSKSKu *'ɦxMgS|nM1n*biST5{M^S\mjTN6MaS봦iM1)7MmSٚ>^AgSڬlMjSզ{Zurj=U~v]gWk]mW\*ojW9Uw]pWUNv]dW넮r슫]+vϮ*?^=] ۮ򶫼xLFc^S1dQTzE(w@QJ+*fUUsVu&]V'UR}I/YչYչYƹ\VQZEiUVQZUiUU1MvՕVWZdHTkz_*gU.\UY?'UIruR:MNIrrR99j3\IvRygE>+YQϊ}VTﰢz';IEN*wRQTT濫z';C/&Ib*~IBBYկ_ÊVTﰢzWջUE*wUQBYTjsSZMi5ՔVSZ]+]QTT濫z';IEN lOT~ʏVTPVBϊ}VTﳢzg7fTTﳢz[AJW9UE~ QuULUbz\%,6/y<;ejݿVEw^/euzϡzջVEW{muWͯT{^CyphC}xŕC9xѼ*\ΛTWeuuἿ=Gl?_|v(^/meuWջUi{ܡtZW_/ڎ?ovؿC}y^=7uyy:Z=^{kv\v~9=Wmǡhkyeu7Ux|U^uq\hEltwWÚEU{qh{;9OoC9pY]CCΡ;~\>_]WyΫ\tuqUϿy٪y|w^U]o;$g}gݞѧOAv_9n޵ﯣ<~eYm gf;wu}g:4cNï:Իw=uN룴Mm:q;ttJWEZ9vՏsc)̺vhju]KsxSkcpVM[.iۋa۵_sv ϼeq~Xk6S)5{g˧}^emM-tܞ1:i)cx#~ɾe?ڝNeeuE/:FkmQO]_l:m?ڱVϛi/26kauϪKgU =vvdY]vBqs.SiYc컴}ͩgݚ<|_)9gM4k?zם{Wd^Vݷ|I_re+N+wu/_l}ҿWWvfE}.OrҎfړwW=oʸDs\2ܷ_;>'W~#:O;.roVŌ^J%OmH?^`k?ybm=-=}n.JW~ѓ>^u|o+><2z$庽|f+O-kmo=o72nk+xqk7Yz߻^wӟ|?٭o|/$oy#i|o7Iܿ{^;d%/8.OZ_^v9~ew{iyz5f+2wyr}fsں0`UW寧ҞvۋΫk;u㣑ne9~e>`-!\Dx}/yq{\.WEN{]+1{IĴCQҏ[ln/ˇ弓=wi%kr=lu],Ov]G9sc'됵j3/4z~ʎn9Yclϲ5;~w]?f?>~H{,W#E׮_c>[s_vzVd<2޷rމi.+ׇ8里YG;:vk'֋>އ|} -ǤqS8.Kk'3;w벶4Ƹ s9޶}uyy2v*ǿtgV(sϫ,$?{lڼ߄K{\4yS]ek3r#;[9_js{#~;o9mf^_I5ߎ &otzTwd}g>12nXr<1/|o{_Y7've7}7~c_?ka{m㸵mO|y>j:߳e{?g\~~k~> {!mycy<1>tnW9i?Vm~ys 9γv3yze{9^yl}c׷kQ7޷uOX.9>q}vs=EŮG ;ힿwv]ӿߛxX/e+#.3gEom\_.ɛ~{m?%֞/>_9yÝӏ~_鍦R[vm2_u|~l_|xt]ie|zNi/[oggi#v-%e^[w5_2v%~d>9G;{#Vwiﲕ|{Y#$_z9nm\LJwu亽e=8/i"Oֻ}K]"óGK#kޣqΌɗ[q#^k-uv=d =5牮2{zd{oe>}h9η~qoݭgOӘ'8mǣ]W7sw{8N!c.\|ۇcs'e+m鷌oɷ] ]H> o{{G=QuǏ|Gy"KU+7^y,ߋuip_KG7>GX݂[=^ZihZ>si=q'F_8E+=~u]=h]OpK(_|jk+7/kw\uz޺N8*|~c#Xx:'2;mܯYgJJd~yOC9O}]w e]gx>pAs.ᒌ#,\x83\_韽rI#~3J͸uʲ1.0*Yu~q\G.[?81_{ ﷆ__ouHs%}>&q5ae+uved|}I w /uwJ~4o7'*<8W/"e+sR3ǝ e_^O/>qϲqZ@ʸ{9_=h,[æ9Ų|I?}o3H?dd;E|->]}a9,/g_z^g~J?lEg_.ەcc,uD('ܴpres8f+v=߲!4~Zs,/y`c}`+oc[|/>8;Kqw;k%gv=#$ܟЮeޘno}";K{d|79_eOck&IhWܳlç79^?t~^:_+ē_S_ǞO-~.ʷv{nov{nov{nov{nog/d/c>Gw.|zR O?55O||L>='˧>|COpx}CO~\~yߓ8vɯWeS?,$,"*&.ݙGi8J(QʣTFRFqhġFqhġFИ<41yhCcИFihFihFih䡑Fyh䡑Fyh䡑FehQFehQFehԡQFuhԡQFuhԡQFmhцFmhцFmhчF}hчF}hE#L,N,FgbeHj&MT6QmDj""""""""""fT6SmLj3fTKTKTKTKTKTKTKTKTKTKTTTTTTTTTTT+T+T+T+T+T+T+T+T+T+TTTTTTTTTTTkTkTkTkTkTkTkTkTkTkTTTTTTTTTT#K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHD$%,dI$K"YɒHDd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kfd&Kf$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"KYȒD$$%,IdI"K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd$%,dI&K2YɒLd%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K YRȒB%,)dI!K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,dI%K*YRɒJT%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#KYȒF4%,idI#K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt%,dI'K:YɒNt<`-OUyVY*WUnt';)INJwRҝt';)ݨtҍJ7*ݨtҍJ7*ݨtҝtg;+YJwVҝtMJ7)ݤtMJ7)ݤtMJ7+ݬtJ7+ݬtJ7+ݬt-J(ݢt-J(ݢt-J*ݪtҭJ*ݪtҭJ*ݪtmJ)ݦtmJ)ݦtmJ+ݮtJ+ݮtJ+]ūIjR&ūIjR&ūIjR&ūIjR&ūIjR=?S}ϯR"9jomo/man/0000755000176200001440000000000014416212532011771 5ustar liggesusersjomo/man/jomo1mix.MCMCchain.Rd0000644000176200001440000000722314410253602015545 0ustar liggesusers\name{jomo1mix.MCMCchain} \alias{jomo1mix.MCMCchain} \title{ JM Imputation of single level data with mixed variable types } \description{ This function is similar to jomo1mix, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1mix.MCMCchain(Y.con, Y.cat, Y.numcat, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, start.imp=NULL, nburn=100, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.con}{ A data frame, or matrix, with continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. If no continuous outcomes are present in the model, jomo1cat should be used instead. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of iterations. Default is 100. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with four elements is returned: the final imputed dataset (finimp) and three 3-dimensional matrices, containing all the values for beta (collectbeta) and omega (collectomega). Finally, in finimp.latnorm it is stored the final state of the imputed dataset with the latent normals in place of the categorical variables. } \examples{ #Then, we define all the inputs: # nburn is smaller than needed. This is #just because of CRAN policies on the examples. Y.con=sldata[,c("measure","age")] Y.cat=sldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,300),sldata[,c("sex")]) colnames(X)<-c("const", "sex") beta.start<-matrix(0,2,5) l1cov.start<-diag(1,5) l1cov.prior=diag(1,5); nburn=as.integer(100); #Then we run the sampler: imp<-jomo1mix.MCMCchain(Y.con,Y.cat,Y.numcat,X,beta.start,l1cov.start,l1cov.prior,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of omega: plot(c(1:nburn),imp$collectomega[1,1,1:nburn],type="l") } jomo/man/jomo.glm.MCMCchain.Rd0000644000176200001440000001043514410253602015523 0ustar liggesusers\name{jomo.glm.MCMCchain} \alias{jomo.glm.MCMCchain} \title{ glm Compatible JM Imputation - A tool to check convergence of the MCMC } \description{ This function is similar to the jomo.glm function, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo.glm.MCMCchain(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, betaY.start=NULL, nburn=1000, start.imp=NULL, start.imp.sub=NULL, output=1, out.iter=10, family="binomial") } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual glm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{start.imp}{ Starting value for the imputed covariates. n-level categorical variables are substituted by n-1 latent normals. } \item{start.imp.sub}{ Starting value for the imputations of the outcome. When using binomial family, this is the value of the latent normal. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{betaY.start}{ Starting value for betaY, the vector of fixed effects for the substantive analysis model. The default is the complete records estimate. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{family}{ One of either "gaussian"" or "binomial". For binomial family, a probit link is assumed. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are fixed effect parameters of the covariates beta (collectbeta), level 1 covariance matrices (collectomega), fixed effect estimates of the substantive model and associated residual variances. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # make sure sex is a factor: sldata<-within(sldata, sex<-factor(sex)) # we define the data frame with all the variables data<-sldata[,c("measure","age", "sex")] # And the formula of the substantive lm model # sex as an outcome only because it is the only binary variable in the dataset... formula<-as.formula(sex~age+measure) #And finally we run the imputation function: imp<-jomo.glm.MCMCchain(formula,data, nburn=10) # Note we are using only 10 iterations to avoid time consuming examples, # which go against CRAN policies. In real applications we would use # much larger burn-ins (around 1000, to say the least). # We can check, for example, the convergence of the first element of beta: plot(c(1:10),imp$collectbeta[1,1,1:10],type="l") } jomo/man/jomo.polr.Rd0000644000176200001440000001016414410253602014176 0ustar liggesusers\name{jomo.polr} \alias{jomo.polr} \title{ Joint Modelling Imputation Compatible with Proportional Odds Ordinal Probit Regression } \description{ A function for substantive model compatible JM imputation, when the substantive model of interest is a simple ordinal regression model. Interactions and polynomial functions of the covariates are allowed. Data must be passed as a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo.polr(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL,nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) } \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ This function allows for substantive model compatible imputation when the substantive model is a simple ordinal regression model. It can deal with interactions and polynomial terms through the usual lm syntax in the formula argument. Format of the columns of data is crucial in order for the function to deal with binary/categorical covariates appropriately in the imputation algorithm. } \value{ On screen, the posterior mean of the fixed effect estimates and of the residual variance are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Wiley, ISBN: 978-0-470-74052-1. } \examples{ # make sure social is a factor: sldata<-within(sldata, social<-factor(social)) # we define the data frame with all the variables data<-sldata[,c("measure","age", "social")] # And the formula of the substantive lm model # social as an outcome only because it is the only binary variable in the dataset... formula<-as.formula(social~age+measure) #And finally we run the imputation function: imp<-jomo.polr(formula,data, nburn=100, nbetween=100, nimp=2) # Note we are using only 100 iterations to avoid time consuming examples, # which go against CRAN policies. In real applications we would use # much larger burn-ins (around 1000) and at least 5 imputations. # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules }jomo/man/jomo1rancon.Rd0000644000176200001440000001175214410253602014511 0ustar liggesusers\name{jomo1rancon} \alias{jomo1rancon} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of clustered data with continuous variables only } \description{ Impute a clustered dataset with continuous outcomes only. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler. Categorical covariates may be considered, but they have to be included with dummy variables. } \usage{ jomo1rancon(Y, X=NULL, Z=NULL, clus, beta.start=NULL,u.start=NULL, l1cov.start=NULL,l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y}{ A data frame, or matrix, with responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ The Gibbs sampler algorithm used is a simplification of the one described in detail in Chapter 9 of Carpenter and Kenward (2013), where we exclude the presence of level 2 variables. Regarding the choice of the priors, a flat prior is considered for beta, while an inverse-Wishart prior is given to the covariance matrices, with p-1 degrees of freedom, aka the minimum possible, to guarantee the greatest uncertainty. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. } \examples{ # we define all the inputs: Y<-cldata[,c("measure","age")] clus<-cldata[,c("city")] X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) beta.start<-matrix(0,2,2) u.start<-matrix(0,10,2) l1cov.start<-diag(1,2) l2cov.start<-diag(1,2) l1cov.prior=diag(1,2); nburn=as.integer(200); nbetween=as.integer(200); nimp=as.integer(5); l2cov.prior=diag(1,5); #And finally we run the imputation function: imp<-jomo1rancon(Y,X,Z,clus,beta.start,u.start,l1cov.start, l2cov.start,l1cov.prior, l2cov.prior,nburn,nbetween,nimp) cat("Original value was missing(",imp[4,1],"), imputed value:", imp[1004,1]) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/jomo.lm.Rd0000644000176200001440000001007314410253602013631 0ustar liggesusers\name{jomo.lm} \alias{jomo.lm} \title{ Joint Modelling Imputation Compatible with Linear Regression Model } \description{ A function for substantive model compatible JM imputation, when the substantive model of interest is a simple linear regression model. Interactions and polynomial functions of the covariates are allowed. Data must be passed as a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo.lm(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) } \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ This function allows for substantive model compatible imputation when the substantive model is a simple linear regression model. It can deal with interactions and polynomial terms through the usual lm syntax in the formula argument. Format of the columns of data is crucial in order for the function to deal with binary/categorical covariates appropriately in the imputation algorithm. } \value{ On screen, the posterior mean of the fixed effect estimates and of the residual variance are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Wiley, ISBN: 978-0-470-74052-1. } \examples{ # make sure sex is a factor: sldata<-within(sldata, sex<-factor(sex)) # we define the data frame with all the variables data<-sldata[,c("measure","age", "sex")] # And the formula of the substantive lm model formula<-as.formula(measure~sex+age+I(age^2)) #And finally we run the imputation function: imp<-jomo.lm(formula,data, nburn=100, nbetween=100) # Note we are using only 100 iterations to avoid time consuming examples, # which go against CRAN policies. # If we were interested in a model with interactions: formula2<-as.formula(measure~sex*age) imp2<-jomo.lm(formula2,data, nburn=100, nbetween=100) # The analysis and combination steps are as for all the other functions # (see e.g. help file for function jomo) }jomo/man/jomo1ranmix.Rd0000644000176200001440000001327514410253602014531 0ustar liggesusers\name{jomo1ranmix} \alias{jomo1ranmix} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of clustered data with mixed variable types } \description{ Impute a clustered dataset with mixed data types as outcome. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler where the covariance matrix is updated with a Metropolis-Hastings step. Fully observed categorical covariates may be considered as covariates as well, but they have to be included as dummy variables. } \usage{ jomo1ranmix(Y.con, Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.con}{ A data frame, or matrix, with continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Categories must be integer numbers from 1 to N. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ TThe Gibbs sampler algorithm used is described in detail in Chapter 9 of Carpenter and Kenward (2013). Regarding the choice of the priors, a flat prior is considered for beta and for the covariance matrix. A Metropolis Hastings step is implemented to update the covariance matrix, as described in the book. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. } \examples{ # we define the inputs: # nimp, nburn and nbetween are smaller than they should. This is #just because of CRAN policies on the examples. Y.con=cldata[,c("measure","age")] Y.cat=cldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) clus<-cldata[,c("city")] beta.start<-matrix(0,2,5) u.start<-matrix(0,10,5) l1cov.start<-diag(1,5) l2cov.start<-diag(1,5) l1cov.prior=diag(1,5); l2cov.prior=diag(1,5); nburn=as.integer(50); nbetween=as.integer(50); nimp=as.integer(5); #Then we can run the sampler: imp<-jomo1ranmix(Y.con, Y.cat, Y.numcat, X,Z,clus,beta.start,u.start,l1cov.start, l2cov.start,l1cov.prior,l2cov.prior,nburn,nbetween,nimp) cat("Original value was missing (",imp[4,1],"), imputed value:", imp[1004,1]) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/jomo.Rd0000644000176200001440000001622214410253602013224 0ustar liggesusers\name{jomo} \alias{jomo} \title{ Joint Modelling Imputation } \description{ A wrapper function linking all the functions for JM imputation. The matrix of responses Y, must be a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo(Y, Y2=NULL, X=NULL, X2=NULL, Z=NULL, clus=NULL, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, a=NULL, a.prior=NULL, meth="common", output=1, out.iter=10) } \arguments{ \item{Y}{ A data.frame containing the (level-1) outcomes of the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{Y2}{ A data.frame containing the level-2 outcomes of the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{X2}{ A data frame, or matrix, with level-2 covariates of the joint imputation model. Rows correspond to different level-1 observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. If missing, functions for single level imputation are automatically used. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects. Rows index different covariates and columns index different level-2 outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects plus the number of level-2 outcomes. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="random") } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ This is just a wrapper function to link all the functions in the package. Format of the columns of Y is crucial in order for the function to be using the right sub-function. } \value{ On screen, the posterior mean of the fixed and random effects estimates and of the covariance matrices are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Wiley, ISBN: 978-0-470-74052-1. } \examples{ # define all the inputs: Y<-cldata[,c("measure","age")] clus<-cldata[,c("city")] nburn=as.integer(200); nbetween=as.integer(200); nimp=as.integer(5); #And finally we run the imputation function: imp<-jomo(Y,clus=clus,nburn=nburn,nbetween=nbetween,nimp=nimp) # Finally we show how to fit the model and combine estimate with Rubin's rules # Here we use mitml, other options are available in mice, mitools, etc etc #if (requireNamespace("mitml", quietly = TRUE)&requireNamespace("lme4", quietly = TRUE)) { #imp.mitml<-jomo2mitml.list(imp) #fit.i<-with(imp.mitml, lmer(measure~age+(1|clus))) #fit.MI<-testEstimates(fit.i, var.comp=T) # } #we could even run imputation with fixed or random cluster-specific covariance matrices: #imp<-jomo(Y,clus=clus,nburn=nburn,nbetween=nbetween,nimp=nimp, meth="fixed") #or: #imp<-jomo(Y,clus=clus,nburn=nburn,nbetween=nbetween,nimp=nimp, meth="random") #if we do not add clus as imput, functions for single level imputation are used: #imp<-jomo(Y) }jomo/man/jomo2com.Rd0000644000176200001440000001473114410253602014010 0ustar liggesusers\name{jomo2com} \alias{jomo2com} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of 2-level data assuming a common level-1 covariance matrix across level-2 units. } \description{ Impute a 2-level dataset with mixed data types as outcome. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler where the covariance matrix is updated with a Metropolis-Hastings step. Fully observed categorical covariates may be considered as covariates as well, but they have to be included as dummy variables. } \usage{ jomo2com(Y.con=NULL, Y.cat=NULL, Y.numcat=NULL, Y2.con=NULL, Y2.cat=NULL, Y2.numcat=NULL,X=NULL, X2=NULL, Z=NULL, clus, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.con}{ A data frame, or matrix, with level-1 continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{Y2.con}{ A data frame, or matrix, with level-2 continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. } \item{Y2.cat}{ A data frame, or matrix, with level-2 categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y2.numcat}{ A vector with the number of categories in each level-2 categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{X2}{ A data frame, or matrix, with level-2 covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects. Rows index different covariates and columns index different level-2 outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects plus the number of level-2 outcomes. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ TThe Gibbs sampler algorithm used is described in detail in Chapter 9 of Carpenter and Kenward (2013). Regarding the choice of the priors, a flat prior is considered for beta and for the covariance matrix. A Metropolis Hastings step is implemented to update the covariance matrix, as described in the book. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. } \examples{ Y<-tldata[,c("measure.a"), drop=FALSE] Y2<-tldata[,c("big.city"), drop=FALSE] clus<-tldata[,c("city")] #now we run the imputation function. Note that we would typically use an higher #number of nburn iterations in real applications (at least 1000) imp<-jomo2com(Y.con=Y, Y2.cat=Y2, Y2.numcat=2, clus=clus,nburn=10, nbetween=10, nimp=2) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/jomo1ranmixhr.Rd0000644000176200001440000001643314410253602015062 0ustar liggesusers\name{jomo1ranmixhr} \alias{jomo1ranmixhr} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of clustered data with mixed variable types with cluster-specific covariance matrices } \description{ Impute a clustered dataset with mixed data types as outcome. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler where a different covariance matrix is sampled within each cluster. Fully observed categorical covariates may be considered as covariates as well, but they have to be included as dummy variables. } \usage{ jomo1ranmixhr(Y.con, Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL,l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000,nimp=5, a=NULL,a.prior=NULL,meth="random", output=1, out.iter=10) } \arguments{ \item{Y.con}{ A data frame, or matrix, with continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. If no continuous outcomes are present in the model, jomo1rancathr must be used instead. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrices, stacked one above the other. Dimension of each square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix for each cluster. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrices. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ When set to "fixed", a flat prior is put on the study-specific covariance matrices and each matrix is updated separately with a different MH-step. When set to "random", we are assuming that all the covariance matrices are draws from an inverse-Wishart distribution, whose parameter values are updated with 2 steps similar to the ones presented in the case of continuous data only for function jomo1ranconhr. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ The Gibbs sampler algorithm used is obtained is a mixture of the ones described in chapter 5 and 9 of Carpenter and Kenward (2013). We update the covariance matrices element-wise with a Metropolis-Hastings step. When meth="fixed", we use a flat prior for rhe matrices, while with meth="random" we use an inverse-Wishar tprior and we assume that all the covariance matrices are drawn from an inverse Wishart distribution. We update values of a and A, degrees of freedom and scale matrix of the inverse Wishart distribution from which all the covariance matrices are sampled, from the proper conditional distributions. A flat prior is considered for beta. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. Yucel R.M., (2011), Random-covariances and mixed-effects models for imputing multivariate multilevel continuous data, Statistical Modelling, 11 (4), 351-370, DOI: 10.1177/1471082X100110040. } \examples{ #we define all the inputs: # nimp, nburn and nbetween are smaller than they should. This is #just because of CRAN policies on the examples. Y.con=cldata[,c("measure","age")] Y.cat=cldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) clus<-cldata[,c("city")] beta.start<-matrix(0,2,5) u.start<-matrix(0,10,5) l1cov.start<-matrix(diag(1,5),50,5,2) l2cov.start<-diag(1,5) l1cov.prior=diag(1,5); l2cov.prior=diag(1,5); nburn=as.integer(50); nbetween=as.integer(50); nimp=as.integer(5); a=6 # And we are finally able to run the imputation: imp<-jomo1ranmixhr(Y.con, Y.cat, Y.numcat, X,Z,clus,beta.start,u.start,l1cov.start, l2cov.start,l1cov.prior,l2cov.prior,nburn,nbetween,nimp, a, meth="random") cat("Original value was missing (",imp[4,1],"), imputed value:", imp[1004,1]) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/jomo.smc.Rd0000644000176200001440000001634414410253602014012 0ustar liggesusers\name{jomo.smc} \alias{jomo.smc} \title{ Joint Modelling Substantive Model Compatible Imputation } \description{ A wrapper function for all the substantive model compatible JM imputation functions. The substantive model of interest is either lm, glm, polr, lmer, clmm, glmer or coxph. Interactions and polynomial functions of the covariates are allowed. Data must be passed as a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo.smc(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, nburn=1000, nbetween=1000, nimp=5, meth="common", family="binomial", output=1, out.iter=10, model) } \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Random effects follow the usual lmer syntax; however, it is possible only to allow for one grouping variable and all the variables with random effects must be included within the same brackets (es: (1+X|clus) is correct, while (1|clus)+(X|clus) is NOT). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{level}{ If the dataset is multilevel, this must be a vector indicating whether each variable is either a level 1 or a level 2 variable. The value assigned to the cluster indicator is irrelevant. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster of the random effects estimates u for the joint model for the covariates. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of level-1 covariates (continuous plus latent normals) in the analysis model times the number of random effects plus the number of level-2 covariates. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{a.start}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{model}{ The type of model we want to impute compatibly with. It can currently be one of lm, glm (binomial), polr, coxph, lmer, clmm or glmer (binomial). } \item{family}{ One of either "gaussian"" or "binomial". For binomial family, a probit link is assumed. } } \details{ This function allows for substantive model compatible imputation. It can deal with interactions and polynomial terms through the usual lmer syntax in the formula argument. Format of the columns of data is crucial in order for the function to deal with binary/categorical covariates appropriately in the imputation algorithm. } \value{ On screen, the posterior mean of the fixed effect estimates and of the residual variance are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Wiley, ISBN: 978-0-470-74052-1. } \examples{ # make sure sex is a factor: cldata<-within(cldata, sex<-factor(sex)) # we define the data frame with all the variables data<-cldata[,c("measure","age", "sex", "city")] mylevel<-c(1,1,1,1) # And the formula of the substantive lm model formula<-as.formula(measure~sex+age+I(age^2)+(1|city)) #And finally we run the imputation function: imp<-jomo.smc(formula,data, level=mylevel, nburn=100, nbetween=100, model="lmer") # Note we are using only 100 iterations to avoid time consuming examples, # which go against CRAN policies. # If we were interested in a model with interactions: # formula2<-as.formula(measure~sex*age+(1|city)) # imp2<-jomo.smc(formula2,data, level=mylevel, nburn=100, nbetween=100, model="lmer") # The analysis and combination steps are as for all the other functions # (see e.g. help file for function jomo) }jomo/man/tldata.Rd0000644000176200001440000000267314410253602013536 0ustar liggesusers\name{tldata} \alias{tldata} \docType{data} \title{ A simulated 2-level dataset } \description{ A simulated dataset to test 2-level functions, i.e. jomo2com and jomo2hr. } \usage{data(tldata)} \format{ A data frame with 1000 observations on the following 6 variables. \describe{ \item{\code{measure.a}}{A numeric variable with some measure of interest (unspecified). This is partially observed.} \item{\code{measure.b}}{A numeric variable with some measure of interest (unspecified). This is fully observed.} \item{\code{measure.a2}}{A numeric variable with some level-2 measure of interest (unspecified). This is partially observed.} \item{\code{previous.events}}{A binary variable indicating if a patient has previous history of (unspecified) events. Patially observed.} \item{\code{group}}{A 3-category variable indicating to which group each patient belongs. This is partially observed.} \item{\code{big.city}}{A binary variable indicating if each city has more than 100000 inhabitants. Patially observed.} \item{\code{region}}{A 3-category variable indicating to which region each city belongs. This is fully observed.} \item{\code{city}}{The cluster indicator vector. 200 cities are indexed 0 to 199.} \item{\code{id}}{The id for each individual within each city.} } } \details{ These are not real data, they are simulated to illustrate the use of the main functions of the package.} jomo/man/jomo.glm.Rd0000644000176200001440000001031014410253602013772 0ustar liggesusers\name{jomo.glm} \alias{jomo.glm} \title{ Joint Modelling Imputation Compatible with glm Model } \description{ A function for substantive model compatible JM imputation, when the substantive model of interest is a simple generalized linear regression model. Interactions and polynomial functions of the covariates are allowed. Data must be passed as a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo.glm(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL,nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10, family="binomial") } \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{family}{ One of either "gaussian"" or "binomial". For binomial family, a probit link is assumed. } } \details{ This function allows for substantive model compatible imputation when the substantive model is a simple linear regression model. It can deal with interactions and polynomial terms through the usual lm syntax in the formula argument. Format of the columns of data is crucial in order for the function to deal with binary/categorical covariates appropriately in the imputation algorithm. } \value{ On screen, the posterior mean of the fixed effect estimates and of the residual variance are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Wiley, ISBN: 978-0-470-74052-1. } \examples{ # make sure sex is a factor: sldata<-within(sldata, sex<-factor(sex)) # we define the data frame with all the variables data<-sldata[,c("measure","age", "sex")] # And the formula of the substantive lm model # sex as an outcome only because it is the only binary variable in the dataset... formula<-as.formula(sex~age+measure) #And finally we run the imputation function: imp<-jomo.glm(formula,data, nburn=10, nbetween=10, nimp=2) # Note we are using only 10 iterations to avoid time consuming examples, # which go against CRAN policies. In real applications we would use # much larger burn-ins (around 1000) and at least 5 imputations. # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules }jomo/man/jomo1rancat.MCMCchain.Rd0000644000176200001440000001126514410253602016221 0ustar liggesusers\name{jomo1rancat.MCMCchain} \alias{jomo1rancat.MCMCchain} \title{ JM Imputation of clustered data with categorical variables - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1rancat, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1rancat.MCMCchain(Y.cat, Y.numcat, X=NULL, Z=NULL,clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL,nburn=1000, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with six elements is returned: the final imputed dataset (finimp) and four 3-dimensional matrices, containing all the values for beta (collectbeta), the random effects (collectu) and the level 1 (collectomega) and level 2 covariance matrices (collectcovu). Finally, the final state of the imputed dataset with the latent normals in place of the categorical variables is stored in finimp.latnorm. } \examples{ # define all the inputs: # nburn smaller than needed. This is #just because of CRAN policies on the examples. Y.cat=cldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) clus<-cldata[,c("city")] beta.start<-matrix(0,2,3) u.start<-matrix(0,10,3) l1cov.start<-diag(1,3) l2cov.start<-diag(1,3) l1cov.prior=diag(1,3); l2cov.prior=diag(1,3); nburn=as.integer(100); #And finally we run the imputation function: imp<-jomo1rancat.MCMCchain(Y.cat, Y.numcat, X,Z,clus,beta.start,u.start,l1cov.start, l2cov.start,l1cov.prior,l2cov.prior,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") }jomo/man/jomo.lm.MCMCchain.Rd0000644000176200001440000001023114410253602015346 0ustar liggesusers\name{jomo.lm.MCMCchain} \alias{jomo.lm.MCMCchain} \title{ lm Compatible JM Imputation - A tool to check convergence of the MCMC } \description{ This function is similar to the jomo.lm function, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo.lm.MCMCchain(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, betaY.start=NULL, varY.start=NULL, nburn=1000, start.imp=NULL, start.imp.sub=NULL, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{betaY.start}{ Starting value for betaY, the vector of fixed effects for the substantive analysis model. The default is the complete records estimate. } \item{varY.start}{ Starting value for varY, the residual variance of the substantive analysis model. The default is the complete records estimate. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{start.imp}{ Starting value for the missing data in the covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } \item{start.imp.sub}{ Starting value for the missing data in the outcome of the substantive model. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are fixed effect parameters of the covariates beta (collectbeta), level 1 covariance matrices (collectomega), fixed effect estimates of the substantive model and associated residual variances. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # make sure sex is a factor: sldata<-within(sldata, sex<-factor(sex)) # we define the data frame with all the variables data<-sldata[,c("measure","age", "sex")] # And the formula of the substantive lm model formula<-as.formula(measure~sex+age+I(age^2)) #And finally we run the imputation function: imp<-jomo.lm.MCMCchain(formula,data, nburn=100) # Note we are using only 100 iterations to avoid time consuming examples, # which go against CRAN policies. # We can check, for example, the convergence of the first element of beta: plot(c(1:100),imp$collectbeta[1,1,1:100],type="l") } jomo/man/jomo1rancathr.MCMCchain.Rd0000644000176200001440000001341414410253602016551 0ustar liggesusers\name{jomo1rancathr.MCMCchain} \alias{jomo1rancathr.MCMCchain} \title{ JM Imputation of clustered data with categorical variables with cluster-specific covariance matrices - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1rancathr, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1rancathr.MCMCchain(Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, a=NULL, a.prior=NULL, meth="random", output=1, out.iter=10) } \arguments{ \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrices, stacked one above the other. Dimension of each square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix for each cluster. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrices. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ When set to "fixed", a flat prior is put on the study-specific covariance matrices and each matrix is updated separately with a different MH-step. When set to "random", we are assuming that all the covariance matrices are draws from an inverse-Wishart distribution, whose parameter values are updated with 2 steps similar to the ones presented in the case of continuous data only for function jomo1ranconhr. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with six elements is returned: the final imputed dataset (finimp) and four 3-dimensional matrices, containing all the values for beta (collectbeta), the random effects (collectu) and the level 1 (collectomega) and level 2 covariance matrices (collectcovu). Finally, the final state of the imputed dataset with the latent normals in place of the categorical variables is stored in finimp.latnorm. } \examples{ #we define the inputs # nburn is smaller than needed. This is #just because of CRAN policies on the examples. Y.cat=cldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) clus<-cldata[,c("city")] beta.start<-matrix(0,2,3) u.start<-matrix(0,10,3) l1cov.start<-matrix(diag(1,3),30,3,2) l2cov.start<-diag(1,3) l1cov.prior=diag(1,3); l2cov.prior=diag(1,3); a=5 nburn=as.integer(100); #Finally we run either the model with fixed or random cluster-specific covariance matrices: imp<-jomo1rancathr.MCMCchain(Y.cat, Y.numcat, X,Z,clus,beta.start, u.start,l1cov.start, l2cov.start,l1cov.prior,l2cov.prior,nburn=nburn, a=a, meth="fixed") #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of th elevel 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") } jomo/man/jomo.lmer.MCMCchain.Rd0000644000176200001440000001730214410253602015703 0ustar liggesusers\name{jomo.lmer.MCMCchain} \alias{jomo.lmer.MCMCchain} \title{ lmer Compatible JM Imputation - A tool to check convergence of the MCMC } \description{ This function is similar to the jomo.lmer function, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo.lmer.MCMCchain(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, betaY.start=NULL, varY.start=NULL, covuY.start=NULL, uY.start=NULL, nburn=1000, meth="common", start.imp=NULL, start.imp.sub=NULL, l2.start.imp=NULL, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Random effects follow the usual lmer syntax; however, it is possible only to allow for one grouping variable and all the variables with random effects must be included within the same brackets (es: (1+X|clus) is correct, while (1|clus)+(X|clus) is NOT). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{level}{ A vector, indicating whether each variable is either a level 1 or a level 2 variable. The value assigned to the cluster indicator is irrelevant. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster of the random effects estimates u for the joint model for the covariates. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of level-1 covariates (continuous plus latent normals) in the analysis model times the number of random effects plus the number of level-2 covariates. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{a.start}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{betaY.start}{ Starting value for betaY, the vector of fixed effects for the substantive analysis model. The default is the complete records estimate. } \item{varY.start}{ Starting value for varY, the residual variance of the substantive analysis model. The default is the complete records estimate. } \item{covuY.start}{ Starting value for covuY, the random effects covariance matrix of the substantive analysis model. The default is the complete records estimate. } \item{uY.start}{ Starting value for uY, the random effects matrix of the substantive analysis model. The default is the complete records estimate. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{start.imp}{ Starting value for the missing data in the covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } \item{l2.start.imp}{ Starting value for the missing data in the level-2 covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } \item{start.imp.sub}{ Starting value for the missing data in the outcome of the substantive model. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are fixed effect parameters of the covariates beta (collectbeta), level 1 covariance matrices (collectomega), fixed effect estimates of the substantive model and associated residual variances. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # make sure sex is a factor: cldata<-within(cldata, sex<-factor(sex)) # we define the data frame with all the variables data<-cldata[,c("measure","age", "sex", "city")] mylevel<-c(1,1,1,1) # And the formula of the substantive lm model formula<-as.formula(measure~sex+age+I(age^2)+(1|city)) #And finally we run the imputation function: imp<-jomo.lmer.MCMCchain(formula,data, level=mylevel, nburn=100) # Note we are using only 100 iterations to avoid time consuming examples, # which go against CRAN policies. # We can check, for example, the convergence of the first element of beta: plot(c(1:100),imp$collectbeta[1,1,1:100],type="l") } jomo/man/jomo1.Rd0000644000176200001440000000607314410253602013310 0ustar liggesusers\name{jomo1} \alias{jomo1} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of single level data } \description{ A wrapper function linking the 3 single level JM Imputation functions. The matrix of responses Y, must be a data.frame where continuous variables are numeric and binary/categorical variables are factors. } \usage{ jomo1 (Y, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=100, nbetween=100, nimp=5, output=1, out.iter=10) } \arguments{ \item{Y}{ A data.frame containing the outcomes of the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 100. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 100. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ This is just a wrapper function to link jomo1con, jomo1cat and jomo1mix. Format of the columns of Y is crucial in order for the function to be using the right sub-function. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 3-5, Wiley, ISBN: 978-0-470-74052-1. } \examples{ # define all the inputs: Y<-sldata[,c("measure","age")] nburn=as.integer(200); nbetween=as.integer(200); nimp=as.integer(5); # Then we run the function: imp<-jomo1(Y,nburn=nburn,nbetween=nbetween,nimp=nimp) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules }jomo/man/jomo1ran.Rd0000644000176200001440000001264014410253602014006 0ustar liggesusers\name{jomo1ran} \alias{jomo1ran} \title{ JM Imputation of clustered data } \description{ A wrapper function linking the six 2-level JM Imputation functions. The matrix of responses Y, must be a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo1ran(Y, X=NULL, Z=NULL,clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, a=NULL, a.prior=NULL, meth="common", output=1, out.iter=10) } \arguments{ \item{Y}{ A data.frame containing the outcomes of the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is the starting value for a. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="random") } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ This is just a wrapper function to link jomo1rancon, jomo1rancat and jomo1ranmix and the respective "hr" (heterogeneity in covariance matrices) versions. Format of the columns of Y is crucial in order for the function to be using the right sub-function. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. } \examples{ # define all the inputs: Y<-cldata[,c("measure","age")] clus<-cldata[,c("city")] nburn=as.integer(200); nbetween=as.integer(200); nimp=as.integer(5); #And finally we run the imputation function: imp<-jomo1ran(Y,clus=clus,nburn=nburn,nbetween=nbetween,nimp=nimp) #we could even run it with fixed or random cluster-specific covariance matrices: #imp<-jomo1ran(Y,clus=clus,nburn=nburn,nbetween=nbetween,nimp=nimp, meth="fixed") #or: #imp<-jomo1ran(Y,clus=clus,nburn=nburn,nbetween=nbetween,nimp=nimp, meth="random") # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules }jomo/man/jomo1ranconhr.Rd0000644000176200001440000001530614410253602015042 0ustar liggesusers\name{jomo1ranconhr} \alias{jomo1ranconhr} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of clustered data with continuous variables only with cluster-specific covariance matrices } \description{ Impute a clustered dataset with continuous outcomes only. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler. A different covariance matrix is estimated within each cluster. Categorical covariates may be considered, but they have to be included with dummy variables. } \usage{ jomo1ranconhr(Y, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, a=(ncol(Y)+50),a.prior=NULL, meth="random", output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y}{ A data frame, or matrix, with responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrices, stacked one above the other. Dimension of each square matrix is equal to the number of outcomes in the imputation model. The default is the identity matrix for each cluster. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrices. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ This can be set to "Fixed" or "Random". In the first case the function will consider fixed study-specific covariance matrices, in the second, random study-specific distributed according to an inverse-Wishart distribution. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ The Gibbs sampler algorithm used is similar to the one described in detail in Chapter 9 of Carpenter and Kenward (2013), where we exclude the presence of level 2 variables and we estimate separetely different covariance matrices within each study. When option meth="random" is specified, all the covariance matrices ae assumed to be random draws from the same underlying inverse Wishart distributions. Details of this algorithm may be found in (Yucel, 2011). Regarding the choice of the priors, a flat prior is considered for beta, while an inverse-Wishart prior is given to the covariance matrices, with p-1 degrees of freedom, aka the minimum possible, to guarantee the greatest uncertainty. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. Yucel R.M., (2011), Random-covariances and mixed-effects models for imputing multivariate multilevel continuous data, Statistical Modelling, 11 (4), 351-370, DOI: 10.1177/1471082X100110040. } \examples{ # we define the inputs # nimp, nburn and nbetween are smaller than they should. This is #just because of CRAN policies on the examples. Y<-cldata[,c("measure","age")] clus<-cldata[,c("city")] X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) beta.start<-matrix(0,2,2) u.start<-matrix(0,10,2) l1cov.start<-matrix(diag(1,2),20,2,2) l2cov.start<-diag(1,2) l1cov.prior=diag(1,2); nburn=as.integer(50); nbetween=as.integer(20); nimp=as.integer(5); l2cov.prior=diag(1,5); a=3 # Finally we run either the model with fixed or random cluster-specific covariance matrices: imp<-jomo1ranconhr(Y,X,Z,clus,beta.start,u.start,l1cov.start, l2cov.start, l1cov.prior,l2cov.prior,nburn,nbetween,nimp,meth="fixed") cat("Original value was missing(",imp[4,1],"), imputed value:", imp[1004,1]) #or: #imp<-jomo1ranconhr(Y,X,Z,clus,beta.start,u.start,l1cov.start, l2cov.start, # l1cov.prior,l2cov.prior,nburn,nbetween,nimp,a,meth="random") # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/sldata.Rd0000644000176200001440000000147114410253602013530 0ustar liggesusers\name{sldata} \alias{sldata} \docType{data} \title{ A simulated single level dataset } \description{ A simulated dataset to test single level functions, i.e. jomo1con, jomo1cat and jomo1mix. } \usage{data(sldata)} \format{ A data frame with 300 observations on the following 4 variables. \describe{ \item{\code{age}}{A numeric variable with age. Fully observed.} \item{\code{measure}}{A numeric variable with some measure of interest (unspecified). This is partially observed.} \item{\code{sex}}{A binary variable for gender indicator. Fully observed.} \item{\code{social}}{A 4-category variable with a social status indicator. This is partially observed.} } } \details{ These are not real data, they are simulated to illustrate the use of the main functions of the package.} jomo/man/jomo.coxph.MCMCchain.Rd0000644000176200001440000000717114410253602016070 0ustar liggesusers\name{jomo.coxph.MCMCchain} \alias{jomo.coxph.MCMCchain} %- Also NEED an '\alias' for EACH other topic documented here. \title{ coxph Compatible JM Imputation - A tool to check convergence of the MCMC } \description{ This function is similar to the jomo.coxph function, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo.coxph.MCMCchain(formula, data, beta.start = NULL, l1cov.start = NULL, l1cov.prior = NULL, nburn = 1000, start.imp = NULL, betaY.start = NULL, output = 1, out.iter = 10) } \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Survival model is specified with the usual coxph syntax. } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{betaY.start}{ Starting value for betaY, the vector of fixed effects for the substantive analysis model. The default is the complete records estimate. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{start.imp}{ Starting value for the missing data in the covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are fixed effect parameters of the covariates beta (collectbeta), level 1 covariance matrices (collectomega), fixed effect estimates of the substantive model. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # define substantive model formula<-as.formula(Surv(time, status) ~ measure + sex + I(measure^2)) #Run imputation if (requireNamespace("survival", quietly = TRUE)) { library(survival) #imp<-jomo.coxph.MCMCchain(formula,surdata, nburn = 100) } } jomo/man/jomo2.Rd0000644000176200001440000001422514410253602013307 0ustar liggesusers\name{jomo2} \alias{jomo2} \title{ JM Imputation of 2-level data } \description{ A wrapper function linking the 2-level JM Imputation functions. The matrices of responses Y and Y2, must be data.frames where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo2(Y, Y2, X=NULL, X2=NULL, Z=NULL,clus, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, a=NULL, a.prior=NULL, meth="common", output=1, out.iter=10) } \arguments{ \item{Y}{ A data.frame with the level-1 outcomes of the imputation model, where columns related to continuous variables are numeric and columns related to binary/categorical variables are factors. } \item{Y2}{ A data.frame containing the level-2 outcomes of the imputation model, i.e. the partially observed level-2 variables. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{X2}{ A data frame, or matrix, with level-2 covariates of the joint imputation model. Rows correspond to different level-1 observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects. Rows index different covariates and columns index different level-2 outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects plus the number of level-2 outcomes. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (function jomo2com). When set to "fixed", fixed study-specific matrices are considered (jomo2hr with option meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo2hr with option meth="random") } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ This is just a wrapper function to link jomo1rancon, jomo1rancat and jomo1ranmix and the respective "hr" (heterogeneity in covariance matrices) versions. Format of the columns of Y is crucial in order for the function to be using the right sub-function. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. } \examples{ Y<-tldata[,c("measure.a"), drop=FALSE] Y2<-tldata[,c("big.city"), drop=FALSE] clus<-tldata[,c("city")] nburn=10 nbetween=10 nimp=2 #now we run the imputation function. Note that we would typically use an higher #number of nburn iterations in real applications (at least 1000) imp<-jomo2(Y=Y, Y2=Y2, clus=clus,nburn=nburn, nbetween=nbetween, nimp=nimp) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules }jomo/man/jomo.smc.MCMCchain.Rd0000644000176200001440000001765714410253602015543 0ustar liggesusers\name{jomo.smc.MCMCchain} \alias{jomo.smc.MCMCchain} \title{ Substantive Model Compatible JM Imputation - A tool to check convergence of the MCMC } \description{ This function is similar to the jomo.smc function, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo.smc.MCMCchain(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, betaY.start=NULL, varY.start=NULL, covuY.start=NULL, uY.start=NULL, nburn=1000, meth="common", family="binomial", start.imp=NULL, start.imp.sub=NULL, l2.start.imp=NULL, output=1, out.iter=10, model) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Random effects follow the usual lmer syntax; however, it is possible only to allow for one grouping variable and all the variables with random effects must be included within the same brackets (es: (1+X|clus) is correct, while (1|clus)+(X|clus) is NOT). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{level}{ If the dataset is multilevel, this must be a vector indicating whether each variable is either a level 1 or a level 2 variable. The value assigned to the cluster indicator is irrelevant. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster of the random effects estimates u for the joint model for the covariates. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of level-1 covariates (continuous plus latent normals) in the analysis model times the number of random effects plus the number of level-2 covariates. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{a.start}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{betaY.start}{ Starting value for betaY, the vector of fixed effects for the substantive analysis model. The default is the complete records estimate. } \item{varY.start}{ Starting value for varY, the residual variance of the substantive analysis model. The default is the complete records estimate. } \item{covuY.start}{ Starting value for covuY, the random effects covariance matrix of the substantive analysis model. The default is the complete records estimate. } \item{uY.start}{ Starting value for uY, the random effects matrix of the substantive analysis model. The default is the complete records estimate. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{start.imp}{ Starting value for the missing data in the covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } \item{l2.start.imp}{ Starting value for the missing data in the level-2 covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } \item{start.imp.sub}{ Starting value for the missing data in the outcome of the substantive model. } \item{model}{ The type of model we want to impute compatibly with. It can currently be one of lm, glm (binomial), polr, coxph, lmer, clmm or glmer (binomial). } \item{family}{ One of either "gaussian"" or "binomial". For binomial family, a probit link is assumed. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are fixed effect parameters of the covariates beta (collectbeta), level 1 covariance matrices (collectomega), fixed effect estimates of the substantive model and associated residual variances. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # make sure sex is a factor: cldata<-within(cldata, sex<-factor(sex)) # we define the data frame with all the variables data<-cldata[,c("measure","age", "sex", "city")] mylevel<-c(1,1,1,1) # And the formula of the substantive lm model formula<-as.formula(measure~sex+age+I(age^2)+(1|city)) #And finally we run the imputation function: imp<-jomo.smc.MCMCchain(formula,data, level=mylevel, nburn=100, model="lmer") # Note we are using only 100 iterations to avoid time consuming examples, # which go against CRAN policies. # We can check, for example, the convergence of the first element of beta: plot(c(1:100),imp$collectbeta[1,1,1:100],type="l") } jomo/man/jomo.MCMCchain.Rd0000644000176200001440000001555314410253602014753 0ustar liggesusers\name{jomo.MCMCchain} \alias{jomo.MCMCchain} \title{ JM Imputation - A tool to check convergence of the MCMC } \description{ This function is similar to the jomo function, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo.MCMCchain(Y, Y2=NULL, X=NULL, X2=NULL, Z=NULL, clus=NULL, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, l2.start.imp=NULL, nburn=1000, a=NULL, a.prior=NULL, meth="common",output=1, out.iter=10) } \arguments{ \item{Y}{ A data.frame containing the outcomes of the imputation model, i.e. the partially observed level 1 variables. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{Y2}{ A data.frame containing the level-2 outcomes of the imputation model, i.e. the partially observed level-2 variables. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{X2}{ A data frame, or matrix, with level-2 covariates of the joint imputation model. Rows correspond to different level-1 observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. If missing, functions for single level imputation are automatically used. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects. Rows index different covariates and columns index different level-2 outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects plus the number of level-2 outcomes. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{l2.start.imp}{ Starting value for the level-2 imputed variables. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of iterations. Default is 1000. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are, potentially, fixed effect parameters beta (collectbeta), random effects (collectu), level 1 (collectomega) and level 2 covariance matrices (collectcovu) and level-2 fixed effect parameters. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # define all the inputs: Y<-cldata[,c("measure","age")] clus<-cldata[,c("city")] nburn=as.integer(200); #And finally we run the imputation function: imp<-jomo.MCMCchain(Y,clus=clus,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") } jomo/man/jomo1ran.MCMCchain.Rd0000644000176200001440000001217114410253602015526 0ustar liggesusers\name{jomo1ran.MCMCchain} \alias{jomo1ran.MCMCchain} \title{ JM Imputation of clustered data - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1ran, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1ran.MCMCchain(Y, X=NULL, Z=NULL,clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL,l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, a=NULL,a.prior=NULL, meth="common", output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y}{ A data.frame containing the outcomes of the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of iterations. Default is 1000. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is the starting value for a. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with six elements is returned: the final imputed dataset (finimp) and four 3-dimensional matrices, containing all the values for beta (collectbeta), the random effects (collectu) and the level 1 (collectomega) and level 2 covariance matrices (collectcovu). Finally, for cases where categorical variabels are present, the final state of the imputed dataset with the latent normals in place of the categorical variables is stored in finimp.latnorm. } \examples{ # define all the inputs: Y<-cldata[,c("measure","age")] clus<-cldata[,c("city")] nburn=as.integer(200); #And finally we run the imputation function: imp<-jomo1ran.MCMCchain(Y,clus=clus,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") } jomo/man/jomo1ranconhr.MCMCchain.Rd0000644000176200001440000001150514410253602016560 0ustar liggesusers\name{jomo1ranconhr.MCMCchain} \alias{jomo1ranconhr.MCMCchain} \title{ JM Imputation of clustered data with continuous variables only with cluster-specific covariance matrices - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1ranconhr, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1ranconhr.MCMCchain(Y, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL,start.imp=NULL, nburn=1000, a=(ncol(Y)+50),a.prior=NULL, meth="random", output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y}{ A data frame, or matrix, with responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ in column. Dimension of each square matrix is equal to the number of outcomes in the imputation model. The default is the identity matrix for each cluster. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrices. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. } \item{nburn}{ Number of iterations. Default is 1000. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ This can be set to "Fixed" or "Random". In the first case the function will consider fixed study-specific covariance matrices, in the second, random study-specific distributed according to an inverse-Wishart distribution. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with five elements is returned: the final imputed dataset (finimp) and four 3-dimensional matrices, containing all the values for beta (collectbeta), the random effects (collectu) and the level 1 (collectomega) and level 2 covariance matrices (collectcovu). } \examples{ # we define the inputs # nburn is smaller than needed. This is #just because of CRAN policies on the examples. Y<-cldata[,c("measure","age")] clus<-cldata[,c("city")] X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) nburn=as.integer(200); a=3 # Finally we run either the model with fixed or random cluster-specific cov. matrices: imp<-jomo1ranconhr.MCMCchain(Y,X,Z,clus,nburn=nburn,meth="random") #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 cov. matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") } jomo/man/jomo1rancathr.Rd0000644000176200001440000001574714410253602015043 0ustar liggesusers\name{jomo1rancathr} \alias{jomo1rancathr} \title{ JM Imputation of clustered data with categorical variables with cluster-specific covariance matrices } \description{ Impute a clustered dataset with categorical variables as outcome. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler where a different covariance matrix is sampled within each cluster. Fully observed categorical covariates may be considered as covariates as well, but they have to be included as dummy variables. } \usage{ jomo1rancathr( Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, a=NULL, a.prior=NULL, meth="random", output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrices, stacked one above the other. Dimension of each square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix for each cluster. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrices. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ When set to "fixed", a flat prior is put on the study-specific covariance matrices and each matrix is updated separately with a different MH-step. When set to "random", we are assuming that all the covariance matrices are draws from an inverse-Wishart distribution, whose parameter values are updated with 2 steps similar to the ones presented in the case of continuous data only for function jomo1ranconhr. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ The Gibbs sampler algorithm used is obtained is a mixture of the ones described in chapter 5 and 9 of Carpenter and Kenward (2013). We update the covariance matrices element-wise with a Metropolis-Hastings step. When meth="fixed", we use a flat prior for rhe matrices, while with meth="random" we use an inverse-Wishar tprior and we assume that all the covariance matrices are drawn from an inverse Wishart distribution. We update values of a and A, degrees of freedom and scale matrix of the inverse Wishart distribution from which all the covariance matrices are sampled, from the proper conditional distributions. A flat prior is considered for beta. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. Yucel R.M., (2011), Random-covariances and mixed-effects models for imputing multivariate multilevel continuous data, Statistical Modelling, 11 (4), 351-370, DOI: 10.1177/1471082X100110040. } \examples{ # we define the inputs # nimp, nburn and nbetween are smaller than they should. This is #just because of CRAN policies on the examples. Y.cat=cldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) clus<-cldata[,c("city")] beta.start<-matrix(0,2,3) u.start<-matrix(0,10,3) l1cov.start<-matrix(diag(1,3),30,3,2) l2cov.start<-diag(1,3) l1cov.prior=diag(1,3); l2cov.prior=diag(1,3); a=5 nburn=as.integer(100); nbetween=as.integer(100); nimp=as.integer(4); #Finally we run either the model with fixed or random cluster-specific cov. matrices: imp<-jomo1rancathr(Y.cat, Y.numcat, X,Z,clus,beta.start,u.start,l1cov.start, l2cov.start,l1cov.prior,l2cov.prior,nburn,nbetween,nimp, a, meth="fixed") cat("Original value was missing (",imp[3,1],"), imputed value:", imp[1003,1]) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/surdata.Rd0000644000176200001440000000157714410253602013732 0ustar liggesusers\name{surdata} \alias{surdata} \docType{data} \title{ A simulated dataset with survival data } \description{ A simulated dataset to test functions for imputation compatible with cox model. } \usage{data(cldata)} \format{ A data frame with 500 observations on the following 5 variables. \describe{ \item{\code{measure}}{A numeric variable with some measure of interest (unspecified). This is partially observed.} \item{\code{sex}}{A binary variable with gender indicator. Partially observed.} \item{\code{id}}{The id for individuals within each city.} \item{\code{time}}{Time to event (death or censoring).} \item{\code{status}}{Binary variables, which takes value 0 for censored observations and 1 for deaths/events.} } } \details{ These are not real data, they are simulated to illustrate the use of the main functions of the package.} jomo/man/jomo2.MCMCchain.Rd0000644000176200001440000001456714410253602015041 0ustar liggesusers\name{jomo2.MCMCchain} \alias{jomo2.MCMCchain} \title{ JM Imputation of 2-level data - A tool to check convergence of the MCMC } \description{ This function is similar to jomo2, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo2.MCMCchain(Y, Y2, X=NULL, X2=NULL, Z=NULL, clus, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL,l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, l2.start.imp=NULL, nburn=1000, a=NULL, a.prior=NULL, meth="common", output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y}{ A data.frame with level-1 outcomes of the imputation model, where columns related to continuous variables are numeric and columns related to binary/categorical variables are factors. } \item{Y2}{ A data.frame containing the level-2 outcomes of the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{X2}{ A data frame, or matrix, with level-2 covariates of the joint imputation model. Rows correspond to different level-1 observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects. Rows index different covariates and columns index different level-2 outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects plus the number of level-2 outcomes. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{l2.start.imp}{ Starting value for the level-2 imputed variables. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of iterations. Default is 1000. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (function jomo2com). When set to "fixed", fixed study-specific matrices are considered (jomo2hr with option meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo2hr with option meth="random") } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are, potentially, fixed effect parameters beta (collectbeta), random effects (collectu), level 1 (collectomega) and level 2 covariance matrices (collectcovu) and level-2 fixed effect parameters. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ Y<-tldata[,c("measure.a"), drop=FALSE] Y2<-tldata[,c("big.city"), drop=FALSE] clus<-tldata[,c("city")] nburn=20 #now we run the imputation function. Note that we would typically use an higher #number of nburn iterations in real applications (at least 100) imp<-jomo2.MCMCchain(Y=Y, Y2=Y2, clus=clus,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") } jomo/man/jomo2com.MCMCchain.Rd0000644000176200001440000001436514410253602015534 0ustar liggesusers\name{jomo2com.MCMCchain} \alias{jomo2com.MCMCchain} \title{ JM Imputation of 2-level data assuming a common level-1 covariance matrix across level-2 units - A tool to check convergence of the MCMC } \description{ This function is similar to jomo2com, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo2com.MCMCchain(Y.con=NULL, Y.cat=NULL, Y.numcat=NULL, Y2.con=NULL, Y2.cat=NULL, Y2.numcat=NULL, X=NULL, X2=NULL, Z=NULL, clus, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, l2.start.imp=NULL, nburn=1000, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.con}{ A data frame, or matrix, with level-1 continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{Y2.con}{ A data frame, or matrix, with level-2 continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. } \item{Y2.cat}{ A data frame, or matrix, with level-2 categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y2.numcat}{ A vector with the number of categories in each level-2 categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{X2}{ A data frame, or matrix, with level-2 covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects. Rows index different covariates and columns index different level-2 outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects plus the number of level-2 outcomes. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{l2.start.imp}{ Starting value for the level-2 imputed variables. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are, potentially, fixed effect parameters beta (collectbeta), random effects (collectu), level 1 (collectomega) and level 2 covariance matrices (collectcovu) and level-2 fixed effect parameters. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ Y<-tldata[,c("measure.a"), drop=FALSE] Y2<-tldata[,c("big.city"), drop=FALSE] clus<-tldata[,c("city")] nburn=20 #now we run the imputation function. Note that we would typically use an higher #number of nburn iterations in real applications (at least 100) imp<-jomo2com.MCMCchain(Y.con=Y, Y2.cat=Y2, Y2.numcat=2, clus=clus,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") } jomo/man/jomo1ranmixhr.MCMCchain.Rd0000644000176200001440000001415414410253602016601 0ustar liggesusers\name{jomo1ranmixhr.MCMCchain} \alias{jomo1ranmixhr.MCMCchain} \title{ JM Imputation of clustered data with mixed variable types with cluster-specific covariance matrices - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1ranmixhr, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1ranmixhr.MCMCchain(Y.con, Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, a=NULL,a.prior=NULL,meth="random", output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.con}{ A data frame, or matrix, with continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. If no continuous outcomes are present in the model, jomo1rancathr must be used instead. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrices, stacked one above the other. Dimension of each square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix for each cluster. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrices. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of iterations. Default is 1000. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ When set to "fixed", a flat prior is used for the study-specific covariance matrices and each matrix is updated separately with a different MH-step. When set to "random", we are assuming that all the covariance matrices are draws from an inverse-Wishart distribution, whose parameter values are updated with 2 steps similar to the ones presented in the case of continuous data only for function jomo1ranconhr. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with six elements is returned: the final imputed dataset (finimp) and four 3-dimensional matrices, containing all the values for beta (collectbeta), the random effects (collectu) and the level 1 (collectomega) and level 2 covariance matrices (collectcovu). Finally, the final state of the imputed dataset with the latent normals in place of the categorical variables is stored in finimp.latnorm. } \examples{ # we define all the inputs: # nburn is smaller than needed. This is #just because of CRAN policies on the examples. Y.con=cldata[,c("measure","age")] Y.cat=cldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) clus<-cldata[,c("city")] beta.start<-matrix(0,2,5) u.start<-matrix(0,10,5) l1cov.start<-matrix(diag(1,5),50,5,2) l2cov.start<-diag(1,5) l1cov.prior=diag(1,5); l2cov.prior=diag(1,5); nburn=as.integer(80); a=6 # And we are finally able to run the imputation: imp<-jomo1ranmixhr.MCMCchain(Y.con, Y.cat, Y.numcat, X,Z,clus,beta.start,u.start, l1cov.start, l2cov.start,l1cov.prior,l2cov.prior,nburn=nburn, a=a) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") } jomo/man/jomo1cat.MCMCchain.Rd0000644000176200001440000000663014410253602015520 0ustar liggesusers\name{jomo1cat.MCMCchain} \alias{jomo1cat.MCMCchain} \title{ JM Imputation of single level data with categorical variables - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1cat, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1cat.MCMCchain(Y.cat, Y.numcat, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, start.imp=NULL, nburn=100, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of iterations. Default is 100. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with four elements is returned: the final imputed dataset (finimp) and three 3-dimensional matrices, containing all the values drawn at each iteration for fixed effect parameters beta (collectbeta) and covariance matrix omega (collectomega). Finally, in finimp.latnorm, it is stored the final state of the imputed dataset with the latent normals in place of the categorical variables. } \examples{ # make sure sex is a factor: sldata<-within(sldata, sex<-factor(sex)) # we define all the inputs: # nburn is smaller than necessary. This is #just because of CRAN policies on the examples. Y.cat=sldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,300),sldata[,c("sex")]) colnames(X)<-c("const", "sex") beta.start<-matrix(0,2,3) l1cov.start<-diag(1,3) l1cov.prior=diag(1,3); nburn=as.integer(100); # Finally we run the sampler: imp<-jomo1cat.MCMCchain(Y.cat,Y.numcat,X,beta.start,l1cov.start,l1cov.prior,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") } jomo/man/jomo1rancon.MCMCchain.Rd0000644000176200001440000001014414410253602016224 0ustar liggesusers\name{jomo1rancon.MCMCchain} \alias{jomo1rancon.MCMCchain} \title{ JM Imputation of clustered data with continuous variables only - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1rancon, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1rancon.MCMCchain(Y, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y}{ A data frame, or matrix, with responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. } \item{nburn}{ Number of iterations. Default is 1000. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with five elements is returned: the final imputed dataset (finimp) and four 3-dimensional matrices, containing all the values for beta (collectbeta), the random effects (collectu) and the level 1 (collectomega) and level 2 covariance matrices (collectcovu). } \examples{ # define all the inputs: Y<-cldata[,c("measure","age")] clus<-cldata[,c("city")] X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) beta.start<-matrix(0,2,2) u.start<-matrix(0,10,2) l1cov.start<-diag(1,2) l2cov.start<-diag(1,2) l1cov.prior=diag(1,2); nburn=as.integer(200); l2cov.prior=diag(1,5); #And finally we run the imputation function: imp<-jomo1rancon.MCMCchain(Y,X,Z,clus,beta.start,u.start,l1cov.start, l2cov.start,l1cov.prior,l2cov.prior,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,1,1:nburn],type="l") } jomo/man/jomo1ranmix.MCMCchain.Rd0000644000176200001440000001206514410253602016246 0ustar liggesusers\name{jomo1ranmix.MCMCchain} \alias{jomo1ranmix.MCMCchain} \title{ JM Imputation of clustered data with mixed variable types - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1ranmix, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1ranmix.MCMCchain(Y.con, Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.con}{ A data frame, or matrix, with continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. If no continuous outcomes are present in the model, jomo1rancat must be used instead. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Categories must be integer numbers from 1 to N. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with six elements is returned: the final imputed dataset (finimp) and four 3-dimensional matrices, containing all the values for beta (collectbeta), the random effects (collectu) and the level 1 (collectomega) and level 2 covariance matrices (collectcovu). Finally, the final state of the imputed dataset with the latent normals in place of the categorical variables is stored in finimp.latnorm. } \examples{ #we define the inputs: # nburn is smaller than necessary. This is #just because of CRAN policies on the examples. Y.con=cldata[,c("measure","age")] Y.cat=cldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) clus<-cldata[,c("city")] beta.start<-matrix(0,2,5) u.start<-matrix(0,10,5) l1cov.start<-diag(1,5) l2cov.start<-diag(1,5) l1cov.prior=diag(1,5); l2cov.prior=diag(1,5); nburn=as.integer(100); #Then we can run the sampler: imp<-jomo1ranmix.MCMCchain(Y.con, Y.cat, Y.numcat, X,Z,clus,beta.start,u.start, l1cov.start, l2cov.start,l1cov.prior,l2cov.prior,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") } jomo/man/ExamScores.Rd0000644000176200001440000000365314410253602014335 0ustar liggesusers\name{ExamScores} \alias{ExamScores} \docType{data} \title{ Exam results for six inner London Education Authorities } \description{ A partially observed version of the tutorial dataset in package R2MLwiN.It includes examination results from six inner London Education Authorities (school boards). } \usage{data(cldata)} \format{ A data frame with 4059 observations on the following 6 variables. \describe{ \item{\code{school}}{A school identifier.} \item{\code{student}}{A student ID.} \item{\code{normexam}}{Students' exam score at age 16, normalised and partially observed.} \item{\code{sex}}{Sex of pupil; a factor with levels boy, girl.} \item{\code{cons}}{A column of 1s. Useful to add an intercept to th eimputation model.} \item{\code{standlrt}}{Students' score at age 11 on the London Reading Test (LRT), standardised.} \item{\code{schgend}}{Schools' gender; a factor with levels corresponding to mixed school (mixedsch), boys' school (boysch), and girls' school (girlsch).} \item{\code{avslrt}}{Average LRT score in school.} \item{\code{schav}}{Average LRT score in school, coded into 3 categories: low = bottom 25\%, mid = middle 50\%, high = top 25\%.} \item{\code{vrband}}{Students' score in test of verbal reasoning at age 11, a factor with 3 levels: vb1 = top 25\%, vb2 = middle 50\%, vb3 = bottom 25\%.} } } \details{ These fully observed verison of the data is available with package R2MLwiN.} \source{ Browne, W. J. (2012) MCMC Estimation in MLwiN Version 2.26. University of Bristol: Centre for Multilevel Modelling. Goldstein, H., Rasbash, J., Yang, M., Woodhouse, G., Pan, H., Nuttall, D., Thomas, S. (1993) A multilevel analysis of school examination results. Oxford Review of Education, 19, 425-433. Rasbash, J., Charlton, C., Browne, W.J., Healy, M. and Cameron, B. (2009) MLwiN Version 2.1. Centre for Multilevel Modelling, University of Bristol. }jomo/man/jomo.clmm.MCMCchain.Rd0000644000176200001440000001703414410253602015676 0ustar liggesusers\name{jomo.clmm.MCMCchain} \alias{jomo.clmm.MCMCchain} \title{ clmm Compatible JM Imputation - A tool to check convergence of the MCMC } \description{ This function is similar to the jomo.clmm function, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo.clmm.MCMCchain(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, betaY.start=NULL, covuY.start=NULL, uY.start=NULL, nburn=1000, meth="common", start.imp=NULL, start.imp.sub=NULL, l2.start.imp=NULL, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Random effects follow the usual lmer syntax; however, it is possible only to allow for one grouping variable and all the variables with random effects must be included within the same brackets (es: (1+X|clus) is correct, while (1|clus)+(X|clus) is NOT). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{level}{ A vector, indicating whether each variable is either a level 1 or a level 2 variable. The value assigned to the cluster indicator is irrelevant. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster of the random effects estimates u for the joint model for the covariates. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of level-1 covariates (continuous plus latent normals) in the analysis model times the number of random effects plus the number of level-2 covariates. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{a.start}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{betaY.start}{ Starting value for betaY, the vector of fixed effects for the substantive analysis model. The default is the complete records estimate. } \item{covuY.start}{ Starting value for covuY, the random effects covariance matrix of the substantive analysis model. The default is the complete records estimate. } \item{uY.start}{ Starting value for uY, the random effects matrix of the substantive analysis model. The default is the complete records estimate. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{start.imp}{ Starting value for the missing data in the covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } \item{l2.start.imp}{ Starting value for the missing data in the level-2 covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } \item{start.imp.sub}{ Starting value for the missing data in the outcome of the substantive model. For family="binomial", these are the values of the latent normals. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are fixed effect parameters of the covariates beta (collectbeta), level 1 covariance matrices (collectomega), fixed effect estimates of the substantive model and associated residual variances. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # make sure social is a factor: cldata<-within(cldata, social<-factor(social)) # we define the data frame with all the variables data<-cldata[,c("measure","age", "social", "city")] # And the formula of the substantive lm model # social as an outcome only because it is the only ordinal variable in the dataset... formula<-as.formula(social~age+measure+(1|city)) #And finally we run the imputation function: imp<-jomo.clmm.MCMCchain(formula,data, nburn=100) # We can check, for example, the convergence of the first element of beta: # plot(c(1:100),imp$collectbeta[1,1,1:100],type="l") } jomo/man/jomo1rancat.Rd0000644000176200001440000001265614410253602014505 0ustar liggesusers\name{jomo1rancat} \alias{jomo1rancat} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of clustered data with categorical variables } \description{ Impute a clustered dataset with categorical variables as outcome. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler where the covariance matrix is updated with a Metropolis-Hastings step. Fully observed categorical covariates may be considered as covariates as well, but they have to be included as dummy variables. } \usage{ jomo1rancat( Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ The Gibbs sampler algorithm used is described in detail in Chapter 9 of Carpenter and Kenward (2013). Regarding the choice of the priors, a flat prior is considered for beta and for the covariance matrix. A Metropolis Hastings step is implemented to update the covariance matrix, as described in the book. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. } \examples{ #we define all the inputs: # nimp, nburn and nbetween are smaller than they should. This is #just because of CRAN policies on the examples. Y.cat=cldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,1000),cldata[,c("sex")]) colnames(X)<-c("const", "sex") Z<-data.frame(rep(1,1000)) clus<-cldata[,c("city")] beta.start<-matrix(0,2,3) u.start<-matrix(0,10,3) l1cov.start<-diag(1,3) l2cov.start<-diag(1,3) l1cov.prior=diag(1,3); l2cov.prior=diag(1,3); nburn=as.integer(100); nbetween=as.integer(100); nimp=as.integer(4); #And finally we run the imputation function: imp<-jomo1rancat(Y.cat, Y.numcat, X,Z,clus,beta.start,u.start,l1cov.start, l2cov.start,l1cov.prior,l2cov.prior,nburn,nbetween,nimp) cat("Original value was missing (",imp[3,1],"), imputed value:", imp[1003,1]) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/cldata.Rd0000644000176200001440000000171114410253602013505 0ustar liggesusers\name{cldata} \alias{cldata} \docType{data} \title{ A simulated clustered dataset } \description{ A simulated dataset to test functions for imputation of clustered data. } \usage{data(cldata)} \format{ A data frame with 1000 observations on the following 6 variables. \describe{ \item{\code{age}}{A numeric variable with (centered) age. Fully observed.} \item{\code{measure}}{A numeric variable with some measure of interest (unspecified). This is partially observed.} \item{\code{sex}}{A binary variable with gender indicator. Fully observed.} \item{\code{social}}{A 4-category variable with some social status indicator. This is partially observed.} \item{\code{city}}{The cluster indicator vector. 10 cities are indexed 0 to 9.} \item{\code{id}}{The id for individuals within each city.} } } \details{ These are not real data, they are simulated to illustrate the use of the main functions of the package.} jomo/man/jomo.lmer.Rd0000644000176200001440000001566614410253602014175 0ustar liggesusers\name{jomo.lmer} \alias{jomo.lmer} \title{ Joint Modelling Imputation Compatible with Linear Mixed-effects Regression Model } \description{ A function for substantive model compatible JM imputation, when the substantive model of interest is a linear mixed-effects regression model. Interactions and polynomial functions of the covariates are allowed. Data must be passed as a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo.lmer(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, nburn=1000, nbetween=1000, nimp=5, meth="common", output=1, out.iter=10) } \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Random effects follow the usual lmer syntax; however, it is possible only to allow for one grouping variable and all the variables with random effects must be included within the same brackets (es: (1+X|clus) is correct, while (1|clus)+(X|clus) is NOT). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{level}{ A vector, indicating whether each variable is either a level 1 or a level 2 variable. The value assigned to the cluster indicator is irrelevant. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster of the random effects estimates u for the joint model for the covariates. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of level-1 covariates (continuous plus latent normals) in the analysis model times the number of random effects plus the number of level-2 covariates. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{a.start}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ This function allows for substantive model compatible imputation when the substantive model is a linear mixed-effects model. It can deal with interactions and polynomial terms through the usual lmer syntax in the formula argument. Format of the columns of data is crucial in order for the function to deal with binary/categorical covariates appropriately in the imputation algorithm. } \value{ On screen, the posterior mean of the fixed effect estimates and of the residual variance are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Wiley, ISBN: 978-0-470-74052-1. } \examples{ # make sure sex is a factor: cldata<-within(cldata, sex<-factor(sex)) # we define the data frame with all the variables data<-cldata[,c("measure","age", "sex", "city")] mylevel<-c(1,1,1,1) # And the formula of the substantive lm model formula<-as.formula(measure~sex+age+I(age^2)+(1|city)) #And finally we run the imputation function: imp<-jomo.lmer(formula,data, level=mylevel, nburn=10, nbetween=10) # Note we are using only 10 iterations to avoid time consuming examples, # which go against CRAN policies. # If we were interested in a model with interactions: # formula2<-as.formula(measure~sex*age+(1|city)) # imp2<-jomo.lmer(formula2,data, level=mylevel, nburn=10, nbetween=10) # The analysis and combination steps are as for all the other functions # (see e.g. help file for function jomo) }jomo/man/JSPmiss.Rd0000644000176200001440000000313014410253602013602 0ustar liggesusers\name{JSPmiss} \alias{JSPmiss} \docType{data} \title{ Exam results for six inner London Education Authorities } \description{ A partially observed version of the jspmix1 dataset in package R2MLwiN. This is an educational dataset of pupils' test scores, a subset of the Junior School Project (Mortimore et al, 1988). } \usage{data(cldata)} \format{ A data frame with 4059 observations on the following 6 variables. \describe{ \item{\code{school}}{A school identifier.} \item{\code{id}}{A student ID.} \item{\code{fluent}}{Fluency in English indicator, where 0 = beginner, 1 = intermediate, 2 = fully fluent; measured in Year 1.} \item{\code{sex}}{Sex of pupil; numeric with levels 0 (boy), 1 (girl).} \item{\code{cons}}{A column of 1s. Useful to add an intercept to th eimputation model.} \item{\code{ravens}}{Test score, out of 40; measured in Year 1.} \item{\code{english}}{Pupils' English test score, out of 100; measured in Year 3.} \item{\code{behaviour}}{Pupils' behaviour score, where lowerquarter = pupil rated in bottom 25\%, and upper otherwise; measured in Year 3.} } } \details{ These fully observed verison of the data is available with package R2MLwiN.} \source{ Browne, W. J. (2012) MCMC Estimation in MLwiN Version 2.26. University of Bristol: Centre for Multilevel Modelling. Mortimore, P., Sammons, P., Stoll, L., Lewis, D., Ecob, R. (1988) School Matters. Wells: Open Books. Rasbash, J., Charlton, C., Browne, W.J., Healy, M. and Cameron, B. (2009) MLwiN Version 2.1. Centre for Multilevel Modelling, University of Bristol. } jomo/man/jomo.coxph.Rd0000644000176200001440000000716214410253602014347 0ustar liggesusers\name{jomo.coxph} \alias{jomo.coxph} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Joint Modelling Imputation Compatible with Cox Proportional Hazards Model } \description{ A function for substantive model compatible JM imputation, when the substantive model of interest is a Cox Proportional Hazards Model. Interactions and polynomial functions of the covariates are allowed. Data must be passed as a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo.coxph(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) } \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Survival model is specified with the usual coxph syntax. } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ This function allows for substantive model compatible imputation when the substantive model is a Cox PH model. It can deal with interactions and polynomial terms through the usual lm syntax in the formula argument. Format of the columns of data is crucial in order for the function to deal with binary/categorical covariates appropriately in the imputation algorithm. } \value{ On screen, the posterior mean of the fixed effect estimates and of the residual variance are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \examples{ #define substantive model formula<-as.formula(Surv(time, status) ~ measure + sex + I(measure^2)) #Run imputation if (requireNamespace("survival", quietly = TRUE)) { library(survival) #imp<-jomo.coxph(formula,surdata, nburn = 100, nbetween = 100, nimp=5) } # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/jomo1con.MCMCchain.Rd0000644000176200001440000000550014410253602015523 0ustar liggesusers\name{jomo1con.MCMCchain} \alias{jomo1con.MCMCchain} \title{ JM Imputation of single level data with continuous variables only - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1con, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1con.MCMCchain(Y, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, start.imp=NULL, nburn=100, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y}{ A data frame, or matrix, with responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. } \item{nburn}{ Number of iterations. Default is 100. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with three elements is returned: the final imputed dataset (finimp) and three 3-dimensional matrices, containing all the values for the fixed effect parameters beta (collectbeta) and the covariance matrix omega (collectomega). } \examples{ #We define all the inputs: Y=sldata[,c("measure", "age")] X=data.frame(rep(1,300),sldata[,c("sex")]) colnames(X)<-c("const", "sex") beta.start<-matrix(0,2,2) l1cov.start<-diag(1,2) l1cov.prior=diag(1,2); nburn=as.integer(200); # Then we run he function: imp<-jomo1con.MCMCchain(Y,X,beta.start,l1cov.start,l1cov.prior,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of omega: plot(c(1:nburn),imp$collectomega[1,2,1:nburn],type="l") } jomo/man/jomo2hr.Rd0000644000176200001440000002001514410253602013633 0ustar liggesusers\name{jomo2hr} \alias{jomo2hr} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of 2-level data assuming cluster-specific level-1 covariance matrices across level-2 unit } \description{ Impute a 2-level dataset with mixed data types as outcome. A joint multivariate normal model for partially observed data, with (either fixed or random) study-specific covariance matrices is assumed and imputations are generated through the use of a Gibbs sampler where a different covariance matrix is sampled within each cluster. Fully observed categorical covariates may be considered as covariates as well, but they have to be included as dummy variables. } \usage{ jomo2hr(Y.con=NULL, Y.cat=NULL, Y.numcat=NULL, Y2.con=NULL, Y2.cat=NULL, Y2.numcat=NULL,X=NULL, X2=NULL, Z=NULL, clus, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, a=NULL, a.prior=NULL, meth="random", output=1, out.iter=10) } \arguments{ \item{Y.con}{ A data frame, or matrix, with level-1 continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{Y2.con}{ A data frame, or matrix, with level-2 continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. } \item{Y2.cat}{ A data frame, or matrix, with level-2 categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y2.numcat}{ A vector with the number of categories in each level-2 categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{X2}{ A data frame, or matrix, with level-2 covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects. Rows index different covariates and columns index different level-2 outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrices, stacked one above the other. Dimension of each square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix for each cluster. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects plus the number of level-2 outcomes. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrices. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices.. } \item{meth}{ When set to "fixed", a flat prior is put on the cluster-specific covariance matrices and each matrix is updated separately with a different MH-step. When set to "random", we are assuming that all the cluster-specific level-1 covariance matrices are draws from an inverse-Wishart distribution, whose parameter values are updated with 2 steps similar to the ones presented in the case of clustered data for function jomo1ranconhr. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ The Gibbs sampler algorithm used is obtained is a mixture of the ones described in chapter 5 and 9 of Carpenter and Kenward (2013). We update the covariance matrices element-wise with a Metropolis-Hastings step. When meth="fixed", we use a flat prior for rhe matrices, while with meth="random" we use an inverse-Wishar tprior and we assume that all the covariance matrices are drawn from an inverse Wishart distribution. We update values of a and A, degrees of freedom and scale matrix of the inverse Wishart distribution from which all the covariance matrices are sampled, from the proper conditional distributions. A flat prior is considered for beta. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 9, Wiley, ISBN: 978-0-470-74052-1. Yucel R.M., (2011), Random-covariances and mixed-effects models for imputing multivariate multilevel continuous data, Statistical Modelling, 11 (4), 351-370, DOI: 10.1177/1471082X100110040. } \examples{ Y<-tldata[,c("measure.a"), drop=FALSE] Y2<-tldata[,c("big.city"), drop=FALSE] clus<-tldata[,c("city")] #now we run the imputation function. Note that we would typically use an higher #number of nburn iterations in real applications (at least 1000) imp<-jomo2hr(Y.con=Y, Y2.cat=Y2, Y2.numcat=2, clus=clus,nburn=10, nbetween=10, nimp=2) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/jomo.polr.MCMCchain.Rd0000644000176200001440000001025414410253602015717 0ustar liggesusers\name{jomo.polr.MCMCchain} \alias{jomo.polr.MCMCchain} \title{ polr Compatible JM Imputation - A tool to check convergence of the MCMC } \description{ This function is similar to the jomo.polr function, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo.polr.MCMCchain(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, betaY.start=NULL, nburn=1000, start.imp=NULL, start.imp.sub=NULL, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual polr syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{start.imp}{ Starting value for the imputed covariates. n-level categorical variables are substituted by n-1 latent normals. } \item{start.imp.sub}{ Starting value for the imputations of the outcome. When using binomial family, this is the value of the latent normal. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{betaY.start}{ Starting value for betaY, the vector of fixed effects for the substantive analysis model. The default is the complete records estimate. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are fixed effect parameters of the covariates beta (collectbeta), level 1 covariance matrices (collectomega), fixed effect estimates of the substantive model and associated residual variances. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # make sure social is a factor: sldata<-within(sldata, social<-factor(social)) # we define the data frame with all the variables data<-sldata[,c("measure","age", "social")] # And the formula of the substantive lm model # social as an outcome only because it is the only ordinal variable in the dataset... formula<-as.formula(social~age+measure) #And finally we run the imputation function: imp<-jomo.polr.MCMCchain(formula,data, nburn=100) # Note we are using only 100 iterations to avoid time consuming examples, # which go against CRAN policies. In real applications we would use # much larger burn-ins (around 1000, to say the least). # We can check, for example, the convergence of the first element of beta: plot(c(1:100),imp$collectbeta[1,1,1:100],type="l") } jomo/man/jomo2hr.MCMCchain.Rd0000644000176200001440000001636514410253602015371 0ustar liggesusers\name{jomo2hr.MCMCchain} \alias{jomo2hr.MCMCchain} \title{ JM Imputation of 2-level data assuming cluster-specific level-1 covariance matrices across level-2 units- A tool to check convergence of the MCMC } \description{ This function is similar to jomo2hr, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo2hr.MCMCchain(Y.con=NULL, Y.cat=NULL, Y.numcat=NULL, Y2.con=NULL, Y2.cat=NULL, Y2.numcat=NULL, X=NULL, X2=NULL, Z=NULL, clus, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, l2.start.imp=NULL, nburn=1000, a=NULL,a.prior=NULL,meth="random", output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.con}{ A data frame, or matrix, with level-1 continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{Y2.con}{ A data frame, or matrix, with level-2 continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. } \item{Y2.cat}{ A data frame, or matrix, with level-2 categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y2.numcat}{ A vector with the number of categories in each level-2 categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{X2}{ A data frame, or matrix, with level-2 covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{Z}{ A data frame, or matrix, for covariates associated to random effects in the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{clus}{ A data frame, or matrix, containing the cluster indicator for each observation. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects. Rows index different covariates and columns index different level-2 outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster for the random effects estimates u. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrices, stacked one above the other. Dimension of each square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix for each cluster. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model times the number of random effects plus the number of level-2 outcomes. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrices. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{l2.start.imp}{ Starting value for the level-2 imputed variables. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of iterations. Default is 1000. } \item{a}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ When set to "fixed", a flat prior is put on the cluster-specific covariance matrices and each matrix is updated separately with a different MH-step. When set to "random", we are assuming that all the cluster-specific level-1 covariance matrices are draws from an inverse-Wishart distribution, whose parameter values are updated with 2 steps similar to the ones presented in the case of clustered data for function jomo1ranconhr. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are, potentially, fixed effect parameters beta (collectbeta), random effects (collectu), level 1 (collectomega) and level 2 covariance matrices (collectcovu) and level-2 fixed effect parameters. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ Y<-tldata[,c("measure.a"), drop=FALSE] Y2<-tldata[,c("big.city"), drop=FALSE] clus<-tldata[,c("city")] nburn=20 #now we run the imputation function. Note that we would typically use an higher #number of nburn iterations in real applications (at least 100) imp<-jomo2hr.MCMCchain(Y.con=Y, Y2.cat=Y2, Y2.numcat=2, clus=clus,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of the level 2 covariance matrix: plot(c(1:nburn),imp$collectcovu[1,2,1:nburn],type="l") } jomo/man/jomo.clmm.Rd0000644000176200001440000001547514410253602014164 0ustar liggesusers\name{jomo.clmm} \alias{jomo.clmm} \title{ Joint Modelling Imputation Compatible with Cumulative Link Mixed Model } \description{ A function for substantive model compatible JM imputation, when the substantive model of interest is a cumulative link mixed model. Interactions and polynomial functions of the covariates are allowed. Data must be passed as a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo.clmm(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, nburn=1000, nbetween=1000, nimp=5, meth="common", output=1, out.iter=10) } \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Random effects follow the usual lmer syntax; however, it is possible only to allow for one grouping variable and all the variables with random effects must be included within the same brackets (es: (1+X|clus) is correct, while (1|clus)+(X|clus) is NOT). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{level}{ A vector, indicating whether each variable is either a level 1 or a level 2 variable. The value assigned to the cluster indicator is irrelevant. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster of the random effects estimates u for the joint model for the covariates. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of level-1 covariates (continuous plus latent normals) in the analysis model times the number of random effects plus the number of level-2 covariates. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{a.start}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ This function allows for substantive model compatible imputation when the substantive model is a cumulative link mixed-effects model. It can deal with interactions and polynomial terms through the usual lmer syntax in the formula argument. Format of the columns of data is crucial in order for the function to deal with binary/categorical covariates appropriately in the imputation algorithm. } \value{ On screen, the posterior mean of the fixed effect estimates and of the residual variance are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Wiley, ISBN: 978-0-470-74052-1. } \examples{ # make sure social is a factor: cldata<-within(cldata, social<-factor(social)) # we define the data frame with all the variables data<-cldata[,c("measure","age", "social", "city")] # And the formula of the substantive lm model # social as an outcome only because it is the only ordinal variable in the dataset... formula<-as.formula(social~age+measure+(1|city)) #And finally we run the imputation function: # imp<-jomo.clmm(formula,data, nburn=1000, nbetween=1000, nimp=2) # Note the function is commented out to avoid time consuming examples, # which go against CRAN policies. # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules }jomo/man/jomo1.MCMCchain.Rd0000644000176200001440000000562014410253602015026 0ustar liggesusers\name{jomo1.MCMCchain} \alias{jomo1.MCMCchain} \title{ JM Imputation of single level data - A tool to check convergence of the MCMC } \description{ This function is similar to jomo1, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo1.MCMCchain(Y, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, start.imp=NULL, nburn=100, output=1, out.iter=10) } \arguments{ \item{Y}{ A data.frame containing the outcomes of the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{start.imp}{ Starting value for the imputed dataset. n-level categorical variables are substituted by n-1 latent normals. } \item{nburn}{ Number of iterations. Default is 100. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \value{ A list with three elements is returned: the final imputed dataset (finimp) and three 3-dimensional matrices, containing all the values for beta (collectbeta) and omega (collectomega). If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # define all the inputs: Y<-sldata[,c("measure","age")] nburn=as.integer(200); # Then we run the function: imp<-jomo1.MCMCchain(Y,nburn=nburn) #We can check the convergence of the first element of beta: plot(c(1:nburn),imp$collectbeta[1,1,1:nburn],type="l") #Or similarly we can check the convergence of any element of omega: plot(c(1:nburn),imp$collectomega[1,2,1:nburn],type="l") } jomo/man/jomo1con.Rd0000644000176200001440000000716114410253602014007 0ustar liggesusers\name{jomo1con} \alias{jomo1con} \title{ JM Imputation of single level data with continuous variables only } \description{ Impute a single level dataset with continuous outcomes only. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler. Categorical covariates may be considered, but they have to be included with dummy variables. } \usage{ jomo1con(Y, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=100, nbetween=100, nimp=5, output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y}{ A data frame, or matrix, with responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 100. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 100. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ The Gibbs sampler algorithm used is described in detail in Chapter 3 of Carpenter and Kenward (2013). Regarding the choice of the priors, a flat prior is considered for beta, while an inverse-Wishart prior is given to the covariance matrix, with p-1 degrees of freedom, aka the minimum possible, to guarantee the greatest uncertainty. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included through dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 3, Wiley, ISBN: 978-0-470-74052-1. } \examples{ #We define all the inputs: Y=sldata[,c("measure", "age")] X=data.frame(rep(1,300),sldata[,c("sex")]) colnames(X)<-c("const", "sex") beta.start<-matrix(0,2,2) l1cov.start<-diag(1,2) l1cov.prior=diag(1,2); nburn=as.integer(200); nbetween=as.integer(200); nimp=as.integer(5); # Then we run he function: imp<-jomo1con(Y,X,beta.start,l1cov.start,l1cov.prior,nburn,nbetween,nimp) cat("Original value was missing(",imp[1,1],"), imputed value:", imp[301,1]) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/jomo1mix.Rd0000644000176200001440000001056414410253602014026 0ustar liggesusers\name{jomo1mix} \alias{jomo1mix} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of single level data with mixed variable types } \description{ Impute a single level dataset with mixed data types as outcome. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler where the covariance matrix is updated with a Metropolis-Hastings step. Fully observed categorical variables may be considered as covariates as well, but they have to be included as dummy variables. } \usage{ jomo1mix(Y.con, Y.cat, Y.numcat, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=100, nbetween=100, nimp=5, output=1,out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.con}{ A data frame, or matrix, with continuous responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. If no continuous outcomes are present in the model, jomo1cat should be used instead. } \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we define n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 100. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 100. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ Regarding the choice of the priors, a flat prior is considered for beta and for the covariance matrix. A Metropolis Hastings step is implemented to update the covariance matrix, as described in the book. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 5, Wiley, ISBN: 978-0-470-74052-1. } \examples{ #Then, we define all the inputs: # nburn is smaller than needed. This is #just because of CRAN policies on the examples. Y.con=sldata[,c("measure","age")] Y.cat=sldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,300),sldata[,c("sex")]) colnames(X)<-c("const", "sex") beta.start<-matrix(0,2,5) l1cov.start<-diag(1,5) l1cov.prior=diag(1,5); nburn=as.integer(100); nbetween=as.integer(100); nimp=as.integer(5); #Then we run the sampler: imp<-jomo1mix(Y.con,Y.cat,Y.numcat,X,beta.start,l1cov.start, l1cov.prior,nburn,nbetween,nimp) cat("Original value was missing(",imp[1,1],"), imputed value:", imp[301,1]) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/jomo.glmer.Rd0000644000176200001440000001606014410253602014331 0ustar liggesusers\name{jomo.glmer} \alias{jomo.glmer} \title{ Joint Modelling Imputation Compatible with Generalized Linear Mixed Model } \description{ A function for substantive model compatible JM imputation, when the substantive model of interest is a generalized linear mixed-effects regression model. Interactions and polynomial functions of the covariates are allowed. Data must be passed as a data.frame where continuous variables are numeric and binary/categorical variables are factors.} \usage{ jomo.glmer(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, nburn=1000, nbetween=1000, nimp=5, meth="common", output=1, out.iter=10, family="binomial") } \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Random effects follow the usual lmer syntax; however, it is possible only to allow for one grouping variable and all the variables with random effects must be included within the same brackets (es: (1+X|clus) is correct, while (1|clus)+(X|clus) is NOT). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{level}{ A vector, indicating whether each variable is either a level 1 or a level 2 variable. The value assigned to the cluster indicator is irrelevant. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster of the random effects estimates u for the joint model for the covariates. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of level-1 covariates (continuous plus latent normals) in the analysis model times the number of random effects plus the number of level-2 covariates. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{a.start}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 1000. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{family}{ One of either "gaussian"" or "binomial". For binomial family, a probit link is assumed. } } \details{ This function allows for substantive model compatible imputation when the substantive model is a linear mixed-effects model. It can deal with interactions and polynomial terms through the usual lmer syntax in the formula argument. Format of the columns of data is crucial in order for the function to deal with binary/categorical covariates appropriately in the imputation algorithm. } \value{ On screen, the posterior mean of the fixed effect estimates and of the residual variance are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Wiley, ISBN: 978-0-470-74052-1. } \examples{ # make sure sex is a factor: cldata<-within(cldata, sex<-factor(sex)) # we define the data frame with all the variables data<-cldata[,c("measure","age", "sex", "city")] # And the formula of the substantive lm model # sex as an outcome only because it is the only binary variable in the dataset... formula<-as.formula(sex~age+measure+(1|city)) #And finally we run the imputation function: imp<-jomo.glmer(formula,data, nburn=2, nbetween=2, nimp=2) # Note we are using only 2 iterations to avoid time consuming examples, # which go against CRAN policies. In real applications we would use # much larger burn-ins (around 1000) and at least 5 imputations. # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules }jomo/man/jomo1cat.Rd0000644000176200001440000001052014410253602013770 0ustar liggesusers\name{jomo1cat} \alias{jomo1cat} %- Also NEED an '\alias' for EACH other topic documented here. \title{ JM Imputation of single level data with categorical variables } \description{ Impute a single level dataset with categorical variables as outcomes. A joint multivariate model for partially observed data is assumed and imputations are generated through the use of a Gibbs sampler where the covariance matrix is updated with a Metropolis-Hastings step. Fully observed categorical covariates can be included in the imputation model as covariates as well, but in that case dummy variables have to be created first. } \usage{ jomo1cat(Y.cat, Y.numcat, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=100, nbetween=100, nimp=5,output=1, out.iter=10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{Y.cat}{ A data frame, or matrix, with categorical (or binary) responses of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are coded as NA. } \item{Y.numcat}{ A vector with the number of categories in each categorical (or binary) variable. } \item{X}{ A data frame, or matrix, with covariates of the joint imputation model. Rows correspond to different observations, while columns are different variables. Missing values are not allowed in these variables. In case we want an intercept, a column of 1 is needed. The default is a column of 1. } \item{beta.start}{ Starting value for beta, the vector(s) of fixed effects. Rows index different covariates and columns index different outcomes. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value for the covariance matrix. Dimension of this square matrix is equal to the number of outcomes (continuous plus latent normals) in the imputation model. The default is the identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{nburn}{ Number of burn in iterations. Default is 100. } \item{nbetween}{ Number of iterations between two successive imputations. Default is 100. } \item{nimp}{ Number of Imputations. Default is 5. } \item{output}{ When set to any value different from 1 (default), no output is shown on screen at the end of the process. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } } \details{ The Gibbs sampler algorithm used is described in detail in Chapter 5 of Carpenter and Kenward (2013). Regarding the choice of the priors, a flat prior is considered for beta and for the covariance matrix. A Metropolis Hastings step is implemented to update the covariance matrix, as described in the book. Binary or continuous covariates in the imputation model may be considered without any problem, but when considering a categorical covariate it has to be included with dummy variables (binary indicators) only. } \value{ On screen, the posterior mean of the fixed effects estimates and of the covariance matrix are shown. The only argument returned is the imputed dataset in long format. Column "Imputation" indexes the imputations. Imputation number 0 are the original data. } \references{ Carpenter J.R., Kenward M.G., (2013), Multiple Imputation and its Application. Chapter 5, Wiley, ISBN: 978-0-470-74052-1. } \examples{ # make sure sex is a factor: sldata<-within(sldata, sex<-factor(sex)) # we define all the inputs: # nimp, nburn and nbetween are smaller than they should. This is #just because of CRAN policies on the examples. Y.cat=sldata[,c("social"), drop=FALSE] Y.numcat=matrix(4,1,1) X=data.frame(rep(1,300),sldata[,c("sex")]) colnames(X)<-c("const", "sex") beta.start<-matrix(0,2,3) l1cov.start<-diag(1,3) l1cov.prior=diag(1,3); nburn=as.integer(100); nbetween=as.integer(100); nimp=as.integer(5); # Finally we run the sampler: imp<-jomo1cat(Y.cat,Y.numcat,X,beta.start,l1cov.start,l1cov.prior,nburn,nbetween,nimp) #See one of the imputed values: cat("Original value was missing (",imp[16,1],"), imputed value:", imp[316,1]) # Check help page for function jomo to see how to fit the model and # combine estimates with Rubin's rules } jomo/man/jomo.glmer.MCMCchain.Rd0000644000176200001440000001722414410253602016055 0ustar liggesusers\name{jomo.glmer.MCMCchain} \alias{jomo.glmer.MCMCchain} \title{ glmer Compatible JM Imputation - A tool to check convergence of the MCMC } \description{ This function is similar to the jomo.glmer function, but it returns the values of all the parameters in the model at each step of the MCMC instead of the imputations. It is useful to check the convergence of the MCMC sampler. } \usage{ jomo.glmer.MCMCchain(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, betaY.start=NULL, covuY.start=NULL, uY.start=NULL, nburn=1000, meth="common", start.imp=NULL, start.imp.sub=NULL, l2.start.imp=NULL, output=1, out.iter=10, family="binomial") } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ an object of class formula: a symbolic description of the model to be fitted. It is possible to include in this formula interactions (through symbols '*' and '%') and polynomial terms (with the usual lm syntax, e.g. for a quadratic effect for variable x, 'I(x^2)'). Random effects follow the usual lmer syntax; however, it is possible only to allow for one grouping variable and all the variables with random effects must be included within the same brackets (es: (1+X|clus) is correct, while (1|clus)+(X|clus) is NOT). } \item{data}{ A data.frame containing all the variables to include in the imputation model. Columns related to continuous variables have to be numeric and columns related to binary/categorical variables have to be factors. } \item{level}{ A vector, indicating whether each variable is either a level 1 or a level 2 variable. The value assigned to the cluster indicator is irrelevant. } \item{beta.start}{ Starting value for beta, the vector(s) of level-1 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{l2.beta.start}{ Starting value for beta2, the vector(s) of level-2 fixed effects for the joint model for the covariates. For each n-category variable we have a fixed effect parameter for each of the n-1 latent normals. The default is a matrix of zeros. } \item{u.start}{ A matrix where different rows are the starting values within each cluster of the random effects estimates u for the joint model for the covariates. The default is a matrix of zeros. } \item{l1cov.start}{ Starting value of the level-1 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of covariates (continuous plus latent normals) in the imputation model. The default is the identity matrix. Functions for imputation with random cluster-specific covariance matrices are an exception, because we need to pass the starting values for all of the matrices stacked one above the other. } \item{l2cov.start}{ Starting value for the level 2 covariance matrix of the joint model for the covariates. Dimension of this square matrix is equal to the number of level-1 covariates (continuous plus latent normals) in the analysis model times the number of random effects plus the number of level-2 covariates. The default is an identity matrix. } \item{l1cov.prior}{ Scale matrix for the inverse-Wishart prior for the covariance matrix. The default is the identity matrix. } \item{l2cov.prior}{ Scale matrix for the inverse-Wishart prior for the level 2 covariance matrix. The default is the identity matrix. } \item{a.start}{ Starting value for the degrees of freedom of the inverse Wishart distribution of the cluster-specific covariance matrices. Default is 50+D, with D being the dimension of the covariance matrices. This is used only with clustered data and when option meth is set to "random". } \item{a.prior}{ Hyperparameter (Degrees of freedom) of the chi square prior distribution for the degrees of freedom of the inverse Wishart distribution for the cluster-specific covariance matrices. Default is D, with D being the dimension of the covariance matrices. } \item{meth}{ Method used to deal with level 1 covariance matrix. When set to "common", a common matrix across clusters is used (functions jomo1rancon, jomo1rancat and jomo1ranmix). When set to "fixed", fixed study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with coption meth="fixed"). Finally, when set to "random", random study-specific matrices are considered (jomo1ranconhr, jomo1rancathr and jomo1ranmixhr with option meth="random") } \item{betaY.start}{ Starting value for betaY, the vector of fixed effects for the substantive analysis model. The default is the complete records estimate. } \item{covuY.start}{ Starting value for covuY, the random effects covariance matrix of the substantive analysis model. The default is the complete records estimate. } \item{uY.start}{ Starting value for uY, the random effects matrix of the substantive analysis model. The default is the complete records estimate. } \item{nburn}{ Number of burn in iterations. Default is 1000. } \item{output}{ When set to 0, no output is shown on screen at the end of the process. When set to 1, only the parameter estimates related to the substantive model are shown (default). When set to 2, all parameter estimates (posterior means) are displayed. } \item{out.iter}{ When set to K, every K iterations a dot is printed on screen. Default is 10. } \item{start.imp}{ Starting value for the missing data in the covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } \item{l2.start.imp}{ Starting value for the missing data in the level-2 covariates of the substantive model. n-level categorical variables are substituted by n-1 latent normals. } \item{start.imp.sub}{ Starting value for the missing data in the outcome of the substantive model. For family="binomial", these are the values of the latent normals. } \item{family}{ One of either "gaussian"" or "binomial". For binomial family, a probit link is assumed. } } \value{ A list is returned; this contains the final imputed dataset (finimp) and several 3-dimensional matrices, containing all the values drawn for each parameter at each iteration: these are fixed effect parameters of the covariates beta (collectbeta), level 1 covariance matrices (collectomega), fixed effect estimates of the substantive model and associated residual variances. If there are some categorical outcomes, a further output is included in the list, finimp.latnorm, containing the final state of the imputed dataset with the latent normal variables. } \examples{ # make sure sex is a factor: cldata<-within(cldata, sex<-factor(sex)) # we define the data frame with all the variables data<-cldata[,c("measure","age", "sex", "city")] # And the formula of the substantive lm model # sex as an outcome only because it is the only binary variable in the dataset... formula<-as.formula(sex~age+measure+(1|city)) #And finally we run the imputation function: imp<-jomo.glmer.MCMCchain(formula,data, nburn=100) # We can check, for example, the convergence of the first element of beta: # plot(c(1:100),imp$collectbeta[1,1,1:100],type="l") } jomo/DESCRIPTION0000644000176200001440000000147614416467232012745 0ustar liggesusersPackage: jomo Type: Package Title: Multilevel Joint Modelling Multiple Imputation Version: 2.7-6 Date: 2023-04-13 Author: Matteo Quartagno, James Carpenter Maintainer: Matteo Quartagno Description: Similarly to package 'pan', 'jomo' is a package for multilevel joint modelling multiple imputation (Carpenter and Kenward, 2013) . Novel aspects of 'jomo' are the possibility of handling binary and categorical data through latent normal variables, the option to use cluster-specific covariance matrices and to impute compatibly with the substantive model. License: GPL-2 LazyData: yes Suggests: mitml Imports: stats, lme4, survival, MASS, ordinal, tibble NeedsCompilation: yes Packaged: 2023-04-14 08:57:20 UTC; rmjlmqu Repository: CRAN Date/Publication: 2023-04-15 09:30:02 UTC jomo/src/0000755000176200001440000000000014416212533012006 5ustar liggesusersjomo/src/jomo2hrsmcC.c0000644000176200001440000017530614410320725014351 0ustar liggesusers#include #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo2hrsmcC(SEXP Ysub, SEXP Ysubimp, SEXP Ysubcat, SEXP submod, SEXP ordersub, SEXP submodran, SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP Y2, SEXP Y2imp, SEXP Y2imp2, SEXP Y2impcat, SEXP X, SEXP X2, SEXP Z, SEXP clus, SEXP betaY, SEXP betaYpost, SEXP beta, SEXP beta2, SEXP u, SEXP uY, SEXP betapost, SEXP upost, SEXP uYpost, SEXP beta2post, SEXP varY, SEXP varYpost, SEXP omega, SEXP omegapost, SEXP covuY, SEXP covuYpost, SEXP covu, SEXP covupost, SEXP nstep, SEXP varYprior, SEXP covuYprior, SEXP Sp, SEXP Sup, SEXP Y_numcat, SEXP Y2_numcat, SEXP Ysub_numcat, SEXP num_con, SEXP num_con2,SEXP a_start, SEXP a_prior, SEXP flagrng, SEXP MCMCchain, SEXP submodtype){ int indic=0,i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0, countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h=0, nconnoaux, nconcat, ncatnoaux, MCMC; int Iu, Ju, IZ, JZ, nj,c,fl, currncat, IY2, JY2, IX2,JX2,Ib2, Jb2, ncon2, ncat2, JYm, JXm, Is, Il=0, Ir=0,Jr, JZm, Jum, accratio=0, totprop=0, accratio2=0, totprop2=0, nconnoaux2, nconcat2, ncatnoaux2; int nsubcat, *Ysubcatint; SEXP RdimY, RdimX, Rdimo, Rdimb, RdimZ, Rdimu, RdimY2, RdimX2, Rdimb2, Rdims, Rdimr; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegamo, *omegamm, *invomega, *invomega2, *help, *help2, *help3, *imp,*imp2, *zi, *yicategorized; double *sumzy, *incrzz, *incrzy, *mu, *mu2, *newbeta, *newomega, *sumzi, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,meanom,sdom, *resid, logLH, newlogLH,detom; double maxx,maxim,maxim2, *sumxy, *sumxi, *uj, *xi, *ziu, *incrxx, *incrxy, *newu, *mu3, *mu4, *help7, *invomega4, *newomega2,*missing2, *Y2red, *X2red, *impsub; double *covu1, *covu2, *covu12, *fixomega2, *Y2impred, *Xsub, *Xsubprop, *Zsub, *Zsubprop, *residsub, *yi2categorized, *allinvomega; double gamma,eta,dx,u_new,precision, *invgamma, *invA, *Gammastar,u_m,con2,deriv2,u_prop, lambda, aj, a, *cumclus, *clusnum; // Protecting R objects from garbage collection and saving matrices dimensions RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; RdimY2=PROTECT(getAttrib(Y2imp,R_DimSymbol)); IY2=INTEGER(RdimY2)[0]; JY2=INTEGER(RdimY2)[1]; Rdims=PROTECT(getAttrib(submod,R_DimSymbol)); Is=INTEGER(Rdims)[0]; Rdimr=PROTECT(getAttrib(submodran,R_DimSymbol)); Jr=INTEGER(Rdimr)[1]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1]; RdimX2=PROTECT(getAttrib(X2,R_DimSymbol)); IX2=INTEGER(RdimX2)[0]; JX2=INTEGER(RdimX2)[1]; RdimZ=PROTECT(getAttrib(Z,R_DimSymbol)); IZ=INTEGER(RdimZ)[0]; JZ=INTEGER(RdimZ)[1]; Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimb2=PROTECT(getAttrib(beta2,R_DimSymbol)); Ib2=INTEGER(Rdimb2)[0]; Jb2=INTEGER(Rdimb2)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Rdimu=PROTECT(getAttrib(u,R_DimSymbol)); Iu=INTEGER(Rdimu)[0]; Ju=INTEGER(Rdimu)[1]; Ysub=PROTECT(coerceVector(Ysub,REALSXP)); submod=PROTECT(coerceVector(submod,INTSXP)); ordersub=PROTECT(coerceVector(ordersub,INTSXP)); submodran=PROTECT(coerceVector(submodran,INTSXP)); Ysubimp=PROTECT(coerceVector(Ysubimp,REALSXP)); Ysubcat=PROTECT(coerceVector(Ysubcat,REALSXP)); Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); Y2=PROTECT(coerceVector(Y2,REALSXP)); Y2impcat=PROTECT(coerceVector(Y2impcat,REALSXP)); Y2_numcat=PROTECT(coerceVector(Y2_numcat,INTSXP)); Ysub_numcat=PROTECT(coerceVector(Ysub_numcat,INTSXP)); Y2imp=PROTECT(coerceVector(Y2imp,REALSXP)); Y2imp2=PROTECT(coerceVector(Y2imp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); X2=PROTECT(coerceVector(X2,REALSXP)); Z=PROTECT(coerceVector(Z,REALSXP)); clus=PROTECT(coerceVector(clus,INTSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); betaY=PROTECT(coerceVector(betaY,REALSXP)); beta2=PROTECT(coerceVector(beta2,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); betaYpost=PROTECT(coerceVector(betaYpost,REALSXP)); beta2post=PROTECT(coerceVector(beta2post,REALSXP)); varY=PROTECT(coerceVector(varY,REALSXP)); varYpost=PROTECT(coerceVector(varYpost,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); varYprior=PROTECT(coerceVector(varYprior,REALSXP)); u=PROTECT(coerceVector(u,REALSXP)); uY=PROTECT(coerceVector(uY,REALSXP)); upost=PROTECT(coerceVector(upost,REALSXP)); uYpost=PROTECT(coerceVector(uYpost,REALSXP)); covuY=PROTECT(coerceVector(covuY,REALSXP)); covu=PROTECT(coerceVector(covu,REALSXP)); covuYpost=PROTECT(coerceVector(covuYpost,REALSXP)); covupost=PROTECT(coerceVector(covupost,REALSXP)); covuYprior=PROTECT(coerceVector(covuYprior,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); Sup=PROTECT(coerceVector(Sup,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; nconnoaux=INTEGER(num_con)[1]; nconcat=INTEGER(num_con)[2]; ncatnoaux=INTEGER(num_con)[3]; num_con2=PROTECT(coerceVector(num_con2,INTSXP)); ncon2=INTEGER(num_con2)[0]; nconnoaux2=INTEGER(num_con2)[1]; nconcat2=INTEGER(num_con2)[2]; ncatnoaux2=INTEGER(num_con2)[3]; nsubcat=INTEGER(Ysub_numcat)[0]; flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); if (REAL(Y2impcat)[0]==(-999)) ncat2=0; else ncat2=length(Y2_numcat); nj=Iu; a_start=PROTECT(coerceVector(a_start,REALSXP)); a=REAL(a_start)[0]; a_prior=PROTECT(coerceVector(a_prior,REALSXP)); submodtype=PROTECT(coerceVector(submodtype,INTSXP)); for (i=0;iJY) JXm=Il; if (JX>JXm) JXm=JX; for (i=0;iJY) JZm=Ir; if (JZ>JZm) JZm=JZ; if (JX2>JXm) JXm=JX2; JYm=JY; if (JY2>JY) JYm=JY2; Jum=Ju; if (Ir>Jum) Jum=Ir; //Allocating memory for C objects in R help = ( double * ) R_alloc ( (Ju*Ju) , sizeof ( double ) ); invomega= (double * ) R_alloc ( (JYm*JYm) , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); fixomega2 = ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); sumzi = ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); sumzy = ( double * ) R_alloc ( JY * JZm , sizeof ( double ) ); sumxi = ( double * ) R_alloc ( JYm * JXm * JYm * JXm , sizeof ( double ) ); sumxy = ( double * ) R_alloc ( JYm * JXm , sizeof ( double ) ); zi = ( double * ) R_alloc ( JY * JZm * JY , sizeof ( double ) ); xi = ( double * ) R_alloc ( JYm * JXm * JYm , sizeof ( double ) ); yi = ( double * ) R_alloc ( JYm , sizeof ( double ) ); uj = ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); newu = ( double * ) R_alloc ( JY * JZm , sizeof ( double ) ); ziu = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JYm *JXm * Ju , sizeof ( double ) ); incrzz = ( double * ) R_alloc ( Jum * Jum, sizeof ( double ) ); incrzy = ( double * ) R_alloc ( JY *JZm , sizeof ( double ) ); incrxx = ( double * ) R_alloc ( JYm *JXm * JYm *JXm , sizeof ( double ) ); incrxy = ( double * ) R_alloc ( JYm *JXm , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JYm * JXm * JYm * JXm ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( Jum * JXm * Jum * JXm, sizeof ( double ) ); mu = ( double * ) R_alloc ( Ju * JXm, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JYm*JXm ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JZm, sizeof ( double ) ); mu3 = ( double * ) R_alloc ( Jum * Jum ,sizeof ( double ) ); mu4 = ( double * ) R_alloc ( JYm * JYm,sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); newomega2 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); betaX=( double * ) R_alloc ( JYm, sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); imp2=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); impsub=( double * ) R_alloc ( IY ,sizeof ( double ) ); Y2impred=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); Y2red=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); X2red=( double * ) R_alloc ( Iu * JX2,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); residsub=( double * ) R_alloc ( IY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( Ju, sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JYm, sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JYm, sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JYm*JYm ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JYm ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( Ju, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( Ju*JYm , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JYm*JYm , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); invomega4 = ( double * ) R_alloc ( Ju *Ju , sizeof ( double ) ); help4 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); help5 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); help6 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help7 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); missing2 = ( double * ) R_alloc ( Iu , sizeof ( double ) ); covu1= (double * ) R_alloc ( JY * JZ * JY * JZ , sizeof ( double ) ); covu2= (double * ) R_alloc ( JY2 * JY2, sizeof ( double ) ); covu12= (double * ) R_alloc ( JY * JZ * JY2 , sizeof ( double ) ); Xsub = ( double * ) R_alloc ( IY* Il , sizeof ( double ) ); Xsubprop = ( double * ) R_alloc ( IY* Il , sizeof ( double ) ); Zsub = ( double * ) R_alloc ( IY* Ir , sizeof ( double ) ); Zsubprop = ( double * ) R_alloc ( Ir , sizeof ( double ) ); yicategorized=( double * ) R_alloc ( JY,sizeof ( double ) ); yi2categorized=( double * ) R_alloc ( JY2,sizeof ( double ) ); Ysubcatint = ( int * ) R_alloc ( IY , sizeof ( int ) ); allinvomega= (double * ) R_alloc ( (nj*JY*JY) , sizeof ( double ) ); invgamma= (double * ) R_alloc ( JY * JY , sizeof(double) ); invA= (double * ) R_alloc ( JY * JY , sizeof(double) ); Gammastar= (double * ) R_alloc ( JY * JY , sizeof(double) ); clusnum = ( double * ) R_alloc ( nj , sizeof(double)); cumclus = ( double * ) R_alloc ( nj+1 , sizeof(double)); // Some initializations for (j=0; j0) Ysubcatint[j]=REAL(Ysubcat)[j]; for (k=0;k0) { for (i=0;i0) { for (i=0;iREAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } for (c=0;c0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*c+JY*nj*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*c+JY*nj*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } kk++; } } flag=0; } } } } pos=pos+INTEGER(Y_numcat)[j]-1; } } // Rejection sampling for level 2 variables if (ncat2>0) { pos=ncon2; for (j=0;j(pos+JY*JZ+currncat-1)))&&((k<(pos+JY*JZ))||(k>(pos+JY*JZ+currncat-1)))) { help4[countm]=REAL(covu)[kk+k*Ju]; countm++; } else if (((kk<(pos+JY*JZ))||(kk>(pos+JY*JZ+currncat-1)))&&((k>(pos+JY*JZ-1))||(k<(pos+JY*JZ+currncat)))) { help5[counto]=REAL(covu)[kk+k*Ju]; counto++; } } } countm=0; counto=0; r8mat_pofac((Ju-currncat),help4, help6,1); r8mat_poinv((Ju-currncat),help6, invomega4); for (jj=1;jj<(Ju-currncat);jj++) for (tt=0;tt0)) { for (k=0;k0) { for (t=0;t0) { if (ISNAN(REAL(Yimp)[j+k*IY])) { betamiss[0]=betaX[k]; omegamm[0]=REAL(omega)[INTEGER(clus)[j]*JY+k+k*Io]; for (t=0;t=ncon)&(k0) { h=0; for (jj=0;jj2) { for (kk=1;kk<(INTEGER(Y_numcat)[jj]-1);kk++) { if (yi[(ncon+h+kk)]>maxx) { maxx=yi[(ncon+h+kk)]; nmaxx=kk; } } } if (maxx>0) yicategorized[jj]=nmaxx; else yicategorized[jj]=INTEGER(Y_numcat)[jj]-1; h=h+INTEGER(Y_numcat)[jj]-1; } } if (ncatnoaux2>0) { h=0; for (jj=0;jj2) { for (kk=1;kk<(INTEGER(Y2_numcat)[jj]-1);kk++) { if (imp2[INTEGER(clus)[j]+Iu*(ncon2+h+kk)]>maxx) { maxx=imp2[INTEGER(clus)[j]+Iu*(ncon2+h+kk)]; nmaxx=kk; } } } if (maxx>0) yi2categorized[jj]=nmaxx; else yi2categorized[jj]=INTEGER(Y2_numcat)[jj]-1; h=h+INTEGER(Y2_numcat)[jj]-1; } } //Update Xsubprop h=0; indic=0; for (t=0;t0) { for (t=0;t0) { if (ISNAN(Y2impred[j+(k-JY*JZ)*Iu])) { betamiss[0]=betaX[k-JY*JZ]; omegamm[0]=REAL(covu)[k+k*Ju]; for (t=0;t=ncon2)&((k-JY*JZ)0) { h=0; for (jj=0;jj2) { for (kk=1;kk<(INTEGER(Y2_numcat)[jj]-1);kk++) { if (yi[(ncon2+h+kk)]>maxx) { maxx=yi[(ncon2+h+kk)]; nmaxx=kk; } } } if (maxx>0) yi2categorized[jj]=nmaxx; else yi2categorized[jj]=INTEGER(Y2_numcat)[jj]-1; h=h+INTEGER(Y2_numcat)[jj]-1; } } //Update Xsubprop h=0; indic=0; for (t=0;t0) { h=0; for (jj=0;jj2) { for (kk=1;kk<(INTEGER(Y_numcat)[jj]-1);kk++) { if (imp[c+IY*(ncon+h+kk)]>maxx) { maxx=imp[c+IY*(ncon+h+kk)]; nmaxx=kk; } } } if (maxx>0) yicategorized[jj]=nmaxx; else yicategorized[jj]=INTEGER(Y_numcat)[jj]-1; h=h+INTEGER(Y_numcat)[jj]-1; } } h=0; if (INTEGER(clus)[c]==j) { for (jj=0;jj0)||(REAL(Ysub)[t]==1&&yi[0]<0)) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } } else if (INTEGER(submodtype)[0]==2) { // Rejection sampling for latent normal outcome for (t=0;tREAL(betaY)[Il+nsubcat-2]))||((Ysubcatint[t]>1)&&(Ysubcatint[t]REAL(betaY)[Il+Ysubcatint[t]-2]))) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } // Update thresholds latent normal for (t=0;t<(nsubcat-1);t++) { mu2[0]=-10; for (j=0;jmu2[0])) mu2[0]=impsub[j]; } mu2[1]=10; for (j=0;jREAL(betaY)[Il+t])&&(impsub[j]0)+1; } else if (INTEGER(submodtype)[0]==2) { if (impsub[t]>REAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } if ((i+1)%fl==0) Rprintf("."); if ((i+1)%(fl*50)==0) Rprintf("\n"); } if (fl==1) Rprintf("\n"); if (((double)accratio/((double)totprop))<0.2) Rprintf("Warning: acceptance ratio for level 1 variables imputation = %f. This might be a sign that the chain did not mix well. \n" , ((double)accratio/((double)totprop))); if (((double)accratio2/((double)totprop2))<0.2) Rprintf("Warning: acceptance ratio for level 2 variables imputation = %f. This might be a sign that the chain did not mix well. \n" , ((double)accratio2/((double)totprop2))); for(i=0;i0) { h=0; for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (ncat2>0) { for (i=0;imaxx) { maxx=imp2[i+(ncon2+h+k)*Iu]; nmaxx=k; } } if (maxx>0) { for (jj=0;jj0) { for (j=0;j #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo1smcC(SEXP Ysub, SEXP Ysubimp, SEXP Ysubcat, SEXP submod, SEXP ordersub, SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP X,SEXP betaY, SEXP betaYpost, SEXP beta, SEXP betapost, SEXP varY, SEXP varYpost, SEXP omega, SEXP omegapost, SEXP nstep, SEXP varYprior, SEXP Sp, SEXP Y_numcat, SEXP Ysub_numcat, SEXP num_con, SEXP flagrng, SEXP MCMCchain, SEXP submodtype){ int indic=0,i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0,countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h=0; int fl, currncat, Is, Il=0, JXm, accratio=0, totprop=0, nconnoaux, nconcat, ncatnoaux, MCMC, nsubcat, *Ysubcatint; SEXP RdimY, RdimX, Rdimo, Rdimb, Rdims; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegamo, *omegamm, *invomega, *invomega2; double *mu, *mu2, *newbeta, *newomega, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,meanom,sdom, *resid, detom, *residsub; double maxx,maxim,maxim2, *sumxy, *sumxi, *xi, *incrxx, *incrxy, *Xsub, *Xsubprop, *helpLH, sumbetanew=0, *sumexpbeta, *sumbeta; double logLH, newlogLH, *help, *help2, *help3, *imp, *yicategorized, *impsub, *sumxexpbeta, *sumx2expbeta, *sumexpbetanew; /* Protecting R objects from garbage collection and saving matrices dimensions*/ RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; Rdims=PROTECT(getAttrib(submod,R_DimSymbol)); Is=INTEGER(Rdims)[0]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1]; Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Ysub=PROTECT(coerceVector(Ysub,REALSXP)); submod=PROTECT(coerceVector(submod,INTSXP)); ordersub=PROTECT(coerceVector(ordersub,INTSXP)); Ysubimp=PROTECT(coerceVector(Ysubimp,REALSXP)); Ysubcat=PROTECT(coerceVector(Ysubcat,REALSXP)); Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); betaY=PROTECT(coerceVector(betaY,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); betaYpost=PROTECT(coerceVector(betaYpost,REALSXP)); varY=PROTECT(coerceVector(varY,REALSXP)); varYpost=PROTECT(coerceVector(varYpost,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); varYprior=PROTECT(coerceVector(varYprior,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; nconnoaux=INTEGER(num_con)[1]; nconcat=INTEGER(num_con)[2]; ncatnoaux=INTEGER(num_con)[3]; Ysub_numcat=PROTECT(coerceVector(Ysub_numcat,INTSXP)); nsubcat=INTEGER(Ysub_numcat)[0]; submodtype=PROTECT(coerceVector(submodtype,INTSXP)); flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); for (i=0;iJY) JXm=Il; if (JX>JXm) JXm=JX; /*Allocating memory for C objects in R*/ help = ( double * ) R_alloc ( (JY*JY) , sizeof ( double ) ); invomega= (double * ) R_alloc ( (JY*JY) , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); sumxi = ( double * ) R_alloc ( JY * JXm * JY * JXm , sizeof ( double ) ); sumxy = ( double * ) R_alloc ( JY * JXm , sizeof ( double ) ); xi = ( double * ) R_alloc ( JY * JXm * JY , sizeof ( double ) ); yi = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JY *JX * JY , sizeof ( double ) ); incrxx = ( double * ) R_alloc ( JY *JXm * JY *JXm , sizeof ( double ) ); incrxy = ( double * ) R_alloc ( JY *JXm , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JY * JXm * JY * JXm ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( JY * JXm * JY * JXm, sizeof ( double ) ); mu = ( double * ) R_alloc ( JY * JXm, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JY*JXm ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JY, sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); betaX=( double * ) R_alloc ( JY, sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); impsub=( double * ) R_alloc ( IY ,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); residsub=( double * ) R_alloc ( IY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( JY, sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JY, sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JY, sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JY*JY ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JY ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( JY, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); help4 = ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); help5 = ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); help6 = ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); Xsub = ( double * ) R_alloc ( IY* Il , sizeof ( double ) ); Xsubprop = ( double * ) R_alloc ( Il , sizeof ( double ) ); yicategorized=( double * ) R_alloc ( JY,sizeof ( double ) ); Ysubcatint = ( int * ) R_alloc ( IY , sizeof ( int ) ); sumbeta = ( double * ) R_alloc ( IY+1 , sizeof ( double ) ); sumexpbetanew = ( double * ) R_alloc ( IY+1 , sizeof ( double ) ); sumexpbeta=( double * ) R_alloc ( IY+1,sizeof ( double ) ); sumxexpbeta = ( double * ) R_alloc ( IY+1 , sizeof ( double ) ); sumx2expbeta=( double * ) R_alloc ( IY+1,sizeof ( double ) ); helpLH=( double * ) R_alloc ( 4,sizeof ( double ) ); /* Some initializations */ for (j=0; j0) Ysubcatint[j]=REAL(Ysubcat)[j]; for (k=0;k0) { for (i=0;iREAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } GetRNGstate(); /* Running ns iterations of Gibbs sampler*/ for (i=0;i0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } kk++; } } flag=0; } } pos=pos+INTEGER(Y_numcat)[j]-1; } } //Updating beta r8mat_pofac(JY,REAL(omega), help,3); r8mat_poinv(JY,help, invomega); for (jj=1;jj-1; j--) { sumbeta[j]=0; for (jj=0;jj0) { for (t=0;t0) { if (ISNAN(REAL(Yimp)[j+k*IY])) { betamiss[0]=betaX[k]; omegamm[0]=REAL(omega)[k+k*Io]; for (t=0;t=ncon)&(k0)) { h=0; for (jj=0;jj<(ncatnoaux);jj++) { maxx=yi[(ncon+h)]; nmaxx=0; if (INTEGER(Y_numcat)[jj]>2) { for (kk=1;kk<(INTEGER(Y_numcat)[jj]-1);kk++) { if (yi[(ncon+h+kk)]>maxx) { maxx=yi[(ncon+h+kk)]; nmaxx=kk; } } } if (maxx>0) yicategorized[jj]=nmaxx; else yicategorized[jj]=INTEGER(Y_numcat)[jj]-1; h=h+INTEGER(Y_numcat)[jj]-1; } } //Update Xsubprop h=0; indic=0; for (t=0;t0)||(REAL(Ysub)[t]==1&&yi[0]<0)) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } } else if (INTEGER(submodtype)[0]==3) { // Rejection sampling for latent normal outcome for (t=0;tREAL(betaY)[Il+nsubcat-2]))||((Ysubcatint[t]>1)&&(Ysubcatint[t]REAL(betaY)[Il+Ysubcatint[t]-2]))) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } // Update thresholds latent normal for (t=0;t<(nsubcat-1);t++) { mu2[0]=-10; for (j=0;jmu2[0])) mu2[0]=impsub[j]; } mu2[1]=10; for (j=0;jREAL(betaY)[Il+t])&&(impsub[j](-1);j--) { sumbeta[j]=0; sumexpbeta[j]=sumexpbeta[j+1]; sumxexpbeta[j]=sumxexpbeta[j+1]; sumx2expbeta[j]=sumx2expbeta[j+1]; for (jj=0;jj0)+1; } else if (INTEGER(submodtype)[0]==3) { if (impsub[t]>REAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } } if ((i+1)%fl==0) Rprintf("."); if ((i+1)%(fl*50)==0) Rprintf("\n"); } if (fl==1) Rprintf("\n"); if (((double)accratio/((double)totprop))<0.15) Rprintf("Warning: acceptance ratio = %f. This might be a sign that the chain did not mix well. \n" , ((double)accratio/((double)totprop))); for(i=0;i0) { h=0; for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (INTEGER(submodtype)[0]>0) { for (j=0;j #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo2hrC(SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP Y2, SEXP Y2imp, SEXP Y2imp2, SEXP Y2impcat, SEXP X, SEXP X2, SEXP Z, SEXP clus, SEXP beta, SEXP beta2, SEXP u, SEXP betapost, SEXP beta2post, SEXP upost, SEXP omega,SEXP omegapost, SEXP covu, SEXP covupost, SEXP nstep, SEXP Sp, SEXP Sup, SEXP Y_numcat, SEXP Y2_numcat, SEXP num_con, SEXP num_con2, SEXP a_start, SEXP a_prior, SEXP flagrng, SEXP fixed, SEXP MCMCchain, SEXP mpid, SEXP npatterns, SEXP mpid2){ int indic=0,i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0, countmm=0, countmo=0,countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h; int Iu, Ju, IZ, JZ, nj,c, fl,currncat, IY2, JY2, IX2,JX2,Ib2, Jb2,ncon2, ncat2, JYm, JXm, MCMC, fix, np, np2, *mpid2red; SEXP RdimY, RdimX, Rdimo, Rdimb, RdimZ, Rdimu, RdimY2, RdimX2, Rdimb2; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegaom, *omegamo, *omegamm, *invomega, *invomega2, *help, *help2, *help3, *imp, *imp2, *zi; double *sumzy, *incrzz, *incrzy, *mu, *mu2, *newbeta, *newomega, *sumzi, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,*resid, sdom, meanom, detom,logLH, newlogLH; double maxx,maxim,maxim2, minim, *sumxy, *sumxi, *uj, *xi, *ziu, *incrxx, *incrxy, *newu, *mu3,*mu4, *help7, *help8, *help9, *invomega4, *newomega2,a, *clusnum, *covu1, *covu2, *covu12; double *cumclus, *allinvomega,gamma,eta,dx,u_new,precision, *invgamma, *invA, *Gammapr, *Gammastar,u_m,con2,deriv2,u_prop, lambda, aj,*missing2, *Y2red, *X2red, *fixomega2; double *Y2impred, *listh8, *listomega; /* Protecting R objects from garbage collection and saving matrices dimensions*/ RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; RdimY2=PROTECT(getAttrib(Y2imp,R_DimSymbol)); IY2=INTEGER(RdimY2)[0]; JY2=INTEGER(RdimY2)[1]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1]; RdimX2=PROTECT(getAttrib(X2,R_DimSymbol)); IX2=INTEGER(RdimX2)[0]; JX2=INTEGER(RdimX2)[1]; RdimZ=PROTECT(getAttrib(Z,R_DimSymbol)); IZ=INTEGER(RdimZ)[0]; JZ=INTEGER(RdimZ)[1]; Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimb2=PROTECT(getAttrib(beta2,R_DimSymbol)); Ib2=INTEGER(Rdimb2)[0]; Jb2=INTEGER(Rdimb2)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Rdimu=PROTECT(getAttrib(u,R_DimSymbol)); Iu=INTEGER(Rdimu)[0]; Ju=INTEGER(Rdimu)[1]; Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); Y2=PROTECT(coerceVector(Y2,REALSXP)); Y2impcat=PROTECT(coerceVector(Y2impcat,REALSXP)); Y2_numcat=PROTECT(coerceVector(Y2_numcat,INTSXP)); Y2imp=PROTECT(coerceVector(Y2imp,REALSXP)); Y2imp2=PROTECT(coerceVector(Y2imp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); X2=PROTECT(coerceVector(X2,REALSXP)); Z=PROTECT(coerceVector(Z,REALSXP)); clus=PROTECT(coerceVector(clus,INTSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); beta2=PROTECT(coerceVector(beta2,REALSXP)); u=PROTECT(coerceVector(u,REALSXP)); upost=PROTECT(coerceVector(upost,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); beta2post=PROTECT(coerceVector(beta2post,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); covu=PROTECT(coerceVector(covu,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); covupost=PROTECT(coerceVector(covupost,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); Sup=PROTECT(coerceVector(Sup,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; num_con2=PROTECT(coerceVector(num_con2,INTSXP)); ncon2=INTEGER(num_con2)[0]; flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; fixed=PROTECT(coerceVector(fixed,INTSXP)); fix=INTEGER(fixed)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); if (REAL(Y2impcat)[0]==(-999)) ncat2=0; else ncat2=length(Y2_numcat); a_start=PROTECT(coerceVector(a_start,REALSXP)); a=REAL(a_start)[0]; a_prior=PROTECT(coerceVector(a_prior,REALSXP)); nj=Iu; JXm=JX; if (JX2>JX) JXm=JX2; JYm=JY; if (JY2>JY) JYm=JY2; if (Ju>JYm) JYm=Ju; mpid=PROTECT(coerceVector(mpid,INTSXP)); npatterns=PROTECT(coerceVector(npatterns,INTSXP)); np=INTEGER(npatterns)[0]; mpid2=PROTECT(coerceVector(mpid2,INTSXP)); np2=INTEGER(npatterns)[1]; /*Allocating memory for C objects in R*/ help = ( double * ) R_alloc ( (Ju*Ju) , sizeof ( double ) ); invomega= (double * ) R_alloc ( (JYm*JYm) , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); fixomega2 = ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); sumzi = ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); sumzy = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); sumxi = ( double * ) R_alloc ( JYm * JXm * JYm * JXm , sizeof ( double ) ); sumxy = ( double * ) R_alloc ( JYm * JXm , sizeof ( double ) ); zi = ( double * ) R_alloc ( JY * JZ * JY , sizeof ( double ) ); xi = ( double * ) R_alloc ( JYm * JXm * JYm , sizeof ( double ) ); yi = ( double * ) R_alloc ( JYm , sizeof ( double ) ); uj = ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); newu = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); ziu = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JYm *JXm * Ju , sizeof ( double ) ); incrzz = ( double * ) R_alloc ( Ju * Ju, sizeof ( double ) ); incrzy = ( double * ) R_alloc ( JY *JZ , sizeof ( double ) ); incrxx = ( double * ) R_alloc ( JYm *JXm * JYm *JXm , sizeof ( double ) ); incrxy = ( double * ) R_alloc ( JYm *JXm , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JYm * JXm * JYm * JXm ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( Ju * JXm * Ju * JXm, sizeof ( double ) ); mu = ( double * ) R_alloc ( Ju * JXm, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JYm*JXm ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JZ, sizeof ( double ) ); mu3 = ( double * ) R_alloc ( Ju * Ju ,sizeof ( double ) ); mu4 = ( double * ) R_alloc ( JYm * JYm,sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); newomega2 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); betaX=( double * ) R_alloc ( JYm, sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); imp2=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); Y2impred=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); Y2red=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); X2red=( double * ) R_alloc ( Iu * JX2,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( Ju, sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JYm, sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JYm, sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JYm*JYm ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JYm ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( Ju, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( Ju*JYm , sizeof ( double ) ); omegaom= ( double * ) R_alloc ( Ju*JYm , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JYm*JYm , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); invomega4 = ( double * ) R_alloc ( Ju *Ju , sizeof ( double ) ); help4 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help5 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help6 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help7 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help8 = ( double * ) R_alloc ( Ju *JYm , sizeof ( double ) ); help9 = ( double * ) R_alloc ( JYm *JYm , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); clusnum = ( double * ) R_alloc ( nj , sizeof(double)); cumclus = ( double * ) R_alloc ( nj+1 , sizeof(double)); allinvomega = ( double * ) R_alloc ( nj* JY * JY , sizeof(double)); invgamma= (double * ) R_alloc ( JY * JY , sizeof(double) ); invA= (double * ) R_alloc ( JY * JY , sizeof(double) ); Gammapr= (double * ) R_alloc ( JY * JY , sizeof(double) ); Gammastar= (double * ) R_alloc ( JY * JY , sizeof(double) ); missing2 = ( double * ) R_alloc ( Iu , sizeof ( double ) ); covu1= (double * ) R_alloc ( JY * JZ * JY * JZ , sizeof ( double ) ); covu2= (double * ) R_alloc ( JY2 * JY2, sizeof ( double ) ); covu12= (double * ) R_alloc ( JY * JZ * JY2 , sizeof ( double ) ); if (np20) { for (i=0;i0) { for (i=0;i0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*c+JY*nj*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*c+JY*nj*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt-3)&(maxim<4)) { if (maxim<0) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } else { while ((flag==0)&(kk<10000)) { r8vec_multinormal_sample((INTEGER(Y_numcat)[j]-1), mumiss,omegamm, newbeta,mu4,0); maxim=maxvec((INTEGER(Y_numcat)[j]-1),newbeta); minim=minvec((INTEGER(Y_numcat)[j]-1),newbeta); if ((minim>-3)&(maxim<4)) { maxim2=argmaxvec((INTEGER(Y_numcat)[j]-1),newbeta); if (((maxim2+1)==REAL(Y)[t+(ncon+j)*IY])&(maxim>0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } flag=0; } } } } pos=pos+INTEGER(Y_numcat)[j]-1; } } // Rejection sampling for level 2 variables if (ncat2>0) { pos=ncon2; for (j=0;j(pos+JY*JZ+currncat-1)))&&((k<(pos+JY*JZ))||(k>(pos+JY*JZ+currncat-1)))) { help4[countm]=REAL(covu)[kk+k*Ju]; countm++; } else if (((kk<(pos+JY*JZ))||(kk>(pos+JY*JZ+currncat-1)))&&((k>(pos+JY*JZ-1))||(k<(pos+JY*JZ+currncat)))) { help5[counto]=REAL(covu)[kk+k*Ju]; counto++; } } } countm=0; counto=0; r8mat_pofac((Ju-currncat),help4, help6,1); r8mat_poinv((Ju-currncat),help6, invomega4); for (jj=1;jj<(Ju-currncat);jj++) for (tt=0;tt-3)&(maxim<4)) { if (maxim<0) { for (k=0;k0)) { for (k=0;k0) { for (k=0;k0) { for (k=0;k0) { for (k=0;k(JY*JZ-1))&&(!ISNAN(Y2impred[j+(k-JY*JZ)*Iu])))) { omegaoo[countoo]=REAL(covu)[k+t*Ju]; countoo++; } } else { if (((k(JY*JZ-1))&&(!ISNAN(Y2impred[j+(k-JY*JZ)*Iu]))&&(!ISNAN(Y2impred[j+(t-JY*JZ)*Iu])))) { omegaoo[countoo]=REAL(covu)[k+t*Ju]; countoo++; } if (((k(JY*JZ-1))&&(!ISNAN(Y2impred[j+(k-JY*JZ)*Iu]))&&(ISNAN(Y2impred[j+(t-JY*JZ)*Iu])))) { omegamo[countmo]=REAL(covu)[k+t*Ju]; countmo++; } if ((k>(JY*JZ-1))&&(ISNAN(Y2impred[j+(k-JY*JZ)*Iu]))&&(ISNAN(Y2impred[j+(t-JY*JZ)*Iu]))) { omegamm[countmm]=REAL(covu)[k+t*Ju]; countmm++; } } } } countmm=0; countmo=0; countoo=0; r8mat_pofac((Ju-nmiss),omegaoo,help7,14); r8mat_poinv((Ju-nmiss),help7,invomega4); for (jj=1;jj0) { for (k=0;k0) { h=0; for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (ncat2>0) { for (i=0;imaxx) { maxx=imp2[i+(ncon2+h+k)*Iu]; nmaxx=k; } } if (maxx>0) { for (jj=0;jj #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo1ranC(SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP X, SEXP Z, SEXP clus, SEXP beta, SEXP u, SEXP betapost, SEXP upost, SEXP omega, SEXP omegapost, SEXP covu, SEXP covupost, SEXP nstep, SEXP Sp, SEXP Sup, SEXP Y_numcat, SEXP num_con, SEXP flagrng, SEXP MCMCchain, SEXP mpid, SEXP npatterns){ int indic=0,i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0, countmm=0, countmo=0,countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h; int Iu, Ju, IZ, JZ, nj,c,fl, currncat, MCMC, np; SEXP RdimY, RdimX, Rdimo, Rdimb, RdimZ, Rdimu; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegamo, *omegamm, *invomega, *invomega2, *help, *help2, *help3, *imp, *zi; double *sumzy, *incrzz, *incrzy, *mu, *mu2, *newbeta, *newomega, *sumzi, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,meanom,sdom, *resid, logLH, newlogLH,detom; double maxx,maxim,maxim2,minim, *sumxy, *sumxi, *uj, *xi, *ziu, *incrxx, *incrxy, *newu, *mu3, *mu4, *help7, *help8, *help9, *invomega4, *newomega2, *listh8, *listomega; /* Protecting R objects from garbage collection and saving matrices dimensions*/ RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1]; RdimZ=PROTECT(getAttrib(Z,R_DimSymbol)); IZ=INTEGER(RdimZ)[0]; JZ=INTEGER(RdimZ)[1]; Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Rdimu=PROTECT(getAttrib(u,R_DimSymbol)); Iu=INTEGER(Rdimu)[0]; Ju=INTEGER(Rdimu)[1]; Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); Z=PROTECT(coerceVector(Z,REALSXP)); clus=PROTECT(coerceVector(clus,INTSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); u=PROTECT(coerceVector(u,REALSXP)); upost=PROTECT(coerceVector(upost,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); covu=PROTECT(coerceVector(covu,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); covupost=PROTECT(coerceVector(covupost,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); Sup=PROTECT(coerceVector(Sup,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); nj=Iu; mpid=PROTECT(coerceVector(mpid,INTSXP)); npatterns=PROTECT(coerceVector(npatterns,INTSXP)); np=INTEGER(npatterns)[0]; /*Allocating memory for C objects in R*/ help = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); invomega= (double * ) R_alloc ( JY * JY , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); sumzi = ( double * ) R_alloc ( JY * JZ * JY * JZ , sizeof ( double ) ); sumzy = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); sumxi = ( double * ) R_alloc ( JY * JX * JY * JX , sizeof ( double ) ); sumxy = ( double * ) R_alloc ( JY * JX , sizeof ( double ) ); zi = ( double * ) R_alloc ( JY * JZ * JY , sizeof ( double ) ); xi = ( double * ) R_alloc ( JY * JX * JY , sizeof ( double ) ); yi = ( double * ) R_alloc ( JY , sizeof ( double ) ); uj = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); newu = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); ziu = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JY *JX * JY , sizeof ( double ) ); incrzz = ( double * ) R_alloc ( JY *JZ * JY *JZ , sizeof ( double ) ); incrzy = ( double * ) R_alloc ( JY *JZ , sizeof ( double ) ); incrxx = ( double * ) R_alloc ( JY *JX * JY *JX , sizeof ( double ) ); incrxy = ( double * ) R_alloc ( JY *JX , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JY * JX * JY * JX ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( JY * JX * JY * JX , sizeof ( double ) ); mu = ( double * ) R_alloc ( JY * JX, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JY * JX ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JZ, sizeof ( double ) ); mu3 = ( double * ) R_alloc ( JY * JY * JZ * JZ ,sizeof ( double ) ); mu4 = ( double * ) R_alloc ( JY * JY,sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); newomega2 = ( double * ) R_alloc ( JY * JY * JZ * JZ , sizeof ( double ) ); betaX=( double * ) R_alloc ( JY , sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( JY , sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JY , sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JY , sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JY * JY ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JY ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( JY, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( JY*JY * JZ * JZ , sizeof ( double ) ); invomega4 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); help4 = ( double * ) R_alloc ( JY *JY *JZ*JZ , sizeof ( double ) ); help5 = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); help6 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); help7 = ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); help8 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); help9 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); listomega = ( double * ) R_alloc ( np*JY *JY , sizeof ( double ) ); listh8 = ( double * ) R_alloc ( np*JY *JY , sizeof ( double ) ); /* Some initializations */ for (j=0; j0) { for (i=0;i0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt-3)&(maxim<4)) { if (maxim<0) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } else { while ((flag==0)&(kk<10000)) { r8vec_multinormal_sample((INTEGER(Y_numcat)[j]-1), mumiss,omegamm, newbeta,mu4,0); maxim=maxvec((INTEGER(Y_numcat)[j]-1),newbeta); minim=minvec((INTEGER(Y_numcat)[j]-1),newbeta); if ((minim>-3)&(maxim<4)) { maxim2=argmaxvec((INTEGER(Y_numcat)[j]-1),newbeta); if (((maxim2+1)==REAL(Y)[t+(ncon+j)*IY])&(maxim>0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } flag=0; } } pos=pos+INTEGER(Y_numcat)[j]-1; } } //Updating beta r8mat_pofac(JY,REAL(omega), help,3); r8mat_poinv(JY,help, invomega); for (jj=1;jj0) { for (k=0;k0) { for (k=0;k0) { for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (MCMC==0) { r8mat_divide(Ib,Jb,ns,REAL(betapost)); r8mat_divide(Iu,Ju,ns,REAL(upost)); r8mat_divide(JY,JY,ns,REAL(omegapost)); r8mat_divide(JY*JZ,JY*JZ,ns,REAL(covupost)); } PutRNGstate(); UNPROTECT(30); return R_NilValue; } jomo/src/jomo1ranhrC.c0000644000176200001440000006656114410334570014353 0ustar liggesusers#include #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo1ranhrC(SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP X, SEXP Z, SEXP clus, SEXP beta, SEXP u, SEXP betapost, SEXP upost, SEXP omega,SEXP omegapost, SEXP covu, SEXP covupost, SEXP nstep, SEXP Sp, SEXP Sup, SEXP Y_numcat, SEXP num_con, SEXP a_start, SEXP a_prior, SEXP flagrng, SEXP fixed, SEXP MCMCchain, SEXP mpid, SEXP npatterns){ int indic=0,i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0, countmm=0, countmo=0,countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h; int Iu, Ju, IZ, JZ, nj,c, fl,currncat, MCMC, fix, np; SEXP RdimY, RdimX, Rdimo, Rdimb, RdimZ, Rdimu; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegaom, *omegamo, *omegamm, *invomega, *invomega2, *help, *help2, *help3, *imp, *zi; double *sumzy, *incrzz, *incrzy, *mu, *mu2, *newbeta, *newomega, *sumzi, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,*resid, sdom, meanom, detom,logLH, newlogLH; double maxx,maxim,maxim2, minim, *sumxy, *sumxi, *uj, *xi, *ziu, *incrxx, *incrxy, *newu, *mu3,*mu4, *help7, *help8, *help9, *invomega4, *newomega2,a, *clusnum; double *cumclus, *allinvomega,gamma,eta,dx,u_new,precision, *invgamma, *invA, *Gammapr, *Gammastar,u_m,con2,deriv2,u_prop, lambda, aj, *listh8, *listomega; /* Protecting R objects from garbage collection and saving matrices dimensions*/ RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1]; RdimZ=PROTECT(getAttrib(Z,R_DimSymbol)); IZ=INTEGER(RdimZ)[0]; JZ=INTEGER(RdimZ)[1]; Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Rdimu=PROTECT(getAttrib(u,R_DimSymbol)); Iu=INTEGER(Rdimu)[0]; Ju=INTEGER(Rdimu)[1]; Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); Z=PROTECT(coerceVector(Z,REALSXP)); clus=PROTECT(coerceVector(clus,INTSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); u=PROTECT(coerceVector(u,REALSXP)); upost=PROTECT(coerceVector(upost,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); covu=PROTECT(coerceVector(covu,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); covupost=PROTECT(coerceVector(covupost,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); Sup=PROTECT(coerceVector(Sup,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; fixed=PROTECT(coerceVector(fixed,INTSXP)); fix=INTEGER(fixed)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); a_start=PROTECT(coerceVector(a_start,REALSXP)); a=REAL(a_start)[0]; a_prior=PROTECT(coerceVector(a_prior,REALSXP)); nj=Iu; mpid=PROTECT(coerceVector(mpid,INTSXP)); npatterns=PROTECT(coerceVector(npatterns,INTSXP)); np=INTEGER(npatterns)[0]; /*Allocating memory for C objects in R*/ help = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); invomega= (double * ) R_alloc ( JY * JY , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); sumzi = ( double * ) R_alloc ( JY * JZ * JY * JZ , sizeof ( double ) ); sumzy = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); sumxi = ( double * ) R_alloc ( JY * JX * JY * JX , sizeof ( double ) ); sumxy = ( double * ) R_alloc ( JY * JX , sizeof ( double ) ); zi = ( double * ) R_alloc ( JY * JZ * JY , sizeof ( double ) ); xi = ( double * ) R_alloc ( JY * JX * JY , sizeof ( double ) ); yi = ( double * ) R_alloc ( JY , sizeof ( double ) ); uj = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); newu = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); ziu = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JY *JX * JY , sizeof ( double ) ); incrzz = ( double * ) R_alloc ( JY *JZ * JY *JZ , sizeof ( double ) ); incrzy = ( double * ) R_alloc ( JY *JZ , sizeof ( double ) ); incrxx = ( double * ) R_alloc ( JY *JX * JY *JX , sizeof ( double ) ); incrxy = ( double * ) R_alloc ( JY *JX , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JY * JX * JY * JX ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( JY * JX * JY * JX , sizeof ( double ) ); mu = ( double * ) R_alloc ( JY * JX, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JY * JX ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JY * JZ,sizeof ( double ) ); mu3 = ( double * ) R_alloc ( JY * JY * JZ * JZ ,sizeof ( double ) ); mu4 = ( double * ) R_alloc ( JY * JY,sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); newomega2 = ( double * ) R_alloc ( JY * JY *JZ * JZ , sizeof ( double ) ); betaX=( double * ) R_alloc ( JY , sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( JY , sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JY , sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JY , sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JY * JY ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JY ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( JY, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); omegaom= ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( JY*JY * JZ * JZ , sizeof ( double ) ); invomega4 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); help4 = ( double * ) R_alloc ( JY *JY*JZ , sizeof ( double ) ); help5 = ( double * ) R_alloc ( JY * JY*JZ*JZ , sizeof ( double ) ); help6 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); help7 = ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); help8 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); help9 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); clusnum = ( double * ) R_alloc ( nj , sizeof(double)); cumclus = ( double * ) R_alloc ( nj+1 , sizeof(double)); allinvomega = ( double * ) R_alloc ( nj* JY * JY , sizeof(double)); invgamma= (double * ) R_alloc ( JY * JY , sizeof(double) ); invA= (double * ) R_alloc ( JY * JY , sizeof(double) ); Gammapr= (double * ) R_alloc ( JY * JY , sizeof(double) ); Gammastar= (double * ) R_alloc ( JY * JY , sizeof(double) ); listomega = ( double * ) R_alloc ( np*JY *JY , sizeof ( double ) ); listh8 = ( double * ) R_alloc ( np*JY *JY , sizeof ( double ) ); /* Some initializations */ gamma=JY+1; //a=JY+1; eta=REAL(a_prior)[0]; dx=0.001; u_new=log(a+JY); precision=0.001; GetRNGstate(); for (i=0;i0) { for (i=0;i0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*c+JY*nj*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*c+JY*nj*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt-3)&(maxim<4)) { if (maxim<0) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } else { while ((flag==0)&(kk<10000)) { r8vec_multinormal_sample((INTEGER(Y_numcat)[j]-1), mumiss,omegamm, newbeta,mu4,0); maxim=maxvec((INTEGER(Y_numcat)[j]-1),newbeta); minim=minvec((INTEGER(Y_numcat)[j]-1),newbeta); if ((minim>-3)&(maxim<4)) { maxim2=argmaxvec((INTEGER(Y_numcat)[j]-1),newbeta); if (((maxim2+1)==REAL(Y)[t+(ncon+j)*IY])&(maxim>0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } flag=0; } } } } pos=pos+INTEGER(Y_numcat)[j]-1; } } //Updating beta for (j=0;j0) { for (k=0;k0) { for (k=0;k0) { for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (MCMC==0) { r8mat_divide(Ib,Jb,ns,REAL(betapost)); r8mat_divide(Iu,Ju,ns,REAL(upost)); r8mat_divide(JY*JZ,JY*JZ,ns,REAL(covupost)); r8mat_divide(JY,nj*JY,ns,REAL(omegapost)); } REAL(a_start)[0]=a; PutRNGstate(); UNPROTECT(33); return R_NilValue; } jomo/src/jomo1ransmcC.c0000644000176200001440000011130114410320661014477 0ustar liggesusers#include #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo1ransmcC(SEXP Ysub, SEXP Ysubimp, SEXP Ysubcat, SEXP submod, SEXP ordersub, SEXP submodran, SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP X, SEXP Z, SEXP clus, SEXP betaY, SEXP betaYpost, SEXP beta, SEXP u, SEXP uY, SEXP betapost, SEXP upost, SEXP uYpost, SEXP varY, SEXP varYpost, SEXP omega, SEXP omegapost, SEXP covuY, SEXP covuYpost, SEXP covu, SEXP covupost, SEXP nstep, SEXP varYprior, SEXP covuYprior, SEXP Sp, SEXP Sup, SEXP Y_numcat, SEXP Ysub_numcat, SEXP num_con, SEXP flagrng, SEXP MCMCchain, SEXP submodtype){ int indic=0,i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0,countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h=0; int Iu, Ju, IZ, JZ, nj,c,fl, currncat, Is, Il=0, JXm, Ir=0,Jr, JZm, Jum, accratio=0, totprop=0, nconnoaux, nconcat, ncatnoaux, MCMC, nsubcat, *Ysubcatint; SEXP RdimY, RdimX, Rdimo, Rdimb, RdimZ, Rdimu, Rdims, Rdimr; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegamo, *omegamm, *invomega, *invomega2, *help, *help2, *help3, *imp, *zi, *yicategorized, *impsub; double *sumzy, *incrzz, *incrzy, *mu, *mu2, *newbeta, *newomega, *sumzi, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,meanom,sdom, *resid, logLH, newlogLH,detom, *residsub; double maxx,maxim,maxim2, *sumxy, *sumxi, *uj, *xi, *ziu, *incrxx, *incrxy, *newu, *mu3, *mu4, *newomega2, *Xsub, *Zsub, *Xsubprop, *Zsubprop; /* Protecting R objects from garbage collection and saving matrices dimensions*/ RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; Rdims=PROTECT(getAttrib(submod,R_DimSymbol)); Is=INTEGER(Rdims)[0]; Rdimr=PROTECT(getAttrib(submodran,R_DimSymbol)); Jr=INTEGER(Rdimr)[1]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1]; RdimZ=PROTECT(getAttrib(Z,R_DimSymbol)); IZ=INTEGER(RdimZ)[0]; JZ=INTEGER(RdimZ)[1]; Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Rdimu=PROTECT(getAttrib(u,R_DimSymbol)); Iu=INTEGER(Rdimu)[0]; Ju=INTEGER(Rdimu)[1]; Ysub=PROTECT(coerceVector(Ysub,REALSXP)); submod=PROTECT(coerceVector(submod,INTSXP)); ordersub=PROTECT(coerceVector(ordersub,INTSXP)); submodran=PROTECT(coerceVector(submodran,INTSXP)); Ysubimp=PROTECT(coerceVector(Ysubimp,REALSXP)); Ysubcat=PROTECT(coerceVector(Ysubcat,REALSXP)); Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Ysub_numcat=PROTECT(coerceVector(Ysub_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); Z=PROTECT(coerceVector(Z,REALSXP)); clus=PROTECT(coerceVector(clus,INTSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); betaY=PROTECT(coerceVector(betaY,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); betaYpost=PROTECT(coerceVector(betaYpost,REALSXP)); varY=PROTECT(coerceVector(varY,REALSXP)); varYpost=PROTECT(coerceVector(varYpost,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); varYprior=PROTECT(coerceVector(varYprior,REALSXP)); u=PROTECT(coerceVector(u,REALSXP)); uY=PROTECT(coerceVector(uY,REALSXP)); upost=PROTECT(coerceVector(upost,REALSXP)); uYpost=PROTECT(coerceVector(uYpost,REALSXP)); covuY=PROTECT(coerceVector(covuY,REALSXP)); covu=PROTECT(coerceVector(covu,REALSXP)); covuYpost=PROTECT(coerceVector(covuYpost,REALSXP)); covupost=PROTECT(coerceVector(covupost,REALSXP)); covuYprior=PROTECT(coerceVector(covuYprior,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); Sup=PROTECT(coerceVector(Sup,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; nconnoaux=INTEGER(num_con)[1]; nconcat=INTEGER(num_con)[2]; ncatnoaux=INTEGER(num_con)[3]; nsubcat=INTEGER(Ysub_numcat)[0]; flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); nj=Iu; submodtype=PROTECT(coerceVector(submodtype,INTSXP)); for (i=0;iJY) JXm=Il; if (JX>JXm) JXm=JX; for (i=0;iJY) JZm=Ir; if (JZ>JZm) JZm=JZ; Jum=Ju; if (Ir>Jum) Jum=Ir; /*Allocating memory for C objects in R*/ help = ( double * ) R_alloc ( (Ju*Ju) , sizeof ( double ) ); invomega= (double * ) R_alloc ( (JY*JY) , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); sumzi = ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); sumzy = ( double * ) R_alloc ( JY * JZm , sizeof ( double ) ); sumxi = ( double * ) R_alloc ( JY * JXm * JY * JXm , sizeof ( double ) ); sumxy = ( double * ) R_alloc ( JY * JXm , sizeof ( double ) ); zi = ( double * ) R_alloc ( JY * JZm * JY , sizeof ( double ) ); xi = ( double * ) R_alloc ( JY * JXm * JY , sizeof ( double ) ); yi = ( double * ) R_alloc ( JY , sizeof ( double ) ); uj = ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); newu = ( double * ) R_alloc ( JY * JZm , sizeof ( double ) ); ziu = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JY *JX * Ju , sizeof ( double ) ); incrzz = ( double * ) R_alloc ( Jum * Jum, sizeof ( double ) ); incrzy = ( double * ) R_alloc ( JY *JZm , sizeof ( double ) ); incrxx = ( double * ) R_alloc ( JY *JXm * JY *JXm , sizeof ( double ) ); incrxy = ( double * ) R_alloc ( JY *JXm , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JY * JXm * JY * JXm ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( Jum * JXm * Jum * JXm, sizeof ( double ) ); mu = ( double * ) R_alloc ( Ju * JXm, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JY*JXm ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JZm, sizeof ( double ) ); mu3 = ( double * ) R_alloc ( Jum * Jum ,sizeof ( double ) ); mu4 = ( double * ) R_alloc ( JY * JY,sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); newomega2 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); betaX=( double * ) R_alloc ( JY, sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); impsub=( double * ) R_alloc ( IY ,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); residsub=( double * ) R_alloc ( IY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( Ju, sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JY, sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JY, sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JY*JY ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JY ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( Ju, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( Ju*JY , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); help4 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); help5 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); help6 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); Ysubcatint = ( int * ) R_alloc ( IY , sizeof ( int ) ); Xsub = ( double * ) R_alloc ( IY* Il , sizeof ( double ) ); Xsubprop = ( double * ) R_alloc ( Il , sizeof ( double ) ); Zsub = ( double * ) R_alloc ( IY* Ir , sizeof ( double ) ); Zsubprop = ( double * ) R_alloc ( Ir , sizeof ( double ) ); yicategorized=( double * ) R_alloc ( JY,sizeof ( double ) ); /* Some initializations */ for (j=0; j0) Ysubcatint[j]=REAL(Ysubcat)[j]; for (k=0;k0) { for (i=0;iREAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } GetRNGstate(); /* Running ns iterations of Gibbs sampler*/ for (i=0;i0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } kk++; } } flag=0; } } pos=pos+INTEGER(Y_numcat)[j]-1; } } //Updating beta r8mat_pofac(JY,REAL(omega), help,3); r8mat_poinv(JY,help, invomega); for (jj=1;jj0) { for (t=0;t0) { if (ISNAN(REAL(Yimp)[j+k*IY])) { betamiss[0]=betaX[k]; omegamm[0]=REAL(omega)[k+k*Io]; for (t=0;t=ncon)&(k0)) { h=0; for (jj=0;jj<(ncatnoaux);jj++) { maxx=yi[(ncon+h)]; nmaxx=0; if (INTEGER(Y_numcat)[jj]>2) { for (kk=1;kk<(INTEGER(Y_numcat)[jj]-1);kk++) { if (yi[(ncon+h+kk)]>maxx) { maxx=yi[(ncon+h+kk)]; nmaxx=kk; } } } if (maxx>0) yicategorized[jj]=nmaxx; else yicategorized[jj]=INTEGER(Y_numcat)[jj]-1; h=h+INTEGER(Y_numcat)[jj]-1; } } //Update Xsubprop h=0; indic=0; for (t=0;t0)||(REAL(Ysub)[t]==1&&yi[0]<0)) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } } else if (INTEGER(submodtype)[0]==2) { // Rejection sampling for latent normal outcome for (t=0;tREAL(betaY)[Il+nsubcat-2]))||((Ysubcatint[t]>1)&&(Ysubcatint[t]REAL(betaY)[Il+Ysubcatint[t]-2]))) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } // Update thresholds latent normal for (t=0;t<(nsubcat-1);t++) { mu2[0]=-10; for (j=0;jmu2[0])) mu2[0]=impsub[j]; } mu2[1]=10; for (j=0;jREAL(betaY)[Il+t])&&(impsub[j]0)+1; } else if (INTEGER(submodtype)[0]==2) { if (impsub[t]>REAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } if ((i+1)%fl==0) Rprintf("."); if ((i+1)%(fl*50)==0) Rprintf("\n"); } if (fl==1) Rprintf("\n"); if (((double)accratio/((double)totprop))<0.15) Rprintf("Warning: acceptance ratio = %f. This might be a sign that the chain did not mix well. \n" , ((double)accratio/((double)totprop))); for(i=0;i0) { h=0; for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (INTEGER(submodtype)[0]>0) { for (j=0;j #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo2smcC(SEXP Ysub, SEXP Ysubimp, SEXP Ysubcat, SEXP submod, SEXP ordersub, SEXP submodran, SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP Y2, SEXP Y2imp, SEXP Y2imp2, SEXP Y2impcat, SEXP X, SEXP X2, SEXP Z, SEXP clus, SEXP betaY, SEXP betaYpost, SEXP beta, SEXP beta2, SEXP u, SEXP uY, SEXP betapost, SEXP upost, SEXP uYpost, SEXP beta2post, SEXP varY, SEXP varYpost, SEXP omega, SEXP omegapost, SEXP covuY, SEXP covuYpost, SEXP covu, SEXP covupost, SEXP nstep, SEXP varYprior, SEXP covuYprior, SEXP Sp, SEXP Sup, SEXP Y_numcat, SEXP Y2_numcat, SEXP Ysub_numcat, SEXP num_con, SEXP num_con2, SEXP flagrng, SEXP MCMCchain, SEXP submodtype){ int indic=0,i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0,countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h=0; int Iu, Ju, IZ, JZ, nj,c,fl, currncat, IY2, JY2, IX2,JX2,Ib2, Jb2, ncon2, ncat2, JYm, JXm, Is, Il=0, Ir=0,Jr, JZm, Jum, accratio=0, totprop=0; int accratio2=0, totprop2=0, nconnoaux2, nconcat2, ncatnoaux2, nconnoaux, nconcat, ncatnoaux, MCMC, nsubcat, *Ysubcatint; SEXP RdimY, RdimX, Rdimo, Rdimb, RdimZ, Rdimu, RdimY2, RdimX2, Rdimb2, Rdims, Rdimr; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegamo, *omegamm, *invomega, *invomega2, *help, *help2, *help3, *imp,*imp2, *zi, *yicategorized; double *sumzy, *incrzz, *incrzy, *mu, *mu2, *newbeta, *newomega, *sumzi, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,meanom,sdom, *resid, logLH, newlogLH,detom; double maxx,maxim,maxim2, *sumxy, *sumxi, *uj, *xi, *ziu, *incrxx, *incrxy, *newu, *mu3, *mu4, *invomega4, *newomega2,*missing2, *Y2red, *X2red, *impsub; double *covu1, *covu2, *covu12, *fixomega2, *Y2impred, *Xsub, *Xsubprop, *Zsub, *Zsubprop, *residsub, *yi2categorized; // Protecting R objects from garbage collection and saving matrices dimensions RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; RdimY2=PROTECT(getAttrib(Y2imp,R_DimSymbol)); IY2=INTEGER(RdimY2)[0]; JY2=INTEGER(RdimY2)[1]; Rdims=PROTECT(getAttrib(submod,R_DimSymbol)); Is=INTEGER(Rdims)[0]; Rdimr=PROTECT(getAttrib(submodran,R_DimSymbol)); Jr=INTEGER(Rdimr)[1]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1]; RdimX2=PROTECT(getAttrib(X2,R_DimSymbol)); IX2=INTEGER(RdimX2)[0]; JX2=INTEGER(RdimX2)[1]; RdimZ=PROTECT(getAttrib(Z,R_DimSymbol)); IZ=INTEGER(RdimZ)[0]; JZ=INTEGER(RdimZ)[1]; Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimb2=PROTECT(getAttrib(beta2,R_DimSymbol)); Ib2=INTEGER(Rdimb2)[0]; Jb2=INTEGER(Rdimb2)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Rdimu=PROTECT(getAttrib(u,R_DimSymbol)); Iu=INTEGER(Rdimu)[0]; Ju=INTEGER(Rdimu)[1]; Ysub=PROTECT(coerceVector(Ysub,REALSXP)); submod=PROTECT(coerceVector(submod,INTSXP)); ordersub=PROTECT(coerceVector(ordersub,INTSXP)); submodran=PROTECT(coerceVector(submodran,INTSXP)); Ysubimp=PROTECT(coerceVector(Ysubimp,REALSXP)); Ysubcat=PROTECT(coerceVector(Ysubcat,REALSXP)); Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Ysub_numcat=PROTECT(coerceVector(Ysub_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); Y2=PROTECT(coerceVector(Y2,REALSXP)); Y2impcat=PROTECT(coerceVector(Y2impcat,REALSXP)); Y2_numcat=PROTECT(coerceVector(Y2_numcat,INTSXP)); Y2imp=PROTECT(coerceVector(Y2imp,REALSXP)); Y2imp2=PROTECT(coerceVector(Y2imp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); X2=PROTECT(coerceVector(X2,REALSXP)); Z=PROTECT(coerceVector(Z,REALSXP)); clus=PROTECT(coerceVector(clus,INTSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); betaY=PROTECT(coerceVector(betaY,REALSXP)); beta2=PROTECT(coerceVector(beta2,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); betaYpost=PROTECT(coerceVector(betaYpost,REALSXP)); beta2post=PROTECT(coerceVector(beta2post,REALSXP)); varY=PROTECT(coerceVector(varY,REALSXP)); varYpost=PROTECT(coerceVector(varYpost,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); varYprior=PROTECT(coerceVector(varYprior,REALSXP)); u=PROTECT(coerceVector(u,REALSXP)); uY=PROTECT(coerceVector(uY,REALSXP)); upost=PROTECT(coerceVector(upost,REALSXP)); uYpost=PROTECT(coerceVector(uYpost,REALSXP)); covuY=PROTECT(coerceVector(covuY,REALSXP)); covu=PROTECT(coerceVector(covu,REALSXP)); covuYpost=PROTECT(coerceVector(covuYpost,REALSXP)); covupost=PROTECT(coerceVector(covupost,REALSXP)); covuYprior=PROTECT(coerceVector(covuYprior,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); Sup=PROTECT(coerceVector(Sup,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; nconnoaux=INTEGER(num_con)[1]; nconcat=INTEGER(num_con)[2]; ncatnoaux=INTEGER(num_con)[3]; num_con2=PROTECT(coerceVector(num_con2,INTSXP)); ncon2=INTEGER(num_con2)[0]; nconnoaux2=INTEGER(num_con2)[1]; nconcat2=INTEGER(num_con2)[2]; ncatnoaux2=INTEGER(num_con2)[3]; nsubcat=INTEGER(Ysub_numcat)[0]; flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); if (REAL(Y2impcat)[0]==(-999)) ncat2=0; else ncat2=length(Y2_numcat); nj=Iu; submodtype=PROTECT(coerceVector(submodtype,INTSXP)); for (i=0;iJY) JXm=Il; if (JX>JXm) JXm=JX; for (i=0;iJY) JZm=Ir; if (JZ>JZm) JZm=JZ; if (JX2>JXm) JXm=JX2; JYm=JY; if (JY2>JY) JYm=JY2; Jum=Ju; if (Ir>Jum) Jum=Ir; //Allocating memory for C objects in R help = ( double * ) R_alloc ( (Ju*Ju) , sizeof ( double ) ); invomega= (double * ) R_alloc ( (JYm*JYm) , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); fixomega2 = ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); sumzi = ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); sumzy = ( double * ) R_alloc ( JY * JZm , sizeof ( double ) ); sumxi = ( double * ) R_alloc ( JYm * JXm * JYm * JXm , sizeof ( double ) ); sumxy = ( double * ) R_alloc ( JYm * JXm , sizeof ( double ) ); zi = ( double * ) R_alloc ( JY * JZm * JY , sizeof ( double ) ); xi = ( double * ) R_alloc ( JYm * JXm * JYm , sizeof ( double ) ); yi = ( double * ) R_alloc ( JYm , sizeof ( double ) ); uj = ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); newu = ( double * ) R_alloc ( JY * JZm , sizeof ( double ) ); ziu = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JYm *JXm * Ju , sizeof ( double ) ); incrzz = ( double * ) R_alloc ( Jum * Jum, sizeof ( double ) ); incrzy = ( double * ) R_alloc ( JY *JZm , sizeof ( double ) ); incrxx = ( double * ) R_alloc ( JYm *JXm * JYm *JXm , sizeof ( double ) ); incrxy = ( double * ) R_alloc ( JYm *JXm , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JYm * JXm * JYm * JXm ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( Jum * JXm * Jum * JXm, sizeof ( double ) ); mu = ( double * ) R_alloc ( Ju * JXm, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JYm*JXm ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JZm, sizeof ( double ) ); mu3 = ( double * ) R_alloc ( Jum * Jum ,sizeof ( double ) ); mu4 = ( double * ) R_alloc ( JYm * JYm,sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); newomega2 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); betaX=( double * ) R_alloc ( JYm, sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); imp2=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); impsub=( double * ) R_alloc ( IY ,sizeof ( double ) ); Y2impred=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); Y2red=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); X2red=( double * ) R_alloc ( Iu * JX2,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); residsub=( double * ) R_alloc ( IY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( Ju, sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JYm, sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JYm, sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JYm*JYm ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JYm ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( Ju, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( Ju*JYm , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JYm*JYm , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); invomega4 = ( double * ) R_alloc ( Ju *Ju , sizeof ( double ) ); help4 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); help5 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); help6 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); missing2 = ( double * ) R_alloc ( Iu , sizeof ( double ) ); covu1= (double * ) R_alloc ( JY * JZ * JY * JZ , sizeof ( double ) ); covu2= (double * ) R_alloc ( JY2 * JY2, sizeof ( double ) ); covu12= (double * ) R_alloc ( JY * JZ * JY2 , sizeof ( double ) ); Xsub = ( double * ) R_alloc ( IY* Il , sizeof ( double ) ); Xsubprop = ( double * ) R_alloc ( IY* Il , sizeof ( double ) ); Zsub = ( double * ) R_alloc ( IY* Ir , sizeof ( double ) ); Zsubprop = ( double * ) R_alloc ( Ir , sizeof ( double ) ); yicategorized=( double * ) R_alloc ( JY,sizeof ( double ) ); yi2categorized=( double * ) R_alloc ( JY2,sizeof ( double ) ); Ysubcatint = ( int * ) R_alloc ( IY , sizeof ( int ) ); // Some initializations for (j=0; j0) Ysubcatint[j]=REAL(Ysubcat)[j]; for (k=0;k0) { for (i=0;i0) { for (i=0;iREAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } GetRNGstate(); // Running ns iterations of Gibbs sampler for (i=0;i0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } kk++; } } flag=0; } } pos=pos+INTEGER(Y_numcat)[j]-1; } } // Rejection sampling for level 2 variables if (ncat2>0) { pos=ncon2; for (j=0;j(pos+JY*JZ+currncat-1)))&&((k<(pos+JY*JZ))||(k>(pos+JY*JZ+currncat-1)))) { help4[countm]=REAL(covu)[kk+k*Ju]; countm++; } else if (((kk<(pos+JY*JZ))||(kk>(pos+JY*JZ+currncat-1)))&&((k>(pos+JY*JZ-1))||(k<(pos+JY*JZ+currncat)))) { help5[counto]=REAL(covu)[kk+k*Ju]; counto++; } } } countm=0; counto=0; r8mat_pofac((Ju-currncat),help4, help6,1); r8mat_poinv((Ju-currncat),help6, invomega4); for (jj=1;jj<(Ju-currncat);jj++) for (tt=0;tt0)) { for (k=0;k0) { for (t=0;t0) { if (ISNAN(REAL(Yimp)[j+k*IY])) { betamiss[0]=betaX[k]; omegamm[0]=REAL(omega)[k+k*Io]; for (t=0;t=ncon)&(k0) { h=0; for (jj=0;jj2) { for (kk=1;kk<(INTEGER(Y_numcat)[jj]-1);kk++) { if (yi[(ncon+h+kk)]>maxx) { maxx=yi[(ncon+h+kk)]; nmaxx=kk; } } } if (maxx>0) yicategorized[jj]=nmaxx; else yicategorized[jj]=INTEGER(Y_numcat)[jj]-1; h=h+INTEGER(Y_numcat)[jj]-1; } } if (ncatnoaux2>0) { h=0; for (jj=0;jj2) { for (kk=1;kk<(INTEGER(Y2_numcat)[jj]-1);kk++) { if (imp2[INTEGER(clus)[j]+Iu*(ncon2+h+kk)]>maxx) { maxx=imp2[INTEGER(clus)[j]+Iu*(ncon2+h+kk)]; nmaxx=kk; } } } if (maxx>0) yi2categorized[jj]=nmaxx; else yi2categorized[jj]=INTEGER(Y2_numcat)[jj]-1; h=h+INTEGER(Y2_numcat)[jj]-1; } } //Update Xsubprop h=0; indic=0; for (t=0;t0) { for (t=0;t0) { if (ISNAN(Y2impred[j+(k-JY*JZ)*Iu])) { betamiss[0]=betaX[k-JY*JZ]; omegamm[0]=REAL(covu)[k+k*Ju]; for (t=0;t=ncon2)&((k-JY*JZ)0) { h=0; for (jj=0;jj2) { for (kk=1;kk<(INTEGER(Y2_numcat)[jj]-1);kk++) { if (yi[(ncon2+h+kk)]>maxx) { maxx=yi[(ncon2+h+kk)]; nmaxx=kk; } } } if (maxx>0) yi2categorized[jj]=nmaxx; else yi2categorized[jj]=INTEGER(Y2_numcat)[jj]-1; h=h+INTEGER(Y2_numcat)[jj]-1; } } //Update Xsubprop h=0; indic=0; for (t=0;t0) { h=0; for (jj=0;jj2) { for (kk=1;kk<(INTEGER(Y_numcat)[jj]-1);kk++) { if (imp[c+IY*(ncon+h+kk)]>maxx) { maxx=imp[c+IY*(ncon+h+kk)]; nmaxx=kk; } } } if (maxx>0) yicategorized[jj]=nmaxx; else yicategorized[jj]=INTEGER(Y_numcat)[jj]-1; h=h+INTEGER(Y_numcat)[jj]-1; } } h=0; if (INTEGER(clus)[c]==j) { for (jj=0;jj0)||(REAL(Ysub)[t]==1&&yi[0]<0)) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } } else if (INTEGER(submodtype)[0]==2) { // Rejection sampling for latent normal outcome for (t=0;tREAL(betaY)[Il+nsubcat-2]))||((Ysubcatint[t]>1)&&(Ysubcatint[t]REAL(betaY)[Il+Ysubcatint[t]-2]))) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } // Update thresholds latent normal for (t=0;t<(nsubcat-1);t++) { mu2[0]=-10; for (j=0;jmu2[0])) mu2[0]=impsub[j]; } mu2[1]=10; for (j=0;jREAL(betaY)[Il+t])&&(impsub[j]0)+1; } else if (INTEGER(submodtype)[0]==2) { if (impsub[t]>REAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } if ((i+1)%fl==0) Rprintf("."); if ((i+1)%(fl*50)==0) Rprintf("\n"); } if (fl==1) Rprintf("\n"); if (((double)accratio/((double)totprop))<0.2) Rprintf("Warning: acceptance ratio for level 1 variables imputation = %f. This might be a sign that the chain did not mix well. \n" , ((double)accratio/((double)totprop))); if (((double)accratio2/((double)totprop2))<0.2) Rprintf("Warning: acceptance ratio for level 2 variables imputation = %f. This might be a sign that the chain did not mix well. \n" , ((double)accratio2/((double)totprop2))); for(i=0;i0) { h=0; for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (ncat2>0) { for (i=0;imaxx) { maxx=imp2[i+(ncon2+h+k)*Iu]; nmaxx=k; } } if (maxx>0) { for (jj=0;jj0) { for (j=0;j #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo2comC(SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP Y2, SEXP Y2imp, SEXP Y2imp2, SEXP Y2impcat, SEXP X, SEXP X2, SEXP Z, SEXP clus, SEXP beta, SEXP beta2, SEXP u, SEXP betapost, SEXP beta2post, SEXP upost, SEXP omega, SEXP omegapost, SEXP covu, SEXP covupost, SEXP nstep, SEXP Sp, SEXP Sup, SEXP Y_numcat, SEXP Y2_numcat, SEXP num_con, SEXP num_con2, SEXP flagrng, SEXP MCMCchain, SEXP mpid, SEXP npatterns, SEXP mpid2){ int indic=0,i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0, countmm=0, countmo=0,countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h; int Iu, Ju, IZ, JZ, nj,c,fl, currncat, IY2, JY2, IX2,JX2,Ib2, Jb2, ncon2, ncat2, JYm, JXm, MCMC, np, np2, *mpid2red; SEXP RdimY, RdimX, Rdimo, Rdimb, RdimZ, Rdimu, RdimY2, RdimX2, Rdimb2; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegamo, *omegamm, *invomega, *invomega2, *help, *help2, *help3, *imp,*imp2, *zi; double *sumzy, *incrzz, *incrzy, *mu, *mu2, *newbeta, *newomega, *sumzi, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,meanom,sdom, *resid, logLH, newlogLH,detom; double maxx,maxim,maxim2, minim,*sumxy, *sumxi, *uj, *xi, *ziu, *incrxx, *incrxy, *newu, *mu3, *mu4, *help7, *help8, *help9, *invomega4, *newomega2,*missing2, *Y2red, *X2red; double *covu1, *covu2, *covu12, *fixomega2, *Y2impred, *listh8, *listomega; /* Protecting R objects from garbage collection and saving matrices dimensions*/ RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; RdimY2=PROTECT(getAttrib(Y2imp,R_DimSymbol)); IY2=INTEGER(RdimY2)[0]; JY2=INTEGER(RdimY2)[1]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1]; RdimX2=PROTECT(getAttrib(X2,R_DimSymbol)); IX2=INTEGER(RdimX2)[0]; JX2=INTEGER(RdimX2)[1]; RdimZ=PROTECT(getAttrib(Z,R_DimSymbol)); IZ=INTEGER(RdimZ)[0]; JZ=INTEGER(RdimZ)[1]; Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimb2=PROTECT(getAttrib(beta2,R_DimSymbol)); Ib2=INTEGER(Rdimb2)[0]; Jb2=INTEGER(Rdimb2)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Rdimu=PROTECT(getAttrib(u,R_DimSymbol)); Iu=INTEGER(Rdimu)[0]; Ju=INTEGER(Rdimu)[1]; Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); Y2=PROTECT(coerceVector(Y2,REALSXP)); Y2impcat=PROTECT(coerceVector(Y2impcat,REALSXP)); Y2_numcat=PROTECT(coerceVector(Y2_numcat,INTSXP)); Y2imp=PROTECT(coerceVector(Y2imp,REALSXP)); Y2imp2=PROTECT(coerceVector(Y2imp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); X2=PROTECT(coerceVector(X2,REALSXP)); Z=PROTECT(coerceVector(Z,REALSXP)); clus=PROTECT(coerceVector(clus,INTSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); beta2=PROTECT(coerceVector(beta2,REALSXP)); u=PROTECT(coerceVector(u,REALSXP)); upost=PROTECT(coerceVector(upost,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); beta2post=PROTECT(coerceVector(beta2post,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); covu=PROTECT(coerceVector(covu,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); covupost=PROTECT(coerceVector(covupost,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); Sup=PROTECT(coerceVector(Sup,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; num_con2=PROTECT(coerceVector(num_con2,INTSXP)); ncon2=INTEGER(num_con2)[0]; flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); if (REAL(Y2impcat)[0]==(-999)) ncat2=0; else ncat2=length(Y2_numcat); nj=Iu; JXm=JX; if (JX2>JX) JXm=JX2; JYm=JY; if (JY2>JY) JYm=JY2; if (Ju>JYm) JYm=Ju; mpid=PROTECT(coerceVector(mpid,INTSXP)); npatterns=PROTECT(coerceVector(npatterns,INTSXP)); np=INTEGER(npatterns)[0]; mpid2=PROTECT(coerceVector(mpid2,INTSXP)); np2=INTEGER(npatterns)[1]; /*Allocating memory for C objects in R*/ help = ( double * ) R_alloc ( (Ju*Ju) , sizeof ( double ) ); invomega= (double * ) R_alloc ( (JYm*JYm) , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); fixomega2 = ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); sumzi = ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); sumzy = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); sumxi = ( double * ) R_alloc ( JYm * JXm * JYm * JXm , sizeof ( double ) ); sumxy = ( double * ) R_alloc ( JYm * JXm , sizeof ( double ) ); zi = ( double * ) R_alloc ( JY * JZ * JY , sizeof ( double ) ); xi = ( double * ) R_alloc ( JYm * JXm * JYm , sizeof ( double ) ); yi = ( double * ) R_alloc ( JYm , sizeof ( double ) ); uj = ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); newu = ( double * ) R_alloc ( JY * JZ , sizeof ( double ) ); ziu = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JYm *JXm * Ju , sizeof ( double ) ); incrzz = ( double * ) R_alloc ( Ju * Ju, sizeof ( double ) ); incrzy = ( double * ) R_alloc ( JY *JZ , sizeof ( double ) ); incrxx = ( double * ) R_alloc ( JYm *JXm * JYm *JXm , sizeof ( double ) ); incrxy = ( double * ) R_alloc ( JYm *JXm , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JYm * JXm * JYm * JXm ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( Ju * JXm * Ju * JXm, sizeof ( double ) ); mu = ( double * ) R_alloc ( Ju * JXm, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JYm*JXm ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JZ, sizeof ( double ) ); mu3 = ( double * ) R_alloc ( Ju * Ju ,sizeof ( double ) ); mu4 = ( double * ) R_alloc ( JYm * JYm,sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); newomega2 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); betaX=( double * ) R_alloc ( JYm, sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); imp2=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); Y2impred=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); Y2red=( double * ) R_alloc ( Iu * JY2,sizeof ( double ) ); X2red=( double * ) R_alloc ( Iu * JX2,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( Ju, sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JYm, sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JYm, sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JYm*JYm ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JYm ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( Ju, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( Ju*JYm , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JYm*JYm , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( Ju * Ju , sizeof ( double ) ); invomega4 = ( double * ) R_alloc ( Ju *Ju , sizeof ( double ) ); help4 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help5 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help6 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help7 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help8 = ( double * ) R_alloc ( JYm *Ju , sizeof ( double ) ); help9 = ( double * ) R_alloc ( JYm *JYm , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); missing2 = ( double * ) R_alloc ( Iu , sizeof ( double ) ); covu1= (double * ) R_alloc ( JY * JZ * JY * JZ , sizeof ( double ) ); covu2= (double * ) R_alloc ( JY2 * JY2, sizeof ( double ) ); covu12= (double * ) R_alloc ( JY * JZ * JY2 , sizeof ( double ) ); if (np20) { for (i=0;i0) { for (i=0;i0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt-3)&(maxim<4)) { if (maxim<0) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } else { while ((flag==0)&(kk<10000)) { r8vec_multinormal_sample((INTEGER(Y_numcat)[j]-1), mumiss,omegamm, newbeta,mu4,0); maxim=maxvec((INTEGER(Y_numcat)[j]-1),newbeta); minim=minvec((INTEGER(Y_numcat)[j]-1),newbeta); if ((minim>-3)&(maxim<4)) { maxim2=argmaxvec((INTEGER(Y_numcat)[j]-1),newbeta); if (((maxim2+1)==REAL(Y)[t+(ncon+j)*IY])&(maxim>0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } flag=0; } } pos=pos+INTEGER(Y_numcat)[j]-1; } } // Rejection sampling for level 2 variables if (ncat2>0) { pos=ncon2; for (j=0;j(pos+JY*JZ+currncat-1)))&&((k<(pos+JY*JZ))||(k>(pos+JY*JZ+currncat-1)))) { help4[countm]=REAL(covu)[kk+k*Ju]; countm++; } else if (((kk<(pos+JY*JZ))||(kk>(pos+JY*JZ+currncat-1)))&&((k>(pos+JY*JZ-1))||(k<(pos+JY*JZ+currncat)))) { help5[counto]=REAL(covu)[kk+k*Ju]; counto++; } } } countm=0; counto=0; r8mat_pofac((Ju-currncat),help4, help6,1); r8mat_poinv((Ju-currncat),help6, invomega4); for (jj=1;jj<(Ju-currncat);jj++) for (tt=0;tt-3)&(maxim<4)) { if (maxim<0) { for (k=0;k-3)&(maxim<4)) { maxim2=argmaxvec((INTEGER(Y2_numcat)[j]-1),newbeta); if (((maxim2+1)==Y2red[t+(ncon2+j)*Iu])&(maxim>0)) { for (k=0;k0) { for (k=0;k0) { for (k=0;k0) { for (k=0;k(JY*JZ-1))&&(!ISNAN(Y2impred[j+(k-JY*JZ)*Iu])))) { omegaoo[countoo]=REAL(covu)[k+t*Ju]; countoo++; } } else { if (((k(JY*JZ-1))&&(!ISNAN(Y2impred[j+(k-JY*JZ)*Iu]))&&(!ISNAN(Y2impred[j+(t-JY*JZ)*Iu])))) { omegaoo[countoo]=REAL(covu)[k+t*Ju]; countoo++; } if (((k(JY*JZ-1))&&(!ISNAN(Y2impred[j+(k-JY*JZ)*Iu]))&&(ISNAN(Y2impred[j+(t-JY*JZ)*Iu])))) { omegamo[countmo]=REAL(covu)[k+t*Ju]; countmo++; } if ((k>(JY*JZ-1))&&(ISNAN(Y2impred[j+(k-JY*JZ)*Iu]))&&(ISNAN(Y2impred[j+(t-JY*JZ)*Iu]))) { omegamm[countmm]=REAL(covu)[k+t*Ju]; countmm++; } } } } countmm=0; countmo=0; countoo=0; r8mat_pofac((Ju-nmiss),omegaoo,help7,14); r8mat_poinv((Ju-nmiss),help7,invomega4); for (jj=1;jj0) { for (k=0;k0) { h=0; for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (ncat2>0) { for (i=0;imaxx) { maxx=imp2[i+(ncon2+h+k)*Iu]; nmaxx=k; } } if (maxx>0) { for (jj=0;jj #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo1ranhrsmcC(SEXP Ysub, SEXP Ysubimp, SEXP Ysubcat, SEXP submod, SEXP ordersub, SEXP submodran, SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP X, SEXP Z, SEXP clus, SEXP betaY, SEXP betaYpost, SEXP beta, SEXP u, SEXP uY, SEXP betapost, SEXP upost, SEXP uYpost, SEXP varY, SEXP varYpost, SEXP omega, SEXP omegapost, SEXP covuY, SEXP covuYpost, SEXP covu, SEXP covupost, SEXP nstep, SEXP varYprior, SEXP covuYprior, SEXP Sp, SEXP Sup, SEXP Y_numcat, SEXP Ysub_numcat, SEXP num_con, SEXP a_start, SEXP a_prior, SEXP flagrng, SEXP MCMCchain, SEXP submodtype){ int indic=0,i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0, countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h=0, *Ysubcatint; int Iu, Ju, IZ, JZ, nj,c,fl, currncat, Is, Il=0, JXm, Ir=0,Jr, JZm, Jum, accratio=0, totprop=0, nconnoaux, nconcat, ncatnoaux, MCMC, nsubcat; SEXP RdimY, RdimX, Rdimo, Rdimb, RdimZ, Rdimu, Rdims, Rdimr; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegamo, *omegamm, *invomega, *invomega2, *help, *help2, *help3, *imp, *zi, *yicategorized, *impsub; double *sumzy, *incrzz, *incrzy, *mu, *mu2, *newbeta, *newomega, *sumzi, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,meanom,sdom, *resid, logLH, newlogLH,detom, *residsub; double maxx,maxim,maxim2, *sumxy, *sumxi, *uj, *xi, *ziu, *incrxx, *incrxy, *newu, *mu3, *mu4, *help7, *newomega2, *Xsub, *Zsub, *Xsubprop, *Zsubprop, *allinvomega; double gamma,eta,dx,u_new,precision, *invgamma, *invA, *Gammastar,u_m,con2,deriv2,u_prop, lambda, aj, a, *cumclus, *clusnum; /* Protecting R objects from garbage collection and saving matrices dimensions*/ RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; Rdims=PROTECT(getAttrib(submod,R_DimSymbol)); Is=INTEGER(Rdims)[0]; Rdimr=PROTECT(getAttrib(submodran,R_DimSymbol)); Jr=INTEGER(Rdimr)[1]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1]; RdimZ=PROTECT(getAttrib(Z,R_DimSymbol)); IZ=INTEGER(RdimZ)[0]; JZ=INTEGER(RdimZ)[1]; Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Rdimu=PROTECT(getAttrib(u,R_DimSymbol)); Iu=INTEGER(Rdimu)[0]; Ju=INTEGER(Rdimu)[1]; Ysub=PROTECT(coerceVector(Ysub,REALSXP)); submod=PROTECT(coerceVector(submod,INTSXP)); ordersub=PROTECT(coerceVector(ordersub,INTSXP)); submodran=PROTECT(coerceVector(submodran,INTSXP)); Ysubimp=PROTECT(coerceVector(Ysubimp,REALSXP)); Ysubcat=PROTECT(coerceVector(Ysubcat,REALSXP)); Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Ysub_numcat=PROTECT(coerceVector(Ysub_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); Z=PROTECT(coerceVector(Z,REALSXP)); clus=PROTECT(coerceVector(clus,INTSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); betaY=PROTECT(coerceVector(betaY,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); betaYpost=PROTECT(coerceVector(betaYpost,REALSXP)); varY=PROTECT(coerceVector(varY,REALSXP)); varYpost=PROTECT(coerceVector(varYpost,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); varYprior=PROTECT(coerceVector(varYprior,REALSXP)); u=PROTECT(coerceVector(u,REALSXP)); uY=PROTECT(coerceVector(uY,REALSXP)); upost=PROTECT(coerceVector(upost,REALSXP)); uYpost=PROTECT(coerceVector(uYpost,REALSXP)); covuY=PROTECT(coerceVector(covuY,REALSXP)); covu=PROTECT(coerceVector(covu,REALSXP)); covuYpost=PROTECT(coerceVector(covuYpost,REALSXP)); covupost=PROTECT(coerceVector(covupost,REALSXP)); covuYprior=PROTECT(coerceVector(covuYprior,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); Sup=PROTECT(coerceVector(Sup,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; nconnoaux=INTEGER(num_con)[1]; nconcat=INTEGER(num_con)[2]; ncatnoaux=INTEGER(num_con)[3]; nsubcat=INTEGER(Ysub_numcat)[0]; flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); a_start=PROTECT(coerceVector(a_start,REALSXP)); a=REAL(a_start)[0]; a_prior=PROTECT(coerceVector(a_prior,REALSXP)); nj=Iu; submodtype=PROTECT(coerceVector(submodtype,INTSXP)); for (i=0;iJY) JXm=Il; if (JX>JXm) JXm=JX; for (i=0;iJY) JZm=Ir; if (JZ>JZm) JZm=JZ; Jum=Ju; if (Ir>Jum) Jum=Ir; /*Allocating memory for C objects in R*/ help = ( double * ) R_alloc ( (Ju*Ju) , sizeof ( double ) ); invomega= (double * ) R_alloc ( (JY*JY) , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); sumzi = ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); sumzy = ( double * ) R_alloc ( JY * JZm , sizeof ( double ) ); sumxi = ( double * ) R_alloc ( JY * JXm * JY * JXm , sizeof ( double ) ); sumxy = ( double * ) R_alloc ( JY * JXm , sizeof ( double ) ); zi = ( double * ) R_alloc ( JY * JZm * JY , sizeof ( double ) ); xi = ( double * ) R_alloc ( JY * JXm * JY , sizeof ( double ) ); yi = ( double * ) R_alloc ( JY , sizeof ( double ) ); uj = ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); newu = ( double * ) R_alloc ( JY * JZm , sizeof ( double ) ); ziu = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JY *JX * Ju , sizeof ( double ) ); incrzz = ( double * ) R_alloc ( Jum * Jum, sizeof ( double ) ); incrzy = ( double * ) R_alloc ( JY *JZm , sizeof ( double ) ); incrxx = ( double * ) R_alloc ( JY *JXm * JY *JXm , sizeof ( double ) ); incrxy = ( double * ) R_alloc ( JY *JXm , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JY * JXm * JY * JXm ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( Jum * JXm * Jum * JXm, sizeof ( double ) ); mu = ( double * ) R_alloc ( Ju * JXm, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JY*JXm ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JZm, sizeof ( double ) ); mu3 = ( double * ) R_alloc ( Jum * Jum ,sizeof ( double ) ); mu4 = ( double * ) R_alloc ( JY * JY,sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); newomega2 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); betaX=( double * ) R_alloc ( JY, sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); impsub=( double * ) R_alloc ( IY ,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); residsub=( double * ) R_alloc ( IY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( Ju, sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JY, sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JY, sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JY*JY ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JY ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( Ju, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( Ju*JY , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( Jum * Jum , sizeof ( double ) ); help4 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); help5 = ( double * ) R_alloc ( Jum*Jum , sizeof ( double ) ); help6 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); help7 = ( double * ) R_alloc ( Ju*Ju , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); Xsub = ( double * ) R_alloc ( IY* Il , sizeof ( double ) ); Xsubprop = ( double * ) R_alloc ( Il , sizeof ( double ) ); Zsub = ( double * ) R_alloc ( IY* Ir , sizeof ( double ) ); Zsubprop = ( double * ) R_alloc ( Ir , sizeof ( double ) ); yicategorized=( double * ) R_alloc ( JY,sizeof ( double ) ); allinvomega= (double * ) R_alloc ( (nj*JY*JY) , sizeof ( double ) ); invgamma= (double * ) R_alloc ( JY * JY , sizeof(double) ); invA= (double * ) R_alloc ( JY * JY , sizeof(double) ); Gammastar= (double * ) R_alloc ( JY * JY , sizeof(double) ); clusnum = ( double * ) R_alloc ( nj , sizeof(double)); cumclus = ( double * ) R_alloc ( nj+1 , sizeof(double)); Ysubcatint = ( int * ) R_alloc ( IY , sizeof ( int ) ); /* Some initializations */ for (j=0; j0) Ysubcatint[j]=REAL(Ysubcat)[j]; for (k=0;k0) { for (i=0;iREAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } gamma=JY+1; //a=JY+1; eta=REAL(a_prior)[0]; dx=0.001; u_new=log(a+JY); precision=0.001; r8mat_pofac(JY,REAL(Sp),help,1); r8mat_poinv(JY, help, invgamma); for (jj=1;jj0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*c+JY*nj*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*c+JY*nj*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } kk++; } } flag=0; } } } } pos=pos+INTEGER(Y_numcat)[j]-1; } } //Updating beta for (j=0;j0) { for (t=0;t0) { if (ISNAN(REAL(Yimp)[j+k*IY])) { betamiss[0]=betaX[k]; omegamm[0]=REAL(omega)[INTEGER(clus)[j]*JY+k+k*Io]; for (t=0;t=ncon)&(k0) { h=0; for (jj=0;jj2) { for (kk=1;kk<(INTEGER(Y_numcat)[jj]-1);kk++) { if (yi[(ncon+h+kk)]>maxx) { maxx=yi[(ncon+h+kk)]; nmaxx=kk; } } } if (maxx>0) yicategorized[jj]=nmaxx; else yicategorized[jj]=INTEGER(Y_numcat)[jj]-1; h=h+INTEGER(Y_numcat)[jj]-1; } } //Update Xsubprop h=0; indic=0; for (t=0;t0)||(REAL(Ysub)[t]==1&&yi[0]<0)) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } } else if (INTEGER(submodtype)[0]==2) { // Rejection sampling for latent normal outcome for (t=0;tREAL(betaY)[Il+nsubcat-2]))||((Ysubcatint[t]>1)&&(Ysubcatint[t]REAL(betaY)[Il+Ysubcatint[t]-2]))) { impsub[t]=yi[0]; flag=1; } else { kk++; } } } } // Update thresholds latent normal for (t=0;t<(nsubcat-1);t++) { mu2[0]=-10; for (j=0;jmu2[0])) mu2[0]=impsub[j]; } mu2[1]=10; for (j=0;jREAL(betaY)[Il+t])&&(impsub[j]0)+1; } else if (INTEGER(submodtype)[0]==2) { if (impsub[t]>REAL(betaY)[Il+nsubcat-2]) { Ysubcatint[t]=nsubcat; } else { flag=0; k=0; while (flag==0) { if (impsub[t]<=REAL(betaY)[Il+k]) { Ysubcatint[t]=k+1; flag=1; } else { k++; } } } } } } if ((i+1)%fl==0) Rprintf("."); if ((i+1)%(fl*50)==0) Rprintf("\n"); } if (fl==1) Rprintf("\n"); if (((double)accratio/((double)totprop))<0.3) Rprintf("Warning: acceptance ratio = %f. This might be a sign that the chain did not mix well. \n" , ((double)accratio/((double)totprop))); for(i=0;i0) { h=0; for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (INTEGER(submodtype)[0]>0) { for (j=0;j # include # include # include # include # include # include "pdflib.h" double normal_cdf(double value) { return 0.5 * erfc(-value * M_SQRT1_2); } int checkposdef(int dim, double matr[], double matrh[],double matrh2[]) { int hg,hj,hi,flag=1; double detma; if (matr[0]<=0) flag=0; for (hg=2;hg<(dim+1);hg++) { for (hj=0;hjmaxv) { maxv=vec[gf]; argmaxx=gf; } } return argmaxx; } double maxvec (int card, double vec[]) { int gf; double maxv; maxv=vec[0]; for (gf=1; gfmaxv) maxv=vec[gf]; } return maxv; } double minvec (int card, double vec[]) { int gf; double minv; minv=vec[0]; for (gf=1; gf 12 is from reference 3, while approximations for X < 12.0 are similar to those in reference 1, but are unpublished. Licensing: This code is distributed under the GNU LGPL license. Modified: 19 April 2013 Author: Original FORTRAN77 version by William Cody, Laura Stoltz. C version by John Burkardt. Reference: William Cody, Kenneth Hillstrom, Chebyshev Approximations for the Natural Logarithm of the Gamma Function, Mathematics of Computation, Volume 21, Number 98, April 1967, pages 198-203. Kenneth Hillstrom, ANL/AMD Program ANLC366S, DGAMMA/DLGAMA, May 1969. John Hart, Ward Cheney, Charles Lawson, Hans Maehly, Charles Mesztenyi, John Rice, Henry Thatcher, Christoph Witzgall, Computer Approximations, Wiley, 1968, LC: QA297.C64. Parameters: Input, double X, the argument of the function. Output, double R8_GAMMA_LOG, the value of the function. */ { double c[7] = { -1.910444077728E-03, 8.4171387781295E-04, -5.952379913043012E-04, 7.93650793500350248E-04, -2.777777777777681622553E-03, 8.333333333333333331554247E-02, 5.7083835261E-03 }; double corr; const double d1 = -5.772156649015328605195174E-01; const double d2 = 4.227843350984671393993777E-01; const double d4 = 1.791759469228055000094023; const double frtbig = 2.25E+76; int i5; double p1[8] = { 4.945235359296727046734888, 2.018112620856775083915565E+02, 2.290838373831346393026739E+03, 1.131967205903380828685045E+04, 2.855724635671635335736389E+04, 3.848496228443793359990269E+04, 2.637748787624195437963534E+04, 7.225813979700288197698961E+03 }; double p2[8] = { 4.974607845568932035012064, 5.424138599891070494101986E+02, 1.550693864978364947665077E+04, 1.847932904445632425417223E+05, 1.088204769468828767498470E+06, 3.338152967987029735917223E+06, 5.106661678927352456275255E+06, 3.074109054850539556250927E+06 }; double p4[8] = { 1.474502166059939948905062E+04, 2.426813369486704502836312E+06, 1.214755574045093227939592E+08, 2.663432449630976949898078E+09, 2.940378956634553899906876E+10, 1.702665737765398868392998E+11, 4.926125793377430887588120E+11, 5.606251856223951465078242E+11 }; double q1[8] = { 6.748212550303777196073036E+01, 1.113332393857199323513008E+03, 7.738757056935398733233834E+03, 2.763987074403340708898585E+04, 5.499310206226157329794414E+04, 6.161122180066002127833352E+04, 3.635127591501940507276287E+04, 8.785536302431013170870835E+03 }; double q2[8] = { 1.830328399370592604055942E+02, 7.765049321445005871323047E+03, 1.331903827966074194402448E+05, 1.136705821321969608938755E+06, 5.267964117437946917577538E+06, 1.346701454311101692290052E+07, 1.782736530353274213975932E+07, 9.533095591844353613395747E+06 }; double q4[8] = { 2.690530175870899333379843E+03, 6.393885654300092398984238E+05, 4.135599930241388052042842E+07, 1.120872109616147941376570E+09, 1.488613728678813811542398E+10, 1.016803586272438228077304E+11, 3.417476345507377132798597E+11, 4.463158187419713286462081E+11 }; double res; const double sqrtpi = 0.9189385332046727417803297; const double xbig = 2.55E+305; double xden; const double xinf = 1.79E+308; double xm1; double xm2; double xm4; double xnum; double y; double ysq; y = x; if ( 0.0 < y && y <= xbig ) { if ( y <= r8_epsilon ( ) ) { res = - log ( y ); } /* EPS < X <= 1.5. */ else if ( y <= 1.5 ) { if ( y < 0.6796875 ) { corr = -log ( y ); xm1 = y; } else { corr = 0.0; xm1 = ( y - 0.5 ) - 0.5; } if ( y <= 0.5 || 0.6796875 <= y ) { xden = 1.0; xnum = 0.0; for ( i5 = 0; i5 < 8; i5++ ) { xnum = xnum * xm1 + p1[i5]; xden = xden * xm1 + q1[i5]; } res = corr + ( xm1 * ( d1 + xm1 * ( xnum / xden ) ) ); } else { xm2 = ( y - 0.5 ) - 0.5; xden = 1.0; xnum = 0.0; for ( i5 = 0; i5 < 8; i5++ ) { xnum = xnum * xm2 + p2[i5]; xden = xden * xm2 + q2[i5]; } res = corr + xm2 * ( d2 + xm2 * ( xnum / xden ) ); } } /* 1.5 < X <= 4.0. */ else if ( y <= 4.0 ) { xm2 = y - 2.0; xden = 1.0; xnum = 0.0; for ( i5 = 0; i5 < 8; i5++ ) { xnum = xnum * xm2 + p2[i5]; xden = xden * xm2 + q2[i5]; } res = xm2 * ( d2 + xm2 * ( xnum / xden ) ); } /* 4.0 < X <= 12.0. */ else if ( y <= 12.0 ) { xm4 = y - 4.0; xden = -1.0; xnum = 0.0; for ( i5 = 0; i5 < 8; i5++ ) { xnum = xnum * xm4 + p4[i5]; xden = xden * xm4 + q4[i5]; } res = d4 + xm4 * ( xnum / xden ); } /* Evaluate for 12 <= argument. */ else { res = 0.0; if ( y <= frtbig ) { res = c[6]; ysq = y * y; for ( i5 = 0; i5 < 6; i5++ ) { res = res / ysq + c[i5]; } } res = res / y; corr = log ( y ); res = res + sqrtpi - 0.5 * corr; res = res + y * ( corr - 1.0 ); } } /* Return for bad arguments. */ else { res = xinf; } /* Final adjustments and return. */ return res; } /******************************************************************************/ double log_mul_gamma ( int p, double a ) /******************************************************************************/ { int j2; double g=0; for ( j2 = 1; j2 < (p+1); j2++ ) { g = g+(lgamma(a + (1-(double)j2)/2)); } return g; } /******************************************************************************/ double r8_chi_pdf ( double df, double rval) /******************************************************************************/ /* Purpose: R8_CHI_PDF evaluates the PDF of a chi-squared distribution. Licensing: This code is distributed under the GNU LGPL license. Modified: 21 April 2013 Author: Original FORTRAN90 version by Guannan Zhang. C by John Burkardt. Parameters: Input, double DF, the degrees of freedom. 0.0 < DF. Input, double RVAL, the point where the PDF is evaluated. Output, double R8_CHI_PDF, the value of the PDF at RVAL. */ { double temp1; double temp2; double value; if ( df <= 0.0 ) { Rprintf ( "\n" ); Rprintf ( "R8_CHI_PDF - Fatal error!\n" ); Rprintf ( " Degrees of freedom must be positive.\nAssuming DF=0.1 instead\n" ); df=0.1; } if ( rval <= 0.0 ) { value = 0.0; } else { temp2 = df * 0.5; temp1 = ( temp2 - 1.0 ) * log ( rval ) - 0.5 * rval - temp2 * log ( 2.0 ) - r8_gamma_log ( temp2 ); value = exp ( temp1 ); } return value; } /******************************************************************************/ double wishart_dens ( double df, int dim, double X[], double invA[], double help[], double help2[]) /******************************************************************************/ { double d1,d2,res; r8mat_pofac(dim,X,help,18); d1=r8mat_podet ( dim, help ) ; r8mat_pofac(dim,invA,help,19); d2=r8mat_podet ( dim, help ) ; res=(-df*dim/2)*log(2)-(df/2)*log(1/d2)-log_mul_gamma(dim,df/2)+((df-dim-1)/2)*log(d1); return res; } /******************************************************************************/ double log_f_u ( double eta, double u, int dim, int nclus, double allinvomega[], double omega[], double invgamma[], double help[], double help2[]) /******************************************************************************/ { double d1,d2,res=0,gamma,a; int i7; int j4; int t1; a=exp(u)-dim; gamma=dim+1; r8mat_pofac(dim,help,help2,18); d1=r8mat_podet ( dim, help2 ); res=log(r8_chi_pdf(eta, a)); //Rprintf("eta=%f a=%f res=%f\n",eta,a,res); res=res-nclus*log_mul_gamma(dim,a/2); //Rprintf("res2=%f mulg=%f\n",res,log_mul_gamma(dim,a/2)); for (i7=0;i7 # include # include # include # include # include # include "wishart.h" # include "pdflib.h" void r8mat_add ( int m, int n, double a[], double b[] ) /******************************************************************************/ /* Purpose: R8MAT_ADD adds one R8MAT to another. Discussion: An R8MAT is a doubly dimensioned array of R8 values, stored as a vector in column-major order. Licensing: This code is distributed under the GNU LGPL license. Modified: 31 July 2013 Author: John Burkardt Parameters: Input, int M, N, the number of rows and columns. Input, double A[M*N], the matrix to add. Input/output, double B[M*N], the matrix to be incremented. */ { int i; int j; for ( j = 0; j < n; j++ ) { for ( i = 0; i < m; i++ ) { b[i+j*m] = b[i+j*m] + a[i+j*m]; } } return; } /******************************************************************************/ void r8mat_cholesky_factor_upper ( int n, double a[], double c[], int *flag ) /******************************************************************************/ /* Purpose: R8MAT_CHOLESKY_FACTOR_UPPER: upper Cholesky factor of a symmetric R8MAT. Discussion: An R8MAT is a doubly dimensioned array of R8 values, stored as a vector in column-major order. The matrix must be symmetric and positive semidefinite. For a positive semidefinite symmetric matrix A, the Cholesky factorization is an upper triangular matrix R such that: A = R' * R Note that the usual Cholesky factor is a LOWER triangular matrix L such that A = L * L' Licensing: This code is distributed under the GNU LGPL license. Modified: 03 August 2013 Author: John Burkardt Parameters: Input, int N, the number of rows and columns of the matrix A. Input, double A[N*N], the N by N matrix. Output, int *FLAG, an error flag. 0, no error was detected. 1, the matrix was not positive definite. A NULL factor was returned. Output, double R8MAT_CHOLESKY_FACTOR_UPPER[N*N], the N by N upper triangular "Choresky" factor. */ { int i; int j; int k; double sum2; *flag = 0; r8mat_copy_new ( n, n, a, c ); for ( j = 0; j < n; j++ ) { for ( i = 0; i < j; i++ ) { c[j+i*n] = 0.0; } for ( i = j; i < n; i++ ) { sum2 = c[i+j*n]; for ( k = 0; k < j; k++ ) { sum2 = sum2 - c[k+j*n] * c[k+i*n]; } if ( i == j ) { if ( sum2 <= 0.0 ) { *flag = 1; return; } c[j+i*n] = sqrt ( sum2 ); } else { if ( c[j+j*n] != 0.0 ) { c[j+i*n] = sum2 / c[j+j*n]; } else { c[j+i*n] = 0.0; } } } } return; } /******************************************************************************/ void r8mat_copy_new ( int m, int n, double a1[], double a2[] ) /******************************************************************************/ /* Purpose: R8MAT_COPY_NEW copies one R8MAT to a "new" R8MAT. Discussion: An R8MAT is a doubly dimensioned array of R8 values, stored as a vector in column-major order. Licensing: This code is distributed under the GNU LGPL license. Modified: 26 July 2008 Author: John Burkardt Parameters: Input, int M, N, the number of rows and columns. Input, double A1[M*N], the matrix to be copied. Output, double R8MAT_COPY_NEW[M*N], the copy of A1. */ { int i; int j; for ( j = 0; j < n; j++ ) { for ( i = 0; i < m; i++ ) { a2[i+j*m] = a1[i+j*m]; } } return; } /******************************************************************************/ void r8mat_divide ( int m, int n, double s, double a[] ) /******************************************************************************/ /* Purpose: R8MAT_DIVIDE divides an R8MAT by a scalar. Discussion: An R8MAT is a doubly dimensioned array of R8 values, stored as a vector in column-major order. Licensing: This code is distributed under the GNU LGPL license. Modified: 31 July 2013 Author: John Burkardt Parameters: Input, int M, N, the number of rows and columns. Input, double S, the divisor Input/output, double A[M*N], the matrix to be scaled. */ { int i; int j; for ( j = 0; j < n; j++ ) { for ( i = 0; i < m; i++ ) { a[i+j*m] = a[i+j*m] / s; } } return; } /******************************************************************************/ void r8mat_mm_new ( int n1, int n2, int n3, double a[], double b[], double c[] ) /******************************************************************************/ /* Purpose: R8MAT_MM_NEW multiplies two matrices. Discussion: An R8MAT is a doubly dimensioned array of R8 values, stored as a vector in column-major order. For this routine, the result is returned as the function value. Licensing: This code is distributed under the GNU LGPL license. Modified: 08 April 2009 Author: John Burkardt Parameters: Input, int N1, N2, N3, the order of the matrices. Input, double A[N1*N2], double B[N2*N3], the matrices to multiply. Output, double R8MAT_MM[N1*N3], the product matrix C = A * B. */ { int i; int j; int k; for ( i = 0; i < n1; i++ ) { for ( j = 0; j < n3; j++ ) { c[i+j*n1] = 0.0; for ( k = 0; k < n2; k++ ) { c[i+j*n1] = c[i+j*n1] + a[i+k*n1] * b[k+j*n2]; } } } return; } /******************************************************************************/ void r8mat_mmt_new ( int n1, int n2, int n3, double a[], double b[], double c[] ) /******************************************************************************/ /* Purpose: R8MAT_MMT_NEW computes C = A * B'. Discussion: An R8MAT is a doubly dimensioned array of R8 values, stored as a vector in column-major order. For this routine, the result is returned as the function value. Licensing: This code is distributed under the GNU LGPL license. Modified: 13 November 2012 Author: John Burkardt Parameters: Input, int N1, N2, N3, the order of the matrices. Input, double A[N1*N2], double B[N3*N2], the matrices to multiply. Output, double R8MAT_MMT[N1*N3], the product matrix C = A * B'. */ { int i; int j; int k; for ( i = 0; i < n1; i++ ) { for ( j = 0; j < n3; j++ ) { c[i+j*n1] = 0.0; for ( k = 0; k < n2; k++ ) { c[i+j*n1] = c[i+j*n1] + a[i+k*n1] * b[j+k*n3]; } } } return; } /******************************************************************************/ void r8mat_mtm_new ( int n1, int n2, int n3, double a[], double b[], double c[] ) /******************************************************************************/ /* Purpose: R8MAT_MTM_NEW computes C = A' * B. Discussion: An R8MAT is a doubly dimensioned array of R8 values, stored as a vector in column-major order. For this routine, the result is returned as the function value. Licensing: This code is distributed under the GNU LGPL license. Modified: 07 September 2012 Author: John Burkardt Parameters: Input, int N1, N2, N3, the order of the matrices. Input, double A[N2*N1], double B[N2*N3], the matrices to multiply. Output, double R8MAT_MTM_NEW[N1*N3], the product matrix C = A' * B. */ { int i; int j; int k; for ( i = 0; i < n1; i++ ) { for ( j = 0; j < n3; j++ ) { c[i+j*n1] = 0.0; for ( k = 0; k < n2; k++ ) { c[i+j*n1] = c[i+j*n1] + a[k+i*n2] * b[k+j*n2]; } } } return; } /******************************************************************************/ void r8mat_print ( int m, int n, double a[], char *title ) /******************************************************************************/ /* Purpose: R8MAT_PRINT prints an R8MAT. Discussion: An R8MAT is a doubly dimensioned array of R8 values, stored as a vector in column-major order. Entry A(I,J) is stored as A[I+J*M] Licensing: This code is distributed under the GNU LGPL license. Modified: 28 May 2008 Author: John Burkardt Parameters: Input, int M, the number of rows in A. Input, int N, the number of columns in A. Input, double A[M*N], the M by N matrix. Input, char *TITLE, a title. */ { r8mat_print_some ( m, n, a, 1, 1, m, n, title ); return; } /******************************************************************************/ void r8mat_print_some ( int m, int n, double a[], int ilo, int jlo, int ihi, int jhi, char *title ) /******************************************************************************/ /* Purpose: R8MAT_PRINT_SOME prints some of an R8MAT. Discussion: An R8MAT is a doubly dimensioned array of R8 values, stored as a vector in column-major order. Licensing: This code is distributed under the GNU LGPL license. Modified: 26 June 2013 Author: John Burkardt Parameters: Input, int M, the number of rows of the matrix. M must be positive. Input, int N, the number of columns of the matrix. N must be positive. Input, double A[M*N], the matrix. Input, int ILO, JLO, IHI, JHI, designate the first row and column, and the last row and column to be printed. Input, char *TITLE, a title. */ { # define INCX 5 int i; int i2hi; int i2lo; int j; int j2hi; int j2lo; Rprintf ( "\n" ); Rprintf ("%s\n", title ); if ( m <= 0 || n <= 0 ) { Rprintf ( "\n" ); Rprintf ( " (None)\n" ); return; } /* Print the columns of the matrix, in strips of 5. */ for ( j2lo = jlo; j2lo <= jhi; j2lo = j2lo + INCX ) { j2hi = j2lo + INCX - 1; if ( n < j2hi ) { j2hi = n; } if ( jhi < j2hi ) { j2hi = jhi; } Rprintf ( "\n" ); /* For each column J in the current range... Write the header. */ Rprintf ( " Col: "); for ( j = j2lo; j <= j2hi; j++ ) { Rprintf ( " %7d ", j - 1 ); } Rprintf ( "\n" ); Rprintf ( " Row\n" ); Rprintf ( "\n" ); /* Determine the range of the rows in this strip. */ if ( 1 < ilo ) { i2lo = ilo; } else { i2lo = 1; } if ( m < ihi ) { i2hi = m; } else { i2hi = ihi; } for ( i = i2lo; i <= i2hi; i++ ) { /* Print out (up to) 5 entries in row I, that lie in the current strip. */ Rprintf ( "%5d:", i - 1 ); for ( j = j2lo; j <= j2hi; j++ ) { Rprintf ( " %14f", a[i-1+(j-1)*m] ); } Rprintf ( "\n" ); } } return; # undef INCX } /******************************************************************************/ void wishart_sample ( int m, int df, double sigma[], double a[], double au[], double aur[], double r[], double h[], int fl ) /******************************************************************************/ /* Purpose: WISHART_SAMPLE samples the Wishart distribution. Discussion: This function requires functions from the PDFLIB and RNGLIB libraries. The "initialize()" function from RNGLIB must be called before using this function. Licensing: This code is distributed under the GNU LGPL license. Modified: 31 July 2013 Author: John Burkardt Reference: Patrick Odell, Alan Feiveson, A numerical procedure to generate a sample covariance matrix, Journal of the American Statistical Association, Volume 61, Number 313, March 1966, pages 199-203. Parameters: Input, int M, the order of the matrix. Input, int DF, the number of degrees of freedom. M <= DF. Input, double SIGMA[M*M], the covariance matrix, which should be a symmetric positive definite matrix. Output, double WISHART_SAMPLE[M*M], the sample matrix from the Wishart distribution. */ { //int flag; if ( df < m ) { Rprintf ( "\n" ); Rprintf ( "WISHART_SAMPLE - Error!\n" ); Rprintf ( " DF = %d < M = %d.\n Setting df=m instead.\n", df, m ); df=m; } /* Get R, the upper triangular Cholesky factor of SIGMA. */ r8mat_pofac ( m, sigma, r ,22); /*if ( flag != 0 ) { Rprintf ( "\n" ); Rprintf ( "WISHART_SAMPLE - Fatal error!\n" ); Rprintf ( " Unexpected error return from R8MAT_CHOLESKY_FACTOR_UPPER.\n" ); Rprintf ( " FLAG = %d\n", flag ); } */ /* Get AU, a sample from the unit Wishart distribution. */ wishart_unit_sample ( m, df, au, h, fl); /* Construct the matrix A = R' * AU * R. */ r8mat_mm_new ( m, m, m, au, r,aur ); r8mat_mtm_new ( m, m, m, r, aur,a ); return; } /******************************************************************************/ void wishart_unit_sample ( int m, int df, double a[], double c[] , int fl) /******************************************************************************/ /* Purpose: WISHART_UNIT_SAMPLE samples the unit Wishart distribution. Discussion: This function requires functions from the PDFLIB and RNGLIB libraries. The "initialize()" function from RNGLIB must be called before using this function. Licensing: This code is distributed under the GNU LGPL license. Modified: 11 October 2013 Author: John Burkardt Reference: Patrick Odell, Alan Feiveson, A numerical procedure to generate a sample covariance matrix, Journal of the American Statistical Association, Volume 61, Number 313, March 1966, pages 199-203. Parameters: Input, int M, the order of the matrix. Input, int DF, the number of degrees of freedom. M <= DF. Output, double WISHART_UNIT_SAMPLE[M*M], the sample matrix from the unit Wishart distribution. */ { double df_chi; int i; int j; if ( df < m ) { Rprintf ( "\n" ); Rprintf ( " DF = %d < M = %d.\n Setting df=m instead.", df, m ); df=m; } for ( i = 0; i < m; i++ ) { for ( j = 0; j < i; j++ ) { c[i+j*m] = 0.0; } df_chi = ( double ) ( df - i ); c[i+i*m] = sqrt ( r8_chi_sample ( df_chi, fl ) ); for ( j = i + 1; j < m; j++ ) { c[i+j*m] = r8_normal_01_sample ( fl ); } } r8mat_mtm_new ( m, m, m, c, c,a ); return; } jomo/src/jomo1C.c0000644000176200001440000003704314410334473013313 0ustar liggesusers#include #include #include #include #include #include "pdflib.h" #include "wishart.h" #include #include #include SEXP jomo1C(SEXP Y, SEXP Yimp, SEXP Yimp2, SEXP Yimpcat, SEXP X, SEXP beta, SEXP betapost, SEXP omega, SEXP omegapost, SEXP nstep, SEXP Sp, SEXP Y_numcat, SEXP num_con, SEXP flagrng, SEXP MCMCchain, SEXP mpid, SEXP npatterns){ int i,j,k, IY,JY, IX, JX, Io, Jo, Ib, Jb, ns, nmiss=0,t, countm=0, counto=0, countmm=0, countmo=0, countoo=0, jj, tt, kk, ncon,ncat, pos,flag=0,nmaxx,h,fl, indic=0,currncat, MCMC, np; SEXP RdimY, RdimX, Rdimo, Rdimb; double *betaX, *Yobs, *Ymiss, *mumiss, *omegadrawmiss, *betamiss, *betaobs, *omegaoo, *omegamo, *omegamm, *invomega, *invomega2, *help, *help2, *help3, *imp, *zi; double *sumzy, *incrzz, *incrzy, *mu, *mu2, *newbeta, *newomega, *sumzi, *yi, *invomega3, *help4, *help5, *help6, *missing, *fixomega,meanom,sdom, *resid, logLH, newlogLH,detom; double maxx,maxim,maxim2, minim, *help7, *listomega, *listh5; /* Protecting R objects from garbage collection and saving matrices dimensions*/ RdimY=PROTECT(getAttrib(Yimp,R_DimSymbol)); IY=INTEGER(RdimY)[0]; JY=INTEGER(RdimY)[1]; RdimX=PROTECT(getAttrib(X,R_DimSymbol)); IX=INTEGER(RdimX)[0]; JX=INTEGER(RdimX)[1];if(IX!=IY) error("Covariates and Responses matrices have different length"); Rdimb=PROTECT(getAttrib(beta,R_DimSymbol)); Ib=INTEGER(Rdimb)[0]; Jb=INTEGER(Rdimb)[1]; Rdimo=PROTECT(getAttrib(omega,R_DimSymbol)); Io=INTEGER(Rdimo)[0]; Jo=INTEGER(Rdimo)[1]; Y=PROTECT(coerceVector(Y,REALSXP)); Yimpcat=PROTECT(coerceVector(Yimpcat,REALSXP)); Y_numcat=PROTECT(coerceVector(Y_numcat,INTSXP)); Yimp=PROTECT(coerceVector(Yimp,REALSXP)); Yimp2=PROTECT(coerceVector(Yimp2,REALSXP)); X=PROTECT(coerceVector(X,REALSXP)); beta=PROTECT(coerceVector(beta,REALSXP)); betapost=PROTECT(coerceVector(betapost,REALSXP)); omega=PROTECT(coerceVector(omega,REALSXP)); omegapost=PROTECT(coerceVector(omegapost,REALSXP)); Sp=PROTECT(coerceVector(Sp,REALSXP)); nstep=PROTECT(coerceVector(nstep,INTSXP)); ns=INTEGER(nstep)[0]; num_con=PROTECT(coerceVector(num_con,INTSXP)); ncon=INTEGER(num_con)[0]; flagrng=PROTECT(coerceVector(flagrng,INTSXP)); fl=INTEGER(flagrng)[0]; MCMCchain=PROTECT(coerceVector(MCMCchain,INTSXP)); MCMC=INTEGER(MCMCchain)[0]; if (REAL(Yimpcat)[0]==(-999)) ncat=0; else ncat=length(Y_numcat); mpid=PROTECT(coerceVector(mpid,INTSXP)); npatterns=PROTECT(coerceVector(npatterns,INTSXP)); np=INTEGER(npatterns)[0]; /*Allocating memory for C objects in R*/ help = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); invomega= (double * ) R_alloc ( JY * JY , sizeof ( double ) ); fixomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); sumzi = ( double * ) R_alloc ( JY * JX * JY * JX , sizeof ( double ) ); sumzy = ( double * ) R_alloc ( JY * JX , sizeof ( double ) ); zi = ( double * ) R_alloc ( JY * JX * JY , sizeof ( double ) ); yi = ( double * ) R_alloc ( JY , sizeof ( double ) ); help2 = ( double * ) R_alloc ( JY *JX * JY , sizeof ( double ) ); incrzz = ( double * ) R_alloc ( JY *JX * JY *JX , sizeof ( double ) ); incrzy = ( double * ) R_alloc ( JY *JX , sizeof ( double ) ); help3 = ( double * ) R_alloc ( JY * JX * JY * JX ,sizeof ( double ) ); invomega2= (double * ) R_alloc ( JY * JX * JY * JX , sizeof ( double ) ); mu = ( double * ) R_alloc ( JY * JX, sizeof ( double ) ); newbeta = ( double * ) R_alloc ( JY * JX ,sizeof ( double ) ); mu2 = ( double * ) R_alloc ( JY * JY,sizeof ( double ) ); newomega = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); betaX=( double * ) R_alloc ( JY , sizeof ( double ) ); imp=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); resid=( double * ) R_alloc ( IY * JY,sizeof ( double ) ); Yobs=( double * ) R_alloc ( JY , sizeof ( double ) ); Ymiss=( double * ) R_alloc ( JY , sizeof ( double ) ); mumiss = ( double * ) R_alloc ( JY , sizeof ( double ) ); omegadrawmiss = ( double * ) R_alloc ( JY * JY ,sizeof ( double ) ); betamiss = ( double * ) R_alloc ( JY ,sizeof ( double ) ); betaobs = ( double * ) R_alloc ( JY, sizeof ( double ) ); omegaoo= ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); omegamo= ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); omegamm= ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); invomega3= ( double * ) R_alloc ( JY*JY , sizeof ( double ) ); help4 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); help5 = ( double * ) R_alloc ( JY * JY , sizeof ( double ) ); help6 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); help7 = ( double * ) R_alloc ( JY *JY , sizeof ( double ) ); missing = ( double * ) R_alloc ( IY , sizeof ( double ) ); listomega = ( double * ) R_alloc ( np*JY *JY , sizeof ( double ) ); listh5 = ( double * ) R_alloc ( np*JY *JY , sizeof ( double ) ); /* Some initializations */ for (j=0; j0) { for (i=0;i0) { pos=ncon; for (j=0;j(pos+currncat-1)))&&((k(pos+currncat-1)))) { help4[countm]=REAL(omega)[kk+JY*k]; countm++; } else if (((kk(pos+currncat-1)))&&((k>(pos-1))||(k<(pos+currncat)))) { help5[counto]=REAL(omega)[kk+JY*k]; counto++; } } } countm=0; counto=0; r8mat_pofac((JY-currncat),help4, help6,1); r8mat_poinv((JY-currncat),help6, invomega); for (jj=1;jj<(JY-currncat);jj++) for (tt=0;tt-3)&(maxim<4)) { if (maxim<0) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } else { while ((flag==0)&(kk<10000)) { r8vec_multinormal_sample((INTEGER(Y_numcat)[j]-1), mumiss,omegamm, newbeta,mu2,0); maxim=maxvec((INTEGER(Y_numcat)[j]-1),newbeta); minim=minvec((INTEGER(Y_numcat)[j]-1),newbeta); if ((minim>-3)&(maxim<4)) { maxim2=argmaxvec((INTEGER(Y_numcat)[j]-1),newbeta); if (((maxim2+1)==REAL(Y)[t+(ncon+j)*IY])&(maxim>0)) { for (k=0;k<(INTEGER(Y_numcat)[j]-1);k++) imp[t+(k+pos)*IY]=newbeta[k]; flag=1; indic++; } } kk++; } } flag=0; } } pos=pos+INTEGER(Y_numcat)[j]-1; } } //Updating beta r8mat_pofac(JY,REAL(omega), help,3); r8mat_poinv(JY,help, invomega); for (j=1;j0) { for (k=0;k0) { for (k=0;k0) { for (j=0;jmaxx) { maxx=imp[i+(ncon+h+k)*IY]; nmaxx=k; } } if (maxx>0) REAL(Yimpcat)[i+IY*j]=nmaxx+1; else REAL(Yimpcat)[i+IY*j]=INTEGER(Y_numcat)[j]; h=h+INTEGER(Y_numcat)[j]-1; } } } if (MCMC==0) { r8mat_divide(Ib,Jb,ns,REAL(betapost)); r8mat_divide(JY,JY,ns,REAL(omegapost)); } PutRNGstate(); UNPROTECT(21); return R_NilValue; } jomo/src/jomo_init.c0000644000176200001440000000647714410320577014161 0ustar liggesusers#include #include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .Call calls */ extern SEXP jomo1C(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP jomo1ranC(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP jomo1ranhrC(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP jomo1ranhrsmcC(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP jomo1ransmcC(SEXP ,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP jomo1smcC(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP , SEXP , SEXP , SEXP , SEXP , SEXP , SEXP , SEXP , SEXP , SEXP , SEXP , SEXP, SEXP); extern SEXP jomo2comC(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP jomo2hrC(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP jomo2hrsmcC(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP jomo2smcC(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { {"jomo1C", (DL_FUNC) &jomo1C, 17}, {"jomo1ranC", (DL_FUNC) &jomo1ranC, 24}, {"jomo1ranhrC", (DL_FUNC) &jomo1ranhrC, 27}, {"jomo1ranhrsmcC", (DL_FUNC) &jomo1ranhrsmcC, 42}, {"jomo1ransmcC", (DL_FUNC) &jomo1ransmcC, 40}, {"jomo1smcC", (DL_FUNC) &jomo1smcC, 27}, {"jomo2comC", (DL_FUNC) &jomo2comC, 34}, {"jomo2hrC", (DL_FUNC) &jomo2hrC, 37}, {"jomo2hrsmcC", (DL_FUNC) &jomo2hrsmcC, 51}, {"jomo2smcC", (DL_FUNC) &jomo2smcC, 49}, {NULL, NULL, 0} }; void R_init_jomo(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } jomo/src/pdflib.h0000644000176200001440000000415014410320772013416 0ustar liggesusersdouble normal_cdf(double value); int checkposdef(int dim, double matr[], double matrh[],double matrh2[]); double argmaxvec(int card, double vec[]); double maxvec(int card, double vec[]); double minvec(int card, double vec[]); double r8_chi_sample ( double df , int fl); double r8_epsilon ( void ); double r8_exponential_01_sample ( int fl ); double r8_gamma_sample ( double a, double r, int fl ); double r8_gamma_01_sample ( double a, int fl ); double r8_max ( double x, double y ); double r8_min ( double x, double y ); double r8_normal_sample ( double av, double sd, int fl ); double r8_normal_01_sample ( int fl ); double r8_uniform_sample ( double low, double high, int fl ); double r8_uniform_01_sample ( int fl ); double r8mat_podet ( int n, double r[] ); void r8mat_pofac ( int n, double a[], double r[], int indica ); void r8mat_poinv ( int n, double r[], double b[] ); void r8vec_multinormal_sample ( int n, double mu[], double r[],double x[], double z[] , int fl); double r8_gamma_log ( double x ); double log_mul_gamma ( int p, double a ); double r8_chi_pdf ( double df, double rval ); double wishart_dens ( double df, int dim, double X[], double invA[], double help[], double help2[]); double log_f_u ( double eta, double u, int dim, int nclus, double allinvomega[], double omega[], double invgamma[], double help[], double help2[]); double derive_log_f_u ( double dx, double eta, double u, int dim, int nclus, double allinvomega[], double omega[], double invgamma[], double help[], double help2[]); double derive2_log_f_u ( double dx, double eta, double u, int dim, int nclus, double allinvomega[], double omega[], double invgamma[], double help[], double help2[]); double derive2_f_u ( double dx, double eta, double u, int dim, int nclus, double allinvomega[], double omega[], double invgamma[], double help[], double help2[], double K); double newton_raphson ( double x, double precision, double dx, double eta, int dim, int nclus, double allinvomega[], double omega[], double invgamma[], double help[], double help2[]); double h_u ( double u, double u_m, double lambda ); double t_sample ( double df , int fl); jomo/R/0000755000176200001440000000000014416212541011417 5ustar liggesusersjomo/R/jomo1ranconhr.MCMCchain.R0000644000176200001440000001747714410253602016060 0ustar liggesusersjomo1ranconhr.MCMCchain <- function(Y, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, a=(ncol(Y)+50),a.prior=NULL, meth="random", output=1, out.iter=10) { if (is.null(X)) X=matrix(1,nrow(Y),1) if (is.null(Z)) Z=matrix(1,nrow(Y),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),ncol(Y)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is.null(a.prior)) a.prior=ncol(beta.start) if (is_tibble(Y)) { Y<-data.frame(Y) warning("tibbles not supported. Y converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*ncol(Y)) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (is.null(l1cov.start)) l1cov.start=matrix(diag(1,ncol(beta.start)),ncol(beta.start)*nlevels(clus),ncol(beta.start),2) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot((meth=="fixed"|meth=="random"),nrow(Y)==nrow(clus),nrow(Y)==nrow(X), nrow(beta.start)==ncol(X), ncol(beta.start)==ncol(Y),nrow(l1cov.start)==nrow(u.start)*ncol(l1cov.start), nrow(l1cov.start)==nrow(u.start)*ncol(Y), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.start)==nrow(u.start)*nrow(l1cov.prior), nrow(Z)==nrow(Y), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*ncol(Y)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } ait=as.numeric(a) nimp=1 colnamy<-colnames(Y) colnamx<-colnames(X) colnamz<-colnames(Z) Y<-data.matrix(Y) storage.mode(Y) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Y Yimp2=matrix(Yimp, nrow(Y),ncol(Y)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),nburn)) meanobs<-colMeans(Y,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) { for (j in 1:ncol(Y.auxiliary)) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } } X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (is.null(l1cov.start)) { l1cov.start=diag(1,ncol(beta.start)) } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) ncolYcon<-rep(NA,4) ncolYcon[1]=max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con)) ncolYcon[2]=max(as.numeric(!is.null(Y.con)),ncol(Y.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } colnamx<-colnames(X) X<-data.matrix(X) storage.mode(X) <- "numeric" Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } if (output == 0) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+4) imp[1:nrow(Y),1:2]=Ysub imp[1:nrow(Y),3:(2+ncol(Y))]=Y imp[1:nrow(X), (ncol(Y)+3)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+3)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+4)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] .Call("jomo1smcC", Ysub, 0, 0, submod, order.sub, Y, Yimp, Yimp2, Y.cat.tot, X, betaY.start, bYpost, betait,bpost, 0, 0, covit,opost, nburn, 0, l1cov.prior,Y.numcat.tot,1, ncolYcon,out.iter, 0, 2, PACKAGE = "jomo") #betapost[,,1]=bpost #omegapost[,,(1)]=opost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) imp[(nrow(Y)+1):(2*nrow(Y)),1:2]=as.matrix(Ysub) if (!is.null(Y.con)|!is.null(Y.aux.con)) { imp[(nrow(Y)+1):(2*nrow(Y)),3:(2+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(nrow(Y)+1):(2*nrow(Y)),(ncolYcon[1]+3):(2+ncol(Y))]=Y.cat.tot } if (output>0) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+3)]=c(1:nrow(Y)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+4)]=i .Call("jomo1smcC", Ysub, 0, 0, submod, order.sub, Y, Yimp, Yimp2, Y.cat.tot, X, betaY.start, bYpost, betait,bpost, 0, 0, covit,opost, nbetween, 0, l1cov.prior,Y.numcat.tot, 1, ncolYcon,out.iter, 0, 2, PACKAGE = "jomo") betapost[,,(i-1)]=bpost betaYpost[,,(i-1)]=bYpost omegapost[,,(i-1)]=opost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1:2]=as.matrix(Ysub) if (!is.null(Y.con)|!is.null(Y.aux.con)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),3:(2+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.aux.con))+max(0,ncol(Y.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolYcon[1]+3):(2+ncol(Y))]=Y.cat.tot } if (output>0) cat("Imputation number ", i, "registered", "\n") } cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) betaYpostmean<-apply(betaYpost, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) colnames(betaYpostmean)<-names(fit.cr$coefficients) if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) } } imp<-data.frame(imp) if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(2+ncolYcon[1]+i)]<-as.factor(imp[,(2+ncolYcon[1]+i)]) levels(imp[,(2+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(2+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(2+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(2+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+2]=as.numeric(imp[,j+2]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (is.null(colnamysub)) colnamysub=c("time","status") colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,"id","Imputation") return(imp) } jomo/R/jomo1ran.MCMCchain.R0000644000176200001440000001407314410253602015013 0ustar liggesusersjomo1ran.MCMCchain <- function(Y, X=NULL, Z=NULL,clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, a=NULL, a.prior=NULL, meth="common", output=1, out.iter=10) { stopifnot(meth=="common"|meth=="fixed"|meth=="random") ncon=0 ncat=0 Y.con=NULL Y.cat=NULL Y.numcat=NULL for (i in 1:ncol(Y)) { if (is.numeric(Y[,i])) { ncon=ncon+1 if (is.null(Y.con)) { Y.con<-data.frame(Y[,i]) } else { Y.con<-data.frame(Y.con,Y[,i]) } colnames(Y.con)[ncon]<-colnames(Y)[i] } else { if (is.factor(Y[,i])) { ncat=ncat+1 if (is.null(Y.cat)) { Y.cat<-data.frame(Y[,i]) } else { Y.cat<-data.frame(Y.cat,Y[,i]) } colnames(Y.cat)[ncat]<-colnames(Y)[i] Y.numcat<-cbind(Y.numcat,nlevels(Y[,i])) } } } if (is.null(X)) X=matrix(1,nrow(Y),1) if (is.null(Z)) Z=matrix(1,nrow(Y),1) if (meth=="common") { if (ncat==0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and no categorical. Using function jomo1rancon.", "\n") imp<-jomo1rancon.MCMCchain(Y=Y.con, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn, output=output,out.iter=out.iter) attr(imp, "function") = "jomo1rancon.MCMCchain" } if (ncat>0 & ncon==0) { cat("Found ", ncat, "categorical outcomes and no continuous. Using function jomo1rancat.", "\n") imp<-jomo1rancat.MCMCchain(Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn, output=output,out.iter=out.iter) attr(imp, "function") = "jomo1rancat.MCMCchain" } if (ncat>0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and ", ncat, "categorical. Using function jomo1ranmix.", "\n") imp<-jomo1ranmix.MCMCchain(Y.con=Y.con,Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn, output=output,out.iter=out.iter) attr(imp, "function") = "jomo1ranmix.MCMCchain" } } if (meth=="fixed") { if (ncat==0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and no categorical. Using function jomo1ranconhr with fixed cluster-specific covariance matrices.", "\n") imp<-jomo1ranconhr.MCMCchain(Y=Y.con, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn, a=0, meth="fixed", output=output,out.iter=out.iter) attr(imp, "function") = "jomo1ranconhr.MCMCchain.fixed" } if (ncat>0 & ncon==0) { cat("Found ", ncat, "categorical outcomes and no continuous. Using function jomo1rancathr with fixed cluster-specific covariance matrices.", "\n") imp<-jomo1rancathr.MCMCchain(Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn, a=0, meth="fixed", output=output,out.iter=out.iter) attr(imp, "function") = "jomo1rancathr.MCMCchain.fixed" } if (ncat>0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and ", ncat, "categorical. Using function jomo1ranmixhr with fixed cluster-specific covariance matrices.", "\n") imp<-jomo1ranmixhr.MCMCchain(Y.con=Y.con,Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn,a=0, meth="fixed", output=output,out.iter=out.iter) attr(imp, "function") = "jomo1ranmixhr.MCMCchain.fixed" } } if (meth=="random") { if (ncat==0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and no categorical. Using function jomo1ranconhr with random cluster-specific covariance matrices.", "\n") imp<-jomo1ranconhr.MCMCchain(Y=Y.con, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn, a=a, a.prior=a.prior, meth="random", output=output,out.iter=out.iter) attr(imp, "function") = "jomo1ranconhr.MCMCchain.random" } if (ncat>0 & ncon==0) { cat("Found ", ncat, "categorical outcomes and no continuous. Using function jomo1rancathr with random cluster-specific covariance matrices.", "\n") imp<-jomo1rancathr.MCMCchain(Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn, a=a, a.prior=a.prior, meth="random", output=output,out.iter=out.iter) attr(imp, "function") = "jomo1rancathr.MCMCchain.random" } if (ncat>0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and ", ncat, "categorical. Using function jomo1ranmixhr with random cluster-specific covariance matrices.", "\n") imp<-jomo1ranmixhr.MCMCchain(Y.con=Y.con,Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn,a=a, a.prior=a.prior, meth="random", output=output,out.iter=out.iter) attr(imp, "function") = "jomo1ranmixhr.MCMCchain.random" } } return(imp) } jomo/R/jomo.MCMCchain.R0000644000176200001440000000276314410253602014234 0ustar liggesusersjomo.MCMCchain <- function(Y, Y2=NULL, X=NULL, X2=NULL, Z=NULL,clus=NULL, beta.start=NULL,l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, l2.start.imp=NULL, nburn=1000, a=NULL, a.prior=NULL, meth="common",output=1, out.iter=10) { if (is.null(Y2)) { if (is.null(clus)) { cat("No clustering, using functions for single level imputation.\n") imp<-jomo1.MCMCchain(Y=Y, X=X, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, start.imp=start.imp, nburn=nburn, output=output, out.iter=out.iter) } if (!is.null(clus)) { cat("Clustered data, using functions for two-level imputation.\n") imp<-jomo1ran.MCMCchain(Y=Y, X=X, Z=Z,clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, nburn=nburn, a=a, a.prior=a.prior, meth=meth, output=output, out.iter=out.iter) } } else { cat("2-level data, using functions for two-level imputation.\n") imp<-jomo2.MCMCchain(Y=Y, Y2=Y2, X=X, X2=X2, Z=Z,clus=clus, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, l2.start.imp=l2.start.imp, nburn=nburn, a=a, a.prior=a.prior, meth=meth, output=output, out.iter=out.iter) } return(imp) } jomo/R/jomo2hr.R0000644000176200001440000004653214410253602013131 0ustar liggesusersjomo2hr <- function(Y.con=NULL, Y.cat=NULL, Y.numcat=NULL,Y2.con=NULL, Y2.cat=NULL, Y2.numcat=NULL, X=NULL, X2=NULL, Z=NULL, clus, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, a=NULL, a.prior=NULL, meth="random", output=1, out.iter=10) { if (nimp<2) { nimp=2 cat("Minimum number of imputations:2. For single imputation using function jomo2hr.MCMCchain\n") } if (is.null(X)) X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(X2)) X2=matrix(1,max(nrow(Y2.cat),nrow(Y2.con)),1) if (is.null(Z)) Z=matrix(1,nrow(X),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(0,ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat))))) if (is.null(l2.beta.start)) l2.beta.start=matrix(0,ncol(X2),(max(0,ncol(Y2.con))+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is.null(a)) a=ncol(beta.start)+50 if (is.null(a.prior)) a.prior=ncol(beta.start) if (is_tibble(Y.con)) { Y.con<-data.frame(Y.con) warning("tibbles not supported. Y.con converted to standard data.frame. ") } if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(Y2.con)) { Y2.con<-data.frame(Y2.con) warning("tibbles not supported. Y2.con converted to standard data.frame. ") } if (is_tibble(Y2.cat)) { Y2.cat<-data.frame(Y2.cat) warning("tibbles not supported. Y2.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } if (is_tibble(X2)) { X2<-data.frame(X2) warning("tibbles not supported. X2 converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) ncolYcon=max(0,ncol(Y.con)) ncolY2con=max(0,ncol(Y2.con)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat))), ((!is.null(Y2.con))||(!is.null(Y2.cat)&!is.null(Y2.numcat)))) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncolYcon+max(0,(sum(Y.numcat)-length(Y.numcat))))+(ncolY2con+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (is.null(l1cov.start)) l1cov.start=matrix(diag(1,ncol(beta.start)),ncol(beta.start)*nlevels(clus),ncol(beta.start),2) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 Y.cat=-999 Y.numcat=-999 } if (!is.null(Y2.cat)) { isnullcat2=0 previous_levels2<-list() Y2.cat<-data.frame(Y2.cat) for (i in 1:ncol(Y2.cat)) { Y2.cat[,i]<-factor(Y2.cat[,i]) previous_levels2[[i]]<-levels(Y2.cat[,i]) levels(Y2.cat[,i])<-1:nlevels(Y2.cat[,i]) } } else { isnullcat2=1 Y2.cat=-999 Y2.numcat=-999 } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(X2)) { if (is.factor(X2[,i])) X2[,i]<-as.numeric(X2[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } if (!is.null(Y.con)) { stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(Z)==nrow(Y.con)) } if (isnullcat==0) { stopifnot(nrow(Y.cat)==nrow(clus),nrow(Y.cat)==nrow(X), nrow(Z)==nrow(Y.cat)) } if (!is.null(Y2.con)) { stopifnot(nrow(Y2.con)==nrow(clus),nrow(Y2.con)==nrow(X), nrow(Z)==nrow(Y2.con)) } if (isnullcat2==0) { stopifnot(nrow(Y2.cat)==nrow(clus),nrow(Y2.cat)==nrow(X), nrow(Z)==nrow(Y2.cat)) } stopifnot((meth=="fixed"|meth=="random")) stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon+max(0,(sum(Y.numcat)-length(Y.numcat))))) stopifnot(nrow(l2.beta.start)==ncol(X2), ncol(l2.beta.start)==(ncolY2con+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) stopifnot(ncol(u.start)==ncol(Z)*(ncolYcon+max(0,(sum(Y.numcat)-length(Y.numcat))))+(ncolY2con+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) stopifnot(nrow(l1cov.start)==nrow(u.start)*ncol(l1cov.start), ncol(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior),ncol(l2cov.start)==ncol(u.start)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } beta2it=matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) for (i in 1:nrow(l2.beta.start)) { for (j in 1:ncol(l2.beta.start)) beta2it[i,j]=l2.beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } ait=0 ait=a if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } if (isnullcat==0) { colnamycat<-colnames(Y.cat) Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" } if (!is.null(Y2.con)) { colnamy2con<-colnames(Y2.con) Y2.con<-data.matrix(Y2.con) storage.mode(Y2.con) <- "numeric" } if (isnullcat2==0) { colnamy2cat<-colnames(Y2.cat) Y2.cat<-data.matrix(Y2.cat) storage.mode(Y2.cat) <- "numeric" } colnamx<-colnames(X) colnamz<-colnames(Z) colnamx2<-colnames(X2) X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) X2<-data.matrix(X2) storage.mode(X2) <- "numeric" stopifnot(!any(is.na(X2))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) if (!is.null(Y.con)&isnullcat==0) { Y=cbind(Y.con,Y.cat) Yi=cbind(Y.con, matrix(0,nrow(Y.con),(sum(Y.numcat)-length(Y.numcat)))) } else if (!is.null(Y.con)) { Y=Y.con Yi=Y.con } else { Y=Y.cat Yi=matrix(0,nrow(Y.cat),(sum(Y.numcat)-length(Y.numcat))) } n.patterns<-c(0,0) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns[1]<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns[1]<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns[1]<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns[1]) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } if (!is.null(Y2.con)&isnullcat2==0) { Y2=cbind(Y2.con,Y2.cat) Y2i=cbind(Y2.con, matrix(0,nrow(Y2.con),(sum(Y2.numcat)-length(Y2.numcat)))) } else if (!is.null(Y2.con)) { Y2=Y2.con Y2i=Y2.con } else { Y2=Y2.cat Y2i=matrix(0,nrow(Y2.cat),(sum(Y2.numcat)-length(Y2.numcat))) } if (any(is.na(Y2))) { if (ncol(Y2)==1) { miss.pat2<-matrix(c(0,1),2,1) n.patterns[2]<-2 } else { miss.pat2<-md.pattern.mice(Y2, plot=F) miss.pat2<-miss.pat2[,colnames(Y2)] n.patterns[2]<-nrow(miss.pat2)-1 } } else { miss.pat2<-matrix(0,2,ncol(Y2)) n.patterns[2]<-nrow(miss.pat2)-1 } miss.pat.id2<-rep(0,nrow(Y2)) for (i in 1:nrow(Y2)) { k <- 1 flag <- 0 while ((k <= n.patterns[2]) & (flag == 0)) { if (all(!is.na(Y2[i,])==miss.pat2[k,1:(ncol(miss.pat2))])) { miss.pat.id2[i] <- k flag <- 1 } else { k <- k + 1 } } } h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon+h):(ncolYcon+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } h=1 if (isnullcat2==0) { for (i in 1:length(Y2.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.cat[j,i])) { Y2i[j,(ncolY2con+h):(ncolY2con+h+Y2.numcat[i]-2)]=NA } } h=h+Y2.numcat[i]-1 } } if (output!=1) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(Y2),(ncol(Y)+1):(ncol(Y)+ncol(Y2))]=Y2 imp[1:nrow(X), (ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X))]=X imp[1:nrow(X2), (ncol(Y)+ncol(Y2)+ncol(X)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2))]=X2 imp[1:nrow(Z), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) Y2imp=Y2i Y2imp2=matrix(Y2imp, nrow(Y2imp),ncol(Y2imp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X))]=X imp[(nrow(X2)+1):(2*nrow(X2)), (ncol(Y)+ncol(Y2)+ncol(X)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2))]=X2 imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) beta2post<- array(0, dim=c(nrow(l2.beta.start),ncol(l2.beta.start),(nimp-1))) b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nimp-1))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nimp-1))) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] meanobs2<-colMeans(Y2i,na.rm=TRUE) for (i in 1:nrow(Y2i)) for (j in 1:ncol(Y2i)) if (is.na(Y2imp[i,j])) Y2imp2[i,j]=meanobs2[j] if (meth=="fixed") { fixed=1 } else { fixed=0 } .Call("jomo2hrC", Y, Yimp, Yimp2, Y.cat, Y2, Y2imp,Y2imp2, Y2.cat, X, X2, Z, clus,betait,beta2it,uit,bpost,b2post,upost,covit,opost, covuit,cpost,nburn, l1cov.prior,l2cov.prior,Y.numcat, Y2.numcat, ncolYcon,ncolY2con,ait,a.prior,out.iter, fixed, 0, miss.pat.id, n.patterns, miss.pat.id2, PACKAGE = "jomo") #betapost[,,1]=bpost #upostall[,,1]=upost #omegapost[,,(1)]=opost #covupost[,,(1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) if (!is.null(Y.con)) { imp[(nrow(Y)+1):(2*nrow(Y)),1:ncol(Y.con)]=Yimp2[,1:ncol(Y.con)] } if (isnullcat==0) { imp[(nrow(Y)+1):(2*nrow(Y)),(ncolYcon+1):ncol(Y)]=Y.cat } if (!is.null(Y2.con)) { imp[(nrow(Y2)+1):(2*nrow(Y2)),(ncol(Y)+1):(ncol(Y)+ncol(Y2.con))]=Y2imp2[,1:ncol(Y2.con)] } if (isnullcat2==0) { imp[(nrow(Y2)+1):(2*nrow(Y2)),(ncolY2con+ncol(Y)+1):(ncol(Y)+ncol(Y2))]=Y2.cat } if (output==1) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X))]=X imp[(i*nrow(X2)+1):((i+1)*nrow(X2)), (ncol(Y)+ncol(Y2)+ncol(X)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2))]=X2 imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))]=Z imp[(i*nrow(clus)+1):((i+1)*nrow(clus)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)]=clus imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+3)]=i .Call("jomo2hrC", Y, Yimp, Yimp2, Y.cat, Y2, Y2imp,Y2imp2, Y2.cat, X, X2, Z, clus,betait,beta2it,uit,bpost,b2post,upost,covit,opost, covuit,cpost,nbetween, l1cov.prior,l2cov.prior,Y.numcat, Y2.numcat, ncolYcon,ncolY2con,ait,a.prior,out.iter, fixed, 0, miss.pat.id, n.patterns, miss.pat.id2, PACKAGE = "jomo") betapost[,,(i-1)]=bpost beta2post[,,(i-1)]=b2post upostall[,,(i-1)]=upost omegapost[,,(i-1)]=opost covupost[,,(i-1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) if (!is.null(Y.con)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),1:ncol(Y.con)]=Yimp2[,1:ncol(Y.con)] } if (isnullcat==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolYcon+1):ncol(Y)]=Y.cat } if (!is.null(Y2.con)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(Y2.con))]=Y2imp2[,1:ncol(Y2.con)] } if (isnullcat2==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolY2con+ncol(Y)+1):(ncol(Y)+ncol(Y2))]=Y2.cat } if (output==1) cat("Imputation number ", i, "registered", "\n") } imp<-data.frame(imp) if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(ncolYcon+i)]<-as.factor(imp[,(ncolYcon+i)]) levels(imp[,(ncolYcon+i)])<-previous_levels[[i]] } } if (isnullcat2==0) { for (i in 1:ncol(Y2.cat)) { imp[,(ncol(Y)+ncolY2con+i)]<-as.factor(imp[,(ncol(Y)+ncolY2con+i)]) levels(imp[,(ncol(Y)+ncolY2con+i)])<-previous_levels2[[i]] } } imp[,(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)]<-factor(imp[,(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)]) levels(imp[,(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus if (ncolYcon>0) { for (j in 1:(ncolYcon)) { imp[,j]=as.numeric(imp[,j]) } } if (ncolY2con>0) { for (j in 1:(ncolY2con)) { imp[,ncol(Y)+j]=as.numeric(imp[,ncol(Y)+j]) } } for (j in (ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))) { imp[,j]=as.numeric(imp[,j]) } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (is.null(colnamz)) colnamz=paste("Z", 1:ncol(Z), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") if (is.null(colnamx2)) colnamx2=paste("X2", 1:ncol(X2), sep = ".") colnames(imp)<-c(colnamycon,colnamycat,colnamy2con,colnamy2cat,colnamx,colnamx2,colnamz,"clus","id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } if (!is.null(Y.con)) { cnamycomp<-c(colnamycon,cnycatcomp) } else { cnamycomp<-c(cnycatcomp) } } else { cnamycomp<-c(colnamycon) } if (isnullcat2==0) { cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } if (!is.null(Y2.con)) { cnamy2comp<-c(colnamy2con,cny2catcomp) } else { cnamy2comp<-c(cny2catcomp) } } else { cnamy2comp<-c(colnamy2con) } dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(beta2post)[1] <- list(colnamx2) dimnames(beta2post)[2] <- list(cnamy2comp) dimnames(omegapost)[1] <- list(paste(cnamycomp,rep(levels(clus),each=ncol(Yimp2)), sep=".")) dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-paste(cnamycomp,rep(colnamz,each=ncol(omegapost)),sep="*") colnamcovu<-c(colnamcovu,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) dimnames(Yimp2)[2] <- list(cnamycomp) dimnames(Y2imp2)[2] <- list(cnamy2comp) betapostmean<-data.frame(apply(betapost, c(1,2), mean)) beta2postmean<-data.frame(apply(beta2post, c(1,2), mean)) upostmean<-data.frame(apply(upostall, c(1,2), mean)) omegapostmean<-data.frame(apply(omegapost, c(1,2), mean)) covupostmean<-data.frame(apply(covupost, c(1,2), mean)) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior mean of the level 2 fixed effects estimates is:\n") print(t(beta2postmean)) cat("\nThe posterior mean of the random effects estimates is:\n") print(upostmean) cat("\nThe posterior mean of the level 1 covariance matrices is:\n") print(omegapostmean) cat("\nThe posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } return(imp) } jomo/R/jomo1con.MCMCchain.R0000644000176200001440000001054314410253602015010 0ustar liggesusersjomo1con.MCMCchain<- function(Y, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL,start.imp=NULL, nburn=100,output=1, out.iter=10) { if (is.null(X)) X=matrix(1,nrow(Y),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),ncol(Y)) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is_tibble(Y)) { Y<-data.frame(Y) warning("tibbles not supported. Y converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } stopifnot(nrow(Y)==nrow(X), nrow(beta.start)==ncol(X), ncol(beta.start)==ncol(Y),nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(Y), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } nimp=1 colnamy<-colnames(Y) colnamx<-colnames(X) Y<-data.matrix(Y) storage.mode(Y) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+2) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(X), (ncol(Y)+ncol(X)+1)]=c(1:nrow(Y)) Yimp=Y Yimp2=matrix(Yimp, nrow(Y),ncol(Y)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+1)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+2)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) meanobs<-colMeans(Y,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) { for (j in 1:ncol(Y.auxiliary)) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } } X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (is.null(l1cov.start)) { l1cov.start=diag(1,ncol(beta.start)) } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) ncolYcon<-rep(NA,4) ncolYcon[1]=max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con)) ncolYcon[2]=max(as.numeric(!is.null(Y.con)),ncol(Y.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))) Ysub<-as.factor(Ysub) previous_levelssub<-levels(Ysub) levels(Ysub)<-1:2 if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } colnamx<-colnames(X) X<-data.matrix(X) storage.mode(X) <- "numeric" Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } Ysubimp<-as.numeric(Ysub) if (output==0) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+3) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y imp[1:nrow(X), (ncol(Y)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) varYpost<-rep(0,(nimp-1)) vYpost<-matrix(0,1,1) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] for (i in 1:length(Ysubimp)) if (is.na(Ysubimp[i])) Ysubimp[i]=sample(1:2,1) Ysubcat <- as.numeric(Ysub) .Call("jomo1smcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, Y, Yimp, Yimp2, Y.cat.tot, X, betaY.start, bYpost, betait,bpost, varY.start, vYpost, covit,opost, nburn, varY.prior, l1cov.prior,Y.numcat.tot, 1, ncolYcon,out.iter, 0,1, PACKAGE = "jomo") #betapost[,,1]=bpost #omegapost[,,(1)]=opost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) imp[(nrow(Y)+1):(2*nrow(Y)),1]=Ysubcat if (!is.null(Y.con)|!is.null(Y.aux.con)) { imp[(nrow(Y)+1):(2*nrow(Y)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(nrow(Y)+1):(2*nrow(Y)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if (output>0) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+2)]=c(1:nrow(Y)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+3)]=i .Call("jomo1smcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, Y, Yimp, Yimp2, Y.cat.tot, X, betaY.start, bYpost, betait,bpost, varY.start, vYpost, covit,opost, nbetween, varY.prior, l1cov.prior,Y.numcat.tot, 1, ncolYcon,out.iter, 0,1, PACKAGE = "jomo") betapost[,,(i-1)]=bpost betaYpost[,,(i-1)]=bYpost omegapost[,,(i-1)]=opost varYpost[i-1]=vYpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1]=Ysubcat if (!is.null(Y.con)|!is.null(Y.aux.con)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if (output>0) cat("Imputation number ", i, "registered", "\n") } cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-mean(varYpost) betapostmean<-apply(betapost, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) colnames(betaYpostmean)<-names(fit.cr$coefficients) rownames(betaYpostmean)<-colnamysub if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) } } imp<-data.frame(imp) imp[,1]<-as.factor(imp[,1]) levels(imp[,1])<-previous_levelssub if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,"id","Imputation") } return(imp) } jomo/R/jomo.clmm.MCMCchain.R0000644000176200001440000010432014411550061015153 0ustar liggesusersjomo.clmm.MCMCchain <- function(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, betaY.start=NULL, covuY.start=NULL, uY.start=NULL, nburn=1000, meth="common", start.imp=NULL, start.imp.sub=NULL, l2.start.imp=NULL, output=1, out.iter=10) { cat("This function is beta software. Please use carefully and report any bug to the package mantainer\n") stopifnot(is.data.frame(data)) if (is_tibble(data)) { data<-data.frame(data) warning("tibbles not supported. data converted to standard data.frame. ") } if (isTRUE(any(sapply(df, is.character)))) stop("Character variables not allowed in data\n") stopifnot(any(grepl("~",deparse(formula)))) fit.cr<-ordinal::clmm(formula,data=data, na.action = na.omit, Hess=T, link = "probit") colnamysub<-all.vars(formula[[2]]) Ysub<-get(colnamysub,pos=data) stopifnot(is.factor(Ysub)) Ysub.ncat<-nlevels(Ysub) if (is.null(betaY.start)) betaY.start<-c(coef(summary(fit.cr))[-c(1:Ysub.ncat-1),1],coef(summary(fit.cr))[c(1:Ysub.ncat-1),1]) varY.start<-1 varY.prior<-1 Ycov<-data.frame(mget(all.vars(formula[[3]]), envir =as.environment(data))) level<-data.frame(matrix(level,1,ncol(data))) colnames(level)<-colnames(data) terms.sub<-attr(terms(formula), "term.labels") split.terms<-strsplit(terms.sub,":") length.sub<-length(terms.sub) order.sub<-attr(terms(formula), "order") submod<-matrix(1,4,sum(order.sub)-1) Y.con<-NULL Y.cat<-NULL Y.numcat<-NULL Y2.con<-NULL Y2.cat<-NULL Y2.numcat<-NULL Y2i<-NULL Y2imp2<-NULL for (j in 1:ncol(Ycov)) { if (level[1, which(colnames(level)==colnames(Ycov)[j])]==1) { if (is.numeric(Ycov[,j])) { if (is.null(Y.con)) { Y.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.con<-data.frame(Y.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y.cat)) { Y.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.cat<-data.frame(Y.cat,Ycov[,j,drop=FALSE]) } Y.numcat<-cbind(Y.numcat,nlevels(Ycov[,j])) } } else { if (is.numeric(Ycov[,j])) { if (is.null(Y2.con)) { Y2.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.con<-data.frame(Y2.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y2.cat)) { Y2.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.cat<-data.frame(Y2.cat,Ycov[,j,drop=FALSE]) } Y2.numcat<-cbind(Y2.numcat,nlevels(Ycov[,j])) } } } h<-1 for ( j in 1:length.sub) { for ( k in 1:order.sub[j]) { current.term<-split.terms[[j]][k] if (grepl("\\|", deparse(current.term))) { j.tbd<-j clus.name<-sub(".*\\|","",current.term) clus.name<-gsub(" ","",clus.name) current.term<-sub("\\|.*$","",current.term) random.terms<-strsplit(current.term,"+", fixed=T) length.ran<-length(random.terms[[1]]) submod.ran<-matrix(1,3,length.ran) for (t in 1:length.ran) { ct<-gsub(" ","",random.terms[[1]][t]) if (ct==1) { submod.ran[1:2,t]<-0 } else if (length(which(colnames(Y.cat)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.cat)==ct) submod.ran[2,t]<-2 submod.ran[3,t]<-Y.numcat[submod.ran[1,t]]-1 } else if (length(which(colnames(Y.con)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.con)==ct) submod.ran[2,t]<-1 } } } else { current.term<-sub(".*I\\(","",current.term) current.term<-sub("\\)","",current.term) if (grepl("\\^",current.term)) { submod[3,h]<-as.integer(sub(".*\\^","",current.term)) current.term<-sub("\\^.*","",current.term) } else { submod[3,h]<-1 } if (length(which(colnames(Y.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y.cat)==current.term) submod[2,h]<-2 submod[4,h]<-Y.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y.con)==current.term) submod[2,h]<-1 } else if (length(which(colnames(Y2.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.cat)==current.term) submod[2,h]<-4 submod[4,h]<-Y2.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y2.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.con)==current.term) submod[2,h]<-3 } h<-h+1 } } } order.sub<-order.sub[-j.tbd] if (!is.null(Y.con)&sum((colnames(Y.con)==clus.name)==1)) Y.con<-data.frame(Y.con[,-which(colnames(Y.con)==clus.name), drop=FALSE]) if (!is.null(Y2.con)&sum((colnames(Y2.con)==clus.name)==1)) Y2.con<-data.frame(Y2.con[,-which(colnames(Y2.con)==clus.name), drop=FALSE]) if (!is.null(Y.cat)&sum((colnames(Y.cat)==clus.name)==1)) { Y.cat<-data.frame(Y.cat[,-which(colnames(Y.cat)==clus.name), drop=FALSE]) Y.numcat<-Y.numcat[-which(colnames(Y.cat)==clus.name)] } if (!is.null(Y2.cat)&sum((colnames(Y2.cat)==clus.name)==1)) { Y2.numcat<-Y2.numcat[-which(colnames(Y2.cat)==clus.name)] Y2.cat<-data.frame(Y2.cat[,-which(colnames(Y2.cat)==clus.name), drop=FALSE]) } if (!is.null(Y.con)&&ncol(Y.con)==0) Y.con <- NULL if (!is.null(Y.cat)&&ncol(Y.cat)==0) Y.cat <- NULL if (!is.null(Y2.cat)&&ncol(Y2.cat)==0) Y2.cat <- NULL if (!is.null(Y2.con)&&ncol(Y2.con)==0) Y2.con <- NULL Y.auxiliary<-data.frame(data[,-c(which(colnames(data)%in%colnames(Y.con)),which(colnames(data)%in%colnames(Y.cat)),which(colnames(data)%in%colnames(Y2.con)),which(colnames(data)%in%colnames(Y2.cat)),which(colnames(data)==clus.name),which(colnames(data)==colnamysub)), drop=FALSE]) Y.aux.con<-NULL Y.aux.cat<-NULL Y.aux.numcat<-NULL Y2.aux.con<-NULL Y2.aux.cat<-NULL Y2.aux.numcat<-NULL if (ncol(Y.auxiliary)>0) { for (j in 1:ncol(Y.auxiliary)) { if (level[1, which(colnames(level)==colnames(Y.auxiliary)[j])]==1) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } else { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y2.aux.con)) Y2.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.con<-data.frame(Y2.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y2.aux.cat)) Y2.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.cat<-data.frame(Y2.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y2.aux.numcat<-cbind(Y2.aux.numcat,nlevels(Y.auxiliary[,j])) } } } } if (((is.null(Y.con))&&(is.null(Y.cat)&is.null(Y.numcat)))) stop("No level 1 covariates in substantive model. jomo currently supports only models with at least one level 1 variable besides the outcome.\n") X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (!is.null(Y2.con)|!is.null(Y2.cat)|!is.null(Y2.aux.con)|!is.null(Y2.aux.cat)) { X2=matrix(1,max(nrow(Y2.cat),nrow(Y2.con),nrow(Y2.aux.cat),nrow(Y2.aux.con)),1) if (is.null(l2.beta.start)) l2.beta.start=matrix(0,ncol(X2),(max(0,ncol(Y2.con))+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(as.numeric(!is.null(Y2.aux.con)),ncol(Y2.aux.con))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) } Z=matrix(1,nrow(X),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(0,ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) clus<-factor(data[,clus.name]) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(uY.start)) uY.start<-matrix(0,nlevels(clus),ncol(ordinal::VarCorr(fit.cr)[[1]])) if (is.null(l1cov.start)) { if (meth=="common") { l1cov.start=diag(1,ncol(beta.start)) } else { l1cov.start=matrix(diag(1,ncol(beta.start)),nlevels(clus)*ncol(beta.start),ncol(beta.start),2) } } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) diagVar<-as.data.frame(ordinal::VarCorr(fit.cr))[1:ncol(ordinal::VarCorr(fit.cr)[[1]]),4] if (is.null(covuY.start)) covuY.start<-ordinal::VarCorr(fit.cr)[[1]][1:ncol(ordinal::VarCorr(fit.cr)[[1]]),1:ncol(ordinal::VarCorr(fit.cr)[[1]])] covuY.prior<-ordinal::VarCorr(fit.cr)[[1]][1:ncol(ordinal::VarCorr(fit.cr)[[1]]),1:ncol(ordinal::VarCorr(fit.cr)[[1]])] if (kappa(covuY.start)>10^8) { covuY.prior<-diag(1, ncol(ordinal::VarCorr(fit.cr)[[1]])) covuY.start<-diag(1, ncol(ordinal::VarCorr(fit.cr)[[1]])) } ncolYcon<-rep(NA,4) ncolY2con<-rep(NA,4) ncolYcon[1]=max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)) ncolY2con[1]=max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)) ncolYcon[2]=max(0,ncol(Y.con)) ncolY2con[2]=max(0,ncol(Y2.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolY2con[3]=ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) ncolY2con[4]=max(0,ncol(Y2.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))||((!is.null(Y2.con))||(!is.null(Y2.cat)&!is.null(Y2.numcat)))) previous_levelssub<-levels(Ysub) levels(Ysub)<-1:Ysub.ncat if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } if (!is.null(Y2.cat)) { isnullcat2=0 previous_levels2<-list() Y2.cat<-data.frame(Y2.cat) for (i in 1:ncol(Y2.cat)) { Y2.cat[,i]<-factor(Y2.cat[,i]) previous_levels2[[i]]<-levels(Y2.cat[,i]) levels(Y2.cat[,i])<-1:nlevels(Y2.cat[,i]) } } else { isnullcat2=1 } if (!is.null(Y2.aux.cat)) { isnullcat2aux=0 previous_levels2aux<-list() Y2.aux.cat<-data.frame(Y2.aux.cat) for (i in 1:ncol(Y2.aux.cat)) { Y2.aux.cat[,i]<-factor(Y2.aux.cat[,i]) previous_levels2aux[[i]]<-levels(Y2.aux.cat[,i]) levels(Y2.aux.cat[,i])<-1:nlevels(Y2.aux.cat[,i]) } } else { isnullcat2aux=1 } if (!is.null(Y.con)) { stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(Z)==nrow(Y.con)) } if (isnullcat==0) { stopifnot(nrow(Y.cat)==nrow(clus),nrow(Y.cat)==nrow(X), nrow(Z)==nrow(Y.cat)) } if (!is.null(Y2.con)) { stopifnot(nrow(Y2.con)==nrow(clus),nrow(Y2.con)==nrow(X), nrow(Z)==nrow(Y2.con)) } if (isnullcat2==0) { stopifnot(nrow(Y2.cat)==nrow(clus),nrow(Y2.cat)==nrow(X), nrow(Z)==nrow(Y2.cat)) } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) stopifnot(nrow(l2.beta.start)==ncol(X2), ncol(l2.beta.start)==(ncolY2con[3]+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) stopifnot(ncol(u.start)==ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (meth=="common") stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) stopifnot(ncol(l2cov.start)==ncol(u.start), nrow(l2cov.prior)==nrow(l2cov.start), nrow(l2cov.prior)==ncol(l2cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) { beta2it=matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) for (i in 1:nrow(l2.beta.start)) { for (j in 1:ncol(l2.beta.start)) beta2it[i,j]=l2.beta.start[i,j] } } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y2.con)) { colnamy2con<-colnames(Y2.con) Y2.con<-data.matrix(Y2.con) storage.mode(Y2.con) <- "numeric" } else { colnamy2con<-NULL } if (isnullcat2==0) { colnamy2cat<-colnames(Y2.cat) Y2.cat<-data.matrix(Y2.cat) storage.mode(Y2.cat) <- "numeric" cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } } else { cny2catcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } if (!is.null(Y2.aux.con)) { colnamy2auxcon<-colnames(Y2.aux.con) Y2.aux.con<-data.matrix(Y2.aux.con) storage.mode(Y2.aux.con) <- "numeric" } else { colnamy2auxcon<-NULL } if (isnullcat2aux==0) { colnamy2auxcat<-colnames(Y2.aux.cat) Y2.aux.cat<-data.matrix(Y2.aux.cat) storage.mode(Y2.aux.cat) <- "numeric" cny2auxcatcomp<-rep(NA,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))) count=0 for ( j in 1:ncol(Y2.aux.cat)) { for (k in 1:(Y2.aux.numcat[j]-1)) { cny2auxcatcomp[count+k]<-paste(colnamy2auxcat[j],k,sep=".") } count=count+Y2.aux.numcat[j]-1 } } else { cny2auxcatcomp<-NULL } Y.cat.tot<-cbind(Y.cat,Y.aux.cat) colnamx<-colnames(X) colnamz<-colnames(Z) X<-data.matrix(X) storage.mode(X) <- "numeric" Z<-data.matrix(Z) storage.mode(Z) <- "numeric" if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) { colnamx2<-colnames(X2) X2<-data.matrix(X2) storage.mode(X2) <- "numeric" } clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) Y2=cbind(Y2.con,Y2.aux.con,Y2.cat, Y2.aux.cat) Y2i=cbind(Y2.con, Y2.aux.con, switch(is.null(Y2.cat)+1, matrix(0,nrow(Y2),(sum(Y2.numcat)-length(Y2.numcat))), NULL), switch(is.null(Y2.aux.cat)+1, matrix(0,nrow(Y2.aux.cat),(sum(Y2.aux.numcat)-length(Y2.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } h=1 if (isnullcat2==0) { for (i in 1:length(Y2.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.numcat[i]-2)]=NA } } h=h+Y2.numcat[i]-1 } } if (isnullcat2aux==0) { for (i in 1:length(Y2.aux.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.aux.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.aux.numcat[i]-2)]=NA } } h=h+Y2.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } if (isnullcat2==0||isnullcat2aux==0) { Y2.cat.tot<-cbind(Y2.cat,Y2.aux.cat) Y2.numcat.tot<-c(Y2.numcat, Y2.aux.numcat) } else { Y2.cat.tot=-999 Y2.numcat.tot=-999 } ncY2<-max(0,ncol(Y2)) Ysubimp<-as.numeric(Ysub) if (is.null(a.start)) a.start=50+ncol(Y) if (is.null(a.prior)) a.prior=a.start if (output == 0 ) out.iter=nburn+2 nimp=1 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncY2+4) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y if (!is.null(Y2)) imp[1:nrow(Y2),(ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2 imp[1:nrow(clus), (ncol(Y)+ncY2+2)]=clus imp[1:nrow(X), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) if (!is.null(Y2)) { Y2imp=Y2i Y2imp2=matrix(Y2imp, nrow(Y2imp),ncol(Y2imp)) } imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncY2+2)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+4)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) betaYpost<- array(0, dim=c(1,length(betaY.start),nburn)) if (!is.null(Y2)) { beta2post<- array(0, dim=c(nrow(l2.beta.start),ncol(l2.beta.start),nburn)) } else { beta2post<-NULL } upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),nburn)) uYpostall<-array(0, dim=c(nrow(uY.start),ncol(uY.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) varYpost<-rep(0,nburn) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),nburn)) covuYpost<-array(0, dim=c(nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start)),nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] if (!is.null(Y2)) { meanobs2<-colMeans(Y2i,na.rm=TRUE) } if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)ncol(l2.start.imp))) { cat("l2.start.imp dimensions incorrect. Not using l2.start.imp as starting value for the level 2 imputed dataset.\n") l2.start.imp=NULL } else { if ((nrow(l2.start.imp)==nrow(Y2imp2))&(ncol(Y2imp2) 0) cat("First imputation registered.", "\n") cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) cnamy2comp<-c(colnamy2con, colnamy2auxcon, cny2catcomp, cny2auxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) if (!is.null(Y2)) { dimnames(beta2post)[1] <- list("(Intercept)") dimnames(beta2post)[2] <- list(cnamy2comp) } dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-c(cnamycomp,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-mean(varYpost) covuYpostmean<-apply(covuYpost, c(1,2), mean) uYpostmean<-apply(uYpostall, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) if (!is.null(Y2)) beta2postmean<-apply(beta2post, c(1,2), mean) upostmean<-apply(upostall, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) covupostmean<-apply(covupost, c(1,2), mean) colnames(betaYpostmean)<-names(fit.cr$coefficients)[c(Ysub.ncat:length(fit.cr$coefficients),1:(Ysub.ncat-1))] rownames(betaYpostmean)<-colnamysub colnames(covuYpostmean)<-rownames(covuYpostmean)<-colnames(uYpostmean)<-rownames(fit.cr$ST[[1]]) rownames(uYpostmean)<-levels(factor(clus)) if (output> 0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) cat("The posterior mean of the substantive model random effects covariance matrix is:\n") print(covuYpostmean) cat("The posterior mean of the substantive model random effects estimates is:\n") print(uYpostmean) if ( output == 2 ) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) if (!is.null(Y2)) { cat("The posterior mean of the level 2 fixed effects estimates is:\n") print(beta2postmean) } cat("The posterior mean of the random effects estimates is:\n") print(upostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) cat("The posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } } imp<-data.frame(imp) imp[,1]<-as.factor(imp[,1]) levels(imp[,1])<-previous_levelssub if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+length(Y.numcat)+i)]<-as.factor(imp[,(1+ncolYcon[1]+length(Y.numcat)+i)]) levels(imp[,(1+ncolYcon[1]+length(Y.numcat)+i)])<-previous_levelsaux[[i]] } } if (isnullcat2==0) { for (i in 1:ncol(Y2.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+i)])<-previous_levels2[[i]] } } if (isnullcat2aux==0) { for (i in 1:ncol(Y2.aux.cat)) { imp[,(1+ncol(Y)+ncolY2con[3]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[3]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[3]+i)])<-previous_levels2aux[[i]] } } imp[,(ncol(Y)+ncY2+2)]<-factor(imp[,(ncol(Y)+ncY2+2)]) levels(imp[,(ncol(Y)+ncY2+2)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (ncolY2con[1]>0) { for (j in 1:(ncolY2con[1])) { imp[,ncol(Y)+j+1]=as.numeric(imp[,ncol(Y)+j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (isnullcat2aux==0) { if (is.null(colnamy2auxcat)) colnamy2auxcat=paste("Y2cat.aux", 1:ncol(Y2.aux.cat), sep = "") } else { colnamy2auxcat=NULL Y2.aux.cat=NULL Y2.aux.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (!is.null(Y2.aux.con)) { if (is.null(colnamy2auxcon)) colnamy2auxcon=paste("Y2con.aux", 1:ncol(Y2.aux.con), sep = "") } else { colnamy2auxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,colnamy2con,colnamy2auxcon,colnamy2cat,colnamy2auxcat,"clus","id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (isnullcataux==0) { cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } cnamycomp<-c(colnamycon,colnamyauxcon,cnycatcomp,cnyauxcatcomp) if (isnullcat2==0) { cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } } else { cny2catcomp<-NULL } if (isnullcat2aux==0) { cny2auxcatcomp<-rep(NA,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))) count=0 for ( j in 1:ncol(Y2.aux.cat)) { for (k in 1:(Y2.aux.numcat[j]-1)) { cny2auxcatcomp[count+k]<-paste(colnamy2auxcat[j],k,sep=".") } count=count+Y2.aux.numcat[j]-1 } } else { cny2auxcatcomp<-NULL } cnamy2comp<-c(colnamy2con,colnamy2auxcon,cny2catcomp,cny2auxcatcomp) dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) if (!is.null(Y2)) { dimnames(beta2post)[1] <- list(colnamx2) dimnames(beta2post)[2] <- list(cnamy2comp) } if (meth=="random") { dimnames(omegapost)[1] <- list(paste(rep(cnamycomp, nrow(u.start)),rep(previous_levels_clus,each=ncol(omegapost)))) } else { dimnames(omegapost)[1] <- list(cnamycomp) } dimnames(omegapost)[2] <- list(cnamycomp) dimnames(Yimp2)[2] <- list(cnamycomp) return(list("finimp"=imp, "collectbeta2"=beta2post,"collectbeta"=betapost,"collectu"=upostall,"collectomega"=omegapost, "collectcovu"=covupost, "finimp.latnorm" = Yimp2, "l2.finimp.latnorm" = Y2imp2, "collectbetaY"=betaYpost, "collectvarY"=varYpost, "collectcovuY"=covuYpost, "collectuY"=uYpostall)) } jomo/R/jomo1rancat.R0000644000176200001440000002301114410253602013752 0ustar liggesusersjomo1rancat <- function(Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) { if (nimp<2) { nimp=2 cat("Minimum number of imputations:2. For single imputation using function jomo1rancat.MCMCchain\n") } if (is.null(X)) X=matrix(1,nrow(Y.cat),1) if (is.null(Z)) Z=matrix(1,nrow(Y.cat),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),((sum(Y.numcat)-length(Y.numcat)))) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z) * ((sum(Y.numcat) - length(Y.numcat)))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } if (any(is.na(Y.cat))) { if (ncol(Y.cat)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y.cat, plot=F) miss.pat<-miss.pat[,colnames(Y.cat)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y.cat)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y.cat)) for (i in 1:nrow(Y.cat)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y.cat[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot( nrow(beta.start)==ncol(X), ncol(beta.start)==((sum(Y.numcat)-length(Y.numcat))),nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(beta.start), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start),nrow(Z)==nrow(Y.cat), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*((sum(Y.numcat)-length(Y.numcat)))) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } colnamycat<-colnames(Y.cat) colnamx<-colnames(X) colnamz<-colnames(Z) Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.cat) Yi=cbind(matrix(0,nrow(Y.cat),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,h:(h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nimp-1))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nimp-1))) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=rnorm(1,meanobs[j],1) .Call("jomo1ranC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit, cpost, nburn, l1cov.prior,l2cov.prior,Y.numcat, 0,out.iter, 0, miss.pat.id, n.patterns, PACKAGE = "jomo") #betapost[,,1]=bpost #upostall[,,1]=upost #omegapost[,,(1)]=opost #covupost[,,(1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(nrow(Y)+1):(2*nrow(Y)),1:ncol(Y)]=Y.cat if (output==1) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(i*nrow(clus)+1):((i+1)*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=i .Call("jomo1ranC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit, cpost, nbetween, l1cov.prior,l2cov.prior,Y.numcat, 0, out.iter, 0, miss.pat.id, n.patterns, PACKAGE = "jomo") betapost[,,(i-1)]=bpost upostall[,,(i-1)]=upost omegapost[,,(i-1)]=opost covupost[,,(i-1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1:ncol(Y)]=Y.cat if (output==1) cat("Imputation number ", i, "registered", "\n") } imp<-data.frame(imp) for (i in 1:ncol(Y)) { imp[,i]<-as.factor(imp[,i]) levels(imp[,i])<-previous_levels[[i]] } imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]<-factor(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]) levels(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus for (j in (ncol(Y.cat)+1):(ncol(Y.cat)+ncol(X)+ncol(Z))) { imp[,j]=as.numeric(imp[,j]) } if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") if (is.null(colnamz)) colnamz=paste("Z", 1:ncol(Z), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") colnames(imp)<-c(colnamycat,colnamx,colnamz,"clus","id","Imputation") cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnycatcomp) dimnames(omegapost)[1] <- list(cnycatcomp) dimnames(omegapost)[2] <- list(cnycatcomp) colnamcovu<-paste(cnycatcomp,rep(colnamz,each=ncol(omegapost)),sep="*") dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) betapostmean<-apply(betapost, c(1,2), mean) upostmean<-apply(upostall, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) covupostmean<-apply(covupost, c(1,2), mean) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior mean of the random effects estimates is:\n") print(upostmean) cat("\nThe posterior mean of the level 1 covariance matrices is:\n") print(omegapostmean) cat("\nThe posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } return(imp) } jomo/R/jomo.clmm.R0000644000176200001440000010551214411550073013441 0ustar liggesusersjomo.clmm <- function(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, nburn=1000, nbetween=1000, nimp=5, meth="common", output=1, out.iter=10) { cat("This function is beta software. Please use carefully and report any bug to the package mantainer\n") if (nimp<2) { nimp=2 cat("Minimum number of imputations:2. For single imputation using function jomo.clmm.MCMCchain\n") } stopifnot(is.data.frame(data)) if (is_tibble(data)) { data<-data.frame(data) warning("tibbles not supported. data converted to standard data.frame. ") } if (isTRUE(any(sapply(df, is.character)))) stop("Character variables not allowed in data\n") stopifnot(any(grepl("~",deparse(formula)))) fit.cr<-ordinal::clmm(formula,data=data, na.action = na.omit, Hess=T, link = "probit") colnamysub<-all.vars(formula[[2]]) Ysub<-get(colnamysub,pos=data) stopifnot(is.factor(Ysub)) Ysub.ncat<-nlevels(Ysub) betaY.start<-c(coef(summary(fit.cr))[-c(1:Ysub.ncat-1),1],coef(summary(fit.cr))[c(1:Ysub.ncat-1),1]) varY.start<-1 varY.prior<-1 Ycov<-data.frame(mget(all.vars(formula[[3]]), envir =as.environment(data))) level<-data.frame(matrix(level,1,ncol(data))) colnames(level)<-colnames(data) terms.sub<-attr(terms(formula), "term.labels") split.terms<-strsplit(terms.sub,":") length.sub<-length(terms.sub) order.sub<-attr(terms(formula), "order") submod<-matrix(1,4,sum(order.sub)-1) Y.con<-NULL Y.cat<-NULL Y.numcat<-NULL Y2.con<-NULL Y2.cat<-NULL Y2.numcat<-NULL for (j in 1:ncol(Ycov)) { if (level[1, which(colnames(level)==colnames(Ycov)[j])]==1) { if (is.numeric(Ycov[,j])) { if (is.null(Y.con)) { Y.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.con<-data.frame(Y.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y.cat)) { Y.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.cat<-data.frame(Y.cat,Ycov[,j,drop=FALSE]) } Y.numcat<-cbind(Y.numcat,nlevels(Ycov[,j])) } } else { if (is.numeric(Ycov[,j])) { if (is.null(Y2.con)) { Y2.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.con<-data.frame(Y2.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y2.cat)) { Y2.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.cat<-data.frame(Y2.cat,Ycov[,j,drop=FALSE]) } Y2.numcat<-cbind(Y2.numcat,nlevels(Ycov[,j])) } } } h<-1 for ( j in 1:length.sub) { for ( k in 1:order.sub[j]) { current.term<-split.terms[[j]][k] if (grepl("\\|", deparse(current.term))) { j.tbd<-j clus.name<-sub(".*\\|","",current.term) clus.name<-gsub(" ","",clus.name) current.term<-sub("\\|.*$","",current.term) random.terms<-strsplit(current.term,"+", fixed=T) length.ran<-length(random.terms[[1]]) submod.ran<-matrix(1,3,length.ran) for (t in 1:length.ran) { ct<-gsub(" ","",random.terms[[1]][t]) if (ct==1) { submod.ran[1:2,t]<-0 } else if (length(which(colnames(Y.cat)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.cat)==ct) submod.ran[2,t]<-2 submod.ran[3,t]<-Y.numcat[submod.ran[1,t]]-1 } else if (length(which(colnames(Y.con)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.con)==ct) submod.ran[2,t]<-1 } } } else { current.term<-sub(".*I\\(","",current.term) current.term<-sub("\\)","",current.term) if (grepl("\\^",current.term)) { submod[3,h]<-as.integer(sub(".*\\^","",current.term)) current.term<-sub("\\^.*","",current.term) } else { submod[3,h]<-1 } if (length(which(colnames(Y.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y.cat)==current.term) submod[2,h]<-2 submod[4,h]<-Y.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y.con)==current.term) submod[2,h]<-1 } else if (length(which(colnames(Y2.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.cat)==current.term) submod[2,h]<-4 submod[4,h]<-Y2.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y2.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.con)==current.term) submod[2,h]<-3 } h<-h+1 } } } order.sub<-order.sub[-j.tbd] if (!is.null(Y.con)&sum((colnames(Y.con)==clus.name)==1)) Y.con<-data.frame(Y.con[,-which(colnames(Y.con)==clus.name), drop=FALSE]) if (!is.null(Y2.con)&sum((colnames(Y2.con)==clus.name)==1)) Y2.con<-data.frame(Y2.con[,-which(colnames(Y2.con)==clus.name), drop=FALSE]) if (!is.null(Y.cat)&sum((colnames(Y.cat)==clus.name)==1)) { Y.cat<-data.frame(Y.cat[,-which(colnames(Y.cat)==clus.name), drop=FALSE]) Y.numcat<-Y.numcat[-which(colnames(Y.cat)==clus.name)] } if (!is.null(Y2.cat)&sum((colnames(Y2.cat)==clus.name)==1)) { Y2.numcat<-Y2.numcat[-which(colnames(Y2.cat)==clus.name)] Y2.cat<-data.frame(Y2.cat[,-which(colnames(Y2.cat)==clus.name), drop=FALSE]) } if (!is.null(Y.con)&&ncol(Y.con)==0) Y.con <- NULL if (!is.null(Y.cat)&&ncol(Y.cat)==0) Y.cat <- NULL if (!is.null(Y2.cat)&&ncol(Y2.cat)==0) Y2.cat <- NULL if (!is.null(Y2.con)&&ncol(Y2.con)==0) Y2.con <- NULL Y.auxiliary<-data.frame(data[,-c(which(colnames(data)%in%colnames(Y.con)),which(colnames(data)%in%colnames(Y.cat)),which(colnames(data)%in%colnames(Y2.con)),which(colnames(data)%in%colnames(Y2.cat)),which(colnames(data)==clus.name),which(colnames(data)==colnamysub)), drop=FALSE]) Y.aux.con<-NULL Y.aux.cat<-NULL Y.aux.numcat<-NULL Y2.aux.con<-NULL Y2.aux.cat<-NULL Y2.aux.numcat<-NULL if (ncol(Y.auxiliary)>0) { for (j in 1:ncol(Y.auxiliary)) { if (level[1, which(colnames(level)==colnames(Y.auxiliary)[j])]==1) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } else { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y2.aux.con)) Y2.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.con<-data.frame(Y2.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y2.aux.cat)) Y2.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.cat<-data.frame(Y2.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y2.aux.numcat<-cbind(Y2.aux.numcat,nlevels(Y.auxiliary[,j])) } } } } if (((is.null(Y.con))&&(is.null(Y.cat)&is.null(Y.numcat)))) stop("No level 1 covariates in substantive model. jomo currently supports only models with at least one level 1 variable besides the outcome.\n") X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (!is.null(Y2.con)|!is.null(Y2.cat)|!is.null(Y2.aux.con)|!is.null(Y2.aux.cat)) { X2=matrix(1,max(nrow(Y2.cat),nrow(Y2.con),nrow(Y2.aux.cat),nrow(Y2.aux.con)),1) if (is.null(l2.beta.start)) l2.beta.start=matrix(0,ncol(X2),(max(0,ncol(Y2.con))+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(as.numeric(!is.null(Y2.aux.con)),ncol(Y2.aux.con))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) } Z=matrix(1,nrow(X),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(0,ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) clus<-factor(data[,clus.name]) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) uY.start<-matrix(0,nlevels(clus),ncol(ordinal::VarCorr(fit.cr)[[1]])) if (is.null(l1cov.start)) { if (meth=="common") { l1cov.start=diag(1,ncol(beta.start)) } else { l1cov.start=matrix(diag(1,ncol(beta.start)),nlevels(clus)*ncol(beta.start),ncol(beta.start),2) } } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) diagVar<-as.data.frame(ordinal::VarCorr(fit.cr))[1:ncol(ordinal::VarCorr(fit.cr)[[1]]),4] covuY.start<-ordinal::VarCorr(fit.cr)[[1]][1:ncol(ordinal::VarCorr(fit.cr)[[1]]),1:ncol(ordinal::VarCorr(fit.cr)[[1]])] covuY.prior<-ordinal::VarCorr(fit.cr)[[1]][1:ncol(ordinal::VarCorr(fit.cr)[[1]]),1:ncol(ordinal::VarCorr(fit.cr)[[1]])] if (kappa(covuY.start)>10^8) { covuY.prior<-diag(1, ncol(ordinal::VarCorr(fit.cr)[[1]])) covuY.start<-diag(1, ncol(ordinal::VarCorr(fit.cr)[[1]])) } ncolYcon<-rep(NA,4) ncolY2con<-rep(NA,4) ncolYcon[1]=max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)) ncolY2con[1]=max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)) ncolYcon[2]=max(0,ncol(Y.con)) ncolY2con[2]=max(0,ncol(Y2.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolY2con[3]=ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) ncolY2con[4]=max(0,ncol(Y2.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))||((!is.null(Y2.con))||(!is.null(Y2.cat)&!is.null(Y2.numcat)))) previous_levelssub<-levels(Ysub) levels(Ysub)<-1:Ysub.ncat if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } if (!is.null(Y2.cat)) { isnullcat2=0 previous_levels2<-list() Y2.cat<-data.frame(Y2.cat) for (i in 1:ncol(Y2.cat)) { Y2.cat[,i]<-factor(Y2.cat[,i]) previous_levels2[[i]]<-levels(Y2.cat[,i]) levels(Y2.cat[,i])<-1:nlevels(Y2.cat[,i]) } } else { isnullcat2=1 } if (!is.null(Y2.aux.cat)) { isnullcat2aux=0 previous_levels2aux<-list() Y2.aux.cat<-data.frame(Y2.aux.cat) for (i in 1:ncol(Y2.aux.cat)) { Y2.aux.cat[,i]<-factor(Y2.aux.cat[,i]) previous_levels2aux[[i]]<-levels(Y2.aux.cat[,i]) levels(Y2.aux.cat[,i])<-1:nlevels(Y2.aux.cat[,i]) } } else { isnullcat2aux=1 } if (!is.null(Y.con)) { stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(Z)==nrow(Y.con)) } if (isnullcat==0) { stopifnot(nrow(Y.cat)==nrow(clus),nrow(Y.cat)==nrow(X), nrow(Z)==nrow(Y.cat)) } if (!is.null(Y2.con)) { stopifnot(nrow(Y2.con)==nrow(clus),nrow(Y2.con)==nrow(X), nrow(Z)==nrow(Y2.con)) } if (isnullcat2==0) { stopifnot(nrow(Y2.cat)==nrow(clus),nrow(Y2.cat)==nrow(X), nrow(Z)==nrow(Y2.cat)) } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) stopifnot(nrow(l2.beta.start)==ncol(X2), ncol(l2.beta.start)==(ncolY2con[3]+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) stopifnot(ncol(u.start)==ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (meth=="common") stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) stopifnot(ncol(l2cov.start)==ncol(u.start), nrow(l2cov.prior)==nrow(l2cov.start), nrow(l2cov.prior)==ncol(l2cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) { beta2it=matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) for (i in 1:nrow(l2.beta.start)) { for (j in 1:ncol(l2.beta.start)) beta2it[i,j]=l2.beta.start[i,j] } } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y2.con)) { colnamy2con<-colnames(Y2.con) Y2.con<-data.matrix(Y2.con) storage.mode(Y2.con) <- "numeric" } else { colnamy2con<-NULL } if (isnullcat2==0) { colnamy2cat<-colnames(Y2.cat) Y2.cat<-data.matrix(Y2.cat) storage.mode(Y2.cat) <- "numeric" cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } } else { cny2catcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } if (!is.null(Y2.aux.con)) { colnamy2auxcon<-colnames(Y2.aux.con) Y2.aux.con<-data.matrix(Y2.aux.con) storage.mode(Y2.aux.con) <- "numeric" } else { colnamy2auxcon<-NULL } if (isnullcat2aux==0) { colnamy2auxcat<-colnames(Y2.aux.cat) Y2.aux.cat<-data.matrix(Y2.aux.cat) storage.mode(Y2.aux.cat) <- "numeric" cny2auxcatcomp<-rep(NA,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))) count=0 for ( j in 1:ncol(Y2.aux.cat)) { for (k in 1:(Y2.aux.numcat[j]-1)) { cny2auxcatcomp[count+k]<-paste(colnamy2auxcat[j],k,sep=".") } count=count+Y2.aux.numcat[j]-1 } } else { cny2auxcatcomp<-NULL } Y.cat.tot<-cbind(Y.cat,Y.aux.cat) colnamx<-colnames(X) colnamz<-colnames(Z) X<-data.matrix(X) storage.mode(X) <- "numeric" Z<-data.matrix(Z) storage.mode(Z) <- "numeric" if (!is.null(Y2.con)||isnullcat2==0) { colnamx2<-colnames(X2) X2<-data.matrix(X2) storage.mode(X2) <- "numeric" } clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) Y2=cbind(Y2.con,Y2.aux.con,Y2.cat, Y2.aux.cat) Y2i=cbind(Y2.con, Y2.aux.con, switch(is.null(Y2.cat)+1, matrix(0,nrow(Y2),(sum(Y2.numcat)-length(Y2.numcat))), NULL), switch(is.null(Y2.aux.cat)+1, matrix(0,nrow(Y2.aux.cat),(sum(Y2.aux.numcat)-length(Y2.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } h=1 if (isnullcat2==0) { for (i in 1:length(Y2.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.numcat[i]-2)]=NA } } h=h+Y2.numcat[i]-1 } } if (isnullcat2aux==0) { for (i in 1:length(Y2.aux.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.aux.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.aux.numcat[i]-2)]=NA } } h=h+Y2.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } if (isnullcat2==0||isnullcat2aux==0) { Y2.cat.tot<-cbind(Y2.cat,Y2.aux.cat) Y2.numcat.tot<-c(Y2.numcat, Y2.aux.numcat) } else { Y2.cat.tot=-999 Y2.numcat.tot=-999 } ncY2<-max(0,ncol(Y2)) Ysubimp<-as.numeric(Ysub) if (is.null(a.start)) a.start=50+ncol(Y) if (is.null(a.prior)) a.prior=a.start if (output == 0) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncY2+4) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y if (!is.null(Y2)) imp[1:nrow(Y2),(ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2 imp[1:nrow(clus), (ncol(Y)+ncY2+2)]=clus imp[1:nrow(X), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) if (!is.null(Y2)) { Y2imp=Y2i Y2imp2=matrix(Y2imp, nrow(Y2imp),ncol(Y2imp)) } imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncY2+2)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+4)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) if (!is.null(Y2)) { beta2post<- array(0, dim=c(nrow(l2.beta.start),ncol(l2.beta.start),(nimp-1))) b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) } upost<-matrix(0,nrow(u.start),ncol(u.start)) uYpost<-matrix(0,nrow(uY.start),ncol(uY.start)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nimp-1))) uYpostall<-array(0, dim=c(nrow(uY.start),ncol(uY.start),(nimp-1))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) varYpost<-rep(0,(nimp-1)) vYpost<-matrix(0,1,1) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nimp-1))) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) covuYpost<-array(0, dim=c(nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start)),(nimp-1))) cuYpost<-matrix(0,nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start))) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] if (!is.null(Y2)) { meanobs2<-colMeans(Y2i,na.rm=TRUE) for (i in 1:nrow(Y2i)) for (j in 1:ncol(Y2i)) if (is.na(Y2imp[i,j])) Y2imp2[i,j]=meanobs2[j] } for (i in 1:length(Ysubimp)) if (is.na(Ysubimp[i])) Ysubimp[i]=sample(1:Ysub.ncat,1) Ysubcat <- as.numeric(Ysub) Ysubcat[is.na(Ysubcat)]<-1 if (!is.null(Y2)) { if (meth=="common") { .Call("jomo2smcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, Ysub.ncat, ncolYcon,ncolY2con, out.iter, 0, 2, PACKAGE = "jomo") } else { .Call("jomo2hrsmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, Ysub.ncat, ncolYcon,ncolY2con, a.start, a.prior, out.iter, 0, 2, PACKAGE = "jomo") } } else { if (meth=="common") { .Call("jomo1ransmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Ysub.ncat, ncolYcon,out.iter, 0, 2, PACKAGE = "jomo") } else { .Call("jomo1ranhrsmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Ysub.ncat, ncolYcon, a.start, a.prior, out.iter, 0, 2, PACKAGE = "jomo") } } #betapost[,,1]=bpost #upostall[,,1]=upost #omegapost[,,(1)]=opost #covupost[,,(1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) upost<-matrix(0,nrow(u.start),ncol(u.start)) uYpost<-matrix(0,nrow(uY.start),ncol(uY.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) cuYpost<-matrix(0,nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start))) if (!is.null(Y2)) { b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) } imp[(nrow(Y)+1):(2*nrow(Y)),1]=Ysubcat if ((!is.null(Y.con)&&ncol(Y.con)!=0)|(!is.null(Y.aux.con)&&ncol(Y.aux.con)!=0)) { imp[(nrow(Y)+1):(2*nrow(Y)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(nrow(Y)+1):(2*nrow(Y)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if ((!is.null(Y2.con)&&ncol(Y2.con)!=0)|(!is.null(Y2.aux.con)&&ncol(Y2.aux.con)!=0)) { imp[(nrow(Y2)+1):(2*nrow(Y2)),(ncol(Y)+2):(1+ncol(Y)+max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)))]=Y2imp2[,1:(max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)))] } if (isnullcat2==0|isnullcat2aux==0) { imp[(nrow(Y2)+1):(2*nrow(Y2)),(ncolY2con[1]+ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2.cat.tot } if (output > 0) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(clus)+1):((i+1)*nrow(clus)), (ncol(Y)+ncY2+2)]=clus imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncY2+4)]=i if (!is.null(Y2)) { if (meth=="common") { .Call("jomo2smcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, Ysub.ncat, ncolYcon,ncolY2con, out.iter, 0, 2, PACKAGE = "jomo") } else { .Call("jomo2hrsmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, Ysub.ncat, ncolYcon,ncolY2con, a.start, a.prior, out.iter, 0, 2, PACKAGE = "jomo") } } else { if (meth=="common") { .Call("jomo1ransmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Ysub.ncat, ncolYcon, out.iter, 0, 2, PACKAGE = "jomo") } else { .Call("jomo1ranhrsmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Ysub.ncat, ncolYcon, a.start, a.prior, out.iter, 0, 2, PACKAGE = "jomo") } } betapost[,,(i-1)]=bpost betaYpost[,,(i-1)]=bYpost upostall[,,(i-1)]=upost uYpostall[,,(i-1)]=uYpost omegapost[,,(i-1)]=opost varYpost[i-1]=vYpost covupost[,,(i-1)]=cpost covuYpost[,,(i-1)]=cuYpost if (!is.null(Y2)) { beta2post[,,(i-1)]=b2post b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) } bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) upost<-matrix(0,nrow(u.start),ncol(u.start)) uYpost<-matrix(0,nrow(uY.start),ncol(uY.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) cuYpost<-matrix(0,nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start))) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1]=Ysubcat if ((!is.null(Y.con)&&ncol(Y.con)!=0)|(!is.null(Y.aux.con)&&ncol(Y.aux.con)!=0)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if ((!is.null(Y2.con)&&ncol(Y2.con)!=0)|(!is.null(Y2.aux.con)&&ncol(Y2.aux.con)!=0)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+2):(ncol(Y)+max(0,ncol(Y2.con))+1+max(0,ncol(Y2.aux.con)))]=Y2imp2[,1:(max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)))] } if (isnullcat2==0|isnullcat2aux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolY2con[1]+ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2.cat.tot } if (output > 0) cat("Imputation number ", i, "registered", "\n") } cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) cnamy2comp<-c(colnamy2con, colnamy2auxcon, cny2catcomp, cny2auxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) if (!is.null(Y2)) { dimnames(beta2post)[1] <- list("(Intercept)") dimnames(beta2post)[2] <- list(cnamy2comp) } if (meth=="common") { dimnames(omegapost)[1] <- list(cnamycomp) } else { dimnames(omegapost)[1] <- list(paste(cnamycomp,rep(levels(factor(clus)),each=length(cnamycomp)), sep=".")) } dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-c(cnamycomp,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(factor(clus))) dimnames(upostall)[2]<-list(colnamcovu) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-mean(varYpost) covuYpostmean<-apply(covuYpost, c(1,2), mean) uYpostmean<-apply(uYpostall, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) if (!is.null(Y2)) beta2postmean<-apply(beta2post, c(1,2), mean) upostmean<-apply(upostall, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) covupostmean<-apply(covupost, c(1,2), mean) colnames(betaYpostmean)<-names(fit.cr$coefficients)[c(Ysub.ncat:length(fit.cr$coefficients),1:(Ysub.ncat-1))] rownames(betaYpostmean)<-colnamysub colnames(covuYpostmean)<-rownames(covuYpostmean)<-colnames(uYpostmean)<-rownames(fit.cr$ST[[1]]) rownames(uYpostmean)<-levels(factor(clus)) if (output > 0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) cat("The posterior mean of the substantive model random effects covariance matrix is:\n") print(covuYpostmean) cat("The posterior mean of the substantive model random effects estimates is:\n") print(uYpostmean) if (output ==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) if (!is.null(Y2)) { cat("The posterior mean of the level 2 fixed effects estimates is:\n") print(beta2postmean) } cat("The posterior mean of the random effects estimates is:\n") print(upostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) cat("The posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } } imp<-data.frame(imp) imp[,1]<-as.factor(imp[,1]) levels(imp[,1])<-previous_levelssub if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+length(Y.numcat)+i)]<-as.factor(imp[,(1+ncolYcon[1]+length(Y.numcat)+i)]) levels(imp[,(1+ncolYcon[1]+length(Y.numcat)+i)])<-previous_levelsaux[[i]] } } if (isnullcat2==0) { for (i in 1:ncol(Y2.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+i)])<-previous_levels2[[i]] } } if (isnullcat2aux==0) { for (i in 1:ncol(Y2.aux.cat)) { imp[,(1+ncol(Y)+ncolY2con[3]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[3]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[3]+i)])<-previous_levels2aux[[i]] } } imp[,(ncol(Y)+ncY2+2)]<-factor(imp[,(ncol(Y)+ncY2+2)]) levels(imp[,(ncol(Y)+ncY2+2)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (ncolY2con[1]>0) { for (j in 1:(ncolY2con[1])) { imp[,ncol(Y)+j+1]=as.numeric(imp[,ncol(Y)+j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (isnullcat2aux==0) { if (is.null(colnamy2auxcat)) colnamy2auxcat=paste("Y2cat.aux", 1:ncol(Y2.aux.cat), sep = "") } else { colnamy2auxcat=NULL Y2.aux.cat=NULL Y2.aux.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (!is.null(Y2.aux.con)) { if (is.null(colnamy2auxcon)) colnamy2auxcon=paste("Y2con.aux", 1:ncol(Y2.aux.con), sep = "") } else { colnamy2auxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,colnamy2con,colnamy2auxcon,colnamy2cat,colnamy2auxcat,"clus","id","Imputation") return(imp) } jomo/R/jomo.smc.R0000644000176200001440000000506014410253602013265 0ustar liggesusersjomo.smc <- function(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, nburn=1000, nbetween=1000, nimp=5, meth="common", family="binomial",output=1, out.iter=10, model) { if (model=="lm") { imp<-jomo.lm(formula=formula, data=data, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output, out.iter=out.iter) } else if (model=="glm") { imp<-jomo.glm(formula=formula, data=data, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output, out.iter=out.iter, family=family) } else if (model=="polr") { imp<-jomo.polr(formula=formula, data=data, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output, out.iter=out.iter) }else if (model=="coxph") { imp<-jomo.coxph(formula=formula, data=data, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output, out.iter=out.iter) } else if (model=="lmer") { imp<-jomo.lmer(formula=formula, data=data, level=level, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, a.start=a.start, a.prior=a.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, meth=meth, output=output, out.iter=out.iter) } else if (model=="glmer") { imp<-jomo.glmer(formula=formula, data=data, level=level, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, a.start=a.start, a.prior=a.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, meth=meth, output=output, out.iter=out.iter, family=family) } else if (model=="clmm") { imp<-jomo.clmm(formula=formula, data=data, level=level, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, a.start=a.start, a.prior=a.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, meth=meth, output=output, out.iter=out.iter) }else { cat("Invalid model specification. Models currently available: lm, glm (binomial), polr, coxph, lmer,clmm, glmer (binomial).\n") } return(imp) } jomo/R/jomo.glmer.MCMCchain.R0000644000176200001440000011045514411550052015337 0ustar liggesusersjomo.glmer.MCMCchain <- function(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, betaY.start=NULL, covuY.start=NULL, uY.start=NULL, nburn=1000, meth="common", start.imp=NULL, start.imp.sub=NULL, l2.start.imp=NULL, output=1, out.iter=10, family="binomial") { cat("This function is beta software. Please use carefully and report any bug to the package mantainer\n") if (family!="gaussian"&family!="binomial") cat("ERROR: choose either family binomial or gaussian\n") if (family=="gaussian") { jomo.lmer.MCMCchain(formula, data, level=level, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, a.start=a.start, a.prior=a.prior, betaY.start=betaY.start, varY.start=varY.start, covuY.start=covuY.start, uY.start=uY.start, nburn=nburn, meth=meth, start.imp=start.imp, start.imp.sub=start.imp.sub, l2.start.imp=l2.start.imp, output=output, out.iter=out.iter) } if (family=="binomial") { stopifnot(is.data.frame(data)) if (is_tibble(data)) { data<-data.frame(data) warning("tibbles not supported. data converted to standard data.frame. ") } if (isTRUE(any(sapply(df, is.character)))) stop("Character variables not allowed in data\n") stopifnot(any(grepl("~",deparse(formula)))) fit.cr<-glmer(formula,data=data, family=binomial, na.action = na.omit) if (is.null(betaY.start)) betaY.start<-fixef(fit.cr) varY.start<-1 varY.prior<-1 colnamysub<-all.vars(formula[[2]]) Ysub<-get(colnamysub,pos=data) Ycov<-data.frame(mget(all.vars(formula[[3]]), envir =as.environment(data))) level<-data.frame(matrix(level,1,ncol(data))) colnames(level)<-colnames(data) terms.sub<-attr(terms(formula), "term.labels") split.terms<-strsplit(terms.sub,":") length.sub<-length(terms.sub) order.sub<-attr(terms(formula), "order") submod<-matrix(1,4,sum(order.sub)-1) Y.con<-NULL Y.cat<-NULL Y.numcat<-NULL Y2.con<-NULL Y2.cat<-NULL Y2.numcat<-NULL Y2i<-NULL Y2imp2<-NULL for (j in 1:ncol(Ycov)) { if (level[1, which(colnames(level)==colnames(Ycov)[j])]==1) { if (is.numeric(Ycov[,j])) { if (is.null(Y.con)) { Y.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.con<-data.frame(Y.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y.cat)) { Y.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.cat<-data.frame(Y.cat,Ycov[,j,drop=FALSE]) } Y.numcat<-cbind(Y.numcat,nlevels(Ycov[,j])) } } else { if (is.numeric(Ycov[,j])) { if (is.null(Y2.con)) { Y2.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.con<-data.frame(Y2.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y2.cat)) { Y2.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.cat<-data.frame(Y2.cat,Ycov[,j,drop=FALSE]) } Y2.numcat<-cbind(Y2.numcat,nlevels(Ycov[,j])) } } } h<-1 for ( j in 1:length.sub) { for ( k in 1:order.sub[j]) { current.term<-split.terms[[j]][k] if (grepl("\\|", deparse(current.term))) { j.tbd<-j clus.name<-sub(".*\\|","",current.term) clus.name<-gsub(" ","",clus.name) current.term<-sub("\\|.*$","",current.term) random.terms<-strsplit(current.term,"+", fixed=T) length.ran<-length(random.terms[[1]]) submod.ran<-matrix(1,3,length.ran) for (t in 1:length.ran) { ct<-gsub(" ","",random.terms[[1]][t]) if (ct==1) { submod.ran[1:2,t]<-0 } else if (length(which(colnames(Y.cat)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.cat)==ct) submod.ran[2,t]<-2 submod.ran[3,t]<-Y.numcat[submod.ran[1,t]]-1 } else if (length(which(colnames(Y.con)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.con)==ct) submod.ran[2,t]<-1 } } } else { current.term<-sub(".*I\\(","",current.term) current.term<-sub("\\)","",current.term) if (grepl("\\^",current.term)) { submod[3,h]<-as.integer(sub(".*\\^","",current.term)) current.term<-sub("\\^.*","",current.term) } else { submod[3,h]<-1 } if (length(which(colnames(Y.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y.cat)==current.term) submod[2,h]<-2 submod[4,h]<-Y.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y.con)==current.term) submod[2,h]<-1 } else if (length(which(colnames(Y2.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.cat)==current.term) submod[2,h]<-4 submod[4,h]<-Y2.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y2.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.con)==current.term) submod[2,h]<-3 } h<-h+1 } } } order.sub<-order.sub[-j.tbd] if (!is.null(Y.con)&sum((colnames(Y.con)==clus.name)==1)) Y.con<-data.frame(Y.con[,-which(colnames(Y.con)==clus.name), drop=FALSE]) if (!is.null(Y2.con)&sum((colnames(Y2.con)==clus.name)==1)) Y2.con<-data.frame(Y2.con[,-which(colnames(Y2.con)==clus.name), drop=FALSE]) if (!is.null(Y.cat)&sum((colnames(Y.cat)==clus.name)==1)) { Y.cat<-data.frame(Y.cat[,-which(colnames(Y.cat)==clus.name), drop=FALSE]) Y.numcat<-Y.numcat[-which(colnames(Y.cat)==clus.name)] } if (!is.null(Y2.cat)&sum((colnames(Y2.cat)==clus.name)==1)) { Y2.numcat<-Y2.numcat[-which(colnames(Y2.cat)==clus.name)] Y2.cat<-data.frame(Y2.cat[,-which(colnames(Y2.cat)==clus.name), drop=FALSE]) } if (!is.null(Y.con)&&ncol(Y.con)==0) Y.con <- NULL if (!is.null(Y.cat)&&ncol(Y.cat)==0) Y.cat <- NULL if (!is.null(Y2.cat)&&ncol(Y2.cat)==0) Y2.cat <- NULL if (!is.null(Y2.con)&&ncol(Y2.con)==0) Y2.con <- NULL Y.auxiliary<-data.frame(data[,-c(which(colnames(data)%in%colnames(Y.con)),which(colnames(data)%in%colnames(Y.cat)),which(colnames(data)%in%colnames(Y2.con)),which(colnames(data)%in%colnames(Y2.cat)),which(colnames(data)==clus.name),which(colnames(data)==colnamysub)), drop=FALSE]) Y.aux.con<-NULL Y.aux.cat<-NULL Y.aux.numcat<-NULL Y2.aux.con<-NULL Y2.aux.cat<-NULL Y2.aux.numcat<-NULL if (ncol(Y.auxiliary)>0) { for (j in 1:ncol(Y.auxiliary)) { if (level[1, which(colnames(level)==colnames(Y.auxiliary)[j])]==1) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } else { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y2.aux.con)) Y2.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.con<-data.frame(Y2.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y2.aux.cat)) Y2.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.cat<-data.frame(Y2.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y2.aux.numcat<-cbind(Y2.aux.numcat,nlevels(Y.auxiliary[,j])) } } } } if (((is.null(Y.con))&&(is.null(Y.cat)&is.null(Y.numcat)))) stop("No level 1 covariates in substantive model. jomo currently supports only models with at least one level 1 variable besides the outcome.\n") X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (!is.null(Y2.con)|!is.null(Y2.cat)|!is.null(Y2.aux.con)|!is.null(Y2.aux.cat)) { #cat("Level 2 variables must be fully observed for valid inference. \n") X2=matrix(1,max(nrow(Y2.cat),nrow(Y2.con),nrow(Y2.aux.cat),nrow(Y2.aux.con)),1) if (is.null(l2.beta.start)) l2.beta.start=matrix(0,ncol(X2),(max(0,ncol(Y2.con))+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(as.numeric(!is.null(Y2.aux.con)),ncol(Y2.aux.con))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) } Z=matrix(1,nrow(X),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(0,ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) clus<-factor(data[,clus.name]) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(uY.start)) uY.start<-matrix(0,nlevels(clus),ncol(VarCorr(fit.cr)[[1]])) if (is.null(l1cov.start)) { if (meth=="common") { l1cov.start=diag(1,ncol(beta.start)) } else { l1cov.start=matrix(diag(1,ncol(beta.start)),nlevels(clus)*ncol(beta.start),ncol(beta.start),2) } } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) diagVar<-as.data.frame(VarCorr(fit.cr))[1:ncol(VarCorr(fit.cr)[[1]]),4] if (is.null(covuY.start)) covuY.start<-VarCorr(fit.cr)[[1]][1:ncol(VarCorr(fit.cr)[[1]]),1:ncol(VarCorr(fit.cr)[[1]])] covuY.prior<-VarCorr(fit.cr)[[1]][1:ncol(VarCorr(fit.cr)[[1]]),1:ncol(VarCorr(fit.cr)[[1]])] if (kappa(covuY.start)>10^8) { covuY.prior<-diag(1, ncol(VarCorr(fit.cr)[[1]])) covuY.start<-diag(1, ncol(VarCorr(fit.cr)[[1]])) } ncolYcon<-rep(NA,4) ncolY2con<-rep(NA,4) ncolYcon[1]=max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)) ncolY2con[1]=max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)) ncolYcon[2]=max(0,ncol(Y.con)) ncolY2con[2]=max(0,ncol(Y2.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolY2con[3]=ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) ncolY2con[4]=max(0,ncol(Y2.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))||((!is.null(Y2.con))||(!is.null(Y2.cat)&!is.null(Y2.numcat)))) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) Ysub<-as.factor(Ysub) previous_levelssub<-levels(Ysub) levels(Ysub)<-1:2 if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } if (!is.null(Y2.cat)) { isnullcat2=0 previous_levels2<-list() Y2.cat<-data.frame(Y2.cat) for (i in 1:ncol(Y2.cat)) { Y2.cat[,i]<-factor(Y2.cat[,i]) previous_levels2[[i]]<-levels(Y2.cat[,i]) levels(Y2.cat[,i])<-1:nlevels(Y2.cat[,i]) } } else { isnullcat2=1 } if (!is.null(Y2.aux.cat)) { isnullcat2aux=0 previous_levels2aux<-list() Y2.aux.cat<-data.frame(Y2.aux.cat) for (i in 1:ncol(Y2.aux.cat)) { Y2.aux.cat[,i]<-factor(Y2.aux.cat[,i]) previous_levels2aux[[i]]<-levels(Y2.aux.cat[,i]) levels(Y2.aux.cat[,i])<-1:nlevels(Y2.aux.cat[,i]) } } else { isnullcat2aux=1 } if (!is.null(Y.con)) { stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(Z)==nrow(Y.con)) } if (isnullcat==0) { stopifnot(nrow(Y.cat)==nrow(clus),nrow(Y.cat)==nrow(X), nrow(Z)==nrow(Y.cat)) } if (!is.null(Y2.con)) { stopifnot(nrow(Y2.con)==nrow(clus),nrow(Y2.con)==nrow(X), nrow(Z)==nrow(Y2.con)) } if (isnullcat2==0) { stopifnot(nrow(Y2.cat)==nrow(clus),nrow(Y2.cat)==nrow(X), nrow(Z)==nrow(Y2.cat)) } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) stopifnot(nrow(l2.beta.start)==ncol(X2), ncol(l2.beta.start)==(ncolY2con[3]+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) stopifnot(ncol(u.start)==ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (meth=="common") stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) stopifnot(ncol(l2cov.start)==ncol(u.start), nrow(l2cov.prior)==nrow(l2cov.start), nrow(l2cov.prior)==ncol(l2cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) { beta2it=matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) for (i in 1:nrow(l2.beta.start)) { for (j in 1:ncol(l2.beta.start)) beta2it[i,j]=l2.beta.start[i,j] } } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y2.con)) { colnamy2con<-colnames(Y2.con) Y2.con<-data.matrix(Y2.con) storage.mode(Y2.con) <- "numeric" } else { colnamy2con<-NULL } if (isnullcat2==0) { colnamy2cat<-colnames(Y2.cat) Y2.cat<-data.matrix(Y2.cat) storage.mode(Y2.cat) <- "numeric" cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } } else { cny2catcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } if (!is.null(Y2.aux.con)) { colnamy2auxcon<-colnames(Y2.aux.con) Y2.aux.con<-data.matrix(Y2.aux.con) storage.mode(Y2.aux.con) <- "numeric" } else { colnamy2auxcon<-NULL } if (isnullcat2aux==0) { colnamy2auxcat<-colnames(Y2.aux.cat) Y2.aux.cat<-data.matrix(Y2.aux.cat) storage.mode(Y2.aux.cat) <- "numeric" cny2auxcatcomp<-rep(NA,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))) count=0 for ( j in 1:ncol(Y2.aux.cat)) { for (k in 1:(Y2.aux.numcat[j]-1)) { cny2auxcatcomp[count+k]<-paste(colnamy2auxcat[j],k,sep=".") } count=count+Y2.aux.numcat[j]-1 } } else { cny2auxcatcomp<-NULL } Y.cat.tot<-cbind(Y.cat,Y.aux.cat) colnamx<-colnames(X) colnamz<-colnames(Z) X<-data.matrix(X) storage.mode(X) <- "numeric" Z<-data.matrix(Z) storage.mode(Z) <- "numeric" if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) { colnamx2<-colnames(X2) X2<-data.matrix(X2) storage.mode(X2) <- "numeric" } clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) Y2=cbind(Y2.con,Y2.aux.con,Y2.cat, Y2.aux.cat) Y2i=cbind(Y2.con, Y2.aux.con, switch(is.null(Y2.cat)+1, matrix(0,nrow(Y2),(sum(Y2.numcat)-length(Y2.numcat))), NULL), switch(is.null(Y2.aux.cat)+1, matrix(0,nrow(Y2.aux.cat),(sum(Y2.aux.numcat)-length(Y2.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } h=1 if (isnullcat2==0) { for (i in 1:length(Y2.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.numcat[i]-2)]=NA } } h=h+Y2.numcat[i]-1 } } if (isnullcat2aux==0) { for (i in 1:length(Y2.aux.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.aux.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.aux.numcat[i]-2)]=NA } } h=h+Y2.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } if (isnullcat2==0||isnullcat2aux==0) { Y2.cat.tot<-cbind(Y2.cat,Y2.aux.cat) Y2.numcat.tot<-c(Y2.numcat, Y2.aux.numcat) } else { Y2.cat.tot=-999 Y2.numcat.tot=-999 } ncY2<-max(0,ncol(Y2)) Ysubimp<-as.numeric(Ysub) if (is.null(a.start)) a.start=50+ncol(Y) if (is.null(a.prior)) a.prior=a.start if (output==0) out.iter=nburn+2 nimp=1 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncY2+4) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y if (!is.null(Y2)) imp[1:nrow(Y2),(ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2 imp[1:nrow(clus), (ncol(Y)+ncY2+2)]=clus imp[1:nrow(X), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) if (!is.null(Y2)) { Y2imp=Y2i Y2imp2=matrix(Y2imp, nrow(Y2imp),ncol(Y2imp)) } imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncY2+2)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+4)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nburn))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nburn))) if (!is.null(Y2)) { beta2post<- array(0, dim=c(nrow(l2.beta.start),ncol(l2.beta.start),(nburn))) } else { beta2post<-NULL } upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nburn))) uYpostall<-array(0, dim=c(nrow(uY.start),ncol(uY.start),(nburn))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nburn))) varYpost<-rep(0,(nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nburn))) covuYpost<-array(0, dim=c(nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start)),(nburn))) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(Y2)) { meanobs2<-colMeans(Y2i,na.rm=TRUE) } if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)ncol(l2.start.imp))) { cat("l2.start.imp dimensions incorrect. Not using l2.start.imp as starting value for the level 2 imputed dataset.\n") l2.start.imp=NULL } else { if ((nrow(l2.start.imp)==nrow(Y2imp2))&(ncol(Y2imp2)0) cat("First imputation registered.", "\n") cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) cnamy2comp<-c(colnamy2con, colnamy2auxcon, cny2catcomp, cny2auxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) if (!is.null(Y2)) { dimnames(beta2post)[1] <- list("(Intercept)") dimnames(beta2post)[2] <- list(cnamy2comp) } if (meth=="common") { dimnames(omegapost)[1] <- list(cnamycomp) } else { dimnames(omegapost)[1] <- list(paste(cnamycomp,rep(levels(factor(clus)),each=length(cnamycomp)), sep=".")) } dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-c(cnamycomp,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(factor(clus))) dimnames(upostall)[2]<-list(colnamcovu) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-mean(varYpost) covuYpostmean<-apply(covuYpost, c(1,2), mean) uYpostmean<-apply(uYpostall, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) if (!is.null(Y2)) beta2postmean<-apply(beta2post, c(1,2), mean) upostmean<-apply(upostall, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) covupostmean<-apply(covupost, c(1,2), mean) colnames(betaYpostmean)<-rownames(summary(fit.cr)$coefficients) rownames(betaYpostmean)<-colnamysub colnames(covuYpostmean)<-rownames(covuYpostmean)<-colnames(uYpostmean)<-dimnames(summary(fit.cr)$varcor[[1]])[[1]] rownames(uYpostmean)<-levels(factor(clus)) if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) cat("The posterior mean of the substantive model random effects covariance matrix is:\n") print(covuYpostmean) cat("The posterior mean of the substantive model random effects estimates is:\n") print(uYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) if (!is.null(Y2)) { cat("The posterior mean of the level 2 fixed effects estimates is:\n") print(beta2postmean) } cat("The posterior mean of the random effects estimates is:\n") print(upostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) cat("The posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } } imp<-data.frame(imp) imp[,1]<-as.factor(imp[,1]) levels(imp[,1])<-previous_levelssub if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (isnullcat2==0) { for (i in 1:ncol(Y2.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+i)])<-previous_levels2[[i]] } } if (isnullcat2aux==0) { for (i in 1:ncol(Y2.aux.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)])<-previous_levels2aux[[i]] } } imp[,(ncol(Y)+ncY2+2)]<-factor(imp[,(ncol(Y)+ncY2+2)]) levels(imp[,(ncol(Y)+ncY2+2)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (ncolY2con[1]>0) { for (j in 1:(ncolY2con[1])) { imp[,ncol(Y)+j+1]=as.numeric(imp[,ncol(Y)+j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (isnullcat2aux==0) { if (is.null(colnamy2auxcat)) colnamy2auxcat=paste("Y2cat.aux", 1:ncol(Y2.aux.cat), sep = "") } else { colnamy2auxcat=NULL Y2.aux.cat=NULL Y2.aux.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (!is.null(Y2.aux.con)) { if (is.null(colnamy2auxcon)) colnamy2auxcon=paste("Y2con.aux", 1:ncol(Y2.aux.con), sep = "") } else { colnamy2auxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,colnamy2con,colnamy2auxcon,colnamy2cat,colnamy2auxcat,"clus","id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (isnullcataux==0) { cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } cnamycomp<-c(colnamycon,colnamyauxcon,cnycatcomp,cnyauxcatcomp) if (isnullcat2==0) { cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } } else { cny2catcomp<-NULL } if (isnullcat2aux==0) { cny2auxcatcomp<-rep(NA,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))) count=0 for ( j in 1:ncol(Y2.aux.cat)) { for (k in 1:(Y2.aux.numcat[j]-1)) { cny2auxcatcomp[count+k]<-paste(colnamy2auxcat[j],k,sep=".") } count=count+Y2.aux.numcat[j]-1 } } else { cny2auxcatcomp<-NULL } cnamy2comp<-c(colnamy2con,colnamy2auxcon,cny2catcomp,cny2auxcatcomp) dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) if (!is.null(Y2)) { dimnames(beta2post)[1] <- list(colnamx2) dimnames(beta2post)[2] <- list(cnamy2comp) } if (meth=="random") { dimnames(omegapost)[1] <- list(paste(rep(cnamycomp, nrow(u.start)),rep(previous_levels_clus,each=ncol(omegapost)))) } else { dimnames(omegapost)[1] <- list(cnamycomp) } dimnames(omegapost)[2] <- list(cnamycomp) dimnames(Yimp2)[2] <- list(cnamycomp) return(list("finimp"=imp, "collectbeta2"=beta2post,"collectbeta"=betapost,"collectu"=upostall,"collectomega"=omegapost, "collectcovu"=covupost, "finimp.latnorm" = Yimp2, "l2.finimp.latnorm" = Y2imp2, "collectbetaY"=betaYpost, "collectvarY"=varYpost, "collectcovuY"=covuYpost, "collectuY"=uYpostall)) } } jomo/R/jomo.coxph.MCMCchain.R0000644000176200001440000003266514410253602015360 0ustar liggesusersjomo.coxph.MCMCchain <- function(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=1000, start.imp=NULL, betaY.start=NULL, output=1, out.iter=10) { cat("This function is beta software. Use carefully and please report any bug to the package mantainer\n") stopifnot(is.data.frame(data)) if (is_tibble(data)) { data<-data.frame(data) warning("tibbles not supported. data converted to standard data.frame. ") } if (isTRUE(any(sapply(df, is.character)))) stop("Character variables not allowed in data\n") stopifnot(any(grepl("~",deparse(formula)))) fit.cr<-coxph(formula,data=data, na.action = na.omit) if (is.null(betaY.start)) betaY.start<-as.numeric(coef(fit.cr)) colnamysub<-all.vars(formula[[2]]) data <- data[order(data[, colnamysub[1]]), ] Ysub <- as.matrix(data[, colnamysub]) Ycov<-data.frame(mget(all.vars(formula[[3]]), envir =as.environment(data))) terms.sub<-attr(terms(formula), "term.labels") split.terms<-strsplit(terms.sub,":") length.sub<-length(terms.sub) order.sub<-attr(terms(formula), "order") submod<-matrix(1,4,sum(order.sub)) Y.con<-NULL Y.cat<-NULL Y.numcat<-NULL for (j in 1:ncol(Ycov)) { if (is.numeric(Ycov[,j])) { if (is.null(Y.con)) { Y.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.con<-data.frame(Y.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y.cat)) { Y.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.cat<-data.frame(Y.cat,Ycov[,j,drop=FALSE]) } Y.numcat<-cbind(Y.numcat,nlevels(Ycov[,j])) } } h<-1 for ( j in 1:length.sub) { for ( k in 1:order.sub[j]) { current.term<-split.terms[[j]][k] current.term<-sub(".*I\\(","",current.term) current.term<-sub("\\)","",current.term) if (grepl("\\^",current.term)) { submod[3,h]<-as.integer(sub(".*\\^","",current.term)) current.term<-sub("\\^.*","",current.term) } else { submod[3,h]<-1 } if (length(which(colnames(Y.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y.cat)==current.term) submod[2,h]<-2 submod[4,h]<-Y.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y.con)==current.term) submod[2,h]<-1 } h<-h+1 } } Y.auxiliary<-data.frame(data[,-c(which(colnames(data)%in%colnames(Y.con)),which(colnames(data)%in%colnames(Y.cat)),which(colnames(data)%in%colnamysub)), drop=FALSE]) Y.aux.con<-NULL Y.aux.cat<-NULL Y.aux.numcat<-NULL if (ncol(Y.auxiliary)>0) { for (j in 1:ncol(Y.auxiliary)) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } } X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (is.null(l1cov.start)) { l1cov.start=diag(1,ncol(beta.start)) } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) ncolYcon<-rep(NA,4) ncolYcon[1]=max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con)) ncolYcon[2]=max(as.numeric(!is.null(Y.con)),ncol(Y.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } colnamx<-colnames(X) X<-data.matrix(X) storage.mode(X) <- "numeric" Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } if (output == 0) out.iter=nburn+2 nimp=1 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+4) imp[1:nrow(Y),1:2]=Ysub imp[1:nrow(Y),3:(2+ncol(Y))]=Y imp[1:nrow(X), (ncol(Y)+3)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+3)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+4)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nburn))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nburn))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nburn))) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) cat("First imputation registered.", "\n") cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) betaYpostmean<-apply(betaYpost, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) colnames(betaYpostmean)<-names(fit.cr$coefficients) if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) if (output ==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) } } imp<-data.frame(imp) if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(2+ncolYcon[1]+i)]<-as.factor(imp[,(2+ncolYcon[1]+i)]) levels(imp[,(2+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(2+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(2+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(2+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+2]=as.numeric(imp[,j+2]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (is.null(colnamysub)) colnamysub=c("time","status") colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,"id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (isnullcataux==0) { cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } cnamycomp<-c(colnamycon,colnamyauxcon,cnycatcomp,cnyauxcatcomp) dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) dimnames(Yimp2)[2] <- list(cnamycomp) return(list("finimp"=imp,"collectbeta"=betapost,"collectomega"=omegapost, "finimp.latnorm" = Yimp2, "collectbetaY"=betaYpost)) }jomo/R/jomo1ranmix.MCMCchain.R0000644000176200001440000002220714410253602015527 0ustar liggesusersjomo1ranmix.MCMCchain <- function(Y.con, Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, output=1, out.iter=10) { if (is.null(X)) X=matrix(1,nrow(Y.cat),1) if (is.null(Z)) Z=matrix(1,nrow(Y.cat),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is_tibble(Y.con)) { Y.con<-data.frame(Y.con) warning("tibbles not supported. Y.con converted to standard data.frame. ") } if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(beta.start)==ncol(X), ncol(beta.start)==(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat))),nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(beta.start), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start),nrow(Z)==nrow(Y.con), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } nimp=1 colnamycon<-colnames(Y.con) colnamycat<-colnames(Y.cat) colnamx<-colnames(X) colnamz<-colnames(Z) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.con,Y.cat) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } Yi=cbind(Y.con, matrix(0,nrow(Y.con),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncol(Y.con)+h):(ncol(Y.con)+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) { for (j in 1:ncol(Y.auxiliary)) { if (level[1, which(colnames(level)==colnames(Y.auxiliary)[j])]==1) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } else { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y2.aux.con)) Y2.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.con<-data.frame(Y2.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y2.aux.cat)) Y2.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.cat<-data.frame(Y2.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y2.aux.numcat<-cbind(Y2.aux.numcat,nlevels(Y.auxiliary[,j])) } } } } if (((is.null(Y.con))&&(is.null(Y.cat)&is.null(Y.numcat)))) stop("No level 1 covariates in substantive model. jomo currently supports only models with at least one level 1 variable besides the outcome.\n") X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (!is.null(Y2.con)|!is.null(Y2.cat)|!is.null(Y2.aux.con)|!is.null(Y2.aux.cat)) { #cat("Level 2 variables must be fully observed for valid inference. \n") X2=matrix(1,max(nrow(Y2.cat),nrow(Y2.con),nrow(Y2.aux.cat),nrow(Y2.aux.con) ),1) if (is.null(l2.beta.start)) l2.beta.start=matrix(0,ncol(X2),(max(0,ncol(Y2.con))+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(as.numeric(!is.null(Y2.aux.con)),ncol(Y2.aux.con))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) } Z=matrix(1,nrow(X),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(0,ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) clus<-factor(data[,clus.name]) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(uY.start)) uY.start<-matrix(0,nlevels(clus),ncol(VarCorr(fit.cr)[[1]])) if (is.null(l1cov.start)) { if (meth=="common") { l1cov.start=diag(1,ncol(beta.start)) } else { l1cov.start=matrix(diag(1,ncol(beta.start)),nlevels(clus)*ncol(beta.start),ncol(beta.start),2) } } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) diagVar<-as.data.frame(VarCorr(fit.cr))[1:ncol(VarCorr(fit.cr)[[1]]),4] if (is.null(covuY.start)) covuY.start<-VarCorr(fit.cr)[[1]][1:ncol(VarCorr(fit.cr)[[1]]),1:ncol(VarCorr(fit.cr)[[1]])] covuY.prior<-VarCorr(fit.cr)[[1]][1:ncol(VarCorr(fit.cr)[[1]]),1:ncol(VarCorr(fit.cr)[[1]])] if (kappa(covuY.start)>10^8) { covuY.prior<-diag(1, ncol(VarCorr(fit.cr)[[1]])) covuY.start<-diag(1, ncol(VarCorr(fit.cr)[[1]])) } ncolYcon<-rep(NA,4) ncolY2con<-rep(NA,4) ncolYcon[1]=max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)) ncolY2con[1]=max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)) ncolYcon[2]=max(0,ncol(Y.con)) ncolY2con[2]=max(0,ncol(Y2.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolY2con[3]=ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) ncolY2con[4]=max(0,ncol(Y2.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))||((!is.null(Y2.con))||(!is.null(Y2.cat)&!is.null(Y2.numcat)))) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } if (!is.null(Y2.cat)) { isnullcat2=0 previous_levels2<-list() Y2.cat<-data.frame(Y2.cat) for (i in 1:ncol(Y2.cat)) { Y2.cat[,i]<-factor(Y2.cat[,i]) previous_levels2[[i]]<-levels(Y2.cat[,i]) levels(Y2.cat[,i])<-1:nlevels(Y2.cat[,i]) } } else { isnullcat2=1 } if (!is.null(Y2.aux.cat)) { isnullcat2aux=0 previous_levels2aux<-list() Y2.aux.cat<-data.frame(Y2.aux.cat) for (i in 1:ncol(Y2.aux.cat)) { Y2.aux.cat[,i]<-factor(Y2.aux.cat[,i]) previous_levels2aux[[i]]<-levels(Y2.aux.cat[,i]) levels(Y2.aux.cat[,i])<-1:nlevels(Y2.aux.cat[,i]) } } else { isnullcat2aux=1 } if (!is.null(Y.con)) { stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(Z)==nrow(Y.con)) } if (isnullcat==0) { stopifnot(nrow(Y.cat)==nrow(clus),nrow(Y.cat)==nrow(X), nrow(Z)==nrow(Y.cat)) } if (!is.null(Y2.con)) { stopifnot(nrow(Y2.con)==nrow(clus),nrow(Y2.con)==nrow(X), nrow(Z)==nrow(Y2.con)) } if (isnullcat2==0) { stopifnot(nrow(Y2.cat)==nrow(clus),nrow(Y2.cat)==nrow(X), nrow(Z)==nrow(Y2.cat)) } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) stopifnot(nrow(l2.beta.start)==ncol(X2), ncol(l2.beta.start)==(ncolY2con[3]+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) stopifnot(ncol(u.start)==ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (meth=="common") stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) stopifnot(ncol(l2cov.start)==ncol(u.start), nrow(l2cov.prior)==nrow(l2cov.start), nrow(l2cov.prior)==ncol(l2cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) { beta2it=matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) for (i in 1:nrow(l2.beta.start)) { for (j in 1:ncol(l2.beta.start)) beta2it[i,j]=l2.beta.start[i,j] } } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y2.con)) { colnamy2con<-colnames(Y2.con) Y2.con<-data.matrix(Y2.con) storage.mode(Y2.con) <- "numeric" } else { colnamy2con<-NULL } if (isnullcat2==0) { colnamy2cat<-colnames(Y2.cat) Y2.cat<-data.matrix(Y2.cat) storage.mode(Y2.cat) <- "numeric" cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } } else { cny2catcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } if (!is.null(Y2.aux.con)) { colnamy2auxcon<-colnames(Y2.aux.con) Y2.aux.con<-data.matrix(Y2.aux.con) storage.mode(Y2.aux.con) <- "numeric" } else { colnamy2auxcon<-NULL } if (isnullcat2aux==0) { colnamy2auxcat<-colnames(Y2.aux.cat) Y2.aux.cat<-data.matrix(Y2.aux.cat) storage.mode(Y2.aux.cat) <- "numeric" cny2auxcatcomp<-rep(NA,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))) count=0 for ( j in 1:ncol(Y2.aux.cat)) { for (k in 1:(Y2.aux.numcat[j]-1)) { cny2auxcatcomp[count+k]<-paste(colnamy2auxcat[j],k,sep=".") } count=count+Y2.aux.numcat[j]-1 } } else { cny2auxcatcomp<-NULL } Y.cat.tot<-cbind(Y.cat,Y.aux.cat) colnamx<-colnames(X) colnamz<-colnames(Z) X<-data.matrix(X) storage.mode(X) <- "numeric" Z<-data.matrix(Z) storage.mode(Z) <- "numeric" if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) { colnamx2<-colnames(X2) X2<-data.matrix(X2) storage.mode(X2) <- "numeric" } clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) Y2=cbind(Y2.con,Y2.aux.con,Y2.cat, Y2.aux.cat) Y2i=cbind(Y2.con, Y2.aux.con, switch(is.null(Y2.cat)+1, matrix(0,nrow(Y2),(sum(Y2.numcat)-length(Y2.numcat))), NULL), switch(is.null(Y2.aux.cat)+1, matrix(0,nrow(Y2.aux.cat),(sum(Y2.aux.numcat)-length(Y2.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } h=1 if (isnullcat2==0) { for (i in 1:length(Y2.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.numcat[i]-2)]=NA } } h=h+Y2.numcat[i]-1 } } if (isnullcat2aux==0) { for (i in 1:length(Y2.aux.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.aux.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.aux.numcat[i]-2)]=NA } } h=h+Y2.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } if (isnullcat2==0||isnullcat2aux==0) { Y2.cat.tot<-cbind(Y2.cat,Y2.aux.cat) Y2.numcat.tot<-c(Y2.numcat, Y2.aux.numcat) } else { Y2.cat.tot=-999 Y2.numcat.tot=-999 } ncY2<-max(0,ncol(Y2)) Ysubimp<-Ysub if (is.null(a.start)) a.start=50+ncol(Y) if (is.null(a.prior)) a.prior=a.start if (output==0) out.iter=nburn+2 nimp=1 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncY2+4) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y if (!is.null(Y2)) imp[1:nrow(Y2),(ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2 imp[1:nrow(clus), (ncol(Y)+ncY2+2)]=clus imp[1:nrow(X), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) if (!is.null(Y2)) { Y2imp=Y2i Y2imp2=matrix(Y2imp, nrow(Y2imp),ncol(Y2imp)) } imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncY2+2)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+4)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nburn))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nburn))) if (!is.null(Y2)) { beta2post<- array(0, dim=c(nrow(l2.beta.start),ncol(l2.beta.start),(nburn))) } else { beta2post<-NULL } upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nburn))) uYpostall<-array(0, dim=c(nrow(uY.start),ncol(uY.start),(nburn))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nburn))) varYpost<-rep(0,(nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nburn))) covuYpost<-array(0, dim=c(nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start)),(nburn))) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(Y2)) { meanobs2<-colMeans(Y2i,na.rm=TRUE) } if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)ncol(l2.start.imp))) { cat("l2.start.imp dimensions incorrect. Not using l2.start.imp as starting value for the level 2 imputed dataset.\n") l2.start.imp=NULL } else { if ((nrow(l2.start.imp)==nrow(Y2imp2))&(ncol(Y2imp2)0) cat("First imputation registered.", "\n") cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) cnamy2comp<-c(colnamy2con, colnamy2auxcon, cny2catcomp, cny2auxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) if (!is.null(Y2)) { dimnames(beta2post)[1] <- list("(Intercept)") dimnames(beta2post)[2] <- list(cnamy2comp) } dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-c(cnamycomp,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(factor(clus))) dimnames(upostall)[2]<-list(colnamcovu) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-mean(varYpost) covuYpostmean<-apply(covuYpost, c(1,2), mean) uYpostmean<-apply(uYpostall, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) if (!is.null(Y2)) beta2postmean<-apply(beta2post, c(1,2), mean) upostmean<-apply(upostall, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) covupostmean<-apply(covupost, c(1,2), mean) colnames(betaYpostmean)<-rownames(summary(fit.cr)$coefficients) rownames(betaYpostmean)<-colnamysub colnames(covuYpostmean)<-rownames(covuYpostmean)<-colnames(uYpostmean)<-dimnames(summary(fit.cr)$varcor[[1]])[[1]] rownames(uYpostmean)<-levels(factor(clus)) if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) cat("The posterior mean of the substantive model random effects covariance matrix is:\n") print(covuYpostmean) cat("The posterior mean of the substantive model random effects estimates is:\n") print(uYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) if (!is.null(Y2)) { cat("The posterior mean of the level 2 fixed effects estimates is:\n") print(beta2postmean) } cat("The posterior mean of the random effects estimates is:\n") print(upostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) cat("The posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } } imp<-data.frame(imp) if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (isnullcat2==0) { for (i in 1:ncol(Y2.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+i)])<-previous_levels2[[i]] } } if (isnullcat2aux==0) { for (i in 1:ncol(Y2.aux.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)])<-previous_levels2aux[[i]] } } imp[,(ncol(Y)+ncY2+2)]<-factor(imp[,(ncol(Y)+ncY2+2)]) levels(imp[,(ncol(Y)+ncY2+2)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (ncolY2con[1]>0) { for (j in 1:(ncolY2con[1])) { imp[,ncol(Y)+j+1]=as.numeric(imp[,ncol(Y)+j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (isnullcat2aux==0) { if (is.null(colnamy2auxcat)) colnamy2auxcat=paste("Y2cat.aux", 1:ncol(Y2.aux.cat), sep = "") } else { colnamy2auxcat=NULL Y2.aux.cat=NULL Y2.aux.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (!is.null(Y2.aux.con)) { if (is.null(colnamy2auxcon)) colnamy2auxcon=paste("Y2con.aux", 1:ncol(Y2.aux.con), sep = "") } else { colnamy2auxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,colnamy2con,colnamy2auxcon,colnamy2cat,colnamy2auxcat,"clus","id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (isnullcataux==0) { cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } cnamycomp<-c(colnamycon,colnamyauxcon,cnycatcomp,cnyauxcatcomp) if (isnullcat2==0) { cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } } else { cny2catcomp<-NULL } if (isnullcat2aux==0) { cny2auxcatcomp<-rep(NA,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))) count=0 for ( j in 1:ncol(Y2.aux.cat)) { for (k in 1:(Y2.aux.numcat[j]-1)) { cny2auxcatcomp[count+k]<-paste(colnamy2auxcat[j],k,sep=".") } count=count+Y2.aux.numcat[j]-1 } } else { cny2auxcatcomp<-NULL } cnamy2comp<-c(colnamy2con,colnamy2auxcon,cny2catcomp,cny2auxcatcomp) dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) if (!is.null(Y2)) { dimnames(beta2post)[1] <- list(colnamx2) dimnames(beta2post)[2] <- list(cnamy2comp) } if (meth=="random") { dimnames(omegapost)[1] <- list(paste(rep(cnamycomp, nrow(u.start)),rep(previous_levels_clus,each=ncol(omegapost)))) } else { dimnames(omegapost)[1] <- list(cnamycomp) } dimnames(omegapost)[2] <- list(cnamycomp) dimnames(Yimp2)[2] <- list(cnamycomp) return(list("finimp"=imp, "collectbeta2"=beta2post,"collectbeta"=betapost,"collectu"=upostall,"collectomega"=omegapost, "collectcovu"=covupost, "finimp.latnorm" = Yimp2, "l2.finimp.latnorm" = Y2imp2, "collectbetaY"=betaYpost, "collectvarY"=varYpost, "collectcovuY"=covuYpost, "collectuY"=uYpostall)) } jomo/R/jomo.smc.MCMCchain.R0000644000176200001440000000640714410253602015014 0ustar liggesusersjomo.smc.MCMCchain <- function(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, betaY.start=NULL, varY.start=NULL, covuY.start=NULL, uY.start=NULL, nburn=1000, meth="common", family="binomial", start.imp=NULL, start.imp.sub=NULL, l2.start.imp=NULL, output=1, out.iter=10, model) { if (model=="lm") { imp<-jomo.lm.MCMCchain(formula=formula, data=data, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, betaY.start=betaY.start, varY.start=varY.start, nburn=nburn, start.imp=start.imp, start.imp.sub=start.imp.sub, output=output, out.iter=out.iter) } else if (model=="glm") { imp<-jomo.glm.MCMCchain(formula=formula, data=data, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, betaY.start=betaY.start, nburn=nburn, start.imp=start.imp, start.imp.sub=start.imp.sub, output=output, out.iter=out.iter, family=family) } else if (model=="polr") { imp<-jomo.polr.MCMCchain(formula=formula, data=data, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, betaY.start=betaY.start, nburn=nburn, start.imp=start.imp, start.imp.sub=start.imp.sub, output=output, out.iter=out.iter) }else if (model=="coxph") { imp<-jomo.coxph.MCMCchain(formula=formula, data=data, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, betaY.start=betaY.start,nburn=nburn, start.imp=start.imp, output=output, out.iter=out.iter) } else if (model=="lmer") { imp<-jomo.lmer.MCMCchain(formula=formula, data=data, level=level, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, a.start=a.start, a.prior=a.prior, betaY.start=betaY.start, varY.start=varY.start, covuY.start=covuY.start, uY.start=uY.start, nburn=nburn, meth=meth, start.imp=start.imp, start.imp.sub=start.imp.sub, l2.start.imp=l2.start.imp, output=output, out.iter=out.iter) } else if (model=="glmer") { imp<-jomo.glmer.MCMCchain(formula=formula, data=data, level=level, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, a.start=a.start, a.prior=a.prior, betaY.start=betaY.start, covuY.start=covuY.start, uY.start=uY.start, nburn=nburn, meth=meth, start.imp=start.imp, start.imp.sub=start.imp.sub, l2.start.imp=l2.start.imp, output=output, out.iter=out.iter, family=family) } else if (model=="clmm") { imp<-jomo.clmm.MCMCchain(formula=formula, data=data, level=level, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, a.start=a.start, a.prior=a.prior, betaY.start=betaY.start, covuY.start=covuY.start, uY.start=uY.start, nburn=nburn, meth=meth, start.imp=start.imp, start.imp.sub=start.imp.sub, l2.start.imp=l2.start.imp, output=output, out.iter=out.iter) }else { cat("Invalid model specification. Models currently available: lm, glm (binomial), polr, coxph, lmer, clmm, glmer (binomial).\n") } return(imp) } jomo/R/jomo1rancon.MCMCchain.R0000644000176200001440000001615414410253602015515 0ustar liggesusersjomo1rancon.MCMCchain<- function(Y, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, output=1, out.iter=10) { if (is.null(X)) X=matrix(1,nrow(Y),1) if (is.null(Z)) Z=matrix(1,nrow(Y),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),ncol(Y)) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is_tibble(Y)) { Y<-data.frame(Y) warning("tibbles not supported. Y converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*ncol(Y)) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot(nrow(Y)==nrow(clus),nrow(Y)==nrow(X), nrow(beta.start)==ncol(X), ncol(beta.start)==ncol(Y),nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(Y), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start), nrow(Z)==nrow(Y), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*ncol(Y)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } nimp=1 colnamy<-colnames(Y) colnamx<-colnames(X) colnamz<-colnames(Z) Y<-data.matrix(Y) storage.mode(Y) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Y Yimp2=matrix(Yimp, nrow(Y),ncol(Y)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),nburn)) meanobs<-colMeans(Y,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } ait=as.numeric(a) colnamycat<-colnames(Y.cat) colnamx<-colnames(X) colnamz<-colnames(Z) Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.cat) Yi=cbind( matrix(0,nrow(Y.cat),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(h):(h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nimp-1))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nimp-1))) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=rnorm(1,meanobs[j],1) if (meth=="fixed") { fixed=1 } else { fixed=0 } .Call("jomo1ranhrC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit,cpost,nburn, l1cov.prior,l2cov.prior,Y.numcat, 0,ait,a.prior,out.iter, fixed, 0, miss.pat.id, n.patterns, PACKAGE = "jomo") #betapost[,,1]=bpost #upostall[,,1]=upost #omegapost[,,(1)]=opost #covupost[,,(1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(nrow(Y)+1):(2*nrow(Y)),1:ncol(Y)]=Y.cat if (output==1) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(i*nrow(clus)+1):((i+1)*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=i .Call("jomo1ranhrC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit,cpost,nbetween, l1cov.prior,l2cov.prior,Y.numcat, 0,ait,a.prior, out.iter, fixed, 0, miss.pat.id, n.patterns, PACKAGE = "jomo") betapost[,,(i-1)]=bpost upostall[,,(i-1)]=upost omegapost[,,(i-1)]=opost covupost[,,(i-1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1:ncol(Y)]=Y.cat if (output==1) cat("Imputation number ", i, "registered", "\n") } imp<-data.frame(imp) for (i in 1:ncol(Y)) { imp[,i]<-as.factor(imp[,i]) levels(imp[,i])<-previous_levels[[i]] } imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]<-factor(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]) levels(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus for (j in (ncol(Y.cat)+1):(ncol(Y.cat)+ncol(X)+ncol(Z))) { imp[,j]=as.numeric(imp[,j]) } if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") if (is.null(colnamz)) colnamz=paste("Z", 1:ncol(Z), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") colnames(imp)<-c(colnamycat,colnamx,colnamz,"clus","id","Imputation") cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnycatcomp) dimnames(omegapost)[1] <- list(paste(cnycatcomp,rep(levels(clus),each=ncol(Yimp2)), sep=".")) dimnames(omegapost)[2] <- list(cnycatcomp) colnamcovu<-paste(cnycatcomp,rep(colnamz,each=ncol(omegapost)),sep="*") dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) betapostmean<-data.frame(apply(betapost, c(1,2), mean)) upostmean<-data.frame(apply(upostall, c(1,2), mean)) omegapostmean<-data.frame(apply(omegapost, c(1,2), mean)) covupostmean<-data.frame(apply(covupost, c(1,2), mean)) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior mean of the random effects estimates is:\n") print(upostmean) cat("\nThe posterior mean of the level 1 covariance matrices is:\n") print(omegapostmean) cat("\nThe posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } return(imp) } jomo/R/md.pattern.mice.R0000644000176200001440000000460714410253602014536 0ustar liggesusersmd.pattern.mice<- function (x, plot = TRUE, rotate.names = FALSE) { if (!(is.matrix(x) || is.data.frame(x))) stop("Data should be a matrix or dataframe") if (ncol(x) < 2) stop("Data should have at least two columns") R <- is.na(x) nmis <- colSums(R) R <- matrix(R[, order(nmis)], dim(x)) pat <- apply(R, 1, function(x) paste(as.numeric(x), collapse = "")) sortR <- matrix(R[order(pat), ], dim(x)) if (nrow(x) == 1) { mpat <- is.na(x) } else { mpat <- sortR[!duplicated(sortR), ] } if (all(!is.na(x))) { cat(" /\\ /\\\n{ `---' }\n{ O O }\n==> V <==") cat(" No need for mice. This data set is completely observed.\n") cat(" \\ \\|/ /\n `-----'\n\n") mpat <- t(as.matrix(mpat, byrow = TRUE)) rownames(mpat) <- table(pat) } else { if (is.null(dim(mpat))) { mpat <- t(as.matrix(mpat)) } rownames(mpat) <- table(pat) } r <- cbind(abs(mpat - 1), rowSums(mpat)) r <- rbind(r, c(nmis[order(nmis)], sum(nmis))) if (plot) { plot.new() if (is.null(dim(sortR[!duplicated(sortR), ]))) { R <- t(as.matrix(r[1:nrow(r) - 1, 1:ncol(r) - 1])) } else { if (is.null(dim(R))) { R <- t(as.matrix(R)) } R <- r[1:nrow(r) - 1, 1:ncol(r) - 1] } op <- par(mar = rep(0, 4)) on.exit(par(op)) if (rotate.names) { adj = c(0, 0.5) srt = 90 length_of_longest_colname = max(nchar(colnames(r)))/2.6 plot.window(xlim = c(-1, ncol(R) + 1), ylim = c(-1, nrow(R) + length_of_longest_colname), asp = 1) } else { adj = c(0.5, 0) srt = 0 plot.window(xlim = c(-1, ncol(R) + 1), ylim = c(-1, nrow(R) + 1), asp = 1) } M <- cbind(c(row(R)), c(col(R))) - 1 rect(M[, 2], M[, 1], M[, 2] + 1, M[, 1] + 1) for (i in 1:ncol(R)) { text(i - 0.5, nrow(R) + 0.3, colnames(r)[i], adj = adj, srt = srt) text(i - 0.5, -0.3, nmis[order(nmis)][i]) } for (i in 1:nrow(R)) { text(ncol(R) + 0.3, i - 0.5, r[(nrow(r) - 1):1, ncol(r)][i], adj = 0) text(-0.3, i - 0.5, rownames(r)[(nrow(r) - 1):1][i], adj = 1) } text(ncol(R) + 0.3, -0.3, r[nrow(r), ncol(r)]) return(r) } else { return(r) } }jomo/R/jomo.polr.R0000644000176200001440000003377114411550163013474 0ustar liggesusersjomo.polr <- function(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) { cat("This function is beta software. Use carefully and please report any bug to the package mantainer\n") if (nimp<2) { nimp=2 cat("Minimum number of imputations:2. For single imputation using function jomo.mlogit.MCMCchain\n") } stopifnot(is.data.frame(data)) if (is_tibble(data)) { data<-data.frame(data) warning("tibbles not supported. data converted to standard data.frame. ") } if (isTRUE(any(sapply(df, is.character)))) stop("Character variables not allowed in data\n") stopifnot(any(grepl("~",deparse(formula)))) fit.cr<-polr(formula,data=data, na.action = na.omit, Hess=T, method = "probit") colnamysub<-all.vars(formula[[2]]) Ysub<-get(colnamysub,pos=data) stopifnot(is.factor(Ysub)) betaY.start<-coef(summary(fit.cr))[,1] Ysub.ncat<-nlevels(Ysub) varY.start<-varY.prior<-1 Ycov<-data.frame(mget(all.vars(formula[[3]]), envir =as.environment(data))) terms.sub<-attr(terms(formula), "term.labels") split.terms<-strsplit(terms.sub,":") length.sub<-length(terms.sub) order.sub<-attr(terms(formula), "order") submod<-matrix(1,4,sum(order.sub)) Y.con<-NULL Y.cat<-NULL Y.numcat<-NULL for (j in 1:ncol(Ycov)) { if (is.numeric(Ycov[,j])) { if (is.null(Y.con)) { Y.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.con<-data.frame(Y.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y.cat)) { Y.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.cat<-data.frame(Y.cat,Ycov[,j,drop=FALSE]) } Y.numcat<-cbind(Y.numcat,nlevels(Ycov[,j])) } } h<-1 for ( j in 1:length.sub) { for ( k in 1:order.sub[j]) { current.term<-split.terms[[j]][k] current.term<-sub(".*I\\(","",current.term) current.term<-sub("\\)","",current.term) if (grepl("\\^",current.term)) { submod[3,h]<-as.integer(sub(".*\\^","",current.term)) current.term<-sub("\\^.*","",current.term) } else { submod[3,h]<-1 } if (length(which(colnames(Y.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y.cat)==current.term) submod[2,h]<-2 submod[4,h]<-Y.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y.con)==current.term) submod[2,h]<-1 } h<-h+1 } } Y.auxiliary<-data.frame(data[,-c(which(colnames(data)%in%colnames(Y.con)),which(colnames(data)%in%colnames(Y.cat)),which(colnames(data)==colnamysub)), drop=FALSE]) Y.aux.con<-NULL Y.aux.cat<-NULL Y.aux.numcat<-NULL if (ncol(Y.auxiliary)>0) { for (j in 1:ncol(Y.auxiliary)) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } } X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (is.null(l1cov.start)) { l1cov.start=diag(1,ncol(beta.start)) } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) ncolYcon<-rep(NA,4) ncolYcon[1]=max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con)) ncolYcon[2]=max(as.numeric(!is.null(Y.con)),ncol(Y.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))) previous_levelssub<-levels(Ysub) levels(Ysub)<-1:Ysub.ncat if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } colnamx<-colnames(X) X<-data.matrix(X) storage.mode(X) <- "numeric" Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } Ysubimp<-as.numeric(Ysub) if (output==0) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+3) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y imp[1:nrow(X), (ncol(Y)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) varYpost<-array(0, dim=c(1,1,(nimp-1))) vYpost<-matrix(0,1,1) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] for (i in 1:length(Ysubimp)) if (is.na(Ysubimp[i])) Ysubimp[i]=sample(1:Ysub.ncat,1) Ysubcat <- as.numeric(Ysub) Ysubcat[is.na(Ysubcat)]<-1 .Call("jomo1smcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, Y, Yimp, Yimp2, Y.cat.tot, X, betaY.start, bYpost, betait,bpost, varY.start, vYpost, covit,opost, nburn, varY.prior, l1cov.prior,Y.numcat.tot, Ysub.ncat, ncolYcon, out.iter, 0, 3, PACKAGE = "jomo") #betapost[,,1]=bpost #omegapost[,,(1)]=opost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) imp[(nrow(Y)+1):(2*nrow(Y)),1]=Ysubcat if (!is.null(Y.con)|!is.null(Y.aux.con)) { imp[(nrow(Y)+1):(2*nrow(Y)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(nrow(Y)+1):(2*nrow(Y)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if (output>0) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+2)]=c(1:nrow(Y)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+3)]=i .Call("jomo1smcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, Y, Yimp, Yimp2, Y.cat.tot, X, betaY.start, bYpost, betait,bpost, varY.start, vYpost, covit,opost, nbetween, varY.prior, l1cov.prior,Y.numcat.tot, Ysub.ncat, ncolYcon,out.iter, 0, 3, PACKAGE = "jomo") betapost[,,(i-1)]=bpost betaYpost[,,(i-1)]=bYpost omegapost[,,(i-1)]=opost varYpost[,,(i-1)]=vYpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1]=Ysubcat if (!is.null(Y.con)|!is.null(Y.aux.con)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if (output>0) cat("Imputation number ", i, "registered", "\n") } cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-apply(varYpost, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) colnames(betaYpostmean)<-c(names(fit.cr$coefficients),names(fit.cr$zeta)) rownames(betaYpostmean)<-colnamysub if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) } } imp<-data.frame(imp) imp[,1]<-as.factor(imp[,1]) levels(imp[,1])<-previous_levelssub if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[3]+i)]<-as.factor(imp[,(1+ncolYcon[3]+i)]) levels(imp[,(1+ncolYcon[3]+i)])<-previous_levelsaux[[i]] } } if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,"id","Imputation") return(imp) } jomo/R/jomo1mix.MCMCchain.R0000644000176200001440000001431714410253602015031 0ustar liggesusersjomo1mix.MCMCchain <- function(Y.con, Y.cat, Y.numcat, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, start.imp=NULL, nburn=100, output=1, out.iter=10) { if (is.null(X)) X=matrix(1,nrow(Y.cat),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is_tibble(Y.con)) { Y.con<-data.frame(Y.con) warning("tibbles not supported. Y.con converted to standard data.frame. ") } if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } stopifnot(nrow(Y.con)==nrow(X), nrow(beta.start)==ncol(X), ncol(beta.start)==(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat))),nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(beta.start), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } nimp=1 colnamycon<-colnames(Y.con) colnamycat<-colnames(Y.cat) colnamx<-colnames(X) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Y=cbind(Y.con,Y.cat) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } Yi=cbind(Y.con, matrix(0,nrow(Y.con),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncol(Y.con)+h):(ncol(Y.con)+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+2) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(X), (ncol(Y)+ncol(X)+1)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+1)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+2)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) { for (j in 1:(ncolYcon)) { imp[,j]=as.numeric(imp[,j]) } } if (ncolY2con>0) { for (j in 1:(ncolY2con)) { imp[,ncol(Y)+j]=as.numeric(imp[,ncol(Y)+j]) } } for (j in (ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))) { imp[,j]=as.numeric(imp[,j]) } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (is.null(colnamz)) colnamz=paste("Z", 1:ncol(Z), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") if (is.null(colnamx2)) colnamx2=paste("X2", 1:ncol(X2), sep = ".") colnames(imp)<-c(colnamycon,colnamycat,colnamy2con,colnamy2cat,colnamx,colnamx2,colnamz,"clus","id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } if (!is.null(Y.con)) { cnamycomp<-c(colnamycon,cnycatcomp) } else { cnamycomp<-c(cnycatcomp) } } else { cnamycomp<-c(colnamycon) } if (isnullcat2==0) { cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } if (!is.null(Y2.con)) { cnamy2comp<-c(colnamy2con,cny2catcomp) } else { cnamy2comp<-c(cny2catcomp) } } else { cnamy2comp<-c(colnamy2con) } dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(beta2post)[1] <- list(colnamx2) dimnames(beta2post)[2] <- list(cnamy2comp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-paste(cnamycomp,rep(colnamz,each=ncol(omegapost)),sep="*") colnamcovu<-c(colnamcovu,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) betapostmean<-data.frame(apply(betapost, c(1,2), mean)) beta2postmean<-data.frame(apply(beta2post, c(1,2), mean)) upostmean<-data.frame(apply(upostall, c(1,2), mean)) omegapostmean<-data.frame(apply(omegapost, c(1,2), mean)) covupostmean<-data.frame(apply(covupost, c(1,2), mean)) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior mean of the level 2 fixed effects estimates is:\n") print(t(beta2postmean)) cat("\nThe posterior mean of the random effects estimates is:\n") print(upostmean) cat("\nThe posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) cat("\nThe posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } return(imp) } jomo/R/jomo1cat.R0000644000176200001440000001415714410253602013264 0ustar liggesusersjomo1cat <- function(Y.cat, Y.numcat, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=100, nbetween=100, nimp=5, output=1, out.iter=10) { if (nimp<2) { nimp=2 cat("Minimum number of imputations: 2. For single imputation using function jomo1cat.MCMCchain\n") } if (is.null(X)) X=matrix(1,nrow(Y.cat),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),((sum(Y.numcat)-length(Y.numcat)))) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } if (any(is.na(Y.cat))) { if (ncol(Y.cat)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y.cat, plot=F) miss.pat<-miss.pat[,colnames(Y.cat)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y.cat)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y.cat)) for (i in 1:nrow(Y.cat)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y.cat[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } stopifnot( nrow(beta.start)==ncol(X), ncol(beta.start)==((sum(Y.numcat)-length(Y.numcat))),nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(beta.start), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } colnamycat<-colnames(Y.cat) colnamx<-colnames(X) Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Y=cbind(Y.cat) Yi=cbind(matrix(0,nrow(Y.cat),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,h:(h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+2) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(X), (ncol(Y)+ncol(X)+1)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+1)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+2)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] .Call("jomo1C", Y, Yimp, Yimp2, Y.cat, X,betait,bpost,covit,opost, nburn, l1cov.prior,Y.numcat, 0, out.iter,0, miss.pat.id, n.patterns, PACKAGE = "jomo") #betapost[,,1]=bpost #omegapost[,,1]=opost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) imp[(nrow(Y)+1):(2*nrow(Y)),1:ncol(Y)]=Y.cat if (output==1) cat("First imputation registered.", "\n") for (i in 2:nimp) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncol(X)+1)]=c(1:nrow(Y)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncol(X)+2)]=i .Call("jomo1C", Y, Yimp, Yimp2, Y.cat, X,betait,bpost,covit, opost, nbetween, l1cov.prior, Y.numcat, 0, out.iter,0, miss.pat.id, n.patterns, PACKAGE = "jomo") betapost[,,(i-1)]=bpost omegapost[,,(i-1)]=opost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1:ncol(Y)]=Y.cat if (output==1) cat("Imputation number ", i, "registered", "\n") } imp<-data.frame(imp) for (i in 1:ncol(Y)) { imp[,i]<-as.factor(imp[,i]) levels(imp[,i])<-previous_levels[[i]] } if (is.null(colnamycat)) colnamycat=paste("Y", 1:ncol(Y.cat), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") colnames(imp)<-c(colnamycat,colnamx,"id","Imputation") cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } cnamycomp<-c(cnycatcomp) dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) betapostmean<-data.frame(apply(betapost, c(1,2), mean)) omegapostmean<-data.frame(apply(omegapost, c(1,2), mean)) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior covariance matrix is:\n") print(omegapostmean) } return(imp) } jomo/R/jomo1rancon.R0000644000176200001440000002027314410253602013771 0ustar liggesusersjomo1rancon<- function(Y, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, output=1, out.iter=10) { if (nimp<2) { nimp=2 cat("Minimum number of imputations:2. For single imputation using function jomo1rancon.MCMCchain\n") } if (is.null(X)) X=matrix(1,nrow(Y),1) if (is.null(Z)) Z=matrix(1,nrow(Y),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),ncol(Y)) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is_tibble(Y)) { Y<-data.frame(Y) warning("tibbles not supported. Y converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*ncol(Y)) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot(nrow(Y)==nrow(clus),nrow(Y)==nrow(X), nrow(beta.start)==ncol(X), ncol(beta.start)==ncol(Y),nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(Y), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start), nrow(Z)==nrow(Y), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*ncol(Y)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } colnamy<-colnames(Y) colnamx<-colnames(X) colnamz<-colnames(Z) Y<-data.matrix(Y) storage.mode(Y) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) if (output!=1) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Y Yimp2=matrix(Yimp, nrow(Y),ncol(Y)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nimp-1))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nimp-1))) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) meanobs<-colMeans(Y,na.rm=TRUE) for (i in 1:nrow(Y)) for (j in 1:ncol(Y)) if (is.na(Yimp[i,j])) Yimp2[i,j]=rnorm(1,meanobs[j],1) #for (i in 1:nrow(Y)) for (j in 1:ncol(Y)) if (is.na(Yimp[i,j])) Yimp[i,j]=rnorm(1,mean=meanobs[j], sd=0.01) Y.cat<-Y.numcat<-(-999) .Call("jomo1ranC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit, cpost, nburn, l1cov.prior,l2cov.prior,Y.numcat, ncol(Y),out.iter,0, miss.pat.id, n.patterns, PACKAGE = "jomo") #betapost[,,1]=bpost #upostall[,,1]=upost #omegapost[,,1]=opost #covupost[,,1]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(nrow(Y)+1):(2*nrow(Y)),1:ncol(Y)]=Yimp2 if (output==1) cat("First imputation registered.", "\n") for (i in 2:nimp) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(i*nrow(clus)+1):((i+1)*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=i .Call("jomo1ranC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit, cpost, nbetween, l1cov.prior,l2cov.prior,Y.numcat, ncol(Y),out.iter,0, miss.pat.id, n.patterns, PACKAGE = "jomo") betapost[,,(i-1)]=bpost upostall[,,(i-1)]=upost omegapost[,,(i-1)]=opost covupost[,,(i-1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(i*nrow(Y)+1):((i+1)*nrow(Y)),1:ncol(Y)]=Yimp2 if (output==1) cat("Imputation number ", i, "registered", "\n") } imp<-data.frame(imp) imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]<-factor(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]) levels(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus for (j in 1:(ncol(Y)+ncol(X)+ncol(Z))) { imp[,j]=as.numeric(imp[,j]) } if (is.null(colnamy)) colnamy=paste("Y", 1:ncol(Y), sep = "") if (is.null(colnamz)) colnamz=paste("Z", 1:ncol(Z), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") colnames(imp)<-c(colnamy,colnamx,colnamz,"clus","id","Imputation") dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(colnamy) dimnames(omegapost)[1] <- list(colnamy) dimnames(omegapost)[2] <- list(colnamy) colnamcovu<-paste(colnamy,rep(colnamz,each=ncol(omegapost)),sep="*") dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) betapostmean<-data.frame(apply(betapost, c(1,2), mean)) upostmean<-data.frame(apply(upostall, c(1,2), mean)) omegapostmean<-data.frame(apply(omegapost, c(1,2), mean)) covupostmean<-data.frame(apply(covupost, c(1,2), mean)) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior mean of the random effects estimates is:\n") print(upostmean) cat("\nThe posterior mean of the level 1 covariance matrices is:\n") print(omegapostmean) cat("\nThe posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } return(imp) }jomo/R/jomo1rancathr.MCMCchain.R0000644000176200001440000002163214410253602016034 0ustar liggesusersjomo1rancathr.MCMCchain <- function(Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000,a=NULL,a.prior=NULL, meth="random", output=1, out.iter=10) { if (is.null(X)) X=matrix(1,nrow(Y.cat),1) if (is.null(Z)) Z=matrix(1,nrow(Y.cat),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),((sum(Y.numcat)-length(Y.numcat)))) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is.null(a)) a=ncol(beta.start)+50 if (is.null(a.prior)) a.prior=ncol(beta.start) if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z) * ((sum(Y.numcat) - length(Y.numcat)))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (is.null(l1cov.start)) l1cov.start=matrix(diag(1,ncol(beta.start)),ncol(beta.start)*nlevels(clus),ncol(beta.start),2) previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } if (any(is.na(Y.cat))) { if (ncol(Y.cat)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y.cat, plot=F) miss.pat<-miss.pat[,colnames(Y.cat)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y.cat)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y.cat)) for (i in 1:nrow(Y.cat)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y.cat[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot((meth=="fixed"|meth=="random"),nrow(beta.start)==ncol(X), ncol(beta.start)==((sum(Y.numcat)-length(Y.numcat))),nrow(l1cov.start)==nrow(u.start)*ncol(l1cov.start), nrow(l1cov.start)==nrow(u.start)*ncol(beta.start), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.start)==nrow(u.start)*nrow(l1cov.prior),nrow(Z)==nrow(Y.cat), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*((sum(Y.numcat)-length(Y.numcat))),det(l1cov.prior)>0) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } ait=as.numeric(a) nimp=1 colnamycat<-colnames(Y.cat) colnamx<-colnames(X) colnamz<-colnames(Z) Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.cat) Yi=cbind( matrix(0,nrow(Y.cat),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(h):(h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) { for (j in 1:ncol(Y.auxiliary)) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } } X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (is.null(l1cov.start)) { l1cov.start=diag(1,ncol(beta.start)) } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) ncolYcon<-rep(NA,4) ncolYcon[1]=max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con)) ncolYcon[2]=max(as.numeric(!is.null(Y.con)),ncol(Y.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))) previous_levelssub<-levels(Ysub) levels(Ysub)<-1:Ysub.ncat if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } colnamx<-colnames(X) X<-data.matrix(X) storage.mode(X) <- "numeric" Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } Ysubimp<-as.numeric(Ysub) if (output==0) out.iter=nburn+2 nimp=1 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+3) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y imp[1:nrow(X), (ncol(Y)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) betaYpost<- array(0, dim=c(1,length(betaY.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) varYpost<-array(0, dim=c(1,1,nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) cat("First imputation registered.", "\n") cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-apply(varYpost, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) colnames(betaYpostmean)<-c(names(fit.cr$coefficients),names(fit.cr$zeta)) rownames(betaYpostmean)<-colnamysub if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) } } imp<-data.frame(imp) imp[,1]<-as.factor(imp[,1]) levels(imp[,1])<-previous_levelssub if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[3]+i)]<-as.factor(imp[,(1+ncolYcon[3]+i)]) levels(imp[,(1+ncolYcon[3]+i)])<-previous_levelsaux[[i]] } } if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,"id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (isnullcataux==0) { cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } cnamycomp<-c(colnamycon,colnamyauxcon,cnycatcomp,cnyauxcatcomp) dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) dimnames(Yimp2)[2] <- list(cnamycomp) return(list("finimp"=imp,"collectbeta"=betapost,"collectomega"=omegapost, "finimp.latnorm" = Yimp2, "collectbetaY"=betaYpost, "collectvarY"=varYpost)) } jomo/R/jomo2hr.MCMCchain.R0000644000176200001440000004416614410253602014653 0ustar liggesusersjomo2hr.MCMCchain <- function(Y.con=NULL, Y.cat=NULL, Y.numcat=NULL,Y2.con=NULL, Y2.cat=NULL, Y2.numcat=NULL, X=NULL, X2=NULL, Z=NULL, clus, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, l2.start.imp=NULL, nburn=1000, a=NULL, a.prior=NULL, meth="random", output=1, out.iter=10) { if (is.null(X)) X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(X2)) X2=matrix(1,max(nrow(Y2.cat),nrow(Y2.con)),1) if (is.null(Z)) Z=matrix(1,nrow(X),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(0,ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat))))) if (is.null(l2.beta.start)) l2.beta.start=matrix(0,ncol(X2),(max(0,ncol(Y2.con))+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is.null(a)) a=ncol(beta.start)+50 if (is.null(a.prior)) a.prior=ncol(beta.start) if (is_tibble(Y.con)) { Y.con<-data.frame(Y.con) warning("tibbles not supported. Y.con converted to standard data.frame. ") } if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(Y2.con)) { Y2.con<-data.frame(Y2.con) warning("tibbles not supported. Y2.con converted to standard data.frame. ") } if (is_tibble(Y2.cat)) { Y2.cat<-data.frame(Y2.cat) warning("tibbles not supported. Y2.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } if (is_tibble(X2)) { X2<-data.frame(X2) warning("tibbles not supported. X2 converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) ncolYcon=max(0,ncol(Y.con)) ncolY2con=max(0,ncol(Y2.con)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat))), ((!is.null(Y2.con))||(!is.null(Y2.cat)&!is.null(Y2.numcat)))) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncolYcon+max(0,(sum(Y.numcat)-length(Y.numcat))))+(ncolY2con+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (is.null(l1cov.start)) l1cov.start=matrix(diag(1,ncol(beta.start)),ncol(beta.start)*nlevels(clus),ncol(beta.start),2) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 Y.cat=-999 Y.numcat=-999 } if (!is.null(Y2.cat)) { isnullcat2=0 previous_levels2<-list() Y2.cat<-data.frame(Y2.cat) for (i in 1:ncol(Y2.cat)) { Y2.cat[,i]<-factor(Y2.cat[,i]) previous_levels2[[i]]<-levels(Y2.cat[,i]) levels(Y2.cat[,i])<-1:nlevels(Y2.cat[,i]) } } else { isnullcat2=1 Y2.cat=-999 Y2.numcat=-999 } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(X2)) { if (is.factor(X2[,i])) X2[,i]<-as.numeric(X2[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } if (!is.null(Y.con)) { stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(Z)==nrow(Y.con)) } if (isnullcat==0) { stopifnot(nrow(Y.cat)==nrow(clus),nrow(Y.cat)==nrow(X), nrow(Z)==nrow(Y.cat)) } if (!is.null(Y2.con)) { stopifnot(nrow(Y2.con)==nrow(clus),nrow(Y2.con)==nrow(X), nrow(Z)==nrow(Y2.con)) } if (isnullcat2==0) { stopifnot(nrow(Y2.cat)==nrow(clus),nrow(Y2.cat)==nrow(X), nrow(Z)==nrow(Y2.cat)) } stopifnot((meth=="fixed"|meth=="random")) stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon+max(0,(sum(Y.numcat)-length(Y.numcat))))) stopifnot(nrow(l2.beta.start)==ncol(X2), ncol(l2.beta.start)==(ncolY2con+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) stopifnot(ncol(u.start)==ncol(Z)*(ncolYcon+max(0,(sum(Y.numcat)-length(Y.numcat))))+(ncolY2con+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) stopifnot(nrow(l1cov.start)==nrow(u.start)*ncol(l1cov.start), ncol(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.start)==nrow(u.start)*nrow(l1cov.prior)) stopifnot(ncol(l2cov.start)==ncol(u.start), ncol(l2cov.start)==ncol(l2cov.prior), ncol(l2cov.prior)==nrow(l2cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } beta2it=matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) for (i in 1:nrow(l2.beta.start)) { for (j in 1:ncol(l2.beta.start)) beta2it[i,j]=l2.beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } ait=0 ait=a nimp=1 if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } if (isnullcat==0) { colnamycat<-colnames(Y.cat) Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" } if (!is.null(Y2.con)) { colnamy2con<-colnames(Y2.con) Y2.con<-data.matrix(Y2.con) storage.mode(Y2.con) <- "numeric" } if (isnullcat2==0) { colnamy2cat<-colnames(Y2.cat) Y2.cat<-data.matrix(Y2.cat) storage.mode(Y2.cat) <- "numeric" } colnamx<-colnames(X) colnamz<-colnames(Z) colnamx2<-colnames(X2) X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) X2<-data.matrix(X2) storage.mode(X2) <- "numeric" stopifnot(!any(is.na(X2))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) if (!is.null(Y.con)&isnullcat==0) { Y=cbind(Y.con,Y.cat) Yi=cbind(Y.con, matrix(0,nrow(Y.con),(sum(Y.numcat)-length(Y.numcat)))) } else if (!is.null(Y.con)) { Y=Y.con Yi=Y.con } else { Y=Y.cat Yi=matrix(0,nrow(Y.cat),(sum(Y.numcat)-length(Y.numcat))) } n.patterns<-c(0,0) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns[1]<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns[1]<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns[1]<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns[1]) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } if (!is.null(Y2.con)&isnullcat2==0) { Y2=cbind(Y2.con,Y2.cat) Y2i=cbind(Y2.con, matrix(0,nrow(Y2.con),(sum(Y2.numcat)-length(Y2.numcat)))) } else if (!is.null(Y2.con)) { Y2=Y2.con Y2i=Y2.con } else { Y2=Y2.cat Y2i=matrix(0,nrow(Y2.cat),(sum(Y2.numcat)-length(Y2.numcat))) } if (any(is.na(Y2))) { if (ncol(Y2)==1) { miss.pat2<-matrix(c(0,1),2,1) n.patterns[2]<-2 } else { miss.pat2<-md.pattern.mice(Y2, plot=F) miss.pat2<-miss.pat2[,colnames(Y2)] n.patterns[2]<-nrow(miss.pat2)-1 } } else { miss.pat2<-matrix(0,2,ncol(Y2)) n.patterns[2]<-nrow(miss.pat2)-1 } miss.pat.id2<-rep(0,nrow(Y2)) for (i in 1:nrow(Y2)) { k <- 1 flag <- 0 while ((k <= n.patterns[2]) & (flag == 0)) { if (all(!is.na(Y2[i,])==miss.pat2[k,1:(ncol(miss.pat2))])) { miss.pat.id2[i] <- k flag <- 1 } else { k <- k + 1 } } } h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon+h):(ncolYcon+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } h=1 if (isnullcat2==0) { for (i in 1:length(Y2.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.cat[j,i])) { Y2i[j,(ncolY2con+h):(ncolY2con+h+Y2.numcat[i]-2)]=NA } } h=h+Y2.numcat[i]-1 } } if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(Y2),(ncol(Y)+1):(ncol(Y)+ncol(Y2))]=Y2 imp[1:nrow(X), (ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X))]=X imp[1:nrow(X2), (ncol(Y)+ncol(Y2)+ncol(X)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2))]=X2 imp[1:nrow(Z), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) Y2imp=Y2i Y2imp2=matrix(Y2imp, nrow(Y2imp),ncol(Y2imp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X))]=X imp[(nrow(X2)+1):(2*nrow(X2)), (ncol(Y)+ncol(Y2)+ncol(X)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2))]=X2 imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) beta2post<- array(0, dim=c(nrow(l2.beta.start),ncol(l2.beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)ncol(l2.start.imp))) { cat("l2.start.imp dimensions incorrect. Not using l2.start.imp as starting value for the level 2 imputed dataset.\n") l2.start.imp=NULL } else { if ((nrow(l2.start.imp)==nrow(Y2imp2))&(ncol(Y2imp2)0) { for (j in 1:(ncolYcon)) { imp[,j]=as.numeric(imp[,j]) } } if (ncolY2con>0) { for (j in 1:(ncolY2con)) { imp[,ncol(Y)+j]=as.numeric(imp[,ncol(Y)+j]) } } for (j in (ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))) { imp[,j]=as.numeric(imp[,j]) } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (is.null(colnamz)) colnamz=paste("Z", 1:ncol(Z), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") if (is.null(colnamx2)) colnamx2=paste("X2", 1:ncol(X2), sep = ".") colnames(imp)<-c(colnamycon,colnamycat,colnamy2con,colnamy2cat,colnamx,colnamx2,colnamz,"clus","id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } if (!is.null(Y.con)) { cnamycomp<-c(colnamycon,cnycatcomp) } else { cnamycomp<-c(cnycatcomp) } } else { cnamycomp<-c(colnamycon) } if (isnullcat2==0) { cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } if (!is.null(Y2.con)) { cnamy2comp<-c(colnamy2con,cny2catcomp) } else { cnamy2comp<-c(cny2catcomp) } } else { cnamy2comp<-c(colnamy2con) } dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(beta2post)[1] <- list(colnamx2) dimnames(beta2post)[2] <- list(cnamy2comp) dimnames(omegapost)[1] <- list(paste(cnamycomp,rep(levels(clus),each=ncol(Yimp2)), sep=".")) dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-paste(cnamycomp,rep(colnamz,each=ncol(omegapost)),sep="*") colnamcovu<-c(colnamcovu,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) dimnames(Yimp2)[2] <- list(cnamycomp) dimnames(Y2imp2)[2] <- list(cnamy2comp) betapostmean<-data.frame(apply(betapost, c(1,2), mean)) beta2postmean<-data.frame(apply(beta2post, c(1,2), mean)) upostmean<-data.frame(apply(upostall, c(1,2), mean)) omegapostmean<-data.frame(apply(omegapost, c(1,2), mean)) covupostmean<-data.frame(apply(covupost, c(1,2), mean)) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior mean of the level 2 fixed effects estimates is:\n") print(t(beta2postmean)) cat("\nThe posterior mean of the random effects estimates is:\n") print(upostmean) cat("\nThe posterior mean of the level 1 covariance matrices is:\n") print(omegapostmean) cat("\nThe posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } return(list("finimp"=imp,"collectbeta"=betapost,"collect.l2.beta"=beta2post,"collectomega"=omegapost,"collectu"=upostall, "collectcovu"=covupost, "finimp.latnorm" = Yimp2, "l2.finimp.latnorm" = Y2imp2)) } jomo/R/jomo1.R0000644000176200001440000000357214410253602012573 0ustar liggesusersjomo1 <- function(Y, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, nburn=100, nbetween=100, nimp=5, output=1, out.iter=10) { ncon=0 ncat=0 Y.con=NULL Y.cat=NULL Y.numcat=NULL for (i in 1:ncol(Y)) { if (is.numeric(Y[,i])) { ncon=ncon+1 if (is.null(Y.con)) { Y.con<-data.frame(Y[,i]) } else { Y.con<-data.frame(Y.con,Y[,i]) } colnames(Y.con)[ncon]<-colnames(Y)[i] } else { if (is.factor(Y[,i])) { ncat=ncat+1 if (is.null(Y.cat)) { Y.cat<-data.frame(Y[,i]) } else { Y.cat<-data.frame(Y.cat,Y[,i]) } colnames(Y.cat)[ncat]<-colnames(Y)[i] Y.numcat<-cbind(Y.numcat,nlevels(Y[,i])) } } } if (is.null(X)) X=matrix(1,nrow(Y),1) if (ncat==0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and no categorical. Using function jomo1con.", "\n") imp<-jomo1con(Y=Y.con, X=X, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output,out.iter=out.iter) } if (ncat>0 & ncon==0) { cat("Found ", ncat, "categorical outcomes and no continuous. Using function jomo1cat.", "\n") imp<-jomo1cat(Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output,out.iter=out.iter) } if (ncat>0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and ", ncat, "categorical. Using function jomo1mix.", "\n") imp<-jomo1mix(Y.con=Y.con,Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output,out.iter=out.iter) } return(imp) } jomo/R/jomo1ranconhr.R0000644000176200001440000002206214410253602014321 0ustar liggesusersjomo1ranconhr <- function(Y, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, a=(ncol(Y)+50),a.prior=NULL, meth="random", output=1, out.iter=10) { if (nimp<2) { nimp=2 cat("Minimum number of imputations:2. For single imputation using function jomo1ranconhr.MCMCchain\n") } if (is.null(X)) X=matrix(1,nrow(Y),1) if (is.null(Z)) Z=matrix(1,nrow(Y),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),ncol(Y)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is.null(a.prior)) a.prior=ncol(beta.start) if (is_tibble(Y)) { Y<-data.frame(Y) warning("tibbles not supported. Y converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*ncol(Y)) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (is.null(l1cov.start)) l1cov.start=matrix(diag(1,ncol(beta.start)),ncol(beta.start)*nlevels(clus),ncol(beta.start),2) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot((meth=="fixed"|meth=="random"),nrow(Y)==nrow(clus),nrow(Y)==nrow(X), nrow(beta.start)==ncol(X), ncol(beta.start)==ncol(Y),nrow(l1cov.start)==nrow(u.start)*ncol(l1cov.start), nrow(l1cov.start)==nrow(u.start)*ncol(Y), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.start)==nrow(u.start)*nrow(l1cov.prior), nrow(Z)==nrow(Y), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*ncol(Y)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } ait=as.numeric(a) colnamy<-colnames(Y) colnamx<-colnames(X) colnamz<-colnames(Z) Y<-data.matrix(Y) storage.mode(Y) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) if (output!=1) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Y Yimp2=matrix(Yimp, nrow(Y),ncol(Y)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nimp-1))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nimp-1))) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) meanobs<-colMeans(Y,na.rm=TRUE) for (i in 1:nrow(Y)) for (j in 1:ncol(Y)) if (is.na(Yimp[i,j])) Yimp2[i,j]=rnorm(1,meanobs[j],1) #for (i in 1:nrow(Y)) for (j in 1:ncol(Y)) if (is.na(Yimp[i,j])) Yimp[i,j]=rnorm(1,mean=meanobs[j], sd=0.01) Y.cat<-Y.numcat<-(-999) if (meth=="fixed") { fixed=1 } else { fixed=0 } .Call("jomo1ranhrC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit,cpost,nburn, l1cov.prior,l2cov.prior,Y.numcat, ncol(Y),ait, a.prior, out.iter, fixed, 0, miss.pat.id, n.patterns, PACKAGE = "jomo") #betapost[,,1]=bpost #upostall[,,1]=upost #omegapost[,,(1)]=opost #covupost[,,(1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(nrow(Y)+1):(2*nrow(Y)),1:ncol(Y)]=Yimp2 if (output==1) cat("First imputation registered.", "\n") for (i in 2:nimp) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(i*nrow(clus)+1):((i+1)*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=i if (meth=="fixed") { fixed=1 } else { fixed=0 } .Call("jomo1ranhrC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit,cpost,nbetween, l1cov.prior,l2cov.prior,Y.numcat, ncol(Y),ait,a.prior,out.iter, fixed, 0, miss.pat.id, n.patterns, PACKAGE = "jomo") betapost[,,(i-1)]=bpost upostall[,,(i-1)]=upost omegapost[,,(i-1)]=opost covupost[,,(i-1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(i*nrow(Y)+1):((i+1)*nrow(Y)),1:ncol(Y)]=Yimp2 if (output==1) cat("Imputation number ", i, "registered", "\n") } imp<-data.frame(imp) imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]<-factor(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]) levels(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus for (j in 1:(ncol(Y)+ncol(X)+ncol(Z))) { imp[,j]=as.numeric(imp[,j]) } if (is.null(colnamy)) colnamy=paste("Y", 1:ncol(Y), sep = "") if (is.null(colnamz)) colnamz=paste("Z", 1:ncol(Z), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") colnames(imp)<-c(colnamy,colnamx,colnamz,"clus","id","Imputation") dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(colnamy) dimnames(omegapost)[1] <- list(paste(colnamy,rep(levels(clus),each=ncol(Y)), sep=".")) dimnames(omegapost)[2] <- list(colnamy) colnamcovu<-paste(colnamy,rep(colnamz,each=ncol(omegapost)),sep="*") dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) betapostmean<-data.frame(apply(betapost, c(1,2), mean)) upostmean<-data.frame(apply(upostall, c(1,2), mean)) omegapostmean<-data.frame(apply(omegapost, c(1,2), mean)) covupostmean<-data.frame(apply(covupost, c(1,2), mean)) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior mean of the random effects estimates is:\n") print(upostmean) cat("\nThe posterior mean of the level 1 covariance matrices is:\n") print(omegapostmean) cat("\nThe posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } return(imp) } jomo/R/jomo1.MCMCchain.R0000644000176200001440000000403114410253602014303 0ustar liggesusersjomo1.MCMCchain <- function(Y, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL,start.imp=NULL, nburn=100, output=1, out.iter=10) { ncon=0 ncat=0 Y.con=NULL Y.cat=NULL Y.numcat=NULL for (i in 1:ncol(Y)) { if (is.numeric(Y[,i])) { ncon=ncon+1 if (is.null(Y.con)) { Y.con<-data.frame(Y[,i]) } else { Y.con<-data.frame(Y.con,Y[,i]) } colnames(Y.con)[ncon]<-colnames(Y)[i] } else { if (is.factor(Y[,i])) { ncat=ncat+1 if (is.null(Y.cat)) { Y.cat<-data.frame(Y[,i]) } else { Y.cat<-data.frame(Y.cat,Y[,i]) } colnames(Y.cat)[ncat]<-colnames(Y)[i] Y.numcat<-cbind(Y.numcat,nlevels(Y[,i])) } } } if (is.null(X)) X=matrix(1,nrow(Y),1) if (ncat==0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and no categorical. Using function jomo1con.", "\n") imp<-jomo1con.MCMCchain(Y=Y.con, X=X, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, start.imp=start.imp,nburn=nburn, output=output,out.iter=out.iter) attr(imp, "function") = "jomo1con.MCMCchain" } if (ncat>0 & ncon==0) { cat("Found ", ncat, "categorical outcomes and no continuous. Using function jomo1cat.", "\n") imp<-jomo1cat.MCMCchain(Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, start.imp=start.imp,nburn=nburn, output=output,out.iter=out.iter) attr(imp, "function") = "jomo1cat.MCMCchain" } if (ncat>0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and ", ncat, "categorical. Using function jomo1mix.", "\n") imp<-jomo1mix.MCMCchain(Y.con=Y.con,Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, beta.start=beta.start, l1cov.start=l1cov.start, l1cov.prior=l1cov.prior, start.imp=start.imp,nburn=nburn, output=output,out.iter=out.iter) attr(imp, "function") = "jomo1mix.MCMCchain" } return(imp) } jomo/R/jomo.glmer.R0000644000176200001440000011135014410253602013611 0ustar liggesusersjomo.glmer <- function(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, nburn=1000, nbetween=1000, nimp=5, meth="common", output=1, out.iter=10, family="binomial") { cat("This function is beta software. Please use carefully and report any bug to the package mantainer\n") if (nimp<2) { nimp=2 cat("Minimum number of imputations:2. For single imputation using function jomo.glmer.MCMCchain\n") } if (family!="gaussian"&family!="binomial") cat("ERROR: choose either family binomial or gaussian\n") if (family=="gaussian") { jomo.lmer(formula, data, level=level, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, a.start=a.start, a.prior=a.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, meth=meth, output=output, out.iter=out.iter) } if (family=="binomial") { stopifnot(is.data.frame(data)) if (is_tibble(data)) { data<-data.frame(data) warning("tibbles not supported. data converted to standard data.frame. ") } if (is_tibble(data)) { data<-data.frame(data) warning("tibbles not supported. data converted to standard data.frame. ") } if (isTRUE(any(sapply(df, is.character)))) stop("Character variables not allowed in data\n") stopifnot(any(grepl("~",deparse(formula)))) fit.cr<-glmer(formula,data=data, family=binomial, na.action = na.omit) betaY.start<-fixef(fit.cr) varY.start<-1 varY.prior<-1 colnamysub<-all.vars(formula[[2]]) Ysub<-get(colnamysub,pos=data) Ycov<-data.frame(mget(all.vars(formula[[3]]), envir =as.environment(data))) level<-data.frame(matrix(level,1,ncol(data))) colnames(level)<-colnames(data) terms.sub<-attr(terms(formula), "term.labels") split.terms<-strsplit(terms.sub,":") length.sub<-length(terms.sub) order.sub<-attr(terms(formula), "order") submod<-matrix(1,4,sum(order.sub)-1) Y.con<-NULL Y.cat<-NULL Y.numcat<-NULL Y2.con<-NULL Y2.cat<-NULL Y2.numcat<-NULL for (j in 1:ncol(Ycov)) { if (level[1, which(colnames(level)==colnames(Ycov)[j])]==1) { if (is.numeric(Ycov[,j])) { if (is.null(Y.con)) { Y.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.con<-data.frame(Y.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y.cat)) { Y.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.cat<-data.frame(Y.cat,Ycov[,j,drop=FALSE]) } Y.numcat<-cbind(Y.numcat,nlevels(Ycov[,j])) } } else { if (is.numeric(Ycov[,j])) { if (is.null(Y2.con)) { Y2.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.con<-data.frame(Y2.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y2.cat)) { Y2.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.cat<-data.frame(Y2.cat,Ycov[,j,drop=FALSE]) } Y2.numcat<-cbind(Y2.numcat,nlevels(Ycov[,j])) } } } h<-1 for ( j in 1:length.sub) { for ( k in 1:order.sub[j]) { current.term<-split.terms[[j]][k] if (grepl("\\|", deparse(current.term))) { j.tbd<-j clus.name<-sub(".*\\|","",current.term) clus.name<-gsub(" ","",clus.name) current.term<-sub("\\|.*$","",current.term) random.terms<-strsplit(current.term,"+", fixed=T) length.ran<-length(random.terms[[1]]) submod.ran<-matrix(1,3,length.ran) for (t in 1:length.ran) { ct<-gsub(" ","",random.terms[[1]][t]) if (ct==1) { submod.ran[1:2,t]<-0 } else if (length(which(colnames(Y.cat)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.cat)==ct) submod.ran[2,t]<-2 submod.ran[3,t]<-Y.numcat[submod.ran[1,t]]-1 } else if (length(which(colnames(Y.con)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.con)==ct) submod.ran[2,t]<-1 } } } else { current.term<-sub(".*I\\(","",current.term) current.term<-sub("\\)","",current.term) if (grepl("\\^",current.term)) { submod[3,h]<-as.integer(sub(".*\\^","",current.term)) current.term<-sub("\\^.*","",current.term) } else { submod[3,h]<-1 } if (length(which(colnames(Y.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y.cat)==current.term) submod[2,h]<-2 submod[4,h]<-Y.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y.con)==current.term) submod[2,h]<-1 } else if (length(which(colnames(Y2.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.cat)==current.term) submod[2,h]<-4 submod[4,h]<-Y2.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y2.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.con)==current.term) submod[2,h]<-3 } h<-h+1 } } } order.sub<-order.sub[-j.tbd] if (!is.null(Y.con)&sum((colnames(Y.con)==clus.name)==1)) Y.con<-data.frame(Y.con[,-which(colnames(Y.con)==clus.name), drop=FALSE]) if (!is.null(Y2.con)&sum((colnames(Y2.con)==clus.name)==1)) Y2.con<-data.frame(Y2.con[,-which(colnames(Y2.con)==clus.name), drop=FALSE]) if (!is.null(Y.cat)&sum((colnames(Y.cat)==clus.name)==1)) { Y.cat<-data.frame(Y.cat[,-which(colnames(Y.cat)==clus.name), drop=FALSE]) Y.numcat<-Y.numcat[-which(colnames(Y.cat)==clus.name)] } if (!is.null(Y2.cat)&sum((colnames(Y2.cat)==clus.name)==1)) { Y2.numcat<-Y2.numcat[-which(colnames(Y2.cat)==clus.name)] Y2.cat<-data.frame(Y2.cat[,-which(colnames(Y2.cat)==clus.name), drop=FALSE]) } if (!is.null(Y.con)&&ncol(Y.con)==0) Y.con <- NULL if (!is.null(Y.cat)&&ncol(Y.cat)==0) Y.cat <- NULL if (!is.null(Y2.cat)&&ncol(Y2.cat)==0) Y2.cat <- NULL if (!is.null(Y2.con)&&ncol(Y2.con)==0) Y2.con <- NULL Y.auxiliary<-data.frame(data[,-c(which(colnames(data)%in%colnames(Y.con)),which(colnames(data)%in%colnames(Y.cat)),which(colnames(data)%in%colnames(Y2.con)),which(colnames(data)%in%colnames(Y2.cat)),which(colnames(data)==clus.name),which(colnames(data)==colnamysub)), drop=FALSE]) Y.aux.con<-NULL Y.aux.cat<-NULL Y.aux.numcat<-NULL Y2.aux.con<-NULL Y2.aux.cat<-NULL Y2.aux.numcat<-NULL if (ncol(Y.auxiliary)>0) { for (j in 1:ncol(Y.auxiliary)) { if (level[1, which(colnames(level)==colnames(Y.auxiliary)[j])]==1) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } else { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y2.aux.con)) Y2.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.con<-data.frame(Y2.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y2.aux.cat)) Y2.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.cat<-data.frame(Y2.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y2.aux.numcat<-cbind(Y2.aux.numcat,nlevels(Y.auxiliary[,j])) } } } } if (((is.null(Y.con))&&(is.null(Y.cat)&is.null(Y.numcat)))) stop("No level 1 covariates in substantive model. jomo currently supports only models with at least one level 1 variable besides the outcome.\n") X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (!is.null(Y2.con)|!is.null(Y2.cat)|!is.null(Y2.aux.con)|!is.null(Y2.aux.cat)) { #cat("Level 2 variables must be fully observed for valid inference. \n") X2=matrix(1,max(nrow(Y2.cat),nrow(Y2.con),nrow(Y2.aux.cat),nrow(Y2.aux.con)),1) if (is.null(l2.beta.start)) l2.beta.start=matrix(0,ncol(X2),(max(0,ncol(Y2.con))+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(as.numeric(!is.null(Y2.aux.con)),ncol(Y2.aux.con))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) } Z=matrix(1,nrow(X),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(0,ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) clus<-factor(data[,clus.name]) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) uY.start<-matrix(0,nlevels(clus),ncol(VarCorr(fit.cr)[[1]])) if (is.null(l1cov.start)) { if (meth=="common") { l1cov.start=diag(1,ncol(beta.start)) } else { l1cov.start=matrix(diag(1,ncol(beta.start)),nlevels(clus)*ncol(beta.start),ncol(beta.start),2) } } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) diagVar<-as.data.frame(VarCorr(fit.cr))[1:ncol(VarCorr(fit.cr)[[1]]),4] covuY.start<-VarCorr(fit.cr)[[1]][1:ncol(VarCorr(fit.cr)[[1]]),1:ncol(VarCorr(fit.cr)[[1]])] covuY.prior<-VarCorr(fit.cr)[[1]][1:ncol(VarCorr(fit.cr)[[1]]),1:ncol(VarCorr(fit.cr)[[1]])] if (kappa(covuY.start)>10^8) { covuY.prior<-diag(1, ncol(VarCorr(fit.cr)[[1]])) covuY.start<-diag(1, ncol(VarCorr(fit.cr)[[1]])) } ncolYcon<-rep(NA,4) ncolY2con<-rep(NA,4) ncolYcon[1]=max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)) ncolY2con[1]=max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)) ncolYcon[2]=max(0,ncol(Y.con)) ncolY2con[2]=max(0,ncol(Y2.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolY2con[3]=ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) ncolY2con[4]=max(0,ncol(Y2.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))||((!is.null(Y2.con))||(!is.null(Y2.cat)&!is.null(Y2.numcat)))) Ysub<-as.factor(Ysub) previous_levelssub<-levels(Ysub) levels(Ysub)<-1:2 if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } if (!is.null(Y2.cat)) { isnullcat2=0 previous_levels2<-list() Y2.cat<-data.frame(Y2.cat) for (i in 1:ncol(Y2.cat)) { Y2.cat[,i]<-factor(Y2.cat[,i]) previous_levels2[[i]]<-levels(Y2.cat[,i]) levels(Y2.cat[,i])<-1:nlevels(Y2.cat[,i]) } } else { isnullcat2=1 } if (!is.null(Y2.aux.cat)) { isnullcat2aux=0 previous_levels2aux<-list() Y2.aux.cat<-data.frame(Y2.aux.cat) for (i in 1:ncol(Y2.aux.cat)) { Y2.aux.cat[,i]<-factor(Y2.aux.cat[,i]) previous_levels2aux[[i]]<-levels(Y2.aux.cat[,i]) levels(Y2.aux.cat[,i])<-1:nlevels(Y2.aux.cat[,i]) } } else { isnullcat2aux=1 } if (!is.null(Y.con)) { stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(Z)==nrow(Y.con)) } if (isnullcat==0) { stopifnot(nrow(Y.cat)==nrow(clus),nrow(Y.cat)==nrow(X), nrow(Z)==nrow(Y.cat)) } if (!is.null(Y2.con)) { stopifnot(nrow(Y2.con)==nrow(clus),nrow(Y2.con)==nrow(X), nrow(Z)==nrow(Y2.con)) } if (isnullcat2==0) { stopifnot(nrow(Y2.cat)==nrow(clus),nrow(Y2.cat)==nrow(X), nrow(Z)==nrow(Y2.cat)) } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) stopifnot(nrow(l2.beta.start)==ncol(X2), ncol(l2.beta.start)==(ncolY2con[3]+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) stopifnot(ncol(u.start)==ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (meth=="common") stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) stopifnot(ncol(l2cov.start)==ncol(u.start), nrow(l2cov.prior)==nrow(l2cov.start), nrow(l2cov.prior)==ncol(l2cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) { beta2it=matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) for (i in 1:nrow(l2.beta.start)) { for (j in 1:ncol(l2.beta.start)) beta2it[i,j]=l2.beta.start[i,j] } } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y2.con)) { colnamy2con<-colnames(Y2.con) Y2.con<-data.matrix(Y2.con) storage.mode(Y2.con) <- "numeric" } else { colnamy2con<-NULL } if (isnullcat2==0) { colnamy2cat<-colnames(Y2.cat) Y2.cat<-data.matrix(Y2.cat) storage.mode(Y2.cat) <- "numeric" cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } } else { cny2catcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } if (!is.null(Y2.aux.con)) { colnamy2auxcon<-colnames(Y2.aux.con) Y2.aux.con<-data.matrix(Y2.aux.con) storage.mode(Y2.aux.con) <- "numeric" } else { colnamy2auxcon<-NULL } if (isnullcat2aux==0) { colnamy2auxcat<-colnames(Y2.aux.cat) Y2.aux.cat<-data.matrix(Y2.aux.cat) storage.mode(Y2.aux.cat) <- "numeric" cny2auxcatcomp<-rep(NA,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))) count=0 for ( j in 1:ncol(Y2.aux.cat)) { for (k in 1:(Y2.aux.numcat[j]-1)) { cny2auxcatcomp[count+k]<-paste(colnamy2auxcat[j],k,sep=".") } count=count+Y2.aux.numcat[j]-1 } } else { cny2auxcatcomp<-NULL } Y.cat.tot<-cbind(Y.cat,Y.aux.cat) colnamx<-colnames(X) colnamz<-colnames(Z) X<-data.matrix(X) storage.mode(X) <- "numeric" Z<-data.matrix(Z) storage.mode(Z) <- "numeric" if (!is.null(Y2.con)||isnullcat2==0) { colnamx2<-colnames(X2) X2<-data.matrix(X2) storage.mode(X2) <- "numeric" } clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) Y2=cbind(Y2.con,Y2.aux.con,Y2.cat, Y2.aux.cat) Y2i=cbind(Y2.con, Y2.aux.con, switch(is.null(Y2.cat)+1, matrix(0,nrow(Y2),(sum(Y2.numcat)-length(Y2.numcat))), NULL), switch(is.null(Y2.aux.cat)+1, matrix(0,nrow(Y2.aux.cat),(sum(Y2.aux.numcat)-length(Y2.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } h=1 if (isnullcat2==0) { for (i in 1:length(Y2.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.numcat[i]-2)]=NA } } h=h+Y2.numcat[i]-1 } } if (isnullcat2aux==0) { for (i in 1:length(Y2.aux.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.aux.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.aux.numcat[i]-2)]=NA } } h=h+Y2.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } if (isnullcat2==0||isnullcat2aux==0) { Y2.cat.tot<-cbind(Y2.cat,Y2.aux.cat) Y2.numcat.tot<-c(Y2.numcat, Y2.aux.numcat) } else { Y2.cat.tot=-999 Y2.numcat.tot=-999 } ncY2<-max(0,ncol(Y2)) Ysubimp<-as.numeric(Ysub) if (is.null(a.start)) a.start=50+ncol(Y) if (is.null(a.prior)) a.prior=a.start if (output==0) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncY2+4) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y if (!is.null(Y2)) imp[1:nrow(Y2),(ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2 imp[1:nrow(clus), (ncol(Y)+ncY2+2)]=clus imp[1:nrow(X), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) if (!is.null(Y2)) { Y2imp=Y2i Y2imp2=matrix(Y2imp, nrow(Y2imp),ncol(Y2imp)) } imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncY2+2)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+4)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) if (!is.null(Y2)) { beta2post<- array(0, dim=c(nrow(l2.beta.start),ncol(l2.beta.start),(nimp-1))) b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) } upost<-matrix(0,nrow(u.start),ncol(u.start)) uYpost<-matrix(0,nrow(uY.start),ncol(uY.start)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nimp-1))) uYpostall<-array(0, dim=c(nrow(uY.start),ncol(uY.start),(nimp-1))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) varYpost<-rep(0,(nimp-1)) vYpost<-matrix(0,1,1) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nimp-1))) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) covuYpost<-array(0, dim=c(nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start)),(nimp-1))) cuYpost<-matrix(0,nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start))) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] if (!is.null(Y2)) { meanobs2<-colMeans(Y2i,na.rm=TRUE) for (i in 1:nrow(Y2i)) for (j in 1:ncol(Y2i)) if (is.na(Y2imp[i,j])) Y2imp2[i,j]=meanobs2[j] } for (i in 1:length(Ysubimp)) if (is.na(Ysubimp[i])) Ysubimp[i]=sample(1:2,1) Ysubcat <- as.numeric(Ysub) if (!is.null(Y2)) { if (meth=="common") { .Call("jomo2smcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, 1, ncolYcon,ncolY2con, out.iter, 0, 1, PACKAGE = "jomo") } else { .Call("jomo2hrsmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, 1, ncolYcon,ncolY2con, a.start, a.prior, out.iter, 0, 1, PACKAGE = "jomo") } } else { if (meth=="common") { .Call("jomo1ransmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, 1, ncolYcon,out.iter, 0, 1, PACKAGE = "jomo") } else { .Call("jomo1ranhrsmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, 1, ncolYcon, a.start, a.prior, out.iter, 0, 1, PACKAGE = "jomo") } } #betapost[,,1]=bpost #upostall[,,1]=upost #omegapost[,,(1)]=opost #covupost[,,(1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) upost<-matrix(0,nrow(u.start),ncol(u.start)) uYpost<-matrix(0,nrow(uY.start),ncol(uY.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) cuYpost<-matrix(0,nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start))) if (!is.null(Y2)) { b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) } imp[(nrow(Y)+1):(2*nrow(Y)),1]=Ysubcat if ((!is.null(Y.con)&&ncol(Y.con)!=0)|(!is.null(Y.aux.con)&&ncol(Y.aux.con)!=0)) { imp[(nrow(Y)+1):(2*nrow(Y)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(nrow(Y)+1):(2*nrow(Y)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if ((!is.null(Y2.con)&&ncol(Y2.con)!=0)|(!is.null(Y2.aux.con)&&ncol(Y2.aux.con)!=0)) { imp[(nrow(Y2)+1):(2*nrow(Y2)),(ncol(Y)+2):(1+ncol(Y)+max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)))]=Y2imp2[,1:(max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)))] } if (isnullcat2==0|isnullcat2aux==0) { imp[(nrow(Y2)+1):(2*nrow(Y2)),(ncolY2con[1]+ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2.cat.tot } if (output>0) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(clus)+1):((i+1)*nrow(clus)), (ncol(Y)+ncY2+2)]=clus imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncY2+4)]=i if (!is.null(Y2)) { if (meth=="common") { .Call("jomo2smcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, 1, ncolYcon,ncolY2con, out.iter, 0, 1, PACKAGE = "jomo") } else { .Call("jomo2hrsmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, 1, ncolYcon,ncolY2con, a.start, a.prior, out.iter, 0, 1, PACKAGE = "jomo") } } else { if (meth=="common") { .Call("jomo1ransmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, 1, ncolYcon,out.iter, 0, 1, PACKAGE = "jomo") } else { .Call("jomo1ranhrsmcC", Ysub, Ysubimp, Ysubcat, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, 1, ncolYcon, a.start, a.prior, out.iter, 0, 1, PACKAGE = "jomo") } } betapost[,,(i-1)]=bpost betaYpost[,,(i-1)]=bYpost upostall[,,(i-1)]=upost uYpostall[,,(i-1)]=uYpost omegapost[,,(i-1)]=opost varYpost[i-1]=vYpost covupost[,,(i-1)]=cpost covuYpost[,,(i-1)]=cuYpost if (!is.null(Y2)) { beta2post[,,(i-1)]=b2post b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) } bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) upost<-matrix(0,nrow(u.start),ncol(u.start)) uYpost<-matrix(0,nrow(uY.start),ncol(uY.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) cuYpost<-matrix(0,nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start))) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1]=Ysubcat if ((!is.null(Y.con)&&ncol(Y.con)!=0)|(!is.null(Y.aux.con)&&ncol(Y.aux.con)!=0)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if ((!is.null(Y2.con)&&ncol(Y2.con)!=0)|(!is.null(Y2.aux.con)&&ncol(Y2.aux.con)!=0)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+2):(ncol(Y)+max(0,ncol(Y2.con))+1+max(0,ncol(Y2.aux.con)))]=Y2imp2[,1:(max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)))] } if (isnullcat2==0|isnullcat2aux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolY2con[1]+ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2.cat.tot } if (output>0) cat("Imputation number ", i, "registered", "\n") } cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) cnamy2comp<-c(colnamy2con, colnamy2auxcon, cny2catcomp, cny2auxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) if (!is.null(Y2)) { dimnames(beta2post)[1] <- list("(Intercept)") dimnames(beta2post)[2] <- list(cnamy2comp) } if (meth=="common") { dimnames(omegapost)[1] <- list(cnamycomp) } else { dimnames(omegapost)[1] <- list(paste(cnamycomp,rep(levels(factor(clus)),each=length(cnamycomp)), sep=".")) } dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-c(cnamycomp,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(factor(clus))) dimnames(upostall)[2]<-list(colnamcovu) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-mean(varYpost) covuYpostmean<-apply(covuYpost, c(1,2), mean) uYpostmean<-apply(uYpostall, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) if (!is.null(Y2)) beta2postmean<-apply(beta2post, c(1,2), mean) upostmean<-apply(upostall, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) covupostmean<-apply(covupost, c(1,2), mean) colnames(betaYpostmean)<-rownames(summary(fit.cr)$coefficients) rownames(betaYpostmean)<-colnamysub colnames(covuYpostmean)<-rownames(covuYpostmean)<-colnames(uYpostmean)<-dimnames(summary(fit.cr)$varcor[[1]])[[1]] rownames(uYpostmean)<-levels(factor(clus)) if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) cat("The posterior mean of the substantive model random effects covariance matrix is:\n") print(covuYpostmean) cat("The posterior mean of the substantive model random effects estimates is:\n") print(uYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) if (!is.null(Y2)) { cat("The posterior mean of the level 2 fixed effects estimates is:\n") print(beta2postmean) } cat("The posterior mean of the random effects estimates is:\n") print(upostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) cat("The posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } } imp<-data.frame(imp) imp[,1]<-as.factor(imp[,1]) levels(imp[,1])<-previous_levelssub if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (isnullcat2==0) { for (i in 1:ncol(Y2.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+i)])<-previous_levels2[[i]] } } if (isnullcat2aux==0) { for (i in 1:ncol(Y2.aux.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)])<-previous_levels2aux[[i]] } } imp[,(ncol(Y)+ncY2+2)]<-factor(imp[,(ncol(Y)+ncY2+2)]) levels(imp[,(ncol(Y)+ncY2+2)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (ncolY2con[1]>0) { for (j in 1:(ncolY2con[1])) { imp[,ncol(Y)+j+1]=as.numeric(imp[,ncol(Y)+j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (isnullcat2aux==0) { if (is.null(colnamy2auxcat)) colnamy2auxcat=paste("Y2cat.aux", 1:ncol(Y2.aux.cat), sep = "") } else { colnamy2auxcat=NULL Y2.aux.cat=NULL Y2.aux.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (!is.null(Y2.aux.con)) { if (is.null(colnamy2auxcon)) colnamy2auxcon=paste("Y2con.aux", 1:ncol(Y2.aux.con), sep = "") } else { colnamy2auxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,colnamy2con,colnamy2auxcon,colnamy2cat,colnamy2auxcat,"clus","id","Imputation") return(imp) } } jomo/R/jomo1ranmixhr.MCMCchain.R0000644000176200001440000002307414410253602016064 0ustar liggesusersjomo1ranmixhr.MCMCchain <- function(Y.con, Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, a=NULL, a.prior=NULL, meth="random", output=1, out.iter=10) { if (is.null(X)) X=matrix(1,nrow(Y.cat),1) if (is.null(Z)) Z=matrix(1,nrow(Y.cat),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is.null(a)) a=ncol(beta.start)+50 if (is.null(a.prior)) a.prior=ncol(beta.start) if (is_tibble(Y.con)) { Y.con<-data.frame(Y.con) warning("tibbles not supported. Y.con converted to standard data.frame. ") } if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (is.null(l1cov.start)) l1cov.start=matrix(diag(1,ncol(beta.start)),ncol(beta.start)*nlevels(clus),ncol(beta.start),2) previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot((meth=="fixed"|meth=="random"),nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(beta.start)==ncol(X), ncol(beta.start)==(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat))),nrow(l1cov.start)==nrow(u.start)*ncol(l1cov.start), nrow(l1cov.start)==nrow(u.start)*ncol(beta.start), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.start)==nrow(u.start)*nrow(l1cov.prior),nrow(Z)==nrow(Y.con), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } ait=as.numeric(a) nimp=1 colnamycon<-colnames(Y.con) colnamycat<-colnames(Y.cat) colnamx<-colnames(X) colnamz<-colnames(Z) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.con,Y.cat) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } Yi=cbind(Y.con, matrix(0,nrow(Y.con),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncol(Y.con)+h):(ncol(Y.con)+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) { for (j in 1:ncol(Y.auxiliary)) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } } X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (is.null(l1cov.start)) { l1cov.start=diag(1,ncol(beta.start)) } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) ncolYcon<-rep(NA,4) ncolYcon[1]=max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con)) ncolYcon[2]=max(as.numeric(!is.null(Y.con)),ncol(Y.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } colnamx<-colnames(X) X<-data.matrix(X) storage.mode(X) <- "numeric" Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } Ysubimp<-Ysub if (output == 0) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+3) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y imp[1:nrow(X), (ncol(Y)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) varYpost<-rep(0,(nimp-1)) vYpost<-matrix(0,1,1) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] for (i in 1:length(Ysubimp)) if (is.na(Ysubimp[i])) Ysubimp[i]=mean(Ysubimp, na.rm = TRUE) .Call("jomo1smcC", Ysub, Ysubimp, 0, submod, order.sub, Y, Yimp, Yimp2, Y.cat.tot, X, betaY.start, bYpost, betait,bpost, varY.start, vYpost, covit,opost, nburn, varY.prior, l1cov.prior,Y.numcat.tot,1, ncolYcon,out.iter, 0, 0, PACKAGE = "jomo") #betapost[,,1]=bpost #omegapost[,,(1)]=opost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) imp[(nrow(Y)+1):(2*nrow(Y)),1]=Ysubimp if (!is.null(Y.con)|!is.null(Y.aux.con)) { imp[(nrow(Y)+1):(2*nrow(Y)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(nrow(Y)+1):(2*nrow(Y)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if (output > 0) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+2)]=c(1:nrow(Y)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+3)]=i .Call("jomo1smcC", Ysub, Ysubimp, 0, submod, order.sub, Y, Yimp, Yimp2, Y.cat.tot, X, betaY.start, bYpost, betait,bpost, varY.start, vYpost, covit,opost, nbetween, varY.prior, l1cov.prior,Y.numcat.tot,1, ncolYcon,out.iter, 0, 0, PACKAGE = "jomo") betapost[,,(i-1)]=bpost betaYpost[,,(i-1)]=bYpost omegapost[,,(i-1)]=opost varYpost[i-1]=vYpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1]=Ysubimp if (!is.null(Y.con)|!is.null(Y.aux.con)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0||isnullcataux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if (output > 0) cat("Imputation number ", i, "registered", "\n") } cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) betaYpostmean <- apply(betaYpost, c(1, 2), mean) varYpostmean <- mean(varYpost) betapostmean <- apply(betapost, c(1, 2), mean) omegapostmean <- apply(omegapost, c(1, 2), mean) colnames(betaYpostmean)<-names(fit.cr$coefficients) rownames(betaYpostmean)<-colnamysub if (output > 0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) if ( output == 2 ) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) } } imp<-data.frame(imp) if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,"id","Imputation") return(imp) } jomo/R/jomo2.MCMCchain.R0000644000176200001440000001022714410253602014310 0ustar liggesusersjomo2.MCMCchain <- function(Y, Y2, X=NULL, X2=NULL, Z=NULL,clus, beta.start=NULL,l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, l2.start.imp=NULL, nburn=1000, a=NULL, a.prior=NULL, meth="common",output=1, out.iter=10) { stopifnot(meth=="common"|meth=="fixed"|meth=="random") ncon=0 ncat=0 Y.con=NULL Y.cat=NULL Y.numcat=NULL for (i in 1:ncol(Y)) { if (is.numeric(Y[,i])) { ncon=ncon+1 if (is.null(Y.con)) { Y.con<-data.frame(Y[,i]) } else { Y.con<-data.frame(Y.con,Y[,i]) } colnames(Y.con)[ncon]<-colnames(Y)[i] } else { if (is.factor(Y[,i])) { ncat=ncat+1 if (is.null(Y.cat)) { Y.cat<-data.frame(Y[,i]) } else { Y.cat<-data.frame(Y.cat,Y[,i]) } colnames(Y.cat)[ncat]<-colnames(Y)[i] Y.numcat<-cbind(Y.numcat,nlevels(Y[,i])) } } } if (is.null(X)) X=matrix(1,nrow(Y),1) if (is.null(Z)) Z=matrix(1,nrow(Y),1) ncon2=0 ncat2=0 Y2.con=NULL Y2.cat=NULL Y2.numcat=NULL for (i in 1:ncol(Y2)) { if (is.numeric(Y2[,i])) { ncon2=ncon2+1 if (is.null(Y2.con)) { Y2.con<-data.frame(Y2[,i]) } else { Y2.con<-data.frame(Y2.con,Y2[,i]) } colnames(Y2.con)[ncon2]<-colnames(Y2)[i] } else { if (is.factor(Y2[,i])) { ncat2=ncat2+1 if (is.null(Y2.cat)) { Y2.cat<-data.frame(Y2[,i]) } else { Y2.cat<-data.frame(Y2.cat,Y2[,i]) } colnames(Y2.cat)[ncat2]<-colnames(Y2)[i] Y2.numcat<-cbind(Y2.numcat,nlevels(Y2[,i])) } } } if (is.null(X2)) X2=matrix(1,nrow(Y2),1) if (meth=="common") { cat("Found ", ncon, "level 1 continuous and ", ncat, "level 1 categorical outcomes, ",ncon2," level 2 continuous and ",ncat2," level 2 categorical outcomes. Using function jomo2com, assuming common covariance matrix across clusters", "\n") imp<-jomo2com.MCMCchain(Y.con=Y.con, Y.cat=Y.cat, Y.numcat=Y.numcat, Y2.con=Y2.con, Y2.cat=Y2.cat, Y2.numcat=Y2.numcat, X=X, X2=X2, Z=Z, clus=clus, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, l2.start.imp=l2.start.imp, nburn=nburn, output=output, out.iter=out.iter) attr(imp, "function") = "jomo2com.MCMCchain" } if (meth=="fixed") { cat("Found ", ncon, "level 1 continuous and ", ncat, "level 1 categorical outcomes, ",ncon2," level 2 continuous and ",ncat2," level 2 categorical outcomes. Using function jomo2hr with fixed cluster-specific covariance matrices.", "\n") imp<-jomo2hr.MCMCchain(Y.con=Y.con, Y.cat=Y.cat, Y.numcat=Y.numcat, Y2.con=Y2.con, Y2.cat=Y2.cat, Y2.numcat=Y2.numcat, X=X, X2=X2, Z=Z, clus=clus, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, l2.start.imp=l2.start.imp, nburn=nburn, a=a, meth="fixed", output=output, out.iter=out.iter) attr(imp, "function") = "jomo2hr.MCMCchain.fixed" } if (meth=="random") { cat("Found ", ncon, "level 1 continuous and ", ncat, "level 1 categorical outcomes, ",ncon2," level 2 continuous and ",ncat2," level 2 categorical outcomes. Using function jomo2hr with random cluster-specific covariance matrices.", "\n") imp<-jomo2hr.MCMCchain(Y.con=Y.con, Y.cat=Y.cat, Y.numcat=Y.numcat, Y2.con=Y2.con, Y2.cat=Y2.cat, Y2.numcat=Y2.numcat, X=X, X2=X2, Z=Z, clus=clus, beta.start=beta.start, l2.beta.start=l2.beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, start.imp=start.imp, l2.start.imp=l2.start.imp, nburn=nburn, a=a, a.prior=a.prior, meth="random", output=output, out.iter=out.iter) attr(imp, "function") = "jomo2hr.MCMCchain.random" } return(imp) } jomo/R/jomo.glm.MCMCchain.R0000644000176200001440000003714214410253602015011 0ustar liggesusersjomo.glm.MCMCchain <- function(formula, data, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, betaY.start=NULL, nburn=1000, start.imp=NULL, start.imp.sub=NULL, output=1, out.iter=10, family="binomial") { cat("This function is beta software. Use carefully and please report any bug to the package mantainer\n") if (family != "gaussian" & family != "binomial") cat("ERROR: choose either family binomial or gaussian\n") if (family == "gaussian") { jomo.lm.MCMCchain(formula, data, start.imp = start.imp, start.imp.sub = start.imp.sub, beta.start = beta.start, l1cov.start = l1cov.start, l1cov.prior = l1cov.prior, betaY.start = betaY.start, varY.start = varY.start, nburn = nburn, output = output, out.iter = out.iter) } if (family == "binomial") { stopifnot(is.data.frame(data)) if (is_tibble(data)) { data<-data.frame(data) warning("tibbles not supported. data converted to standard data.frame. ") } if (isTRUE(any(sapply(df, is.character)))) stop("Character variables not allowed in data\n") stopifnot(any(grepl("~",deparse(formula)))) fit.cr<-glm(formula,data=data, na.action = na.omit, family=binomial) if (is.null(betaY.start)) betaY.start<-coef(fit.cr) varY.start<-1 varY.prior<-1 colnamysub<-all.vars(formula[[2]]) Ysub<-get(colnamysub,pos=data) Ycov<-data.frame(mget(all.vars(formula[[3]]), envir =as.environment(data))) terms.sub<-attr(terms(formula), "term.labels") split.terms<-strsplit(terms.sub,":") length.sub<-length(terms.sub) order.sub<-attr(terms(formula), "order") submod<-matrix(1,4,sum(order.sub)) Y.con<-NULL Y.cat<-NULL Y.numcat<-NULL for (j in 1:ncol(Ycov)) { if (is.numeric(Ycov[,j])) { if (is.null(Y.con)) { Y.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.con<-data.frame(Y.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y.cat)) { Y.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.cat<-data.frame(Y.cat,Ycov[,j,drop=FALSE]) } Y.numcat<-cbind(Y.numcat,nlevels(Ycov[,j])) } } h<-1 for ( j in 1:length.sub) { for ( k in 1:order.sub[j]) { current.term<-split.terms[[j]][k] current.term<-sub(".*I\\(","",current.term) current.term<-sub("\\)","",current.term) if (grepl("\\^",current.term)) { submod[3,h]<-as.integer(sub(".*\\^","",current.term)) current.term<-sub("\\^.*","",current.term) } else { submod[3,h]<-1 } if (length(which(colnames(Y.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y.cat)==current.term) submod[2,h]<-2 submod[4,h]<-Y.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y.con)==current.term) submod[2,h]<-1 } h<-h+1 } } Y.auxiliary<-data.frame(data[,-c(which(colnames(data)%in%colnames(Y.con)),which(colnames(data)%in%colnames(Y.cat)),which(colnames(data)==colnamysub)), drop=FALSE]) Y.aux.con<-NULL Y.aux.cat<-NULL Y.aux.numcat<-NULL if (ncol(Y.auxiliary)>0) { for (j in 1:ncol(Y.auxiliary)) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } } X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (is.null(l1cov.start)) { l1cov.start=diag(1,ncol(beta.start)) } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) ncolYcon<-rep(NA,4) ncolYcon[1]=max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con)) ncolYcon[2]=max(as.numeric(!is.null(Y.con)),ncol(Y.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))) Ysub<-as.factor(Ysub) previous_levelssub<-levels(Ysub) levels(Ysub)<-1:2 if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } colnamx<-colnames(X) X<-data.matrix(X) storage.mode(X) <- "numeric" Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } Ysubimp<-as.numeric(Ysub) if (output==0) out.iter=nburn+2 nimp=1 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+3) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y imp[1:nrow(X), (ncol(Y)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nburn))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nburn))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nburn))) varYpost<-rep(0,(nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) cat("First imputation registered.", "\n") cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-mean(varYpost) betapostmean<-apply(betapost, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) colnames(betaYpostmean)<-names(fit.cr$coefficients) rownames(betaYpostmean)<-colnamysub if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) } } imp<-data.frame(imp) imp[,1]<-as.factor(imp[,1]) levels(imp[,1])<-previous_levelssub if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,"id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (isnullcataux==0) { cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } cnamycomp<-c(colnamycon,colnamyauxcon,cnycatcomp,cnyauxcatcomp) dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) dimnames(Yimp2)[2] <- list(cnamycomp) return(list("finimp"=imp,"collectbeta"=betapost,"collectomega"=omegapost, "finimp.latnorm" = Yimp2, "collectbetaY"=betaYpost, "collectvarY"=varYpost)) } } jomo/R/jomo2com.MCMCchain.R0000644000176200001440000004367114410253602015020 0ustar liggesusersjomo2com.MCMCchain <- function(Y.con=NULL, Y.cat=NULL, Y.numcat=NULL, Y2.con=NULL, Y2.cat=NULL, Y2.numcat=NULL, X=NULL, X2=NULL, Z=NULL, clus, beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, l2.start.imp=NULL, nburn=1000, output=1, out.iter=10) { if (is.null(X)) X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(X2)) X2=matrix(1,max(nrow(Y2.cat),nrow(Y2.con)),1) if (is.null(Z)) Z=matrix(1,nrow(X),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(0,ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat))))) if (is.null(l2.beta.start)) l2.beta.start=matrix(0,ncol(X2),(max(0,ncol(Y2.con))+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) if (is_tibble(Y.con)) { Y.con<-data.frame(Y.con) warning("tibbles not supported. Y.con converted to standard data.frame. ") } if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(Y2.con)) { Y2.con<-data.frame(Y2.con) warning("tibbles not supported. Y2.con converted to standard data.frame. ") } if (is_tibble(Y2.cat)) { Y2.cat<-data.frame(Y2.cat) warning("tibbles not supported. Y2.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } if (is_tibble(X2)) { X2<-data.frame(X2) warning("tibbles not supported. X2 converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) ncolYcon=max(0,ncol(Y.con)) ncolY2con=max(0,ncol(Y2.con)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat))),((!is.null(Y2.con))||(!is.null(Y2.cat)&!is.null(Y2.numcat)))) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncolYcon+max(0,(sum(Y.numcat)-length(Y.numcat))))+(ncolY2con+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 Y.cat=-999 Y.numcat=-999 } if (!is.null(Y2.cat)) { isnullcat2=0 previous_levels2<-list() Y2.cat<-data.frame(Y2.cat) for (i in 1:ncol(Y2.cat)) { Y2.cat[,i]<-factor(Y2.cat[,i]) previous_levels2[[i]]<-levels(Y2.cat[,i]) levels(Y2.cat[,i])<-1:nlevels(Y2.cat[,i]) } } else { isnullcat2=1 Y2.cat=-999 Y2.numcat=-999 } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(X2)) { if (is.factor(X2[,i])) X2[,i]<-as.numeric(X2[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } if (!is.null(Y.con)) { stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(Z)==nrow(Y.con)) } if (isnullcat==0) { stopifnot(nrow(Y.cat)==nrow(clus),nrow(Y.cat)==nrow(X), nrow(Z)==nrow(Y.cat)) } if (!is.null(Y2.con)) { stopifnot(nrow(Y2.con)==nrow(clus),nrow(Y2.con)==nrow(X), nrow(Z)==nrow(Y2.con)) } if (isnullcat2==0) { stopifnot(nrow(Y2.cat)==nrow(clus),nrow(Y2.cat)==nrow(X), nrow(Z)==nrow(Y2.cat)) } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon+max(0,(sum(Y.numcat)-length(Y.numcat))))) stopifnot(nrow(l2.beta.start)==ncol(X2), ncol(l2.beta.start)==(ncolY2con+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) stopifnot(ncol(u.start)==ncol(Z)*(ncolYcon+max(0,(sum(Y.numcat)-length(Y.numcat))))+(ncolY2con+max(0,(sum(Y2.numcat)-length(Y2.numcat))))) stopifnot(nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start)) stopifnot(ncol(l2cov.start)==ncol(u.start), ncol(l2cov.start)==ncol(l2cov.prior), ncol(l2cov.prior)==nrow(l2cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } beta2it=matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) for (i in 1:nrow(l2.beta.start)) { for (j in 1:ncol(l2.beta.start)) beta2it[i,j]=l2.beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } if (isnullcat==0) { colnamycat<-colnames(Y.cat) Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" } if (!is.null(Y2.con)) { colnamy2con<-colnames(Y2.con) Y2.con<-data.matrix(Y2.con) storage.mode(Y2.con) <- "numeric" } if (isnullcat2==0) { colnamy2cat<-colnames(Y2.cat) Y2.cat<-data.matrix(Y2.cat) storage.mode(Y2.cat) <- "numeric" } colnamx<-colnames(X) colnamz<-colnames(Z) colnamx2<-colnames(X2) X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) X2<-data.matrix(X2) storage.mode(X2) <- "numeric" stopifnot(!any(is.na(X2))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) if (!is.null(Y.con)&isnullcat==0) { Y=cbind(Y.con,Y.cat) Yi=cbind(Y.con, matrix(0,nrow(Y.con),(sum(Y.numcat)-length(Y.numcat)))) } else if (!is.null(Y.con)) { Y=Y.con Yi=Y.con } else { Y=Y.cat Yi=matrix(0,nrow(Y.cat),(sum(Y.numcat)-length(Y.numcat))) } n.patterns<-c(0,0) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns[1]<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns[1]<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns[1]<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns[1]) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } if (!is.null(Y2.con)&isnullcat2==0) { Y2=cbind(Y2.con,Y2.cat) Y2i=cbind(Y2.con, matrix(0,nrow(Y2.con),(sum(Y2.numcat)-length(Y2.numcat)))) } else if (!is.null(Y2.con)) { Y2=Y2.con Y2i=Y2.con } else { Y2=Y2.cat Y2i=matrix(0,nrow(Y2.cat),(sum(Y2.numcat)-length(Y2.numcat))) } if (any(is.na(Y2))) { if (ncol(Y2)==1) { miss.pat2<-matrix(c(0,1),2,1) n.patterns[2]<-2 } else { miss.pat2<-md.pattern.mice(Y2, plot=F) miss.pat2<-miss.pat2[,colnames(Y2)] n.patterns[2]<-nrow(miss.pat2)-1 } } else { miss.pat2<-matrix(0,2,ncol(Y2)) n.patterns[2]<-nrow(miss.pat2)-1 } miss.pat.id2<-rep(0,nrow(Y2)) for (i in 1:nrow(Y2)) { k <- 1 flag <- 0 while ((k <= n.patterns[2]) & (flag == 0)) { if (all(!is.na(Y2[i,])==miss.pat2[k,1:(ncol(miss.pat2))])) { miss.pat.id2[i] <- k flag <- 1 } else { k <- k + 1 } } } h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon+h):(ncolYcon+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } h=1 if (isnullcat2==0) { for (i in 1:length(Y2.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.cat[j,i])) { Y2i[j,(ncolY2con+h):(ncolY2con+h+Y2.numcat[i]-2)]=NA } } h=h+Y2.numcat[i]-1 } } if (output!=1) out.iter=nburn+2 nimp=1 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(Y2),(ncol(Y)+1):(ncol(Y)+ncol(Y2))]=Y2 imp[1:nrow(X), (ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X))]=X imp[1:nrow(X2), (ncol(Y)+ncol(Y2)+ncol(X)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2))]=X2 imp[1:nrow(Z), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) Y2imp=Y2i Y2imp2=matrix(Y2imp, nrow(Y2imp),ncol(Y2imp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X))]=X imp[(nrow(X2)+1):(2*nrow(X2)), (ncol(Y)+ncol(Y2)+ncol(X)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2))]=X2 imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) beta2post<- array(0, dim=c(nrow(l2.beta.start),ncol(l2.beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)ncol(l2.start.imp))) { cat("l2.start.imp dimensions incorrect. Not using l2.start.imp as starting value for the level 2 imputed dataset.\n") l2.start.imp=NULL } else { if ((nrow(l2.start.imp)==nrow(Y2imp2))&(ncol(Y2imp2)0) { for (j in 1:(ncolYcon)) { imp[,j]=as.numeric(imp[,j]) } } if (ncolY2con>0) { for (j in 1:(ncolY2con)) { imp[,ncol(Y)+j]=as.numeric(imp[,ncol(Y)+j]) } } for (j in (ncol(Y)+ncol(Y2)+1):(ncol(Y)+ncol(Y2)+ncol(X)+ncol(X2)+ncol(Z))) { imp[,j]=as.numeric(imp[,j]) } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (is.null(colnamz)) colnamz=paste("Z", 1:ncol(Z), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") if (is.null(colnamx2)) colnamx2=paste("X2", 1:ncol(X2), sep = ".") colnames(imp)<-c(colnamycon,colnamycat,colnamy2con,colnamy2cat,colnamx,colnamx2,colnamz,"clus","id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } if (!is.null(Y.con)) { cnamycomp<-c(colnamycon,cnycatcomp) } else { cnamycomp<-c(cnycatcomp) } } else { cnamycomp<-c(colnamycon) } if (isnullcat2==0) { cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } if (!is.null(Y2.con)) { cnamy2comp<-c(colnamy2con,cny2catcomp) } else { cnamy2comp<-c(cny2catcomp) } } else { cnamy2comp<-c(colnamy2con) } dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(beta2post)[1] <- list(colnamx2) dimnames(beta2post)[2] <- list(cnamy2comp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-paste(cnamycomp,rep(colnamz,each=ncol(omegapost)),sep="*") colnamcovu<-c(colnamcovu,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) dimnames(Yimp2)[2] <- list(cnamycomp) dimnames(Y2imp2)[2] <- list(cnamy2comp) betapostmean<-data.frame(apply(betapost, c(1,2), mean)) beta2postmean<-data.frame(apply(beta2post, c(1,2), mean)) upostmean<-data.frame(apply(upostall, c(1,2), mean)) omegapostmean<-data.frame(apply(omegapost, c(1,2), mean)) covupostmean<-data.frame(apply(covupost, c(1,2), mean)) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior mean of the level 2 fixed effects estimates is:\n") print(t(beta2postmean)) cat("\nThe posterior mean of the random effects estimates is:\n") print(upostmean) cat("\nThe posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) cat("\nThe posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } return(list("finimp"=imp,"collectbeta"=betapost,"collect.l2.beta"=beta2post,"collectomega"=omegapost,"collectu"=upostall, "collectcovu"=covupost, "finimp.latnorm" = Yimp2, "l2.finimp.latnorm" = Y2imp2)) } jomo/R/jomo1ranmixhr.R0000644000176200001440000002464214410253602014345 0ustar liggesusersjomo1ranmixhr <- function(Y.con, Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, nburn=1000, nbetween=1000, nimp=5, a=NULL, a.prior=NULL, meth="random", output=1, out.iter=10) { if (nimp<2) { nimp=2 cat("Minimum number of imputations:2. For single imputation using function jomo1ranmixhr.MCMCchain\n") } if (is.null(X)) X=matrix(1,nrow(Y.cat),1) if (is.null(Z)) Z=matrix(1,nrow(Y.cat),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is.null(a)) a=ncol(beta.start)+50 if (is.null(a.prior)) a.prior=ncol(beta.start) if (is_tibble(Y.con)) { Y.con<-data.frame(Y.con) warning("tibbles not supported. Y.con converted to standard data.frame. ") } if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus),ncol(Z)*(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (is.null(l1cov.start)) l1cov.start=matrix(diag(1,ncol(beta.start)),ncol(beta.start)*nlevels(clus),ncol(beta.start),2) previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot((meth=="fixed"|meth=="random"),nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(beta.start)==ncol(X), ncol(beta.start)==(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat))),nrow(l1cov.start)==nrow(u.start)*ncol(l1cov.start), nrow(l1cov.start)==nrow(u.start)*ncol(beta.start), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.start)==nrow(u.start)*nrow(l1cov.prior),nrow(Z)==nrow(Y.con), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*(ncol(Y.con)+(sum(Y.numcat)-length(Y.numcat)))) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } ait=as.numeric(a) colnamycon<-colnames(Y.con) colnamycat<-colnames(Y.cat) colnamx<-colnames(X) colnamz<-colnames(Z) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.con,Y.cat) if (any(is.na(Y))) { if (ncol(Y)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y, plot=F) miss.pat<-miss.pat[,colnames(Y)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y)) for (i in 1:nrow(Y)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } Yi=cbind(Y.con, matrix(0,nrow(Y.con),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncol(Y.con)+h):(ncol(Y.con)+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nimp-1))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nimp-1))) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=rnorm(1,meanobs[j],1) if (meth=="fixed") { fixed=1 } else { fixed=0 } .Call("jomo1ranhrC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit,cpost,nburn, l1cov.prior,l2cov.prior,Y.numcat, ncol(Y.con),ait, a.prior, out.iter, fixed, 0, miss.pat.id, n.patterns, PACKAGE = "jomo") #betapost[,,1]=bpost #upostall[,,1]=upost #omegapost[,,(1)]=opost #covupost[,,(1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(nrow(Y)+1):(2*nrow(Y)),1:ncol(Y.con)]=Yimp2[,1:ncol(Y.con)] imp[(nrow(Y)+1):(2*nrow(Y)),(ncol(Y.con)+1):ncol(Y)]=Y.cat if (output==1) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(i*nrow(clus)+1):((i+1)*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(i*nrow(Z)+1):((i+1)*nrow(Z)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=i if (meth=="fixed") { fixed=1 } else { fixed=0 } .Call("jomo1ranhrC", Y, Yimp, Yimp2, Y.cat, X, Z, clus,betait,uit,bpost,upost,covit,opost, covuit,cpost,nbetween, l1cov.prior,l2cov.prior,Y.numcat, ncol(Y.con),ait,a.prior,out.iter, fixed, 0, miss.pat.id, n.patterns, PACKAGE = "jomo") betapost[,,(i-1)]=bpost upostall[,,(i-1)]=upost omegapost[,,(i-1)]=opost covupost[,,(i-1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) upost<-matrix(0,nrow(u.start),ncol(u.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1:ncol(Y.con)]=Yimp2[,1:ncol(Y.con)] imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y.con)+1):ncol(Y)]=Y.cat if (output==1) cat("Imputation number ", i, "registered", "\n") } imp<-data.frame(imp) for (i in 1:ncol(Y.cat)) { imp[,(ncol(Y.con)+i)]<-as.factor(imp[,(ncol(Y.con)+i)]) levels(imp[,(ncol(Y.con)+i)])<-previous_levels[[i]] } imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]<-factor(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)]) levels(imp[,(ncol(Y)+ncol(X)+ncol(Z)+1)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus for (j in 1:(ncol(Y.con))) { imp[,j]=as.numeric(imp[,j]) } for (j in (ncol(Y)+1):(ncol(Y)+ncol(X)+ncol(Z))) { imp[,j]=as.numeric(imp[,j]) } if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") if (is.null(colnamz)) colnamz=paste("Z", 1:ncol(Z), sep = "") if (is.null(colnamx)) colnamx=paste("X", 1:ncol(X), sep = "") colnames(imp)<-c(colnamycon,colnamycat,colnamx,colnamz,"clus","id","Imputation") cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } cnamycomp<-c(colnamycon,cnycatcomp) dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(paste(cnamycomp,rep(levels(clus),each=ncol(Yimp2)), sep=".")) dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-paste(cnamycomp,rep(colnamz,each=ncol(omegapost)),sep="*") dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(clus)) dimnames(upostall)[2]<-list(colnamcovu) betapostmean<-data.frame(apply(betapost, c(1,2), mean)) upostmean<-data.frame(apply(upostall, c(1,2), mean)) omegapostmean<-data.frame(apply(omegapost, c(1,2), mean)) covupostmean<-data.frame(apply(covupost, c(1,2), mean)) if (output==1) { cat("The posterior mean of the fixed effects estimates is:\n") print(t(betapostmean)) cat("\nThe posterior mean of the random effects estimates is:\n") print(upostmean) cat("\nThe posterior mean of the level 1 covariance matrices is:\n") print(omegapostmean) cat("\nThe posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } return(imp) } jomo/R/jomo.lmer.R0000644000176200001440000010454314410253602013450 0ustar liggesusersjomo.lmer <- function(formula, data, level=rep(1,ncol(data)), beta.start=NULL, l2.beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, a.start=NULL, a.prior=NULL, nburn=1000, nbetween=1000, nimp=5, meth="common", output=1, out.iter=10) { cat("This function is beta software. Use carefully and please report any bug to the package mantainer\n") if (nimp<2) { nimp=2 cat("Minimum number of imputations:2. For single imputation using function jomo.lmer.MCMCchain\n") } stopifnot(is.data.frame(data)) if (is_tibble(data)) { data<-data.frame(data) warning("tibbles not supported. data converted to standard data.frame. ") } if (isTRUE(any(sapply(df, is.character)))) stop("Character variables not allowed in data\n") stopifnot(any(grepl("~",deparse(formula)))) fit.cr<-lmer(formula,data=data, na.action = na.omit) betaY.start<-fixef(fit.cr) varY.start<-(summary(fit.cr)$sigma)^2 varY.prior<-(summary(fit.cr)$sigma)^2 colnamysub<-all.vars(formula[[2]]) Ysub<-get(colnamysub,pos=data) Ycov<-data.frame(mget(all.vars(formula[[3]]), envir =as.environment(data))) level<-data.frame(matrix(level,1,ncol(data))) colnames(level)<-colnames(data) terms.sub<-attr(terms(formula), "term.labels") split.terms<-strsplit(terms.sub,":") length.sub<-length(terms.sub) order.sub<-attr(terms(formula), "order") submod<-matrix(1,4,sum(order.sub)-1) Y.con<-NULL Y.cat<-NULL Y.numcat<-NULL Y2.con<-NULL Y2.cat<-NULL Y2.numcat<-NULL for (j in 1:ncol(Ycov)) { if (level[1, which(colnames(level)==colnames(Ycov)[j])]==1) { if (is.numeric(Ycov[,j])) { if (is.null(Y.con)) { Y.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.con<-data.frame(Y.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y.cat)) { Y.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y.cat<-data.frame(Y.cat,Ycov[,j,drop=FALSE]) } Y.numcat<-cbind(Y.numcat,nlevels(Ycov[,j])) } } else { if (is.numeric(Ycov[,j])) { if (is.null(Y2.con)) { Y2.con<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.con<-data.frame(Y2.con,Ycov[,j,drop=FALSE]) } } if (is.factor(Ycov[,j])) { if (is.null(Y2.cat)) { Y2.cat<-data.frame(Ycov[,j,drop=FALSE]) } else { Y2.cat<-data.frame(Y2.cat,Ycov[,j,drop=FALSE]) } Y2.numcat<-cbind(Y2.numcat,nlevels(Ycov[,j])) } } } h<-1 for ( j in 1:length.sub) { for ( k in 1:order.sub[j]) { current.term<-split.terms[[j]][k] if (grepl("\\|", deparse(current.term))) { j.tbd<-j clus.name<-sub(".*\\|","",current.term) clus.name<-gsub(" ","",clus.name) current.term<-sub("\\|.*$","",current.term) random.terms<-strsplit(current.term,"+", fixed=T) length.ran<-length(random.terms[[1]]) submod.ran<-matrix(1,3,length.ran) for (t in 1:length.ran) { ct<-gsub(" ","",random.terms[[1]][t]) if (ct==1) { submod.ran[1:2,t]<-0 } else if (length(which(colnames(Y.cat)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.cat)==ct) submod.ran[2,t]<-2 submod.ran[3,t]<-Y.numcat[submod.ran[1,t]]-1 } else if (length(which(colnames(Y.con)==ct))!=0) { submod.ran[1,t]<-which(colnames(Y.con)==ct) submod.ran[2,t]<-1 } } } else { current.term<-sub(".*I\\(","",current.term) current.term<-sub("\\)","",current.term) if (grepl("\\^",current.term)) { submod[3,h]<-as.integer(sub(".*\\^","",current.term)) current.term<-sub("\\^.*","",current.term) } else { submod[3,h]<-1 } if (length(which(colnames(Y.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y.cat)==current.term) submod[2,h]<-2 submod[4,h]<-Y.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y.con)==current.term) submod[2,h]<-1 } else if (length(which(colnames(Y2.cat)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.cat)==current.term) submod[2,h]<-4 submod[4,h]<-Y2.numcat[submod[1,h]]-1 } else if (length(which(colnames(Y2.con)==current.term))!=0) { submod[1,h]<-which(colnames(Y2.con)==current.term) submod[2,h]<-3 } h<-h+1 } } } order.sub<-order.sub[-j.tbd] if (!is.null(Y.con)&sum((colnames(Y.con)==clus.name)==1)) Y.con<-data.frame(Y.con[,-which(colnames(Y.con)==clus.name), drop=FALSE]) if (!is.null(Y2.con)&sum((colnames(Y2.con)==clus.name)==1)) Y2.con<-data.frame(Y2.con[,-which(colnames(Y2.con)==clus.name), drop=FALSE]) if (!is.null(Y.cat)&sum((colnames(Y.cat)==clus.name)==1)) { Y.cat<-data.frame(Y.cat[,-which(colnames(Y.cat)==clus.name), drop=FALSE]) Y.numcat<-Y.numcat[-which(colnames(Y.cat)==clus.name)] } if (!is.null(Y2.cat)&sum((colnames(Y2.cat)==clus.name)==1)) { Y2.numcat<-Y2.numcat[-which(colnames(Y2.cat)==clus.name)] Y2.cat<-data.frame(Y2.cat[,-which(colnames(Y2.cat)==clus.name), drop=FALSE]) } if (!is.null(Y.con)&&ncol(Y.con)==0) Y.con <- NULL if (!is.null(Y.cat)&&ncol(Y.cat)==0) Y.cat <- NULL if (!is.null(Y2.cat)&&ncol(Y2.cat)==0) Y2.cat <- NULL if (!is.null(Y2.con)&&ncol(Y2.con)==0) Y2.con <- NULL Y.auxiliary<-data.frame(data[,-c(which(colnames(data)%in%colnames(Y.con)),which(colnames(data)%in%colnames(Y.cat)),which(colnames(data)%in%colnames(Y2.con)),which(colnames(data)%in%colnames(Y2.cat)),which(colnames(data)==clus.name),which(colnames(data)==colnamysub)), drop=FALSE]) Y.aux.con<-NULL Y.aux.cat<-NULL Y.aux.numcat<-NULL Y2.aux.con<-NULL Y2.aux.cat<-NULL Y2.aux.numcat<-NULL if (ncol(Y.auxiliary)>0) { for (j in 1:ncol(Y.auxiliary)) { if (level[1, which(colnames(level)==colnames(Y.auxiliary)[j])]==1) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } else { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y2.aux.con)) Y2.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.con<-data.frame(Y2.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y2.aux.cat)) Y2.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y2.aux.cat<-data.frame(Y2.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y2.aux.numcat<-cbind(Y2.aux.numcat,nlevels(Y.auxiliary[,j])) } } } } if (((is.null(Y.con))&&(is.null(Y.cat)&is.null(Y.numcat)))) stop("No level 1 covariates in substantive model. jomo currently supports only models with at least one level 1 variable besides the outcome.\n") X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (!is.null(Y2.con)|!is.null(Y2.cat)|!is.null(Y2.aux.con)|!is.null(Y2.aux.cat)) { #cat("Level 2 variables must be fully observed for valid inference. \n") X2=matrix(1,max(nrow(Y2.cat),nrow(Y2.con),nrow(Y2.aux.cat),nrow(Y2.aux.con)),1) if (is.null(l2.beta.start)) l2.beta.start=matrix(0,ncol(X2),(max(as.numeric(!is.null(Y2.con)),ncol(Y2.con))+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(as.numeric(!is.null(Y2.aux.con)),ncol(Y2.aux.con))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) } Z=matrix(1,nrow(X),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(0,ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) clus<-factor(data[,clus.name]) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) uY.start<-matrix(0,nlevels(clus),ncol(VarCorr(fit.cr)[[1]])) if (is.null(l1cov.start)) { if (meth=="common") { l1cov.start=diag(1,ncol(beta.start)) } else { l1cov.start=matrix(diag(1,ncol(beta.start)),nlevels(clus)*ncol(beta.start),ncol(beta.start),2) } } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) diagVar<-as.data.frame(VarCorr(fit.cr))[1:ncol(VarCorr(fit.cr)[[1]]),4] covuY.start<-VarCorr(fit.cr)[[1]][1:ncol(VarCorr(fit.cr)[[1]]),1:ncol(VarCorr(fit.cr)[[1]])] covuY.prior<-VarCorr(fit.cr)[[1]][1:ncol(VarCorr(fit.cr)[[1]]),1:ncol(VarCorr(fit.cr)[[1]])] if (kappa(covuY.start)>10^8) { covuY.prior<-diag(1, ncol(VarCorr(fit.cr)[[1]])) covuY.start<-diag(1, ncol(VarCorr(fit.cr)[[1]])) } ncolYcon<-rep(NA,4) ncolY2con<-rep(NA,4) ncolYcon[1]=max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)) ncolY2con[1]=max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)) ncolYcon[2]=max(0,ncol(Y.con)) ncolY2con[2]=max(0,ncol(Y2.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolY2con[3]=ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) ncolY2con[4]=max(0,ncol(Y2.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } if (!is.null(Y2.cat)) { isnullcat2=0 previous_levels2<-list() Y2.cat<-data.frame(Y2.cat) for (i in 1:ncol(Y2.cat)) { Y2.cat[,i]<-factor(Y2.cat[,i]) previous_levels2[[i]]<-levels(Y2.cat[,i]) levels(Y2.cat[,i])<-1:nlevels(Y2.cat[,i]) } } else { isnullcat2=1 } if (!is.null(Y2.aux.cat)) { isnullcat2aux=0 previous_levels2aux<-list() Y2.aux.cat<-data.frame(Y2.aux.cat) for (i in 1:ncol(Y2.aux.cat)) { Y2.aux.cat[,i]<-factor(Y2.aux.cat[,i]) previous_levels2aux[[i]]<-levels(Y2.aux.cat[,i]) levels(Y2.aux.cat[,i])<-1:nlevels(Y2.aux.cat[,i]) } } else { isnullcat2aux=1 } if (!is.null(Y.con)) { stopifnot(nrow(Y.con)==nrow(clus),nrow(Y.con)==nrow(X), nrow(Z)==nrow(Y.con)) } if (isnullcat==0) { stopifnot(nrow(Y.cat)==nrow(clus),nrow(Y.cat)==nrow(X), nrow(Z)==nrow(Y.cat)) } if (!is.null(Y2.con)) { stopifnot(nrow(Y2.con)==nrow(clus),nrow(Y2.con)==nrow(X), nrow(Z)==nrow(Y2.con)) } if (isnullcat2==0) { stopifnot(nrow(Y2.cat)==nrow(clus),nrow(Y2.cat)==nrow(X), nrow(Z)==nrow(Y2.cat)) } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) stopifnot(nrow(l2.beta.start)==ncol(X2), ncol(l2.beta.start)==(ncolY2con[3]+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) stopifnot(ncol(u.start)==ncol(Z)*(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))+(ncolY2con[1]+max(0,(sum(Y2.numcat)-length(Y2.numcat)))+max(0,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))))) if (meth=="common") stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) stopifnot(ncol(l2cov.start)==ncol(u.start), nrow(l2cov.prior)==nrow(l2cov.start), nrow(l2cov.prior)==ncol(l2cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } if (!is.null(Y2.con)||isnullcat2==0||!is.null(Y2.aux.con)||isnullcat2aux==0) { beta2it=matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) for (i in 1:nrow(l2.beta.start)) { for (j in 1:ncol(l2.beta.start)) beta2it[i,j]=l2.beta.start[i,j] } } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y2.con)) { colnamy2con<-colnames(Y2.con) Y2.con<-data.matrix(Y2.con) storage.mode(Y2.con) <- "numeric" } else { colnamy2con<-NULL } if (isnullcat2==0) { colnamy2cat<-colnames(Y2.cat) Y2.cat<-data.matrix(Y2.cat) storage.mode(Y2.cat) <- "numeric" cny2catcomp<-rep(NA,(sum(Y2.numcat)-length(Y2.numcat))) count=0 for ( j in 1:ncol(Y2.cat)) { for (k in 1:(Y2.numcat[j]-1)) { cny2catcomp[count+k]<-paste(colnamy2cat[j],k,sep=".") } count=count+Y2.numcat[j]-1 } } else { cny2catcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } if (!is.null(Y2.aux.con)) { colnamy2auxcon<-colnames(Y2.aux.con) Y2.aux.con<-data.matrix(Y2.aux.con) storage.mode(Y2.aux.con) <- "numeric" } else { colnamy2auxcon<-NULL } if (isnullcat2aux==0) { colnamy2auxcat<-colnames(Y2.aux.cat) Y2.aux.cat<-data.matrix(Y2.aux.cat) storage.mode(Y2.aux.cat) <- "numeric" cny2auxcatcomp<-rep(NA,(sum(Y2.aux.numcat)-length(Y2.aux.numcat))) count=0 for ( j in 1:ncol(Y2.aux.cat)) { for (k in 1:(Y2.aux.numcat[j]-1)) { cny2auxcatcomp[count+k]<-paste(colnamy2auxcat[j],k,sep=".") } count=count+Y2.aux.numcat[j]-1 } } else { cny2auxcatcomp<-NULL } Y.cat.tot<-cbind(Y.cat,Y.aux.cat) colnamx<-colnames(X) colnamz<-colnames(Z) X<-data.matrix(X) storage.mode(X) <- "numeric" Z<-data.matrix(Z) storage.mode(Z) <- "numeric" if (!is.null(Y2.con)||isnullcat2==0) { colnamx2<-colnames(X2) X2<-data.matrix(X2) storage.mode(X2) <- "numeric" } clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) Y2=cbind(Y2.con,Y2.aux.con,Y2.cat, Y2.aux.cat) Y2i=cbind(Y2.con, Y2.aux.con, switch(is.null(Y2.cat)+1, matrix(0,nrow(Y2),(sum(Y2.numcat)-length(Y2.numcat))), NULL), switch(is.null(Y2.aux.cat)+1, matrix(0,nrow(Y2.aux.cat),(sum(Y2.aux.numcat)-length(Y2.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } h=1 if (isnullcat2==0) { for (i in 1:length(Y2.numcat)) { for (j in 1:nrow(Y2)) { cat(j," ", i, "\n") if (is.na(Y2.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.numcat[i]-2)]=NA } } h=h+Y2.numcat[i]-1 } } if (isnullcat2aux==0) { for (i in 1:length(Y2.aux.numcat)) { for (j in 1:nrow(Y2)) { if (is.na(Y2.aux.cat[j,i])) { Y2i[j,(ncolY2con[1]+h):(ncolY2con[1]+h+Y2.aux.numcat[i]-2)]=NA } } h=h+Y2.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } if (isnullcat2==0||isnullcat2aux==0) { Y2.cat.tot<-cbind(Y2.cat,Y2.aux.cat) Y2.numcat.tot<-c(Y2.numcat, Y2.aux.numcat) } else { Y2.cat.tot=-999 Y2.numcat.tot=-999 } ncY2<-max(0,ncol(Y2)) Ysubimp<-Ysub if (is.null(a.start)) a.start=50+ncol(Y) if (is.null(a.prior)) a.prior=a.start if (output==0) out.iter=nburn+nbetween imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncY2+4) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y if (!is.null(Y2)) imp[1:nrow(Y2),(ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2 imp[1:nrow(clus), (ncol(Y)+ncY2+2)]=clus imp[1:nrow(X), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) if (!is.null(Y2)) { Y2imp=Y2i Y2imp2=matrix(Y2imp, nrow(Y2imp),ncol(Y2imp)) } imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncY2+2)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncY2+4)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nimp-1))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nimp-1))) bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) if (!is.null(Y2)) { beta2post<- array(0, dim=c(nrow(l2.beta.start),ncol(l2.beta.start),(nimp-1))) b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) } upost<-matrix(0,nrow(u.start),ncol(u.start)) uYpost<-matrix(0,nrow(uY.start),ncol(uY.start)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),(nimp-1))) uYpostall<-array(0, dim=c(nrow(uY.start),ncol(uY.start),(nimp-1))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nimp-1))) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) varYpost<-rep(0,(nimp-1)) vYpost<-matrix(0,1,1) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),(nimp-1))) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) covuYpost<-array(0, dim=c(nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start)),(nimp-1))) cuYpost<-matrix(0,nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start))) meanobs<-colMeans(Yi,na.rm=TRUE) for (i in 1:nrow(Yi)) for (j in 1:ncol(Yi)) if (is.na(Yimp[i,j])) Yimp2[i,j]=meanobs[j] if (!is.null(Y2)) { meanobs2<-colMeans(Y2i,na.rm=TRUE) for (i in 1:nrow(Y2i)) for (j in 1:ncol(Y2i)) if (is.na(Y2imp[i,j])) Y2imp2[i,j]=meanobs2[j] } for (i in 1:length(Ysubimp)) if (is.na(Ysubimp[i])) Ysubimp[i]=mean(Ysubimp, na.rm = TRUE) if (!is.null(Y2)) { if (meth=="common") { .Call("jomo2smcC", Ysub, Ysubimp, 0, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, 1, ncolYcon,ncolY2con, out.iter, 0, 0, PACKAGE = "jomo") } else { .Call("jomo2hrsmcC", Ysub, Ysubimp, 0, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, 1,ncolYcon,ncolY2con, a.start, a.prior, out.iter, 0, 0, PACKAGE = "jomo") } } else { if (meth=="common") { .Call("jomo1ransmcC", Ysub, Ysubimp, 0, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, 1, ncolYcon,out.iter, 0, 0, PACKAGE = "jomo") } else { .Call("jomo1ranhrsmcC", Ysub, Ysubimp, 0, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nburn, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, 1, ncolYcon, a.start, a.prior, out.iter, 0, 0, PACKAGE = "jomo") } } #betapost[,,1]=bpost #upostall[,,1]=upost #omegapost[,,(1)]=opost #covupost[,,(1)]=cpost bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) upost<-matrix(0,nrow(u.start),ncol(u.start)) uYpost<-matrix(0,nrow(uY.start),ncol(uY.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) cuYpost<-matrix(0,nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start))) if (!is.null(Y2)) { b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) } imp[(nrow(Y)+1):(2*nrow(Y)),1]=Ysubimp if ((!is.null(Y.con)&&ncol(Y.con)!=0)|(!is.null(Y.aux.con)&&ncol(Y.aux.con)!=0)) { imp[(nrow(Y)+1):(2*nrow(Y)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(nrow(Y)+1):(2*nrow(Y)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if ((!is.null(Y2.con)&&ncol(Y2.con)!=0)|(!is.null(Y2.aux.con)&&ncol(Y2.aux.con)!=0)) { imp[(nrow(Y2)+1):(2*nrow(Y2)),(ncol(Y)+2):(1+ncol(Y)+max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)))]=Y2imp2[,1:(max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)))] } if (isnullcat2==0|isnullcat2aux==0) { imp[(nrow(Y2)+1):(2*nrow(Y2)),(ncolY2con[1]+ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2.cat.tot } if (output>0) cat("First imputation registered.", "\n") for (i in 2:nimp) { #Yimp2=matrix(0, nrow(Yimp),ncol(Yimp)) imp[(i*nrow(clus)+1):((i+1)*nrow(clus)), (ncol(Y)+ncY2+2)]=clus imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncY2+3)]=c(1:nrow(Y)) imp[(i*nrow(X)+1):((i+1)*nrow(X)), (ncol(Y)+ncY2+4)]=i if (!is.null(Y2)) { if (meth=="common") { .Call("jomo2smcC", Ysub, Ysubimp, 0, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, 1, ncolYcon,ncolY2con, out.iter, 0, 0, PACKAGE = "jomo") } else { .Call("jomo2hrsmcC", Ysub, Ysubimp, 0, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, Y2, Y2imp, Y2imp2, Y2.cat.tot, X, X2, Z, clus,betaY.start,bYpost, betait, beta2it, uit,uY.start,bpost, upost, uYpost, b2post, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, Y2.numcat.tot, 1, ncolYcon,ncolY2con, a.start, a.prior, out.iter, 0, 0, PACKAGE = "jomo") } } else { if (meth=="common") { .Call("jomo1ransmcC", Ysub, Ysubimp, 0, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, 1, ncolYcon,out.iter, 0, 0, PACKAGE = "jomo") } else { .Call("jomo1ranhrsmcC", Ysub, Ysubimp, 0, submod, order.sub, submod.ran, Y, Yimp, Yimp2, Y.cat.tot, X, Z, clus,betaY.start,bYpost, betait,uit,uY.start,bpost, upost, uYpost, varY.start, vYpost, covit,opost, covuY.start, cuYpost, covuit, cpost, nbetween, varY.prior, covuY.prior, l1cov.prior,l2cov.prior,Y.numcat.tot, 1, ncolYcon, a.start, a.prior, out.iter, 0, 0, PACKAGE = "jomo") } } betapost[,,(i-1)]=bpost betaYpost[,,(i-1)]=bYpost upostall[,,(i-1)]=upost uYpostall[,,(i-1)]=uYpost omegapost[,,(i-1)]=opost varYpost[i-1]=vYpost covupost[,,(i-1)]=cpost covuYpost[,,(i-1)]=cuYpost if (!is.null(Y2)) { beta2post[,,(i-1)]=b2post b2post<-matrix(0,nrow(l2.beta.start),ncol(l2.beta.start)) } bpost<-matrix(0,nrow(beta.start),ncol(beta.start)) bYpost<-matrix(0,1,length(betaY.start)) opost<-matrix(0,nrow(l1cov.start),ncol(l1cov.start)) vYpost<-matrix(0,1,1) upost<-matrix(0,nrow(u.start),ncol(u.start)) uYpost<-matrix(0,nrow(uY.start),ncol(uY.start)) cpost<-matrix(0,nrow(l2cov.start),ncol(l2cov.start)) cuYpost<-matrix(0,nrow(as.matrix(covuY.start)),ncol(as.matrix(covuY.start))) imp[(i*nrow(X)+1):((i+1)*nrow(X)),1]=Ysubimp if ((!is.null(Y.con)&&ncol(Y.con)!=0)|(!is.null(Y.aux.con)&&ncol(Y.aux.con)!=0)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),2:(1+max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))]=Yimp2[,1:(max(0,ncol(Y.con))+max(0,ncol(Y.aux.con)))] } if (isnullcat==0|isnullcataux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolYcon[1]+2):(1+ncol(Y))]=Y.cat.tot } if ((!is.null(Y2.con)&&ncol(Y2.con)!=0)|(!is.null(Y2.aux.con)&&ncol(Y2.aux.con)!=0)) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncol(Y)+2):(ncol(Y)+max(0,ncol(Y2.con))+1+max(0,ncol(Y2.aux.con)))]=Y2imp2[,1:(max(0,ncol(Y2.con))+max(0,ncol(Y2.aux.con)))] } if (isnullcat2==0|isnullcat2aux==0) { imp[(i*nrow(X)+1):((i+1)*nrow(X)),(ncolY2con[1]+ncol(Y)+2):(ncol(Y)+ncY2+1)]=Y2.cat.tot } if (output>0) cat("Imputation number ", i, "registered", "\n") } cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) cnamy2comp<-c(colnamy2con, colnamy2auxcon, cny2catcomp, cny2auxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) if (!is.null(Y2)) { dimnames(beta2post)[1] <- list("(Intercept)") dimnames(beta2post)[2] <- list(cnamy2comp) } if (meth=="common") { dimnames(omegapost)[1] <- list(cnamycomp) } else { dimnames(omegapost)[1] <- list(paste(cnamycomp,rep(levels(factor(clus)),each=length(cnamycomp)), sep=".")) } dimnames(omegapost)[2] <- list(cnamycomp) colnamcovu<-c(cnamycomp,cnamy2comp) dimnames(covupost)[1] <- list(colnamcovu) dimnames(covupost)[2] <- list(colnamcovu) dimnames(upostall)[1]<-list(levels(factor(clus))) dimnames(upostall)[2]<-list(colnamcovu) betaYpostmean<-apply(betaYpost, c(1,2), mean) varYpostmean<-mean(varYpost) covuYpostmean<-apply(covuYpost, c(1,2), mean) uYpostmean<-apply(uYpostall, c(1,2), mean) betapostmean<-apply(betapost, c(1,2), mean) if (!is.null(Y2)) beta2postmean<-apply(beta2post, c(1,2), mean) upostmean<-apply(upostall, c(1,2), mean) omegapostmean<-apply(omegapost, c(1,2), mean) covupostmean<-apply(covupost, c(1,2), mean) colnames(betaYpostmean)<-rownames(summary(fit.cr)$coefficients) rownames(betaYpostmean)<-colnamysub colnames(covuYpostmean)<-rownames(covuYpostmean)<-colnames(uYpostmean)<-dimnames(summary(fit.cr)$varcor[[1]])[[1]] rownames(uYpostmean)<-levels(factor(clus)) if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) cat("The posterior mean of the substantive model random effects covariance matrix is:\n") print(covuYpostmean) cat("The posterior mean of the substantive model random effects estimates is:\n") print(uYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) if (!is.null(Y2)) { cat("The posterior mean of the level 2 fixed effects estimates is:\n") print(beta2postmean) } cat("The posterior mean of the random effects estimates is:\n") print(upostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) cat("The posterior mean of the level 2 covariance matrix is:\n") print(covupostmean) } } imp<-data.frame(imp) if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (isnullcat2==0) { for (i in 1:ncol(Y2.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+i)])<-previous_levels2[[i]] } } if (isnullcat2aux==0) { for (i in 1:ncol(Y2.aux.cat)) { imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)]<-as.factor(imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)]) levels(imp[,(1+ncol(Y)+ncolY2con[1]+ncolY2con[4]+i)])<-previous_levels2aux[[i]] } } imp[,(ncol(Y)+ncY2+2)]<-factor(imp[,(ncol(Y)+ncY2+2)]) levels(imp[,(ncol(Y)+ncY2+2)])<-previous_levels_clus clus<-factor(clus) levels(clus)<-previous_levels_clus if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (ncolY2con[1]>0) { for (j in 1:(ncolY2con[1])) { imp[,ncol(Y)+j+1]=as.numeric(imp[,ncol(Y)+j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (isnullcat2==0) { if (is.null(colnamy2cat)) colnamy2cat=paste("Y2cat", 1:ncol(Y2.cat), sep = "") } else { colnamy2cat=NULL Y2.cat=NULL Y2.numcat=NULL } if (isnullcat2aux==0) { if (is.null(colnamy2auxcat)) colnamy2auxcat=paste("Y2cat.aux", 1:ncol(Y2.aux.cat), sep = "") } else { colnamy2auxcat=NULL Y2.aux.cat=NULL Y2.aux.numcat=NULL } if (!is.null(Y2.con)) { if (is.null(colnamy2con)) colnamy2con=paste("Y2con", 1:ncol(Y2.con), sep = "") } else { colnamy2con=NULL } if (!is.null(Y2.aux.con)) { if (is.null(colnamy2auxcon)) colnamy2auxcon=paste("Y2con.aux", 1:ncol(Y2.aux.con), sep = "") } else { colnamy2auxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,colnamy2con,colnamy2auxcon,colnamy2cat,colnamy2auxcat,"clus","id","Imputation") return(imp) } jomo/R/jomo1cat.MCMCchain.R0000644000176200001440000001324214410253602014777 0ustar liggesusersjomo1cat.MCMCchain <- function(Y.cat, Y.numcat, X=NULL, beta.start=NULL, l1cov.start=NULL, l1cov.prior=NULL, start.imp=NULL, nburn=100, output=1, out.iter=10) { if (is.null(X)) X=matrix(1,nrow(Y.cat),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),((sum(Y.numcat)-length(Y.numcat)))) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } if (any(is.na(Y.cat))) { if (ncol(Y.cat)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y.cat, plot=F) miss.pat<-miss.pat[,colnames(Y.cat)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y.cat)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y.cat)) for (i in 1:nrow(Y.cat)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y.cat[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } stopifnot( nrow(beta.start)==ncol(X), ncol(beta.start)==((sum(Y.numcat)-length(Y.numcat))),nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(beta.start), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } nimp=1; colnamycat<-colnames(Y.cat) colnamx<-colnames(X) Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Y=cbind(Y.cat) Yi=cbind(matrix(0,nrow(Y.cat),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,h:(h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+2) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(X), (ncol(Y)+ncol(X)+1)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+1)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+2)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) { for (j in 1:ncol(Y.auxiliary)) { if (is.numeric(Y.auxiliary[,j])) { if (is.null(Y.aux.con)) Y.aux.con<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.con<-data.frame(Y.aux.con,Y.auxiliary[,j,drop=FALSE]) } if (is.factor(Y.auxiliary[,j])) { if (is.null(Y.aux.cat)) Y.aux.cat<-data.frame(Y.auxiliary[,j,drop=FALSE]) else Y.aux.cat<-data.frame(Y.aux.cat,Y.auxiliary[,j,drop=FALSE]) Y.aux.numcat<-cbind(Y.aux.numcat,nlevels(Y.auxiliary[,j])) } } } X=matrix(1,max(nrow(Y.cat),nrow(Y.con)),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),(max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) if (is.null(l1cov.start)) { l1cov.start=diag(1,ncol(beta.start)) } if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(l1cov.start)) ncolYcon<-rep(NA,4) ncolYcon[1]=max(as.numeric(!is.null(Y.con)),ncol(Y.con))+max(as.numeric(!is.null(Y.aux.con)),ncol(Y.aux.con)) ncolYcon[2]=max(as.numeric(!is.null(Y.con)),ncol(Y.con)) ncolYcon[3]=ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat))) ncolYcon[4]=max(0,ncol(Y.cat)) stopifnot(((!is.null(Y.con))||(!is.null(Y.cat)&!is.null(Y.numcat)))) if (!is.null(Y.cat)) { isnullcat=0 previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } } else { isnullcat=1 } if (!is.null(Y.aux.cat)) { isnullcataux=0 previous_levelsaux<-list() Y.aux.cat<-data.frame(Y.aux.cat) for (i in 1:ncol(Y.aux.cat)) { Y.aux.cat[,i]<-factor(Y.aux.cat[,i]) previous_levelsaux[[i]]<-levels(Y.aux.cat[,i]) levels(Y.aux.cat[,i])<-1:nlevels(Y.aux.cat[,i]) } } else { isnullcataux=1 } stopifnot(nrow(beta.start)==ncol(X), ncol(beta.start)==(ncolYcon[1]+max(0,(sum(Y.numcat)-length(Y.numcat)))+max(0,(sum(Y.aux.numcat)-length(Y.aux.numcat))))) stopifnot(nrow(l1cov.start)==ncol(l1cov.start),nrow(l1cov.prior)==nrow(l1cov.start),nrow(l1cov.start)==ncol(beta.start)) stopifnot(nrow(l1cov.prior)==ncol(l1cov.prior)) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } if (!is.null(Y.con)) { colnamycon<-colnames(Y.con) Y.con<-data.matrix(Y.con) storage.mode(Y.con) <- "numeric" } else { colnamycon<-NULL } if (isnullcat == 0) { colnamycat <- colnames(Y.cat) Y.cat <- data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (!is.null(Y.aux.con)) { colnamyauxcon<-colnames(Y.aux.con) Y.aux.con<-data.matrix(Y.aux.con) storage.mode(Y.aux.con) <- "numeric" } else { colnamyauxcon<-NULL } if (isnullcataux == 0) { colnamyauxcat <- colnames(Y.aux.cat) Y.aux.cat <- data.matrix(Y.aux.cat) storage.mode(Y.aux.cat) <- "numeric" cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } colnamx<-colnames(X) X<-data.matrix(X) storage.mode(X) <- "numeric" Y=cbind(Y.con,Y.aux.con,Y.cat, Y.aux.cat) Yi=cbind(Y.con, Y.aux.con, switch(is.null(Y.cat)+1, matrix(0,nrow(Y),(sum(Y.numcat)-length(Y.numcat))), NULL), switch(is.null(Y.aux.cat)+1, matrix(0,nrow(Y.aux.cat),(sum(Y.aux.numcat)-length(Y.aux.numcat))), NULL)) h=1 if (isnullcat==0) { for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } } if (isnullcataux==0) { for (i in 1:length(Y.aux.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.aux.cat[j,i])) { Yi[j,(ncolYcon[1]+h):(ncolYcon[1]+h+Y.aux.numcat[i]-2)]=NA } } h=h+Y.aux.numcat[i]-1 } } if (isnullcat==0||isnullcataux==0) { Y.cat.tot<-cbind(Y.cat,Y.aux.cat) Y.numcat.tot<-c(Y.numcat, Y.aux.numcat) } else { Y.cat.tot=-999 Y.numcat.tot=-999 } Ysubimp<-Ysub if (output==0) out.iter=nburn+2 nimp=1 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+3) imp[1:nrow(Y),1]=Ysub imp[1:nrow(Y),2:(1+ncol(Y))]=Y imp[1:nrow(X), (ncol(Y)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),(nburn))) betaYpost<- array(0, dim=c(1,length(betaY.start),(nburn))) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),(nburn))) varYpost<-rep(0,(nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) cat("First imputation registered.", "\n") cnamycomp<-c(colnamycon, colnamyauxcon, cnycatcomp, cnyauxcatcomp) dimnames(betapost)[1] <- list("(Intercept)") dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) betaYpostmean <- apply(betaYpost, c(1, 2), mean) varYpostmean <- mean(varYpost) betapostmean <- apply(betapost, c(1, 2), mean) omegapostmean <- apply(omegapost, c(1, 2), mean) colnames(betaYpostmean)<-names(fit.cr$coefficients) rownames(betaYpostmean)<-colnamysub if (output>0) { cat("The posterior mean of the substantive model fixed effects estimates is:\n") print(betaYpostmean) cat("The posterior mean of the substantive model residual variance is:\n") print(varYpostmean) if (output==2) { cat("The posterior mean of the fixed effects estimates is:\n") print(betapostmean) cat("The posterior mean of the level 1 covariance matrix is:\n") print(omegapostmean) } } imp<-data.frame(imp) if (isnullcat==0) { for (i in 1:ncol(Y.cat)) { imp[,(1+ncolYcon[1]+i)]<-as.factor(imp[,(1+ncolYcon[1]+i)]) levels(imp[,(1+ncolYcon[1]+i)])<-previous_levels[[i]] } } if (isnullcataux==0) { for (i in 1:ncol(Y.aux.cat)) { imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]<-as.factor(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)]) levels(imp[,(1+ncolYcon[1]+ncolYcon[4]+i)])<-previous_levelsaux[[i]] } } if (ncolYcon[1]>0) { for (j in 1:(ncolYcon[1])) { imp[,j+1]=as.numeric(imp[,j+1]) } } if (isnullcat==0) { if (is.null(colnamycat)) colnamycat=paste("Ycat", 1:ncol(Y.cat), sep = "") } else { colnamycat=NULL Y.cat=NULL Y.numcat=NULL } if (isnullcataux==0) { if (is.null(colnamyauxcat)) colnamyauxcat=paste("Ycat.aux", 1:ncol(Y.aux.cat), sep = "") } else { colnamyauxcat=NULL Y.aux.cat=NULL Y.aux.numcat=NULL } if (!is.null(Y.con)) { if (is.null(colnamycon)) colnamycon=paste("Ycon", 1:ncol(Y.con), sep = "") } else { colnamycon=NULL } if (!is.null(Y.aux.con)) { if (is.null(colnamyauxcon)) colnamyauxcon=paste("Ycon.aux", 1:ncol(Y.aux.con), sep = "") } else { colnamyauxcon=NULL } if (is.null(colnamysub)) colnamysub="Ysub" colnames(imp)<-c(colnamysub,colnamycon,colnamyauxcon,colnamycat,colnamyauxcat,"id","Imputation") if (isnullcat==0) { cnycatcomp<-rep(NA,(sum(Y.numcat)-length(Y.numcat))) count=0 for ( j in 1:ncol(Y.cat)) { for (k in 1:(Y.numcat[j]-1)) { cnycatcomp[count+k]<-paste(colnamycat[j],k,sep=".") } count=count+Y.numcat[j]-1 } } else { cnycatcomp<-NULL } if (isnullcataux==0) { cnyauxcatcomp<-rep(NA,(sum(Y.aux.numcat)-length(Y.aux.numcat))) count=0 for ( j in 1:ncol(Y.aux.cat)) { for (k in 1:(Y.aux.numcat[j]-1)) { cnyauxcatcomp[count+k]<-paste(colnamyauxcat[j],k,sep=".") } count=count+Y.aux.numcat[j]-1 } } else { cnyauxcatcomp<-NULL } cnamycomp<-c(colnamycon,colnamyauxcon,cnycatcomp,cnyauxcatcomp) dimnames(betapost)[1] <- list(colnamx) dimnames(betapost)[2] <- list(cnamycomp) dimnames(omegapost)[1] <- list(cnamycomp) dimnames(omegapost)[2] <- list(cnamycomp) dimnames(Yimp2)[2] <- list(cnamycomp) return(list("finimp"=imp,"collectbeta"=betapost,"collectomega"=omegapost, "finimp.latnorm" = Yimp2, "collectbetaY"=betaYpost, "collectvarY"=varYpost)) } jomo/R/jomo1rancat.MCMCchain.R0000644000176200001440000002071714410253602015505 0ustar liggesusersjomo1rancat.MCMCchain <- function(Y.cat, Y.numcat, X=NULL, Z=NULL, clus, beta.start=NULL, u.start=NULL, l1cov.start=NULL, l2cov.start=NULL, l1cov.prior=NULL, l2cov.prior=NULL, start.imp=NULL, nburn=1000, output=1, out.iter=10) { if (is.null(X)) X=matrix(1,nrow(Y.cat),1) if (is.null(Z)) Z=matrix(1,nrow(Y.cat),1) if (is.null(beta.start)) beta.start=matrix(0,ncol(X),((sum(Y.numcat)-length(Y.numcat)))) if (is.null(l1cov.start)) l1cov.start=diag(1,ncol(beta.start)) if (is.null(l1cov.prior)) l1cov.prior=diag(1,ncol(beta.start)) if (is_tibble(Y.cat)) { Y.cat<-data.frame(Y.cat) warning("tibbles not supported. Y.cat converted to standard data.frame. ") } if (is_tibble(X)) { X<-data.frame(X) warning("tibbles not supported. X converted to standard data.frame. ") } if (is_tibble(Z)) { Z<-data.frame(Z) warning("tibbles not supported. Z converted to standard data.frame. ") } clus<-factor(unlist(clus)) previous_levels_clus<-levels(clus) levels(clus)<-0:(nlevels(clus)-1) if (is.null(u.start)) u.start = matrix(0, nlevels(clus), ncol(Z) * ((sum(Y.numcat) - length(Y.numcat)))) if (is.null(l2cov.start)) l2cov.start = diag(1, ncol(u.start)) if (is.null(l2cov.prior)) l2cov.prior = diag(1, ncol(l2cov.start)) previous_levels<-list() Y.cat<-data.frame(Y.cat) for (i in 1:ncol(Y.cat)) { Y.cat[,i]<-factor(Y.cat[,i]) previous_levels[[i]]<-levels(Y.cat[,i]) levels(Y.cat[,i])<-1:nlevels(Y.cat[,i]) } if (any(is.na(Y.cat))) { if (ncol(Y.cat)==1) { miss.pat<-matrix(c(0,1),2,1) n.patterns<-2 } else { miss.pat<-md.pattern.mice(Y.cat, plot=F) miss.pat<-miss.pat[,colnames(Y.cat)] n.patterns<-nrow(miss.pat)-1 } } else { miss.pat<-matrix(0,2,ncol(Y.cat)) n.patterns<-nrow(miss.pat)-1 } miss.pat.id<-rep(0,nrow(Y.cat)) for (i in 1:nrow(Y.cat)) { k <- 1 flag <- 0 while ((k <= n.patterns) & (flag == 0)) { if (all(!is.na(Y.cat[i,])==miss.pat[k,1:(ncol(miss.pat))])) { miss.pat.id[i] <- k flag <- 1 } else { k <- k + 1 } } } for (i in 1:ncol(X)) { if (is.factor(X[,i])) X[,i]<-as.numeric(X[,i]) } for (i in 1:ncol(Z)) { if (is.factor(Z[,i])) Z[,i]<-as.numeric(Z[,i]) } stopifnot( nrow(beta.start)==ncol(X), ncol(beta.start)==((sum(Y.numcat)-length(Y.numcat))),nrow(l1cov.start)==ncol(l1cov.start), nrow(l1cov.start)==ncol(beta.start), nrow(l1cov.prior)==ncol(l1cov.prior),nrow(l1cov.prior)==nrow(l1cov.start),nrow(Z)==nrow(Y.cat), ncol(l2cov.start)==ncol(u.start), ncol(u.start)==ncol(Z)*((sum(Y.numcat)-length(Y.numcat)))) betait=matrix(0,nrow(beta.start),ncol(beta.start)) for (i in 1:nrow(beta.start)) { for (j in 1:ncol(beta.start)) betait[i,j]=beta.start[i,j] } covit=matrix(0,nrow(l1cov.start),ncol(l1cov.start)) for (i in 1:nrow(l1cov.start)) { for (j in 1:ncol(l1cov.start)) covit[i,j]=l1cov.start[i,j] } uit=matrix(0,nrow(u.start),ncol(u.start)) for (i in 1:nrow(u.start)) { for (j in 1:ncol(u.start)) uit[i,j]=u.start[i,j] } covuit=matrix(0,nrow(l2cov.start),ncol(l2cov.start)) for (i in 1:nrow(l2cov.start)) { for (j in 1:ncol(l2cov.start)) covuit[i,j]=l2cov.start[i,j] } nimp=1 colnamycat<-colnames(Y.cat) colnamx<-colnames(X) colnamz<-colnames(Z) Y.cat<-data.matrix(Y.cat) storage.mode(Y.cat) <- "numeric" X<-data.matrix(X) storage.mode(X) <- "numeric" stopifnot(!any(is.na(X))) Z<-data.matrix(Z) storage.mode(Z) <- "numeric" stopifnot(!any(is.na(Z))) clus <- matrix(as.integer(levels(clus))[clus], ncol=1) Y=cbind(Y.cat) Yi=cbind(matrix(0,nrow(Y.cat),(sum(Y.numcat)-length(Y.numcat)))) h=1 for (i in 1:length(Y.numcat)) { for (j in 1:nrow(Y)) { if (is.na(Y.cat[j,i])) { Yi[j,h:(h+Y.numcat[i]-2)]=NA } } h=h+Y.numcat[i]-1 } if (output!=1) out.iter=nburn+2 imp=matrix(0,nrow(Y)*(nimp+1),ncol(Y)+ncol(X)+ncol(Z)+3) imp[1:nrow(Y),1:ncol(Y)]=Y imp[1:nrow(X), (ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[1:nrow(Z), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[1:nrow(clus), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[1:nrow(X), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) Yimp=Yi Yimp2=matrix(Yimp, nrow(Yimp),ncol(Yimp)) imp[(nrow(X)+1):(2*nrow(X)),(ncol(Y)+1):(ncol(Y)+ncol(X))]=X imp[(nrow(Z)+1):(2*nrow(Z)), (ncol(Y)+ncol(X)+1):(ncol(Y)+ncol(X)+ncol(Z))]=Z imp[(nrow(clus)+1):(2*nrow(clus)), (ncol(Y)+ncol(X)+ncol(Z)+1)]=clus imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+2)]=c(1:nrow(Y)) imp[(nrow(X)+1):(2*nrow(X)), (ncol(Y)+ncol(X)+ncol(Z)+3)]=1 betapost<- array(0, dim=c(nrow(beta.start),ncol(beta.start),nburn)) omegapost<- array(0, dim=c(nrow(l1cov.start),ncol(l1cov.start),nburn)) upostall<-array(0, dim=c(nrow(u.start),ncol(u.start),nburn)) covupost<- array(0, dim=c(nrow(l2cov.start),ncol(l2cov.start),nburn)) meanobs<-colMeans(Yi,na.rm=TRUE) if (!is.null(start.imp)) { start.imp<-as.matrix(start.imp) if ((nrow(start.imp)!=nrow(Yimp2))||(ncol(Yimp2)>ncol(start.imp))) { cat("start.imp dimensions incorrect. Not using start.imp as starting value for the imputed dataset.\n") start.imp=NULL } else { if ((nrow(start.imp)==nrow(Yimp2))&(ncol(Yimp2)0) { cat("Found ", ncon, "continuous outcomes and no categorical. Using function jomo1rancon.", "\n") imp<-jomo1rancon(Y=Y.con, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output,out.iter=out.iter) } if (ncat>0 & ncon==0) { cat("Found ", ncat, "categorical outcomes and no continuous. Using function jomo1rancat.", "\n") imp<-jomo1rancat(Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output,out.iter=out.iter) } if (ncat>0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and ", ncat, "categorical. Using function jomo1ranmix.", "\n") imp<-jomo1ranmix(Y.con, Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, output=output,out.iter=out.iter) } } if (meth=="fixed") { if (ncat==0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and no categorical. Using function jomo1ranconhr with fixed cluster-specific covariance matrices.", "\n") imp<-jomo1ranconhr(Y=Y.con, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, a=0, meth="fixed", output=output,out.iter=out.iter) } if (ncat>0 & ncon==0) { cat("Found ", ncat, "categorical outcomes and no continuous. Using function jomo1rancathr with fixed cluster-specific covariance matrices.", "\n") imp<-jomo1rancathr(Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, a=0, meth="fixed",output=output,out.iter=out.iter) } if (ncat>0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and ", ncat, "categorical. Using function jomo1ranmixhr with fixed cluster-specific covariance matrices.", "\n") imp<-jomo1ranmixhr(Y.con, Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, a=0, meth="fixed", output=output,out.iter=out.iter) } } if (meth=="random") { if (ncat==0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and no categorical. Using function jomo1ranconhr with random cluster-specific covariance matrices.", "\n") imp<-jomo1ranconhr(Y=Y.con, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, a=a, a.prior=a.prior, meth="random", output=output,out.iter=out.iter) } if (ncat>0 & ncon==0) { cat("Found ", ncat, "categorical outcomes and no continuous. Using function jomo1rancathr with random cluster-specific covariance matrices.", "\n") imp<-jomo1rancathr(Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, a=a, a.prior=a.prior, meth="random",output=output,out.iter=out.iter) } if (ncat>0 & ncon>0) { cat("Found ", ncon, "continuous outcomes and ", ncat, "categorical. Using function jomo1ranmixhr with random cluster-specific covariance matrices.", "\n") imp<-jomo1ranmixhr(Y.con, Y.cat=Y.cat,Y.numcat=Y.numcat, X=X, Z=Z, clus=clus, beta.start=beta.start, u.start=u.start, l1cov.start=l1cov.start, l2cov.start=l2cov.start, l1cov.prior=l1cov.prior, l2cov.prior=l2cov.prior, nburn=nburn, nbetween=nbetween, nimp=nimp, a=a, a.prior=a.prior, meth="random", output=output,out.iter=out.iter) } } return(imp) } jomo/MD50000644000176200001440000001470514416467232011546 0ustar liggesusers64ebc0755fc3608a28df86c9dfe3c670 *DESCRIPTION bf46c503559ba3dc51a009773957a379 *NAMESPACE a2053b97f210d6107ee2cc9d5c773b9a *R/jomo.MCMCchain.R c2f46e88a1dc069511d3c5fe8bdc5f36 *R/jomo.R a15dc44d25d79175766797eaed7ffa46 *R/jomo.clmm.MCMCchain.R 224e721a8b0e3693888ccbf735730f5a *R/jomo.clmm.R e7ed5faec194a1ba6fd66ab7d27e8442 *R/jomo.coxph.MCMCchain.R 21832097cb5d2bc8bcbdd4fc26c235b0 *R/jomo.coxph.R a74a3ff15efaa36904658f11ddf3e336 *R/jomo.glm.MCMCchain.R 8e0df8b0fd0e01bcdd196d02f9a3d32f *R/jomo.glm.R 9a9fbb8a03d01b22fa2d87e1cf963988 *R/jomo.glmer.MCMCchain.R 062408663470667568abb96b11e21c0f *R/jomo.glmer.R 5c4307fb721d486231908dc57b9fbe95 *R/jomo.lm.MCMCchain.R c6d6f9878ebb0b432ebb8f265efedaf9 *R/jomo.lm.R 4a4ce48ab242c0a20115d8705c987cb8 *R/jomo.lmer.MCMCchain.R 15bea3859822147d123e45e6bde57f47 *R/jomo.lmer.R 787f9265078d1e00c3c6cc81bf6a2af7 *R/jomo.polr.MCMCchain.R 8dc8b7c7df66c60c543c77054cb16adf *R/jomo.polr.R 3b2b94c2411467f261ca9d98ba846a60 *R/jomo.smc.MCMCchain.R 780f49271ec70356e725d3848e6f6b1b *R/jomo.smc.R d30aedbc1a7e7eda47bea857655af367 *R/jomo1.MCMCchain.R 15547da4955e8d958537868718e62b89 *R/jomo1.R 83167c6b2ac088ef4ac925eeac95ab9a *R/jomo1cat.MCMCchain.R 6db5115e103d0f6e86c3e5d739253f27 *R/jomo1cat.R 19302f40b85a1d8f8271630decbb6761 *R/jomo1con.MCMCchain.R de319adbf42e509a3bcab9692ce453c4 *R/jomo1con.R 22fe32a69dba762d9cbeb073f3b8ad6a *R/jomo1mix.MCMCchain.R 992fd42bd94444a9c0b51280e1d7f73e *R/jomo1mix.R 2758cae4bc722c0f858e3f659eb77a19 *R/jomo1ran.MCMCchain.R 96f89411637125b7e00bf31cd548f311 *R/jomo1ran.R b7cfff2aff11fea53865bb57f0f66f0b *R/jomo1rancat.MCMCchain.R 4b6273d945060ee94dcedd9eaea62899 *R/jomo1rancat.R e833f66ba93983675d663d5b642bccc5 *R/jomo1rancathr.MCMCchain.R 0d97d3e121a2bc1b702152f7918e3904 *R/jomo1rancathr.R ed4f3b1e23ce315d9664f3b0b72936b7 *R/jomo1rancon.MCMCchain.R 5d44f47afa5c38bc933ee2dc03d30ad5 *R/jomo1rancon.R c4254efc6488bb13849b97afc8c99974 *R/jomo1ranconhr.MCMCchain.R d31145c23c1a320a4c06c40f31dfe1cb *R/jomo1ranconhr.R 055e8134d7c533fb521c0a92135367f6 *R/jomo1ranmix.MCMCchain.R 0796c6cf28606dd14bf0881154264573 *R/jomo1ranmix.R 414ee2d26bd9e52431b5e6b8802016a9 *R/jomo1ranmixhr.MCMCchain.R 91af5654445a1e8b6b16683df54bbb96 *R/jomo1ranmixhr.R 2a5f820146d1933c20d2183e8c184bee *R/jomo2.MCMCchain.R 76d69dad1e6bc7ff3cb0df6bb4c23124 *R/jomo2.R c3d7f5fcffe84d74ae9a10b4621f32c6 *R/jomo2com.MCMCchain.R 1b0eedb0c754b36f29340af6c5492635 *R/jomo2com.R 59e3e2607dd3519cc255d3fd26d5218e *R/jomo2hr.MCMCchain.R 38391b2a86867153ba083f1253be0a51 *R/jomo2hr.R 42a11220c0d00f2c6faf30757cbcebaf *R/md.pattern.mice.R 438bb5c3042f3e5328c066e499237049 *data/ExamScores.RData d841f005383a91f0dd079d0003b3de82 *data/JSPmiss.RData 15b5f7c3c2c6ce6b12535cc2271d3ae6 *data/cldata.RData 64cac254f049269b874232cb713d6e66 *data/sldata.RData a8171366d0e793e5e6cbebd8464fd368 *data/surdata.RData d3f029cdcfdb29608f041f6c6b012fb2 *data/tldata.RData 5b74a5536bc5a8c699ea40fc85dfa0c4 *inst/CITATION 94dc76e426f6b464c25b71200afb4aea *man/ExamScores.Rd 9b8065213719d6e57bd4f5c09af42145 *man/JSPmiss.Rd 0a0152d8a38447bbe2a608edc2876e34 *man/cldata.Rd da92a2f38f570f13444350bc2153faa8 *man/jomo.MCMCchain.Rd 4f3354f015ff0c07cf921fe4391b3c3a *man/jomo.Rd b996e5bfd6ac35cfe46164d34e43033c *man/jomo.clmm.MCMCchain.Rd 2feb0ab1c05503be377a95dd7673ab73 *man/jomo.clmm.Rd 894f57d16e1a937ad0993301dced3141 *man/jomo.coxph.MCMCchain.Rd 3f13ae48f94f40ccca5156e806945f29 *man/jomo.coxph.Rd dd891c48bfdd9064f7ef403b70a246fd *man/jomo.glm.MCMCchain.Rd 04703633714e933f89390ebfa35494ec *man/jomo.glm.Rd 3f9086a2a0c8ef0154761c1759fc9a8b *man/jomo.glmer.MCMCchain.Rd 6b19caa1375628a60b0ed984b27acd8b *man/jomo.glmer.Rd 1d2f61070221a39bdc25fbe235f1d168 *man/jomo.lm.MCMCchain.Rd 38b20d0b88dba9faba695f67a2e17c91 *man/jomo.lm.Rd 5fb739eec4822a2a2e9657f1dcbf19d5 *man/jomo.lmer.MCMCchain.Rd d503d04d47ffc4e00f5a86c3b29fb0e2 *man/jomo.lmer.Rd f284b425ba945840a08530293b2771bc *man/jomo.polr.MCMCchain.Rd aceb433cb457886d45d7ec4a6101e95d *man/jomo.polr.Rd a75d7ea5ea2ed98638045e1699d5e451 *man/jomo.smc.MCMCchain.Rd 3820a60b65d8566f2db484c1a9ce977f *man/jomo.smc.Rd 41265842f95cd2092b3151db4e7f73fa *man/jomo1.MCMCchain.Rd 6f8b71d965cdcd8783719fb90cf4830f *man/jomo1.Rd f6cc5017f429e7f3bf5e0941b6698802 *man/jomo1cat.MCMCchain.Rd 9851d9bfccb00b8909dae229601dfec5 *man/jomo1cat.Rd 2413080c2dcd913498f770d532d0bea8 *man/jomo1con.MCMCchain.Rd c9bf1f10169c0945c48d2507677a0590 *man/jomo1con.Rd c883e16fb91d2cc3ee164483e54a6bb9 *man/jomo1mix.MCMCchain.Rd 496abc660ce4ffbc01d4a74f08e55599 *man/jomo1mix.Rd d273962de4c2dd30e815bced23a7b1e8 *man/jomo1ran.MCMCchain.Rd faa417fca9e9d7fe4315dcb43f3ffecb *man/jomo1ran.Rd 1fc491dac54f0c069f2c98ea25d9fdc2 *man/jomo1rancat.MCMCchain.Rd 8eb55bebf4213d736952db7138e4eea2 *man/jomo1rancat.Rd 32ebc89e8377b483643eddd8c585797b *man/jomo1rancathr.MCMCchain.Rd 24aed07d904c7750ab01760a1285d98a *man/jomo1rancathr.Rd 0c770bd9b6724446207e6658d5fe8178 *man/jomo1rancon.MCMCchain.Rd 6281c4a73a58a3013503777e99a016e0 *man/jomo1rancon.Rd 3ff86bf5e0e13da8c1e95cc2b37d6392 *man/jomo1ranconhr.MCMCchain.Rd 2347833fda1692369c2ed415b4844adf *man/jomo1ranconhr.Rd 001af3db03f977b1e3c1d705670236ee *man/jomo1ranmix.MCMCchain.Rd dd192f542ba44fec12c2970a9e9691e0 *man/jomo1ranmix.Rd ee7cdb1dade7550179186e93318282ff *man/jomo1ranmixhr.MCMCchain.Rd cd902f2866201824639cedf2c36d0097 *man/jomo1ranmixhr.Rd ffe87151d2a3b67463bf565ace69e51e *man/jomo2.MCMCchain.Rd efaf2ded38f351ac2be15d4b5d5576a4 *man/jomo2.Rd 816449a604adc3ade3740515aafdff5b *man/jomo2com.MCMCchain.Rd c508eee869bcb1c24426739be14ee4e5 *man/jomo2com.Rd 1e5e958e6ca460437a6323a089e0a633 *man/jomo2hr.MCMCchain.Rd be9b772959014cfc795ab86aee39bfaa *man/jomo2hr.Rd fe6dbfee0281540c9ce5faaae7a1d317 *man/sldata.Rd cb185f4404a1a6448f4817bb663d2c2c *man/surdata.Rd 3cbdf87324f3179a2f53ea1da6df9ad4 *man/tldata.Rd 68b329da9893e34099c7d8ad5cb9c940 *src/Makevars 7cb3588588ab5cf95c307f446784418a *src/jomo1C.c d6ad45710303294a0b6f0e2aa1245207 *src/jomo1ranC.c dc6447335674d2ed35ae6372e449b8bc *src/jomo1ranhrC.c ce7d45e64b99d1335ff4c12e1ab88c73 *src/jomo1ranhrsmcC.c 194d1873791e2202f3755f2079dc1533 *src/jomo1ransmcC.c 36fb5d29496430493c0b8c2cdd778078 *src/jomo1smcC.c 40ba79f00f7e07c81a68cbeeeca5ef63 *src/jomo2comC.c 96f53a3867aa4ebf2401c2f825e04e4c *src/jomo2hrC.c 7b214511fa167ba9af3b5a14aa531fda *src/jomo2hrsmcC.c b0546c4f5c84f5ded584417007142560 *src/jomo2smcC.c bd4215e97d9a0b54134dd5902076d278 *src/jomo_init.c 52cc2287f553f2c67b842a6f4f4b9a0e *src/pdflib.c cddf9cdc24681ecca94825e07a6795c7 *src/pdflib.h def49cd41c9ad5a85ca5c0a6a0cfe25c *src/wishart.c d7f24ca0ea98bdb8ceb1dda75f22d984 *src/wishart.h jomo/inst/0000755000176200001440000000000014416212532012173 5ustar liggesusersjomo/inst/CITATION0000644000176200001440000000047514410312757013342 0ustar liggesusersbibentry(bibtype = "Manual", title = "{jomo}: A package for Multilevel Joint Modelling Multiple Imputation", author = c(person("Matteo", "Quartagno"), person("James", "Carpenter")), year = 2023, url = "https://CRAN.R-project.org/package=jomo")